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 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
|
||||||
match syntax with
|
| Jbuild -> is_valid_jbuild t
|
||||||
| Jbuild ->
|
| Dune -> is_valid_dune t
|
||||||
if is_valid_jbuild t then
|
|
||||||
t
|
let print ((A s) as t) syntax =
|
||||||
else
|
if is_valid t syntax then
|
||||||
invalid_argf "Dune atom '%s' cannot be printed" t
|
s
|
||||||
| Dune ->
|
else
|
||||||
if is_valid_dune t then
|
match syntax with
|
||||||
t
|
| Jbuild -> invalid_argf "atom '%s' cannot be printed in jbuild syntax" s
|
||||||
else
|
| Dune -> invalid_argf "atom '%s' cannot be in dune syntax" s
|
||||||
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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 '%'"}
|
||||||
|}]
|
|}]
|
||||||
|
|
|
@ -4,43 +4,58 @@ 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 () =
|
||||||
for len = 0 to 3 do
|
[ Usexp.Atom.Dune, Usexp.Lexer.token, (fun s -> Usexp.Atom.is_valid s Dune)
|
||||||
let s = Bytes.create len in
|
; Jbuild, Usexp.Lexer.jbuild_token, (fun s -> Usexp.Atom.is_valid s Jbuild)
|
||||||
for i = 0 to 1 lsl (len * 8) - 1 do
|
]
|
||||||
if len > 0 then Bytes.set s 0 (Char.chr ( i land 0xff));
|
|> List.iter ~f:(fun (syntax, lexer, validator) ->
|
||||||
if len > 1 then Bytes.set s 1 (Char.chr ((i lsr 4) land 0xff));
|
for len = 0 to 3 do
|
||||||
if len > 2 then Bytes.set s 2 (Char.chr ((i lsr 8) land 0xff));
|
let s = Bytes.create len in
|
||||||
let s = Bytes.unsafe_to_string s in
|
for i = 0 to 1 lsl (len * 8) - 1 do
|
||||||
let parser_recognizes_as_atom =
|
if len > 0 then Bytes.set s 0 (Char.chr ( i land 0xff));
|
||||||
match Usexp.parse_string ~fname:"" ~mode:Single s with
|
if len > 1 then Bytes.set s 1 (Char.chr ((i lsr 4) land 0xff));
|
||||||
| exception _ -> false
|
if len > 2 then Bytes.set s 2 (Char.chr ((i lsr 8) land 0xff));
|
||||||
| Atom (_, A s') -> s = s'
|
let s = Bytes.unsafe_to_string s in
|
||||||
| _ -> false
|
let parser_recognizes_as_atom =
|
||||||
in
|
match Usexp.parse_string ~lexer ~fname:"" ~mode:Single s with
|
||||||
let printed_as_atom =
|
| exception _ -> false
|
||||||
match Usexp.atom_or_quoted_string s with
|
| Atom (_, A s') -> s = s'
|
||||||
| Atom _ -> true
|
| _ -> false
|
||||||
| _ -> false
|
in
|
||||||
in
|
let printed_as_atom =
|
||||||
let valid_dune_atom = Usexp.Atom.is_valid_dune s in
|
match Usexp.atom_or_quoted_string s with
|
||||||
if valid_dune_atom <> parser_recognizes_as_atom then begin
|
| Atom _ -> true
|
||||||
Printf.eprintf
|
| _ -> false
|
||||||
"Usexp.Atom.is_valid error:\n\
|
in
|
||||||
- s = %S\n\
|
let valid_dune_atom = validator (Usexp.Atom.of_string s) in
|
||||||
- Usexp.Atom.is_valid s = %B\n\
|
if valid_dune_atom <> parser_recognizes_as_atom then begin
|
||||||
- parser_recognizes_as_atom = %B\n"
|
Printf.eprintf
|
||||||
s valid_dune_atom parser_recognizes_as_atom;
|
"Usexp.Atom.is_valid error:\n\
|
||||||
exit 1
|
- syntax = %s\n\
|
||||||
end;
|
- s = %S\n\
|
||||||
if printed_as_atom && not parser_recognizes_as_atom then begin
|
- Usexp.Atom.is_valid s = %B\n\
|
||||||
Printf.eprintf
|
- parser_recognizes_as_atom = %B\n"
|
||||||
"Usexp.Atom.atom_or_quoted_string error:\n\
|
(string_of_syntax syntax) s valid_dune_atom
|
||||||
- s = %S\n\
|
parser_recognizes_as_atom;
|
||||||
- printed_as_atom = %B\n\
|
exit 1
|
||||||
- parser_recognizes_as_atom = %B\n"
|
end;
|
||||||
s printed_as_atom parser_recognizes_as_atom;
|
if printed_as_atom && not parser_recognizes_as_atom then begin
|
||||||
exit 1
|
Printf.eprintf
|
||||||
end
|
"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"
|
||||||
|
(string_of_syntax syntax) s printed_as_atom
|
||||||
|
parser_recognizes_as_atom;
|
||||||
|
exit 1
|
||||||
|
end
|
||||||
|
done
|
||||||
done
|
done
|
||||||
done
|
)
|
||||||
|
|
Loading…
Reference in New Issue