Parameterize sexp_tests on dune and jbuild syntax

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>

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)

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

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

test/unit-tests/sexp.mlt

@@ -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 '%'"}
 |}]

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
+  )