Check for syntax errors in test scripts instead of ignoring them. (#12194)

check that anything that starts with `(* TEST` is indeed a test script

3 files changed, 18 insertions, 21 deletions

diff --git a/ocamltest/main.ml b/ocamltest/main.ml
index dccbb426fc..ae49bacd09 100644
--- a/ocamltest/main.ml
+++ b/ocamltest/main.ml
@@ -22,22 +22,6 @@ type behavior =
   | Skip_all_tests
   | Run of Environments.t
 
-(*
-let first_token filename =
-  let input_channel = open_in filename in
-  let lexbuf = Lexing.from_channel input_channel in
-  Location.init lexbuf filename;
-  let token =
-    try Tsl_lexer.token lexbuf with e -> close_in input_channel; raise e
-  in close_in input_channel; token
-
-let is_test filename =
-  match first_token filename with
-    | exception _ -> false
-    | Tsl_parser.TSL_BEGIN_C_STYLE | TSL_BEGIN_OCAML_STYLE -> true
-    | _ -> false
-*)
-
 (* this primitive announce should be used for tests
    that were aborted on system error before ocamltest
    could parse them *)
@@ -221,10 +205,12 @@ let test_file test_filename =
     Printf.eprintf "Wall clock: %s took %.02fs\n%!"
                    test_filename wall_clock_duration
 
-let is_test s =
-  match tsl_block_of_file s with
-  | _ -> true
-  | exception _ -> false
+let is_test filename =
+  let input_channel = open_in filename in
+  let lexbuf = Lexing.from_channel input_channel in
+  Fun.protect ~finally:(fun () -> close_in input_channel) begin fun () ->
+    Tsl_lexer.is_test lexbuf
+  end
 
 let ignored s =
   s = "" || s.[0] = '_' || s.[0] = '.'
diff --git a/ocamltest/tsl_lexer.mli b/ocamltest/tsl_lexer.mli
index b25e9f8565..82a355f327 100644
--- a/ocamltest/tsl_lexer.mli
+++ b/ocamltest/tsl_lexer.mli
@@ -16,5 +16,6 @@
 (* Interface to the Tsl_lexer module *)
 
 val token : Lexing.lexbuf -> Tsl_parser.token
+val is_test : Lexing.lexbuf -> bool
 val modifier :
     Lexing.lexbuf -> string * [`Remove | `Add of string | `Append of string]
diff --git a/ocamltest/tsl_lexer.mll b/ocamltest/tsl_lexer.mll
index 8ec1674a26..2c40753747 100644
--- a/ocamltest/tsl_lexer.mll
+++ b/ocamltest/tsl_lexer.mll
@@ -30,7 +30,17 @@ let blank = [' ' '\009' '\012']
 let identchar = ['A'-'Z' 'a'-'z' '_' '.' '-' '\'' '0'-'9']
 let num = ['0'-'9']
 
-rule token = parse
+rule is_test = parse
+  | blank * { is_test lexbuf }
+  | newline { Lexing.new_line lexbuf; is_test lexbuf }
+  | "/*" blank* "TEST" { true }
+  | "/*" blank* "TEST_BELOW" { true }
+  | "(*" blank* "TEST" { true }
+  | "(*" blank* "TEST_BELOW" { true }
+  | _ { false }
+  | eof { false }
+
+and token = parse
   | blank * { token lexbuf }
   | newline { Lexing.new_line lexbuf; token lexbuf }
   | "/*" blank* "TEST" { TSL_BEGIN_C_STYLE }