Harden ocamltest against errors in scripts and hooks
parent
a633b66d8b
commit
123334881a
|
@ -1,22 +1,21 @@
|
||||||
run_unix.$(O): run_unix.c run.h ../runtime/caml/misc.h \
|
run_unix.$(O): run_unix.c run.h ../runtime/caml/misc.h \
|
||||||
../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \
|
../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \
|
||||||
run_common.h
|
run_common.h
|
||||||
run_stubs.$(O): run_stubs.c run.h ../runtime/caml/misc.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/config.h ../runtime/caml/m.h ../runtime/caml/s.h \
|
||||||
../runtime/caml/mlvalues.h ../runtime/caml/misc.h \
|
../runtime/caml/mlvalues.h ../runtime/caml/memory.h \
|
||||||
../runtime/caml/memory.h ../runtime/caml/gc.h ../runtime/caml/mlvalues.h \
|
../runtime/caml/gc.h ../runtime/caml/major_gc.h \
|
||||||
../runtime/caml/major_gc.h ../runtime/caml/freelist.h \
|
../runtime/caml/freelist.h ../runtime/caml/minor_gc.h \
|
||||||
../runtime/caml/minor_gc.h ../runtime/caml/address_class.h \
|
../runtime/caml/address_class.h ../runtime/caml/io.h \
|
||||||
../runtime/caml/io.h ../runtime/caml/osdeps.h ../runtime/caml/memory.h
|
../runtime/caml/osdeps.h
|
||||||
ocamltest_stdlib_stubs.$(O): ocamltest_stdlib_stubs.c \
|
ocamltest_stdlib_stubs.$(O): ocamltest_stdlib_stubs.c \
|
||||||
../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \
|
../runtime/caml/config.h ../runtime/caml/m.h ../runtime/caml/s.h \
|
||||||
../runtime/caml/mlvalues.h ../runtime/caml/config.h \
|
../runtime/caml/mlvalues.h ../runtime/caml/misc.h \
|
||||||
../runtime/caml/misc.h ../runtime/caml/memory.h ../runtime/caml/gc.h \
|
../runtime/caml/memory.h ../runtime/caml/gc.h \
|
||||||
../runtime/caml/mlvalues.h ../runtime/caml/major_gc.h \
|
../runtime/caml/major_gc.h ../runtime/caml/freelist.h \
|
||||||
../runtime/caml/freelist.h ../runtime/caml/minor_gc.h \
|
../runtime/caml/minor_gc.h ../runtime/caml/address_class.h \
|
||||||
../runtime/caml/address_class.h ../runtime/caml/alloc.h \
|
../runtime/caml/alloc.h ../runtime/caml/signals.h \
|
||||||
../runtime/caml/signals.h ../runtime/caml/osdeps.h \
|
../runtime/caml/osdeps.h
|
||||||
../runtime/caml/memory.h
|
|
||||||
actions.cmo : \
|
actions.cmo : \
|
||||||
result.cmi \
|
result.cmi \
|
||||||
environments.cmi \
|
environments.cmi \
|
||||||
|
@ -83,10 +82,12 @@ builtin_variables.cmi : \
|
||||||
variables.cmi
|
variables.cmi
|
||||||
environments.cmo : \
|
environments.cmo : \
|
||||||
variables.cmi \
|
variables.cmi \
|
||||||
|
tsl_lexer.cmi \
|
||||||
ocamltest_stdlib.cmi \
|
ocamltest_stdlib.cmi \
|
||||||
environments.cmi
|
environments.cmi
|
||||||
environments.cmx : \
|
environments.cmx : \
|
||||||
variables.cmx \
|
variables.cmx \
|
||||||
|
tsl_lexer.cmx \
|
||||||
ocamltest_stdlib.cmx \
|
ocamltest_stdlib.cmx \
|
||||||
environments.cmi
|
environments.cmi
|
||||||
environments.cmi : \
|
environments.cmi : \
|
||||||
|
|
|
@ -96,13 +96,13 @@ core := \
|
||||||
run_command.mli run_command.ml \
|
run_command.mli run_command.ml \
|
||||||
filecompare.mli filecompare.ml \
|
filecompare.mli filecompare.ml \
|
||||||
variables.mli variables.ml \
|
variables.mli variables.ml \
|
||||||
environments.mli environments.ml \
|
|
||||||
result.mli result.ml \
|
result.mli result.ml \
|
||||||
actions.mli actions.ml \
|
actions.mli actions.ml \
|
||||||
tests.mli tests.ml \
|
tests.mli tests.ml \
|
||||||
tsl_ast.mli tsl_ast.ml \
|
tsl_ast.mli tsl_ast.ml \
|
||||||
tsl_parser.mly \
|
tsl_parser.mly \
|
||||||
tsl_lexer.mli tsl_lexer.mll \
|
tsl_lexer.mli tsl_lexer.mll \
|
||||||
|
environments.mli environments.ml \
|
||||||
tsl_semantics.mli tsl_semantics.ml \
|
tsl_semantics.mli tsl_semantics.ml \
|
||||||
builtin_variables.mli builtin_variables.ml \
|
builtin_variables.mli builtin_variables.ml \
|
||||||
actions_helpers.mli actions_helpers.ml \
|
actions_helpers.mli actions_helpers.ml \
|
||||||
|
|
|
@ -205,9 +205,17 @@ let run_script log env =
|
||||||
log scriptenv in
|
log scriptenv in
|
||||||
let final_value =
|
let final_value =
|
||||||
if Result.is_pass result then begin
|
if Result.is_pass result then begin
|
||||||
let modifiers = Environments.modifiers_of_file response_file in
|
match Environments.modifiers_of_file response_file with
|
||||||
let modified_env = Environments.apply_modifiers newenv modifiers in
|
| modifiers ->
|
||||||
(result, modified_env)
|
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
|
end else begin
|
||||||
let reason = String.trim (Sys.string_of_file response_file) in
|
let reason = String.trim (Sys.string_of_file response_file) in
|
||||||
let newresult = { result with Result.reason = Some reason } 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
|
} in let exit_status = run settings in
|
||||||
let final_value = match exit_status with
|
let final_value = match exit_status with
|
||||||
| 0 ->
|
| 0 ->
|
||||||
let modifiers = Environments.modifiers_of_file response_file in
|
begin match Environments.modifiers_of_file response_file with
|
||||||
let modified_env = Environments.apply_modifiers hookenv modifiers in
|
| modifiers ->
|
||||||
(Result.pass, modified_env)
|
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;
|
Printf.fprintf log "Hook returned %d" exit_status;
|
||||||
let reason = String.trim (Sys.string_of_file response_file) in
|
let reason = String.trim (Sys.string_of_file response_file) in
|
||||||
|
|
|
@ -144,36 +144,17 @@ and apply_modifiers environment modifiers =
|
||||||
List.fold_left apply_modifier environment modifiers
|
List.fold_left apply_modifier environment modifiers
|
||||||
|
|
||||||
let modifier_of_string str =
|
let modifier_of_string str =
|
||||||
let invalid_argument = (Invalid_argument "modifier_of_string") in
|
let lexbuf = Lexing.from_string str in
|
||||||
if str="" then raise invalid_argument else begin
|
let variable_name, result = Tsl_lexer.modifier lexbuf in
|
||||||
let l = String.length str in
|
let variable =
|
||||||
if str.[0] = '-' then begin
|
match Variables.find_variable variable_name with
|
||||||
let variable_name = String.sub str 1 (l-1) in
|
| None -> raise (Variables.No_such_variable variable_name)
|
||||||
match Variables.find_variable variable_name with
|
| Some variable -> variable
|
||||||
| None -> raise (Variables.No_such_variable variable_name)
|
in
|
||||||
| Some variable -> Remove variable
|
match result with
|
||||||
end else begin match String.index_opt str '=' with
|
| `Remove -> Remove variable
|
||||||
| None -> raise invalid_argument
|
| `Add value -> Add (variable, value)
|
||||||
| Some pos_eq -> if pos_eq <= 0 then raise invalid_argument else
|
| `Append value -> Append (variable, value)
|
||||||
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 modifiers_of_file filename =
|
let modifiers_of_file filename =
|
||||||
let ic = open_in filename in
|
let ic = open_in filename in
|
||||||
|
|
|
@ -16,3 +16,5 @@
|
||||||
(* Interface to the Tsl_lexer module *)
|
(* Interface to the Tsl_lexer module *)
|
||||||
|
|
||||||
val token : Lexing.lexbuf -> Tsl_parser.token
|
val token : Lexing.lexbuf -> Tsl_parser.token
|
||||||
|
val modifier :
|
||||||
|
Lexing.lexbuf -> string * [`Remove | `Add of string | `Append of string]
|
||||||
|
|
|
@ -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
|
open Tsl_parser
|
||||||
|
@ -114,3 +115,14 @@ and comment = parse
|
||||||
{
|
{
|
||||||
comment lexbuf
|
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" }
|
||||||
|
|
Loading…
Reference in New Issue