Harden ocamltest against errors in scripts and hooks

ocamltest/.depend

@@ -1,22 +1,21 @@
 run_unix.$(O): run_unix.c run.h ../runtime/caml/misc.h \
- ../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \
- run_common.h
+  ../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \
+  run_common.h
 run_stubs.$(O): run_stubs.c run.h ../runtime/caml/misc.h \
- ../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \
- ../runtime/caml/mlvalues.h ../runtime/caml/misc.h \
- ../runtime/caml/memory.h ../runtime/caml/gc.h ../runtime/caml/mlvalues.h \
- ../runtime/caml/major_gc.h ../runtime/caml/freelist.h \
- ../runtime/caml/minor_gc.h ../runtime/caml/address_class.h \
- ../runtime/caml/io.h ../runtime/caml/osdeps.h ../runtime/caml/memory.h
+  ../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \
+  ../runtime/caml/mlvalues.h ../runtime/caml/memory.h \
+  ../runtime/caml/gc.h ../runtime/caml/major_gc.h \
+  ../runtime/caml/freelist.h ../runtime/caml/minor_gc.h \
+  ../runtime/caml/address_class.h ../runtime/caml/io.h \
+  ../runtime/caml/osdeps.h
 ocamltest_stdlib_stubs.$(O): ocamltest_stdlib_stubs.c \
- ../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \
- ../runtime/caml/mlvalues.h ../runtime/caml/config.h \
- ../runtime/caml/misc.h ../runtime/caml/memory.h ../runtime/caml/gc.h \
- ../runtime/caml/mlvalues.h ../runtime/caml/major_gc.h \
- ../runtime/caml/freelist.h ../runtime/caml/minor_gc.h \
- ../runtime/caml/address_class.h ../runtime/caml/alloc.h \
- ../runtime/caml/signals.h ../runtime/caml/osdeps.h \
- ../runtime/caml/memory.h
+  ../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \
+  ../runtime/caml/mlvalues.h ../runtime/caml/misc.h \
+  ../runtime/caml/memory.h ../runtime/caml/gc.h \
+  ../runtime/caml/major_gc.h ../runtime/caml/freelist.h \
+  ../runtime/caml/minor_gc.h ../runtime/caml/address_class.h \
+  ../runtime/caml/alloc.h ../runtime/caml/signals.h \
+  ../runtime/caml/osdeps.h
 actions.cmo : \
     result.cmi \
     environments.cmi \
@@ -83,10 +82,12 @@ builtin_variables.cmi : \
     variables.cmi
 environments.cmo : \
     variables.cmi \
+    tsl_lexer.cmi \
     ocamltest_stdlib.cmi \
     environments.cmi
 environments.cmx : \
     variables.cmx \
+    tsl_lexer.cmx \
     ocamltest_stdlib.cmx \
     environments.cmi
 environments.cmi : \

ocamltest/Makefile

@@ -96,13 +96,13 @@ core := \
   run_command.mli run_command.ml \
   filecompare.mli filecompare.ml \
   variables.mli variables.ml \
-  environments.mli environments.ml \
   result.mli result.ml \
   actions.mli actions.ml \
   tests.mli tests.ml \
   tsl_ast.mli tsl_ast.ml \
   tsl_parser.mly \
   tsl_lexer.mli tsl_lexer.mll \
+  environments.mli environments.ml \
   tsl_semantics.mli tsl_semantics.ml \
   builtin_variables.mli builtin_variables.ml \
   actions_helpers.mli actions_helpers.ml \

ocamltest/actions_helpers.ml

@@ -205,9 +205,17 @@ let run_script log env =
     log scriptenv in
   let final_value =
     if Result.is_pass result then begin
-      let modifiers = Environments.modifiers_of_file response_file in
-      let modified_env = Environments.apply_modifiers newenv modifiers in
-      (result, modified_env)
+      match Environments.modifiers_of_file response_file with
+      | modifiers ->
+        let modified_env = Environments.apply_modifiers newenv modifiers in
+        (result, modified_env)
+      | exception Failure reason ->
+        (Result.fail_with_reason reason, newenv)
+      | exception Variables.No_such_variable name ->
+        let reason =
+          Printf.sprintf "error in script response: unknown variable %s" name
+        in
+        (Result.fail_with_reason reason, newenv)
     end else begin
       let reason = String.trim (Sys.string_of_file response_file) in
       let newresult = { result with Result.reason = Some reason } in
