Skip to content
Snippets Groups Projects
Commit e8f53c93 authored by Patrick Baudin's avatar Patrick Baudin
Browse files

[Ptests] use a wrapper to run frama-c tests

parent 7b87945e
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Makefile
+ 14
− 5
View file @ e8f53c93
...@@ -173,18 +173,27 @@ TEST_DIRS=tests $(wildcard src/plugins/*/tests) ...@@ -173,18 +173,27 @@ TEST_DIRS=tests $(wildcard src/plugins/*/tests)
tests.info: tests.info:
echo "TEST_DIRS=$(TEST_DIRS)" echo "TEST_DIRS=$(TEST_DIRS)"
# Note: the plublic name of ptest.exe is frama-c-ptest # Note: the public name of ptest.exe is frama-c-ptests
ptests/ptests.exe: ptests/ptests.ml ptests/ptests.exe: ptests/ptests.ml
dune build --root ptests ptests.exe dune build --root ptests ptests.exe
# Note: the public name of wtest.exe is frama-c-wtests
ptests/wtests.exe: ptests/wtests.ml
dune build --root ptests wtests.exe
# Command for executing ptest (in order to generate dune test files) # Command for executing ptest (in order to generate dune test files)
PTESTS=dune exec --root ptests -- ./ptests.exe PTESTS=dune exec --root ptests -- frama-c-ptests
PTESTS=dune exec --root ptests -- ./ptests.exe -v #PTESTS=dune exec --root ptests -- frama-c-ptests -v
WTESTS=dune exec --root ptests -- frama-c-wtests
.PHONY: ptests-help .PHONY: ptests-help
ptests-help: ptests/ptests.exe ptests-help:
$(PTESTS) --help $(PTESTS) --help
.PHONY: wtests-help
wtests-help:
$(WTESTS) --help
# Removes all dune files generated for testing # Removes all dune files generated for testing
.PHONY: purge-tests .PHONY: purge-tests
purge-tests: purge-tests:
...@@ -197,7 +206,7 @@ clean-tests: purge-tests ...@@ -197,7 +206,7 @@ clean-tests: purge-tests
# Generates all dune files used for testing # Generates all dune files used for testing
.PHONY: run-ptests .PHONY: run-ptests
run-ptests: config.sed purge-tests ptests/ptests.exe run-ptests: config.sed purge-tests
$(PTESTS) $(TEST_DIRS) $(PTESTS) $(TEST_DIRS)
# run tests of for all configurations (requires all dune files) # run tests of for all configurations (requires all dune files)
......
ptests/Makefile
+ 5
− 1
View file @ e8f53c93
...@@ -21,12 +21,16 @@ ...@@ -21,12 +21,16 @@
########################################################################## ##########################################################################
.PHONY: all .PHONY: all
all: ptests.exe all: ptests.exe wtests.exe
.PHONY: ptests.exe .PHONY: ptests.exe
ptests.exe: ptests.exe:
dune build --root . ptests.exe dune build --root . ptests.exe
.PHONY: wtests.exe
wtests.exe:
dune build --root . wtests.exe
.PHONY: clean .PHONY: clean
clean: purge-tests clean: purge-tests
dune clean --root . dune clean --root .
......
ptests/dune
+ 9
− 0
View file @ e8f53c93
...@@ -3,4 +3,13 @@ ...@@ -3,4 +3,13 @@
(name ptests) (name ptests)
(modules ptests) (modules ptests)
(libraries unix str) (libraries unix str)
(preprocess (pps ppx_deriving_yojson))
)
(executable
(public_name frama-c-wtests)
(name wtests)
(modules wtests)
(libraries unix str)
(preprocess (pps ppx_deriving_yojson))
) )
ptests/dune-project
+ 7
− 1
View file @ e8f53c93
(lang dune 2.7) (lang dune 2.7)
(package (name frama-c-ptests)) (allow_approximate_merlin)
(package
(name frama-c-ptests)
(depends
(ppx_deriving_yojson (>= 3.5.1))
)
)
ptests/ptests.ml
+ 258
− 79
View file @ e8f53c93
...@@ -27,6 +27,9 @@ let nb_dune_files = ref 0 ...@@ -27,6 +27,9 @@ let nb_dune_files = ref 0
let nb_ignores = ref 0 let nb_ignores = ref 0
let ignored_suites = ref [] let ignored_suites = ref []
(* Set to an empty string to use no wrapper *)
let wrapper_cmd = ref "frama-c-wtests -brief"
type env_t = { type env_t = {
config: string config: string
; dir: string ; dir: string
...@@ -187,6 +190,9 @@ let example_msg = ...@@ -187,6 +190,9 @@ let example_msg =
@@<alias-name> # Tests all configurations related to the <alias-name>@ \ @@<alias-name> # Tests all configurations related to the <alias-name>@ \
@@<alias-name>_config # Tests only the default configuration.@ \ @@<alias-name>_config # Tests only the default configuration.@ \
@@<alias-name>_config_<configuration> # Tests only the specified <configuration>.@ \ @@<alias-name>_config_<configuration> # Tests only the specified <configuration>.@ \
@@<PTEST_NAME>.wtests # Tests the specified file.@ \
@@<PTEST_NAME>.<PTEST_NUMBER>.exec.wtests # Tests the specified sub-test comand.@ \
@@<PTEST_NAME>.<PTEST_NUMBER>.execnow.wtests # Tests the specified execnow command.@ \
@@<PTEST_FILE> # Force to reproduce the corresponding test and prints the outputs.@ \ @@<PTEST_FILE> # Force to reproduce the corresponding test and prints the outputs.@ \
@@<PTEST_NAME>.<PTEST_NUMBER>.exec.show # Prints the related sub-test command.@ \ @@<PTEST_NAME>.<PTEST_NUMBER>.exec.show # Prints the related sub-test command.@ \
@@<PTEST_NAME>.<PTEST_NUMBER>.execnow.show # Prints the related execnow command.@ \ @@<PTEST_NAME>.<PTEST_NUMBER>.execnow.show # Prints the related execnow command.@ \
...@@ -206,7 +212,7 @@ let example_msg = ...@@ -206,7 +212,7 @@ let example_msg =
test_file_regexp test_file_regexp
!default_toplevel !default_toplevel
let umsg = "Usage: ptests [options] [names of test suites]" let umsg = "Usage: frama-c-ptests [options] [names of test suites]"
let default_dune_alias = ref "ptests" let default_dune_alias = ref "ptests"
let rec argspec = let rec argspec =
...@@ -214,6 +220,9 @@ let rec argspec = ...@@ -214,6 +220,9 @@ let rec argspec =
("-v", Arg.Unit (fun () -> incr verbosity), ("-v", Arg.Unit (fun () -> incr verbosity),
"Increase verbosity (up to twice)") ; "Increase verbosity (up to twice)") ;
("-wrapper" , Arg.String (fun s -> wrapper_cmd := s),
" <command> Uses a wrapper to executes tests (defaults to "^ !wrapper_cmd ^")");
("-adds-default-options" , Arg.String (fun s -> macro_default_options := !macro_default_options ^ " " ^ s), ("-adds-default-options" , Arg.String (fun s -> macro_default_options := !macro_default_options ^ " " ^ s),
" <options> Appends the <options> to the default value of the @DEFAULT_OPTIONS@ macro"); " <options> Appends the <options> to the default value of the @DEFAULT_OPTIONS@ macro");
...@@ -289,7 +298,7 @@ end = struct ...@@ -289,7 +298,7 @@ end = struct
exit 2) exit 2)
| "IGNORE" -> incr nb_ignores; | "IGNORE" -> incr nb_ignores;
ignored_suites := (ptests_config ^ ":" ^ value)::!ignored_suites; ignored_suites := (ptests_config ^ ":" ^ value)::!ignored_suites;
Format.eprintf "%s: %s=%s@." ptests_config key value if !verbosity >=2 then Format.eprintf "%s: %s=%s@." ptests_config key value
| _ -> Format.eprintf "%s: setenv (DEPRECATED): %s=%s@." ptests_config key value; | _ -> Format.eprintf "%s: setenv (DEPRECATED): %s=%s@." ptests_config key value;
in in
if Sys.file_exists ptests_config then begin if Sys.file_exists ptests_config then begin
...@@ -451,10 +460,6 @@ type execnow = ...@@ -451,10 +460,6 @@ type execnow =
ex_dir: SubDir.t; (** directory of test suite *) ex_dir: SubDir.t; (** directory of test suite *)
ex_timeout: string; ex_timeout: string;
(* DEPRECATED FEATURE *)
ex_once: bool; (** true iff the command has to be executed only once
per config file (otherwise it is executed for
every file of the test suite) *)
} }
...@@ -553,8 +558,8 @@ end = struct ...@@ -553,8 +558,8 @@ end = struct
let scan_execnow ~file ~once dir ex_timeout (s:string) = let scan_execnow ~file ~once dir ex_timeout (s:string) =
if once=false then if once=false then
Format.eprintf "%a: using EXEC directive (DEPRECATED): %s@." Format.eprintf "%s: using EXEC directive (DEPRECATED): %s@."
(SubDir.pp_file ~dir) file s; file s;
let rec aux (s:execnow) = let rec aux (s:execnow) =
try try
Scanf.sscanf s.ex_cmd "%_[ ]LOG%_[ ]%[-A-Za-z0-9_',+=:.\\@@]%_[ ]%s@\n" Scanf.sscanf s.ex_cmd "%_[ ]LOG%_[ ]%[-A-Za-z0-9_',+=:.\\@@]%_[ ]%s@\n"
...@@ -570,8 +575,8 @@ end = struct ...@@ -570,8 +575,8 @@ end = struct
Scanf.sscanf s.ex_cmd "%_[ ]make%_[ ]%s@\n" Scanf.sscanf s.ex_cmd "%_[ ]make%_[ ]%s@\n"
(fun cmd -> (fun cmd ->
(* It should be better to use a specific macro into the command (such as @MAKE@) for that. *) (* It should be better to use a specific macro into the command (such as @MAKE@) for that. *)
Format.eprintf "%a: EXEC%s directive with a make command (DEPRECATED): %s@." Format.eprintf "%s: EXEC%s directive with a make command (DEPRECATED): %s@."
(SubDir.pp_file ~dir) file (if once then "NOW" else "") cmd; file (if once then "NOW" else "") cmd;
let s = aux ({ s with ex_cmd = cmd; }) in let s = aux ({ s with ex_cmd = cmd; }) in
{ s with ex_cmd = "make "^cmd; } ) { s with ex_cmd = "make "^cmd; } )
with Scanf.Scan_failure _ -> with Scanf.Scan_failure _ ->
...@@ -582,13 +587,12 @@ end = struct ...@@ -582,13 +587,12 @@ end = struct
ex_log = []; ex_log = [];
ex_bin = []; ex_bin = [];
ex_dir = dir; ex_dir = dir;
ex_once = once;
ex_timeout; ex_timeout;
} }
in in
if execnow.ex_log = [] && execnow.ex_bin = [] then if execnow.ex_log = [] && execnow.ex_bin = [] then
Format.eprintf "%a: EXEC%s without LOG nor BIN target (DEPRECATED): %s@." Format.eprintf "%s: EXEC%s without LOG nor BIN target (DEPRECATED): %s@."
(SubDir.pp_file ~dir) file (if once then "NOW" else "") s; file (if once then "NOW" else "") s;
execnow execnow
let make_custom_opts = let make_custom_opts =
...@@ -994,18 +998,59 @@ end ...@@ -994,18 +998,59 @@ end
let show_cmd = let show_cmd =
let regexp = Str.regexp "%{[a-z]+:\\([^}]+\\)}" in let regexp = Str.regexp "%{[a-z]+:\\([^}]+\\)}" in
let subst = Str.global_replace regexp "\\1" in let subst = Str.global_replace regexp "\\1" in
fun ?reslog ?errlog cmd -> subst
let redirection ?reslog ?errlog cmd =
match reslog, errlog with match reslog, errlog with
| None, None -> Format.sprintf "echo '%s'" (subst cmd) | None, None -> cmd
| None, Some err -> Format.sprintf "echo '%s 2> %s'" (subst cmd) err | None, Some err -> Format.sprintf "%s 2> %s" cmd err
| Some res, None -> Format.sprintf "echo '%s > %s'" (subst cmd) res | Some res, None -> Format.sprintf "%s > %s" cmd res
| Some res, Some err -> Format.sprintf "echo '%s > %s 2> %s'" (subst cmd) res err | Some res, Some err -> Format.sprintf "%s > %s 2> %s" cmd res err
let ptests_alias ~env = config_name ~env (env.dune_alias ^ "_config") let ptests_alias ~env = config_name ~env (env.dune_alias ^ "_config")
let filter_log_regexp = Str.regexp "@PTEST_LOG@" let filter_log_regexp = Str.regexp "@PTEST_LOG@"
let mk_alias cmd suffix = Format.sprintf "%s.%d.%s" cmd.test_name cmd.nth suffix let mk_alias cmd suffix = Format.sprintf "%s.%d.%s" cmd.test_name cmd.nth suffix
type wtest = {
dir: (string [@default ""]); (* information on the test directory *)
info: (string [@default ""]); (* information *)
cmd: (string [@default "echo unknown command"]);
ret_code: (int [@default 0]);
out: (string [@default "" (* bin target built by the command *) ]); (* sdtout target *)
err: (string [@default "" (* bin target built by the command *) ]); (* stderr target *)
tmpout: (string [@default ""]); (* temporary file to filter stdout result *)
tmperr: (string [@default ""]); (* temporary file to filter stderr result *)
sedout: (string [@default ""]); (* filter command for the stdout result *)
sederr: (string [@default ""]); (* filter command for the stderr result *)
bin: (string list [@default []]); (* binary targets (without oracles) *)
log: (string list [@default []]); (* log targets (compared to log oracles *)
oracle_dir: (string [@default "../oracle"]); (* directory containing the oracle of the log files *)
oracle_out: (string [@default "" ]); (* oracle of the stdout target *)
oracle_err: (string [@default "" ]); (* oracle of the stderr target *)
}
[@@deriving yojson]
let std = false
let pp_wtest ?(compacted=false) fmt wtest =
let writer = (if compacted
then (fun json -> Format.fprintf fmt "%s" (Yojson.Safe.to_string ~std json))
else (fun json -> Format.fprintf fmt "%a" (Yojson.Safe.pretty_print ~std) json))
in writer (wtest_to_yojson wtest)
let default_wtest = match wtest_of_yojson (Yojson.Safe.from_string "{}") with
| Ok r -> r
| _ -> assert false
let print_json_wrapper ~file wtest =
(* Prints the JSON file for the wrapper *)
if !verbosity >= 2 then Format.printf "%% Generates %S wrapper file...@." file;
let wrapper_cout = open_out file in
let wrapper_fmt = Format.formatter_of_out_channel wrapper_cout in
Format.fprintf wrapper_fmt "%a@" (pp_wtest ~compacted:false) wtest;
close_out wrapper_cout
let command_string ~env ~result_fmt ~oracle_fmt command = let command_string ~env ~result_fmt ~oracle_fmt command =
let log_prefix = log_prefix ~env command in let log_prefix = log_prefix ~env command in
let reslog = log_prefix ^ ".res.log" in let reslog = log_prefix ^ ".res.log" in
...@@ -1017,42 +1062,128 @@ let command_string ~env ~result_fmt ~oracle_fmt command = ...@@ -1017,42 +1062,128 @@ let command_string ~env ~result_fmt ~oracle_fmt command =
let deps = command.deps in let deps = command.deps in
let accepted_exit_code = Format.sprintf "with-accepted-exit-codes %d" command.exit_code in let accepted_exit_code = Format.sprintf "with-accepted-exit-codes %d" command.exit_code in
let command_string = basic_command_string command in let command_string = basic_command_string command in
Format.fprintf result_fmt let filter_res,filter_err,wtest =
"(rule ; TEST #%d OF TEST FILE %S\n \
(targets %S %S %a)\n \
(deps %a %S (package frama-c)%a)\n \
(action (with-stderr-to %S (with-stdout-to %S (%s (system %S)))))\n\
)@."
command.nth command.file
cmderrlog
cmdreslog
print_list command.log_files
print_list deps
command.file
Fmt.(list (package_as_deps (quote plugin_as_package))) command.plugins
cmderrlog
cmdreslog
accepted_exit_code
command_string
;
begin
match command.filter with match command.filter with
| None -> () | None -> "","",default_wtest
| Some filter -> | Some filter ->
let regexp = Str.regexp "@PTEST_ORACLE@" in let regexp = Str.regexp "@PTEST_ORACLE@" in
let filter_rule txt fin fout foracle = let filter_cmd fin foracle =
let filter = Str.global_replace regexp foracle filter in let filter = Str.global_replace regexp foracle filter in
Format.fprintf result_fmt Format.sprintf "%s %s" filter fin
"(rule ; FILTER %s #%d OF TEST FILE %S\n \
(action (with-stdout-to %S (with-accepted-exit-codes (or 0 1 2 125) (system %S))))\n\
)@."
txt
command.nth command.file
fout (Format.sprintf "%s %%{dep:%s}" filter fin)
in in
filter_rule "RES" cmdreslog reslog (log_prefix ^ ".res.oracle") ; let filter_res = filter_cmd cmdreslog (log_prefix ^ ".res.oracle") in
filter_rule "ERR" cmderrlog errlog (log_prefix ^ ".err.oracle") let filter_err = filter_cmd cmderrlog (log_prefix ^ ".err.oracle") in
end ; filter_res,filter_err, { default_wtest with
sedout = redirection ~reslog filter_res ;
sederr = redirection ~reslog:errlog filter_err ;
tmpout = cmdreslog ;
tmperr = cmderrlog ;
}
in
let oracle_prefix = oracle_prefix ~env command in
let wtest =
{ wtest with
dir = SubDir.get (SubDir.result_subdir ~env command.directory) ;
info = Format.sprintf "TEST #%d OF TEST FILE %s/%s"
command.nth (SubDir.get command.directory) command.file;
cmd = redirection ~reslog:cmdreslog ~errlog:cmderrlog command_string ;
out = reslog;
err = errlog;
ret_code = command.exit_code;
log = command.log_files;
oracle_out = Filename.concat ".." (oracle_prefix ^ ".res.oracle");
oracle_err = Filename.concat ".." (oracle_prefix ^ ".err.oracle");
}
in
let wtest = if wtest.log = [] then wtest else
{ wtest with
oracle_dir = SubDir.get (SubDir.oracle_subdir ~env SubDir.upper_dir)
}
in
let wrapper_basename = mk_alias command "exec.wtests" in
if !wrapper_cmd <> "" then begin
Format.fprintf result_fmt
"(rule ; %s\n \
(alias %S)\n \
(targets %S %S %a)\n \
(deps %S %S %a %a %S (package frama-c)%a)\n \
(action (run %s %%{dep:%s} %S %a))\n\
)@."
(* rules: *)
wtest.info
(* alias *)
wrapper_basename
(* targets: *)
cmderrlog
cmdreslog
print_list command.log_files
(* deps: *)
wtest.oracle_out
wtest.oracle_err
print_list (List.map (Filename.concat wtest.oracle_dir) command.log_files)
print_list deps
command.file
Fmt.(list (package_as_deps (quote plugin_as_package))) command.plugins
(* action: *)
!wrapper_cmd
wrapper_basename
wtest.cmd
print_list (if command.filter = None then [] else [wtest.sedout ; wtest.sederr]);
let wtest =
{ wtest with
cmd = show_cmd wtest.cmd ;
sedout = show_cmd wtest.sedout ;
sederr = show_cmd wtest.sederr
}
in
(* Prints the JSON file for the wrapper *)
print_json_wrapper wtest
~file:(SubDir.make_file (SubDir.result_subdir ~env command.directory) wrapper_basename);
end
else
Format.fprintf result_fmt
"(rule ; %s\n \
(alias %S)\n \
(targets %S %S %a)\n \
(deps %a %S (package frama-c)%a)\n \
(action (with-stderr-to %S (with-stdout-to %S (%s (system %S)))))\n\
)@."
(* rules: *)
wtest.info
(* alias *)
wrapper_basename
(* targets: *)
cmderrlog
cmdreslog
print_list command.log_files
(* deps: *)
print_list deps
command.file
Fmt.(list (package_as_deps (quote plugin_as_package))) command.plugins
(* action: *)
cmderrlog
cmdreslog
accepted_exit_code
command_string
;
let filter_rule txt fin fout cmd =
if cmd <> "" then
Format.fprintf result_fmt
"(rule ; FILTER %s #%d OF TEST FILE %S\n \
(deps %S)
(action (with-stdout-to %S (with-accepted-exit-codes (or 0 1 2 125) (system %S))))\n\
)@."
txt
command.nth
command.file
(* deps *)
fin
(*action *)
fout cmd
in
filter_rule "RES" cmdreslog reslog filter_res ;
filter_rule "ERR" cmderrlog errlog filter_err ;
List.iteri (fun n log -> List.iteri (fun n log ->
Format.fprintf result_fmt Format.fprintf result_fmt
"(rule ; COMPARE TARGET #%d OF TEST #%d FOR TEST FILE %S\n \ "(rule ; COMPARE TARGET #%d OF TEST #%d FOR TEST FILE %S\n \
...@@ -1089,9 +1220,8 @@ let command_string ~env ~result_fmt ~oracle_fmt command = ...@@ -1089,9 +1220,8 @@ let command_string ~env ~result_fmt ~oracle_fmt command =
print_list deps print_list deps
command.file command.file
Fmt.(list (package_as_deps (quote plugin_as_package))) command.plugins Fmt.(list (package_as_deps (quote plugin_as_package))) command.plugins
(show_cmd ~reslog ~errlog command_string); ("echo '" ^ show_cmd wtest.cmd ^"'");
let oracle_prefix = oracle_prefix ~env command in
let diff_alias = log_prefix ^ ".diff" in let diff_alias = log_prefix ^ ".diff" in
(* diff with oracles *) (* diff with oracles *)
Format.fprintf result_fmt Format.fprintf result_fmt
...@@ -1100,7 +1230,7 @@ let command_string ~env ~result_fmt ~oracle_fmt command = ...@@ -1100,7 +1230,7 @@ let command_string ~env ~result_fmt ~oracle_fmt command =
(action (diff %S %S))\n\ (action (diff %S %S))\n\
)@." )@."
diff_alias diff_alias
(Filename.concat ".." (oracle_prefix ^ ".res.oracle")) wtest.oracle_out
reslog; reslog;
Format.fprintf result_fmt Format.fprintf result_fmt
"(rule\n \ "(rule\n \
...@@ -1108,7 +1238,7 @@ let command_string ~env ~result_fmt ~oracle_fmt command = ...@@ -1108,7 +1238,7 @@ let command_string ~env ~result_fmt ~oracle_fmt command =
(action (diff %S %S))\n\ (action (diff %S %S))\n\
)@." )@."
diff_alias diff_alias
(Filename.concat ".." (oracle_prefix ^ ".err.oracle")) wtest.oracle_err
errlog; errlog;
Format.fprintf result_fmt Format.fprintf result_fmt
"(alias (deps (alias %S)) (name %S); (enabled_if (and true %a))\n\ "(alias (deps (alias %S)) (name %S); (enabled_if (and true %a))\n\
...@@ -1178,28 +1308,69 @@ let dispatcher ~env ~result_fmt ~oracle_fmt file directory config = ...@@ -1178,28 +1308,69 @@ let dispatcher ~env ~result_fmt ~oracle_fmt file directory config =
load_module = config.dc_libs @ config.dc_load_module; load_module = config.dc_libs @ config.dc_load_module;
} }
in in
let res = let wtest = {
{ execnow with default_wtest with
ex_cmd = basic_command_string cmd; dir = SubDir.get (SubDir.result_subdir ~env cmd.directory) ;
ex_log = List.map (Macros.expand cmd.macros) execnow.ex_log; info = Format.sprintf "EXECNOW #%d OF TEST FILE %s/%s"
ex_bin = List.map (Macros.expand cmd.macros) execnow.ex_bin; nth (SubDir.get directory) file;
} cmd = basic_command_string cmd;
log = List.map (Macros.expand cmd.macros) execnow.ex_log;
bin = List.map (Macros.expand cmd.macros) execnow.ex_bin;
}
in in
Format.fprintf result_fmt let wrapper_basename = mk_alias cmd "execnow.wtests" in
"(rule ; EXECNOW #%d OF TEST FILE %S\n \ if !wrapper_cmd <> "" then begin
(alias %s)\n \ Format.fprintf result_fmt
(deps %a (package frama-c)%a)\n \ "(rule ; %s\n \
(targets %a %a)\n \ (alias %s)\n \
(action (system %S))\n\ (deps %a (package frama-c)%a)\n \
)@." (targets %a %a)\n \
nth file (action (run %s %%{dep:%s} %S))\n\
(ptests_alias ~env) )@."
print_list config.dc_deps (* rules: *)
Fmt.(list (package_as_deps (quote plugin_as_package))) config.dc_plugins wtest.info
print_list res.ex_log (* alias *)
print_list res.ex_bin wrapper_basename
res.ex_cmd (* deps: *)
; print_list config.dc_deps
Fmt.(list (package_as_deps (quote plugin_as_package))) config.dc_plugins
(* targets: *)
print_list wtest.log
print_list wtest.bin
(* action: *)
!wrapper_cmd
wrapper_basename
wtest.cmd;
let wtest =
{ wtest with
cmd = show_cmd wtest.cmd ;
}
in
(* Prints the JSON file for the wrapper *)
print_json_wrapper wtest
~file:(SubDir.make_file (SubDir.result_subdir ~env cmd.directory) wrapper_basename);
end
else begin
Format.fprintf result_fmt
"(rule ; %s\n \
(alias %s)\n \
(deps %a (package frama-c)%a)\n \
(targets %a %a)\n \
(action (system %S))\n\
)@."
(* rules: *)
wtest.info
(* alias *)
wrapper_basename
(* deps: *)
print_list config.dc_deps
Fmt.(list (package_as_deps (quote plugin_as_package))) config.dc_plugins
(* targets: *)
print_list wtest.log
print_list wtest.bin
(* action: *)
wtest.cmd
end;
Format.fprintf result_fmt Format.fprintf result_fmt
"(rule ; REPRODUCE EXECNOW #%d OF TEST FILE %S\n \ "(rule ; REPRODUCE EXECNOW #%d OF TEST FILE %S\n \
(alias %s)\n \ (alias %s)\n \
...@@ -1210,7 +1381,7 @@ let dispatcher ~env ~result_fmt ~oracle_fmt file directory config = ...@@ -1210,7 +1381,7 @@ let dispatcher ~env ~result_fmt ~oracle_fmt file directory config =
(mk_alias cmd "execnow") (mk_alias cmd "execnow")
print_list config.dc_deps print_list config.dc_deps
Fmt.(list (package_as_deps (quote plugin_as_package))) config.dc_plugins Fmt.(list (package_as_deps (quote plugin_as_package))) config.dc_plugins
res.ex_cmd wtest.cmd
; ;
Format.fprintf result_fmt Format.fprintf result_fmt
"(rule ; SHOW EXECNOW COMMAND #%d OF TEST FILE %S\n \ "(rule ; SHOW EXECNOW COMMAND #%d OF TEST FILE %S\n \
...@@ -1222,7 +1393,7 @@ let dispatcher ~env ~result_fmt ~oracle_fmt file directory config = ...@@ -1222,7 +1393,7 @@ let dispatcher ~env ~result_fmt ~oracle_fmt file directory config =
(mk_alias cmd "execnow.show") (mk_alias cmd "execnow.show")
print_list config.dc_deps print_list config.dc_deps
Fmt.(list (package_as_deps (quote plugin_as_package))) config.dc_plugins Fmt.(list (package_as_deps (quote plugin_as_package))) config.dc_plugins
(show_cmd res.ex_cmd) ("echo '" ^ show_cmd wtest.cmd ^"'");
; ;
List.iteri (fun n log -> List.iteri (fun n log ->
Format.fprintf result_fmt Format.fprintf result_fmt
...@@ -1234,7 +1405,7 @@ let dispatcher ~env ~result_fmt ~oracle_fmt file directory config = ...@@ -1234,7 +1405,7 @@ let dispatcher ~env ~result_fmt ~oracle_fmt file directory config =
(ptests_alias ~env) (ptests_alias ~env)
(SubDir.make_file (SubDir.oracle_subdir ~env SubDir.upper_dir) log) (SubDir.make_file (SubDir.oracle_subdir ~env SubDir.upper_dir) log)
log log
) res.ex_log ) wtest.log
in in
List.iteri (fun n cmxs -> List.iteri (fun n cmxs ->
let libraries = String.concat " " config.dc_libs in let libraries = String.concat " " config.dc_libs in
...@@ -1255,10 +1426,18 @@ let dispatcher ~env ~result_fmt ~oracle_fmt file directory config = ...@@ -1255,10 +1426,18 @@ let dispatcher ~env ~result_fmt ~oracle_fmt file directory config =
if config.dc_commands <> [] || config.dc_execnow <> [] then begin if config.dc_commands <> [] || config.dc_execnow <> [] then begin
let print_list_alias fmt l = List.iter (Format.fprintf fmt "(alias %S)") l in let print_list_alias fmt l = List.iter (Format.fprintf fmt "(alias %S)") l in
Format.fprintf result_fmt Format.fprintf result_fmt
"(alias (deps%a%a) (name %S))@." "; TEST FILE %S\n\
(alias (deps %a%a) (name %S)) ; to performs all sub-tests related to a file\n \
(alias (deps %a%a) (name %S)) ; to reproduce and visualize the all sub-test outputs related to a file@."
file
(* alias #1 *)
print_list_alias (List.mapi (fun i _ -> Format.sprintf "%s.%d.exec.wtests" test_name i) config.dc_commands)
print_list_alias (List.mapi (fun i _ -> Format.sprintf "%s.%d.execnow.wtests" test_name i) config.dc_execnow)
(Format.sprintf "%s.wtests" test_name)
(* alias #2 *)
print_list_alias (List.mapi (fun i _ -> Format.sprintf "%s.%d.exec" test_name i) config.dc_commands) print_list_alias (List.mapi (fun i _ -> Format.sprintf "%s.%d.exec" test_name i) config.dc_commands)
print_list_alias (List.mapi (fun i _ -> Format.sprintf "%s.%d.execnow" test_name i) config.dc_execnow) print_list_alias (List.mapi (fun i _ -> Format.sprintf "%s.%d.execnow" test_name i) config.dc_execnow)
file file;
end ; end ;
List.iter make_cmd config.dc_commands; List.iter make_cmd config.dc_commands;
List.iter make_execnow_cmd config.dc_execnow; List.iter make_execnow_cmd config.dc_execnow;
......
ptests/wtests.ml 0 → 100644
+ 278
− 0
View file @ e8f53c93
(**************************************************************************)
(* *)
(* This file is part of Frama-C. *)
(* *)
(* Copyright (C) 2007-2020 *)
(* CEA (Commissariat à l'énergie atomique et aux énergies *)
(* alternatives) *)
(* *)
(* you can redistribute it and/or modify it under the terms of the GNU *)
(* Lesser General Public License as published by the Free Software *)
(* Foundation, version 2.1. *)
(* *)
(* It is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
(* GNU Lesser General Public License for more details. *)
(* *)
(* See the GNU Lesser General Public License version 2.1 *)
(* for more details (enclosed in the file licenses/LGPLv2.1). *)
(* *)
(**************************************************************************)
(** Command-line flags *)
let verbosity = ref 1
let cmp_cmd = "diff --new-file -q"
let diff_cmd = "diff --new-file"
(* ------------------------------- *)
module Filename = struct
include Filename
let concat =
if Sys.os_type = "Win32" then
fun a b -> a ^ "/" ^ b
else
concat
end
(* ------------------------------- *)
let pp_json fmt json =
Format.fprintf fmt "%% dune build @@%s" json
let fail ~json s info =
Format.printf "%a: Error - %s@.%% Aborting: %s@." pp_json json s info ;
exit 2
let output_unix_error (exn : exn) =
match exn with
| Unix.Unix_error (error, _function, arg) ->
let message = Unix.error_message error in
if arg = "" then
Format.eprintf "%s@." message
else
Format.eprintf "%s: %s@." arg message
| _ -> assert false
let unlink ?(silent = true) file =
let open Unix in
try
Unix.unlink file
with
| Unix_error _ when silent -> ()
| Unix_error (ENOENT,_,_) -> () (* Ignore "No such file or directory" *)
| Unix_error _ as e -> output_unix_error e
let system =
if Sys.os_type = "Win32" then
fun f ->
Unix.system (Format.sprintf "bash -c %S" f)
else
fun f ->
Unix.system f
let print_file dir_info file =
Format.printf "%% Generated output file: %s/%s@." dir_info file;
try
let cin = open_in file in
try
while true do
let line = input_line cin in
Format.printf "%s\n" line
done
with _ ->
close_in cin
with _ ->
Format.printf "%% Cannot open file: %s@." file
(* ------------------------------- *)
let example_msg =
Format.sprintf
"@.@[<v 0>\
Wrapper to run test command.@."
let umsg = "Usage: frama-c-wtests [options] <json-config> <test-command>*"
let rec argspec =
[
("-v", Arg.Unit (fun () -> incr verbosity),
"Increase verbosity (up to twice)") ;
("-brief", Arg.Unit (fun () -> verbosity := 0),
"Brief report only on test failure") ;
]
and help_msg () = Arg.usage (Arg.align argspec) umsg
let parse_args () =
let suites = ref [] in
let add_test_suite s = suites := s :: !suites in
Arg.parse
((Arg.align
(List.sort
(fun (optname1, _, _) (optname2, _, _) ->
compare optname1 optname2
) argspec)
) @ ["", Arg.Unit (fun () -> ()), example_msg;])
add_test_suite
umsg;
List.rev !suites
(* ------------------------------- *)
let launch command_string =
let result = system command_string in
match result with
| Unix.WEXITED 127 ->
Format.printf "%% Couldn't execute command.:@\n%s@\nStopping@."
command_string ;
exit 1
| Unix.WEXITED r -> r
| Unix.WSIGNALED s ->
Format.printf
"%% SIGNAL %d received while executing command:@\n%s@\nStopping@."
s command_string ;
exit 1
| Unix.WSTOPPED s ->
Format.printf
"%% STOP %d received while executing command:@\n%s@\nStopping@."
s command_string;
exit 1
let rm_filter_result (_cmd,stdfile) = unlink stdfile
let filter (cmd,_stdfile) =
if !verbosity > 0 then Format.printf "%% Run filter command: %s@." cmd;
let ret_code = launch cmd in
if !verbosity > 0 && ret_code <> 0 then Format.printf "%% note: the filter command returned an error code (%d)@." ret_code
let compare_files ~json ~error ~result oracle =
let not_generated = not (Sys.file_exists result) in
if not_generated then
Format.printf "%a: missing target %S@." pp_json json result;
let diff_cmd = if !verbosity > 0 then diff_cmd else cmp_cmd in
let cmd = Format.sprintf "%s %s %s" (if !verbosity > 0 then diff_cmd else cmp_cmd) oracle result in
if !verbosity > 0 then Format.printf "%% Run compare command: %s@." cmd;
let ret_code = launch cmd in
let is_ko = ret_code <> 0 in
if is_ko then Format.printf "%a: diff failure on diff: (cd _build/default && %s %S %S)@." pp_json json diff_cmd result oracle ;
error || is_ko
let compare_std ~json error = function
| "" -> fun _ -> error
| result -> compare_files ~json ~error ~result
let compare_log ~json oracle_dir error result =
compare_files ~json ~error ~result (Filename.concat oracle_dir result)
let remove file = if file <> "" then unlink file
let extract filters targets = function
| "" -> fun _ _ -> filters,targets
| stdfile -> function
| "" -> fun _ -> filters,(stdfile::targets)
| tmp -> fun cmd -> ((cmd,stdfile)::filters),(tmp::stdfile::targets)
type wtest = {
info: (string [@default ""]); (* info *)
dir: (string [@default ""]); (* test directory *)
cmd: (string [@default "echo unknown command"]);
ret_code: (int [@default 0]);
out: (string [@default "" (* bin target built by the command *) ]); (* sdtout target *)
err: (string [@default "" (* bin target built by the command *) ]); (* stderr target *)
tmpout: (string [@default ""]); (* temporary file to filter stdout result *)
tmperr: (string [@default ""]); (* temporary file to filter stderr result *)
sedout: (string [@default ""]); (* filter command for the stdout result *)
sederr: (string [@default ""]); (* filter command for the stderr result *)
bin: (string list [@default []]); (* binary targets (without oracles) *)
log: (string list [@default []]); (* log targets (compared to log oracles *)
oracle_dir: (string [@default "../oracle"]); (* directory containing the oracle of the log files *)
oracle_out: (string [@default "" ]); (* oracle of the stdout target *)
oracle_err: (string [@default "" ]); (* oracle of the stderr target *)
}
[@@deriving of_yojson]
let wrapper json test =
let sed,logs = extract [] test.log test.out test.tmpout test.sedout in
let sed,logs = extract sed logs test.err test.tmperr test.sederr in
if logs <> [] || test.bin <> [] then begin
if !verbosity > 0 then Format.printf "%% Clean targets...@.";
List.iter remove logs;
List.iter remove test.bin
end;
if !verbosity > 0 then Format.printf "%% Run test command: %s@." test.cmd;
let ret_code = launch test.cmd in
let error = ret_code <> test.ret_code in
if error || !verbosity > 0 then begin
if test.out <> "" then print_file test.dir (if test.tmpout = "" then test.out else test.tmpout) ;
if test.err <> "" then print_file test.dir (if test.tmperr = "" then test.err else test.tmperr)
end;
if error then begin
Format.printf "%a: return code (%d) differs from the requested code (%d) for the command:%s@."
pp_json json ret_code test.ret_code test.cmd;
true
end else begin
List.iter filter sed ;
let is_cmp_ko = compare_std ~json false test.out test.oracle_out in
let is_cmp_ko = compare_std ~json is_cmp_ko test.err test.oracle_err in
let is_cmp_ko = List.fold_left (compare_log ~json test.oracle_dir) is_cmp_ko test.log in
if !verbosity = 0 then
(* In `-brief` mode (used by the `dune` file generated by `frama-c-ptests`),
the filtered result file are removed
in order to let `dune` applying the filters. *)
List.iter rm_filter_result sed ;
(* In `-brief` mode,
the comparison failures are not reported with an error code
in order to let `dune` reporting them with the textual differences. *)
(if !verbosity > 1 then is_cmp_ko else false)
end
let parse ~json =
if !verbosity > 0 then Format.printf "%% Parsing Jsonjson...@.";
match wtest_of_yojson (Yojson.Safe.from_file json) with
| Error txt -> fail ~json txt "Json file cannot be parsed"
| Ok r -> r
let wrapper ~json =
try
let test = parse ~json in
let json = test.dir ^ "/" ^ json in
if !verbosity > 0 then
Format.printf "%% Wrapping info: %s@." test.info ;
match test with
| { info; out=""; tmpout=tmp; sedout=sed; _} when tmp <> "" || sed <> "" -> fail ~json "StdOut filter cannot be applied" info
| { info; err=""; tmperr=tmp; sederr=sed; _} when tmp <> "" || sed <> "" -> fail ~json "StdErr filter cannot be applied" info
| { info; out=std; oracle_out=oracle; _} when (std <> "") <> (oracle <> "") -> fail ~json "StdOut file cannot be compared to an oracle" info
| { info; err=std; oracle_err=oracle; _} when (std <> "") <> (oracle <> "") -> fail ~json "StdErr file cannot be compared to an oracle" info
| { info; tmpout=tmp; sedout=sed; _} when (tmp <> "") <> (sed <> "") -> fail ~json "StdOut filter cannot be applied" info
| { info; tmperr=tmp; sederr=sed; _} when (tmp <> "") <> (sed <> "") -> fail ~json "StdErr filter cannot be applied" info
| _ ->
if wrapper json test then
fail ~json "Test failed" test.info
with
| Yojson.Json_error txt
| Sys_error txt -> fail ~json txt "Json file cannot be parsed"
let () =
let args = parse_args () in
(* verbosity := 1; *)
match args with
| json::commands ->
if !verbosity > 0 then begin
Format.printf "%% Wrapping from json file: %S@." json ;
match commands with
| cmd::filters ->
Format.printf "%% Wrapped command: %s@." cmd ;
List.iter (fun s -> Format.printf "%% Wrapped filter: %s@." s) filters;
| _ -> ()
end;
wrapper ~json
| _ -> help_msg () ; exit 1
(*
Local Variables:
compile-command: "LC_ALL=C make -C .. ptests"
End:
*)
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment