From 7d2c7d95795e981403a4d5e837ce6e696e4aace2 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 20 Jun 2018 15:54:52 +0630 Subject: [PATCH] Parameterize sexp_tests on dune and jbuild syntax Signed-off-by: Rudi Grinberg --- src/usexp/atom.ml | 23 +++++---- src/usexp/atom.mli | 1 + src/usexp/usexp.mli | 2 +- test/unit-tests/sexp.mlt | 8 +-- test/unit-tests/sexp_tests.ml | 91 ++++++++++++++++++++--------------- 5 files changed, 70 insertions(+), 55 deletions(-) diff --git a/src/usexp/atom.ml b/src/usexp/atom.ml index 80c24213..307857ce 100644 --- a/src/usexp/atom.ml +++ b/src/usexp/atom.ml @@ -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 = - 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 +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 -> 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) diff --git a/src/usexp/atom.mli b/src/usexp/atom.mli index 3922f43c..9b63bc49 100644 --- a/src/usexp/atom.mli +++ b/src/usexp/atom.mli @@ -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 diff --git a/src/usexp/usexp.mli b/src/usexp/usexp.mli index 12b05e76..ec79fb5a 100644 --- a/src/usexp/usexp.mli +++ b/src/usexp/usexp.mli @@ -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 diff --git a/test/unit-tests/sexp.mlt b/test/unit-tests/sexp.mlt index 880f372b..8b521688 100644 --- a/test/unit-tests/sexp.mlt +++ b/test/unit-tests/sexp.mlt @@ -145,7 +145,7 @@ parse {|\%{foo}|} Different {jbuild = Ok - []; + []; dune = Error "Invalid atom character '%'"} |}] @@ -160,7 +160,7 @@ parse {|\$bar%foo%|} Different {jbuild = Ok - []; + []; dune = Error "Invalid atom character '%'"} |}] @@ -170,7 +170,7 @@ parse {|\$bar\%foo%|} Different {jbuild = Ok - []; + []; dune = Error "Invalid atom character '%'"} |}] @@ -180,6 +180,6 @@ parse {|\$bar\%foo%{bar}|} Different {jbuild = Ok - []; + []; dune = Error "Invalid atom character '%'"} |}] diff --git a/test/unit-tests/sexp_tests.ml b/test/unit-tests/sexp_tests.ml index 2d733007..adec99fe 100644 --- a/test/unit-tests/sexp_tests.ml +++ b/test/unit-tests/sexp_tests.ml @@ -4,43 +4,58 @@ 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 () = - for len = 0 to 3 do - let s = Bytes.create len in - for i = 0 to 1 lsl (len * 8) - 1 do - if len > 0 then Bytes.set s 0 (Char.chr ( i land 0xff)); - if len > 1 then Bytes.set s 1 (Char.chr ((i lsr 4) 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 parser_recognizes_as_atom = - match Usexp.parse_string ~fname:"" ~mode:Single s with - | exception _ -> false - | Atom (_, A s') -> s = s' - | _ -> false - in - let printed_as_atom = - match Usexp.atom_or_quoted_string s with - | Atom _ -> true - | _ -> false - in - let valid_dune_atom = Usexp.Atom.is_valid_dune s in - if valid_dune_atom <> parser_recognizes_as_atom then begin - Printf.eprintf - "Usexp.Atom.is_valid error:\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; - exit 1 - end; - if printed_as_atom && not parser_recognizes_as_atom then begin - Printf.eprintf - "Usexp.Atom.atom_or_quoted_string error:\n\ - - s = %S\n\ - - printed_as_atom = %B\n\ - - parser_recognizes_as_atom = %B\n" - s printed_as_atom parser_recognizes_as_atom; - exit 1 - end + [ 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 + if len > 0 then Bytes.set s 0 (Char.chr ( i land 0xff)); + if len > 1 then Bytes.set s 1 (Char.chr ((i lsr 4) 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 parser_recognizes_as_atom = + match Usexp.parse_string ~lexer ~fname:"" ~mode:Single s with + | exception _ -> false + | Atom (_, A s') -> s = s' + | _ -> false + in + let printed_as_atom = + match Usexp.atom_or_quoted_string s with + | Atom _ -> true + | _ -> false + 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" + (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" + (string_of_syntax syntax) s printed_as_atom + parser_recognizes_as_atom; + exit 1 + end + done done - done + )