Parameterize sexp_tests on dune and jbuild syntax
Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
parent
8a87b5b5bf
commit
7d2c7d9579
|
@ -31,18 +31,17 @@ let is_valid_jbuild str =
|
|||
let of_string s = A 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
|
||||
| Jbuild ->
|
||||
if is_valid_jbuild t then
|
||||
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
|
||||
| Jbuild -> invalid_argf "atom '%s' cannot be printed in jbuild syntax" s
|
||||
| Dune -> invalid_argf "atom '%s' cannot be in dune syntax" s
|
||||
|
||||
let of_int i = of_string (string_of_int i)
|
||||
let of_float x = of_string (string_of_float x)
|
||||
|
|
|
@ -3,6 +3,7 @@ type t = private A of string [@@unboxed]
|
|||
type syntax = Jbuild | Dune
|
||||
|
||||
val is_valid_dune : string -> bool
|
||||
val is_valid : t -> syntax -> bool
|
||||
|
||||
val of_string : string -> t
|
||||
val to_string : t -> string
|
||||
|
|
|
@ -9,7 +9,7 @@ module Atom : sig
|
|||
|
||||
type syntax = Jbuild | Dune
|
||||
|
||||
val is_valid_dune : string -> bool
|
||||
val is_valid : t -> syntax -> bool
|
||||
|
||||
val of_string : string -> t
|
||||
val to_string : t -> string
|
||||
|
|
|
@ -145,7 +145,7 @@ parse {|\%{foo}|}
|
|||
Different
|
||||
{jbuild =
|
||||
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 '%'"}
|
||||
|}]
|
||||
|
||||
|
@ -160,7 +160,7 @@ parse {|\$bar%foo%|}
|
|||
Different
|
||||
{jbuild =
|
||||
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 '%'"}
|
||||
|}]
|
||||
|
||||
|
@ -170,7 +170,7 @@ parse {|\$bar\%foo%|}
|
|||
Different
|
||||
{jbuild =
|
||||
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 '%'"}
|
||||
|}]
|
||||
|
||||
|
@ -180,6 +180,6 @@ parse {|\$bar\%foo%{bar}|}
|
|||
Different
|
||||
{jbuild =
|
||||
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 '%'"}
|
||||
|}]
|
||||
|
|
|
@ -4,7 +4,17 @@ let () = Printexc.record_backtrace true
|
|||
|
||||
(* Test that all strings of length <= 3 such that [Usexp.Atom.is_valid
|
||||
s] are recignized as atoms by the parser *)
|
||||
|
||||
let string_of_syntax (x : Usexp.Atom.syntax) =
|
||||
match x with
|
||||
| Dune -> "dune"
|
||||
| Jbuild -> "jbuild"
|
||||
|
||||
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
|
||||
let s = Bytes.create len in
|
||||
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));
|
||||
let s = Bytes.unsafe_to_string s in
|
||||
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
|
||||
| Atom (_, A s') -> s = s'
|
||||
| _ -> false
|
||||
|
@ -23,24 +33,29 @@ let () =
|
|||
| Atom _ -> true
|
||||
| _ -> false
|
||||
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
|
||||
Printf.eprintf
|
||||
"Usexp.Atom.is_valid error:\n\
|
||||
- syntax = %s\n\
|
||||
- s = %S\n\
|
||||
- Usexp.Atom.is_valid s = %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
|
||||
end;
|
||||
if printed_as_atom && not parser_recognizes_as_atom then begin
|
||||
Printf.eprintf
|
||||
"Usexp.Atom.atom_or_quoted_string error:\n\
|
||||
- syntax = %s\n\
|
||||
- s = %S\n\
|
||||
- printed_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
|
||||
end
|
||||
done
|
||||
done
|
||||
)
|
||||
|
|
Loading…
Reference in New Issue