@@ -240,9 +248,18 @@ let run_hook hook_name log input_env =
   } in let exit_status = run settings in
   let final_value = match exit_status with
     | 0 ->
-      let modifiers = Environments.modifiers_of_file response_file in
-      let modified_env = Environments.apply_modifiers hookenv modifiers in
-      (Result.pass, modified_env)
+      begin match Environments.modifiers_of_file response_file with
+      | modifiers ->
+        let modified_env = Environments.apply_modifiers hookenv modifiers in
+        (Result.pass, modified_env)
+      | exception Failure reason ->
+        (Result.fail_with_reason reason, hookenv)
+      | exception Variables.No_such_variable name ->
+        let reason =
+          Printf.sprintf "error in script response: unknown variable %s" name
+        in
+        (Result.fail_with_reason reason, hookenv)
+      end
     | _ ->
       Printf.fprintf log "Hook returned %d" exit_status;
       let reason = String.trim (Sys.string_of_file response_file) in

ocamltest/environments.ml

@@ -144,36 +144,17 @@ and apply_modifiers environment modifiers =
   List.fold_left apply_modifier environment modifiers
 
 let modifier_of_string str =
-  let invalid_argument = (Invalid_argument "modifier_of_string") in
-  if str="" then raise invalid_argument else begin
-    let l = String.length str in
-    if str.[0] = '-' then begin
-      let variable_name = String.sub str 1 (l-1) in
-      match Variables.find_variable variable_name with
-        | None -> raise (Variables.No_such_variable variable_name)
-        | Some variable -> Remove variable
-    end else begin match String.index_opt str '=' with
-      | None -> raise invalid_argument
-      | Some pos_eq -> if pos_eq <= 0 then raise invalid_argument else
-        let (append, varname_length) =
-        (match String.index_opt str '+' with
-        | None -> (false, pos_eq)
-        | Some pos_plus ->
-          if pos_plus = pos_eq-1
-          then (true, pos_plus)
-          else raise invalid_argument) in
-        let variable_name = String.sub str 0 varname_length in
-        match Variables.find_variable variable_name with
-          | None -> raise (Variables.No_such_variable variable_name)
-          | Some variable ->
-            if pos_eq >= l-2 || str.[pos_eq+1]<>'"' || str.[l-1]<>'"'
-            then raise invalid_argument
-            else let value_length = l - pos_eq - 3 in
-            let value = String.sub str (pos_eq+2) value_length in
-            if append then Append (variable, value)
-            else Add (variable, value)
-    end
-  end
+  let lexbuf = Lexing.from_string str in
+  let variable_name, result = Tsl_lexer.modifier lexbuf in
+  let variable =
+    match Variables.find_variable variable_name with
+    | None -> raise (Variables.No_such_variable variable_name)
+    | Some variable -> variable
+  in
+  match result with
+  | `Remove -> Remove variable
+  | `Add value -> Add (variable, value)
+  | `Append value -> Append (variable, value)
 
 let modifiers_of_file filename =
   let ic = open_in filename in

ocamltest/tsl_lexer.mli

@@ -16,3 +16,5 @@
 (* Interface to the Tsl_lexer module *)
 
 val token : Lexing.lexbuf -> Tsl_parser.token
+val modifier :
+    Lexing.lexbuf -> string * [`Remove | `Add of string | `Append of string]

ocamltest/tsl_lexer.mll

@@ -13,7 +13,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
-(* Lexer definitions for the Tests Specification Language *)
+(* Lexer definitions for the Tests Specification Language and for
+   response files *)
 
 {
 open Tsl_parser
@@ -114,3 +115,14 @@ and comment = parse
     {
       comment lexbuf
     }
+
+(* Parse one line of a response file (for scripts and hooks) *)
+and modifier = parse
+  | '-' (identchar* as variable)
+    { variable, `Remove }
+  | (identchar* as variable) "=\"" (_* as str) '"'
+    { variable, `Add str }
+  | (identchar* as variable) "+=\"" (_* as str) '"'
+    { variable, `Append str }
+  | _
+    { failwith "syntax error in script response file" }