From f39b302a8d36357f1008f3ffb1e1bb7fcb56add0 Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <rudi.grinberg@gmail.com>
Date: Sat, 17 Mar 2018 02:33:25 +0800
Subject: [PATCH] Fix Atom definition of Usexp

Fix the is_valid function to only validate atoms that don't contain spaces,
parens, comment characters.
---
 src/usexp/usexp.ml                            | 23 ++++++++++---------
 src/usexp/usexp.mli                           |  4 ++--
 .../test-cases/inline_tests/run.t             |  6 ++---
 3 files changed, 17 insertions(+), 16 deletions(-)

diff --git a/src/usexp/usexp.ml b/src/usexp/usexp.ml
index dd460cb6..5fd0880e 100644
--- a/src/usexp/usexp.ml
+++ b/src/usexp/usexp.ml
@@ -15,17 +15,18 @@ module A = Parser_automaton_internal
 module Atom = struct
  type t = Sexp_ast.atom = A of string [@@unboxed]
 
-  let is_valid s =
-    if s = "" then false
-    else
-      try
-        for i = 0 to String.length s - 1 do
-          match String.unsafe_get s i with
-          | ' ' .. '~' -> ()
-          | _ -> raise Exit
-        done;
-        true
-      with Exit -> false
+ let is_valid str =
+   let len = String.length str in
+   len = 0 ||
+   let rec loop ix =
+     match str.[ix] with
+     | '"' | '(' | ')' | ';' | '\\' -> true
+     | '|' -> ix > 0 && let next = ix - 1 in Char.equal str.[next] '#' || loop next
+     | '#' -> ix > 0 && let next = ix - 1 in Char.equal str.[next] '|' || loop next
+     | '\000' .. '\032' | '\127' .. '\255' -> true
+     | _ -> ix > 0 && loop (ix - 1)
+   in
+   not (loop (len - 1))
 
  (* XXX eventually we want to report a nice error message to the user
      at the point the conversion is made. *)
diff --git a/src/usexp/usexp.mli b/src/usexp/usexp.mli
index 5fae18b0..5fa3a242 100644
--- a/src/usexp/usexp.mli
+++ b/src/usexp/usexp.mli
@@ -2,8 +2,8 @@
 
 module Atom : sig
   type t = private A of string [@@unboxed]
-  (** Acceptable atoms are composed of chars in the range [' ' .. '~']
-     and must be nonempty. *)
+  (** Acceptable atoms are composed of chars in the range ['!' .. '~'] excluding
+      [' ' '"' '(' ')' ';' '\\'], and must be nonempty. *)
 
   val is_valid : string -> bool
   (** [is_valid s] checks that [s] respects the constraints to be an atom. *)
diff --git a/test/blackbox-tests/test-cases/inline_tests/run.t b/test/blackbox-tests/test-cases/inline_tests/run.t
index bcb6814f..b4d71e9d 100644
--- a/test/blackbox-tests/test-cases/inline_tests/run.t
+++ b/test/blackbox-tests/test-cases/inline_tests/run.t
@@ -35,11 +35,11 @@
         -))
       (generate_runner
        ((progn
-         (echo let () = print_int 41)
+         (echo "let () = print_int 41")
          (echo "\n")
-         (echo let () = print_int 42)
+         (echo "let () = print_int 42")
          (echo "\n")
-         (echo let () = print_int 43;;))))
+         (echo "let () = print_int 43;;"))))
       (extends ())))))
            run alias dune-file/runtest
   414243