Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ocamlbuild testsuite: add a "requirements" field to skip tests we cannot run 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14126 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Gabriel Scherer 2013-09-15 11:36:08 +00:00
parent dfc06e175c
commit 0c83a6f7fa
1 changed files with 92 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

134
ocamlbuild/testsuite/ocamlbuild_test.ml
View File

@ -19,8 +19,11 @@ let print_list ~sep f ppf = function
| x :: [] -> f ppf x
| x :: xs -> f ppf x; List.iter (fun x -> sep ppf (); f ppf x) xs
let print_list_com f = print_list ~sep:(fun ppf () -> pp_print_string ppf ",") f
let print_list_blank f = print_list ~sep:(fun ppf () -> pp_print_string ppf " ") f
let print_list_com f =
print_list ~sep:(fun ppf () -> pp_print_string ppf ",") f
let print_list_blank f =
print_list ~sep:(fun ppf () -> pp_print_string ppf " ") f
let print_string_list = print_list_com pp_print_string
let print_string_list_com = print_list_com pp_print_string
let print_string_list_blank = print_list_blank pp_print_string
@ -375,8 +378,11 @@ type content = string
type filename = string
type run = filename * content
type requirements = Fullfilled | Missing of string
type test = { name : string
; description : string
; requirements : requirements option
; tree : Tree.t list
; matching : Match.t list
; options : Option.t list
@ -389,12 +395,24 @@ let tests = ref []
let test name
~description
?requirements
?(options=[]) ?(run=[]) ?pre_cmd ?failing_msg
?(tree=[])
?(matching=[])
~targets ()
=
tests := !tests @ [{ name; description; tree; matching; options; targets; pre_cmd; failing_msg; run }]
tests := !tests @ [{
name;
description;
requirements;
tree;
matching;
options;
targets;
pre_cmd;
failing_msg;
run;
}]
let run ~root =
let dir = Sys.getcwd () in
@ -413,6 +431,7 @@ let run ~root =
let one_test
{ name
; description
; requirements
; tree
; matching
; options
@ -427,47 +446,78 @@ let run ~root =
List.iter (Tree.create_on_fs ~root:full_name) tree;
Unix.chdir full_name;
(match pre_cmd with
| None -> ()
| Some str -> ignore(Sys.command str));
match requirements with
| Some (Missing req) ->
Printf.printf "\x1b[0;33m\x1b[1m[SKIPPED]\x1b[0m \
\x1b[1m%-20s\x1b[0;33m%s.\n\x1b[m%!" name
(Printf.sprintf "%s is required and missing" req)
let log_name = full_name ^ ".log" in
| Some Fullfilled | None -> begin
let cmd = command options (fst targets :: snd targets) in
let allow_failure = failing_msg <> None in
(match pre_cmd with
| None -> ()
| Some str -> ignore(Sys.command str));
let log_name = full_name ^ ".log" in
let cmd = command options (fst targets :: snd targets) in
let allow_failure = failing_msg <> None in
let open Unix in
Unix.(match execute cmd with
| WEXITED n,lines
| WSIGNALED n,lines
| WSTOPPED n,lines when allow_failure || n <> 0 ->
begin match failing_msg with
| None ->
let ch = open_out log_name in
List.iter (fun l -> output_string ch l; output_string ch "\n") lines;
close_out ch;
Printf.printf "\x1b[0;31m\x1b[1m[FAILED]\x1b[0m \x1b[1m%-20s\x1b[0;33m%s.\n\x1b[m%!" name
(Printf.sprintf "Command '%s' with error code %n output written to %s" cmd n log_name);
| Some failing_msg ->
let starts_with_plus s = String.length s > 0 && s.[0] = '+' in
let lines = List.filter (fun s -> not (starts_with_plus s)) lines in
let msg = String.concat "\n" lines in
if failing_msg = msg then
Printf.printf "\x1b[0;32m\x1b[1m[PASSED]\x1b[0m \x1b[1m%-20s\x1b[0;36m%s.\n\x1b[m%!" name description
else
Printf.printf "\x1b[0;31m\x1b[1m[FAILED]\x1b[0m \x1b[1m%-20s\x1b[0;33m%s.\n\x1b[m%!" name ((Printf.sprintf "Failure with not matching message:\n%s\n!=\n%s\n") msg failing_msg)
end;
| _ ->
let errors = List.concat (List.map (Match.match_with_fs ~root:full_name) matching) in
begin if errors == [] then
Printf.printf "\x1b[0;32m\x1b[1m[PASSED]\x1b[0m \x1b[1m%-20s\x1b[0;36m%s.\n\x1b[m%!" name description
else begin
let ch = open_out log_name in
output_string ch ("Run '" ^ cmd ^ "'\n");
List.iter (fun e -> output_string ch (Match.string_of_error e); output_string ch ".\n") errors;
close_out ch;
Printf.printf "\x1b[0;31m\x1b[1m[FAILED]\x1b[0m \x1b[1m%-20s\x1b[0;33m%s.\n\x1b[m%!" name
(Printf.sprintf "Some system checks failed, output written to %s" log_name)
end
end)
match execute cmd with
| WEXITED n,lines
| WSIGNALED n,lines
| WSTOPPED n,lines when allow_failure || n <> 0 ->
begin match failing_msg with
| None ->
let ch = open_out log_name in
List.iter
(fun l -> output_string ch l; output_string ch "\n")
lines;
close_out ch;
Printf.printf "\x1b[0;31m\x1b[1m[FAILED]\x1b[0m \
\x1b[1m%-20s\x1b[0;33m%s.\n\x1b[m%!" name
(Printf.sprintf "Command '%s' with error code %n \
output written to %s" cmd n log_name);
| Some failing_msg ->
let starts_with_plus s = String.length s > 0 && s.[0] = '+' in
let lines =
(* filter out -classic-display output *)
List.filter (fun s -> not (starts_with_plus s)) lines in
let msg = String.concat "\n" lines in
if failing_msg = msg then
Printf.printf "\x1b[0;32m\x1b[1m[PASSED]\x1b[0m \
\x1b[1m%-20s\x1b[0;36m%s.\n\x1b[m%!" name description
else
Printf.printf "\x1b[0;31m\x1b[1m[FAILED]\x1b[0m \
\x1b[1m%-20s\x1b[0;33m%s.\n\x1b[m%!" name
((Printf.sprintf "Failure with not matching message:\n\
%s\n!=\n%s\n") msg failing_msg)
end;
| _ ->
let errors =
List.concat
(List.map (Match.match_with_fs ~root:full_name) matching) in
begin if errors == [] then
Printf.printf "\x1b[0;32m\x1b[1m[PASSED]\x1b[0m \
\x1b[1m%-20s\x1b[0;36m%s.\n\x1b[m%!" name description
else begin
let ch = open_out log_name in
output_string ch ("Run '" ^ cmd ^ "'\n");
List.iter
(fun e ->
output_string ch (Match.string_of_error e);
output_string ch ".\n")
errors;
close_out ch;
Printf.printf "\x1b[0;31m\x1b[1m[FAILED]\x1b[0m \
\x1b[1m%-20s\x1b[0;33m%s.\n\x1b[m%!" name
(Printf.sprintf "Some system checks failed, \
output written to %s"
log_name)
end
end
end
in List.iter one_test !tests