diff --git a/ocamltest/.depend b/ocamltest/.depend index 2e45f645a..8ffbcd6e5 100644 --- a/ocamltest/.depend +++ b/ocamltest/.depend @@ -36,6 +36,7 @@ actions_helpers.cmo : \ run_command.cmi \ result.cmi \ ocamltest_stdlib.cmi \ + modifier_parser.cmi \ filecompare.cmi \ environments.cmi \ builtin_variables.cmi \ @@ -46,6 +47,7 @@ actions_helpers.cmx : \ run_command.cmx \ result.cmx \ ocamltest_stdlib.cmx \ + modifier_parser.cmx \ filecompare.cmx \ environments.cmx \ builtin_variables.cmx \ @@ -86,12 +88,10 @@ 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 : \ @@ -132,6 +132,20 @@ main.cmx : \ actions.cmx \ main.cmi main.cmi : +modifier_parser.cmo : \ + variables.cmi \ + tsl_lexer.cmi \ + ocamltest_stdlib.cmi \ + environments.cmi \ + modifier_parser.cmi +modifier_parser.cmx : \ + variables.cmx \ + tsl_lexer.cmx \ + ocamltest_stdlib.cmx \ + environments.cmx \ + modifier_parser.cmi +modifier_parser.cmi : \ + environments.cmi ocaml_actions.cmo : \ result.cmi \ ocamltest_stdlib.cmi \ diff --git a/ocamltest/Makefile b/ocamltest/Makefile index 9694b94b3..0638b6fc9 100644 --- a/ocamltest/Makefile +++ b/ocamltest/Makefile @@ -96,13 +96,14 @@ 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 \ + modifier_parser.mli modifier_parser.ml \ tsl_semantics.mli tsl_semantics.ml \ builtin_variables.mli builtin_variables.ml \ actions_helpers.mli actions_helpers.ml \ diff --git a/ocamltest/actions_helpers.ml b/ocamltest/actions_helpers.ml index 3e394be27..83fbcaf18 100644 --- a/ocamltest/actions_helpers.ml +++ b/ocamltest/actions_helpers.ml @@ -205,7 +205,7 @@ let run_script log env = log scriptenv in let final_value = if Result.is_pass result then begin - match Environments.modifiers_of_file response_file with + match Modifier_parser.modifiers_of_file response_file with | modifiers -> let modified_env = Environments.apply_modifiers newenv modifiers in (result, modified_env) @@ -248,7 +248,7 @@ let run_hook hook_name log input_env = } in let exit_status = run settings in let final_value = match exit_status with | 0 -> - begin match Environments.modifiers_of_file response_file with + begin match Modifier_parser.modifiers_of_file response_file with | modifiers -> let modified_env = Environments.apply_modifiers hookenv modifiers in (Result.pass, modified_env) diff --git a/ocamltest/environments.ml b/ocamltest/environments.ml index cac5e21ff..43dd1173c 100644 --- a/ocamltest/environments.ml +++ b/ocamltest/environments.ml @@ -142,26 +142,3 @@ let rec apply_modifier environment = function | Remove variable -> remove variable environment and apply_modifiers environment modifiers = List.fold_left apply_modifier environment modifiers - -let modifier_of_string str = - 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 - let rec modifiers_of_lines acc = match input_line_opt ic with - | None -> acc - | Some line -> - modifiers_of_lines ((modifier_of_string (String.trim line)) :: acc) in - let modifiers = modifiers_of_lines [] in - close_in ic; - List.rev modifiers diff --git a/ocamltest/environments.mli b/ocamltest/environments.mli index 94d794bb9..f288a6f10 100644 --- a/ocamltest/environments.mli +++ b/ocamltest/environments.mli @@ -67,7 +67,3 @@ exception Modifiers_name_already_registered of string exception Modifiers_name_not_found of string val register_modifiers : string -> modifiers -> unit - -val modifier_of_string : string -> modifier - -val modifiers_of_file : string -> modifiers diff --git a/ocamltest/modifier_parser.ml b/ocamltest/modifier_parser.ml new file mode 100644 index 000000000..65af12845 --- /dev/null +++ b/ocamltest/modifier_parser.ml @@ -0,0 +1,41 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Sebastien Hinderer, projet Gallium, INRIA Paris *) +(* *) +(* Copyright 2019 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Parsing of modifier (response) files created by hooks and scripts *) + +open Ocamltest_stdlib + +let modifier_of_string str = + 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 -> Environments.Remove variable + | `Add value -> Environments.Add (variable, value) + | `Append value -> Environments.Append (variable, value) + +let modifiers_of_file filename = + let ic = open_in filename in + let rec modifiers_of_lines acc = match input_line_opt ic with + | None -> acc + | Some line -> + modifiers_of_lines ((modifier_of_string (String.trim line)) :: acc) in + let modifiers = modifiers_of_lines [] in + close_in ic; + List.rev modifiers diff --git a/ocamltest/modifier_parser.mli b/ocamltest/modifier_parser.mli new file mode 100644 index 000000000..f34e3a394 --- /dev/null +++ b/ocamltest/modifier_parser.mli @@ -0,0 +1,20 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Sebastien Hinderer, projet Gallium, INRIA Paris *) +(* *) +(* Copyright 2019 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(* Parsing of modifier (response) files created by hooks and scripts *) + +val modifier_of_string : string -> Environments.modifier + +val modifiers_of_file : string -> Environments.modifiers