Parameterize sexp_tests on dune and jbuild syntax

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
Rudi Grinberg 2018-06-20 15:54:52 +06:30
parent 8a87b5b5bf
commit 7d2c7d9579
5 changed files with 70 additions and 55 deletions

View File

@ -31,18 +31,17 @@ let is_valid_jbuild str =
let of_string s = A s let of_string s = A s
let to_string (A s) = s let to_string (A s) = s
let print (A t) syntax = let is_valid (A t) = function
| Jbuild -> is_valid_jbuild t
| Dune -> is_valid_dune t
let print ((A s) as t) syntax =
if is_valid t syntax then
s
else
match syntax with match syntax with
| Jbuild -> | Jbuild -> invalid_argf "atom '%s' cannot be printed in jbuild syntax" s
if is_valid_jbuild t then | Dune -> invalid_argf "atom '%s' cannot be in dune syntax" s
t
else
invalid_argf "Dune atom '%s' cannot be printed" t
| Dune ->
if is_valid_dune t then
t
else
invalid_argf "Jbuild atom '%s' cannot be printed" t
let of_int i = of_string (string_of_int i) let of_int i = of_string (string_of_int i)
let of_float x = of_string (string_of_float x) let of_float x = of_string (string_of_float x)

View File

@ -3,6 +3,7 @@ type t = private A of string [@@unboxed]
type syntax = Jbuild | Dune type syntax = Jbuild | Dune
val is_valid_dune : string -> bool val is_valid_dune : string -> bool
val is_valid : t -> syntax -> bool
val of_string : string -> t val of_string : string -> t
val to_string : t -> string val to_string : t -> string

View File

@ -9,7 +9,7 @@ module Atom : sig
type syntax = Jbuild | Dune type syntax = Jbuild | Dune
val is_valid_dune : string -> bool val is_valid : t -> syntax -> bool
val of_string : string -> t val of_string : string -> t
val to_string : t -> string val to_string : t -> string

View File

@ -145,7 +145,7 @@ parse {|\%{foo}|}
Different Different
{jbuild = {jbuild =
Ok Ok
[<printer pp_sexp_ast raised an exception: Invalid_argument("Jbuild atom '\\%{foo}' cannot be printed")>]; [<printer pp_sexp_ast raised an exception: Invalid_argument("atom '\\%{foo}' cannot be in dune syntax")>];
dune = Error "Invalid atom character '%'"} dune = Error "Invalid atom character '%'"}
|}] |}]
@ -160,7 +160,7 @@ parse {|\$bar%foo%|}
Different Different
{jbuild = {jbuild =
Ok Ok
[<printer pp_sexp_ast raised an exception: Invalid_argument("Jbuild atom '\\$bar%foo%' cannot be printed")>]; [<printer pp_sexp_ast raised an exception: Invalid_argument("atom '\\$bar%foo%' cannot be in dune syntax")>];
dune = Error "Invalid atom character '%'"} dune = Error "Invalid atom character '%'"}
|}] |}]
@ -170,7 +170,7 @@ parse {|\$bar\%foo%|}
Different Different
{jbuild = {jbuild =
Ok Ok
[<printer pp_sexp_ast raised an exception: Invalid_argument("Jbuild atom '\\$bar\\%foo%' cannot be printed")>]; [<printer pp_sexp_ast raised an exception: Invalid_argument("atom '\\$bar\\%foo%' cannot be in dune syntax")>];
dune = Error "Invalid atom character '%'"} dune = Error "Invalid atom character '%'"}
|}] |}]
@ -180,6 +180,6 @@ parse {|\$bar\%foo%{bar}|}
Different Different
{jbuild = {jbuild =
Ok Ok
[<printer pp_sexp_ast raised an exception: Invalid_argument("Jbuild atom '\\$bar\\%foo%{bar}' cannot be printed")>]; [<printer pp_sexp_ast raised an exception: Invalid_argument("atom '\\$bar\\%foo%{bar}' cannot be in dune syntax")>];
dune = Error "Invalid atom character '%'"} dune = Error "Invalid atom character '%'"}
|}] |}]

View File

@ -4,7 +4,17 @@ let () = Printexc.record_backtrace true
(* Test that all strings of length <= 3 such that [Usexp.Atom.is_valid (* Test that all strings of length <= 3 such that [Usexp.Atom.is_valid
s] are recignized as atoms by the parser *) s] are recignized as atoms by the parser *)
let string_of_syntax (x : Usexp.Atom.syntax) =
match x with
| Dune -> "dune"
| Jbuild -> "jbuild"
let () = let () =
[ Usexp.Atom.Dune, Usexp.Lexer.token, (fun s -> Usexp.Atom.is_valid s Dune)
; Jbuild, Usexp.Lexer.jbuild_token, (fun s -> Usexp.Atom.is_valid s Jbuild)
]
|> List.iter ~f:(fun (syntax, lexer, validator) ->
for len = 0 to 3 do for len = 0 to 3 do
let s = Bytes.create len in let s = Bytes.create len in
for i = 0 to 1 lsl (len * 8) - 1 do for i = 0 to 1 lsl (len * 8) - 1 do
@ -13,7 +23,7 @@ let () =
if len > 2 then Bytes.set s 2 (Char.chr ((i lsr 8) land 0xff)); if len > 2 then Bytes.set s 2 (Char.chr ((i lsr 8) land 0xff));
let s = Bytes.unsafe_to_string s in let s = Bytes.unsafe_to_string s in
let parser_recognizes_as_atom = let parser_recognizes_as_atom =
match Usexp.parse_string ~fname:"" ~mode:Single s with match Usexp.parse_string ~lexer ~fname:"" ~mode:Single s with
| exception _ -> false | exception _ -> false
| Atom (_, A s') -> s = s' | Atom (_, A s') -> s = s'
| _ -> false | _ -> false
@ -23,24 +33,29 @@ let () =
| Atom _ -> true | Atom _ -> true
| _ -> false | _ -> false
in in
let valid_dune_atom = Usexp.Atom.is_valid_dune s in let valid_dune_atom = validator (Usexp.Atom.of_string s) in
if valid_dune_atom <> parser_recognizes_as_atom then begin if valid_dune_atom <> parser_recognizes_as_atom then begin
Printf.eprintf Printf.eprintf
"Usexp.Atom.is_valid error:\n\ "Usexp.Atom.is_valid error:\n\
- syntax = %s\n\
- s = %S\n\ - s = %S\n\
- Usexp.Atom.is_valid s = %B\n\ - Usexp.Atom.is_valid s = %B\n\
- parser_recognizes_as_atom = %B\n" - parser_recognizes_as_atom = %B\n"
s valid_dune_atom parser_recognizes_as_atom; (string_of_syntax syntax) s valid_dune_atom
parser_recognizes_as_atom;
exit 1 exit 1
end; end;
if printed_as_atom && not parser_recognizes_as_atom then begin if printed_as_atom && not parser_recognizes_as_atom then begin
Printf.eprintf Printf.eprintf
"Usexp.Atom.atom_or_quoted_string error:\n\ "Usexp.Atom.atom_or_quoted_string error:\n\
- syntax = %s\n\
- s = %S\n\ - s = %S\n\
- printed_as_atom = %B\n\ - printed_as_atom = %B\n\
- parser_recognizes_as_atom = %B\n" - parser_recognizes_as_atom = %B\n"
s printed_as_atom parser_recognizes_as_atom; (string_of_syntax syntax) s printed_as_atom
parser_recognizes_as_atom;
exit 1 exit 1
end end
done done
done done
)