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