Skip to content

Commit

Permalink
ocamltest: one line per passing test (ocaml#12895)
Browse files Browse the repository at this point in the history 
* ocamltest: one line per passing test

* Show timings in same line

* Adapt summarize.awk
  • Loading branch information
@nojb
nojb authored Jan 29, 2024
1 parent f266428 commit 43065a8
Show file tree
Hide file tree
Showing 2 changed files with 37 additions and 38 deletions.
48 changes: 28 additions & 20 deletions ocamltest/main.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -104,16 +104,20 @@ let join_summaries sa sb =
| All_skipped, All_skipped -> All_skipped
| _ -> No_failure

let rec run_test_tree log common_prefix behavior env summ ast =
let string_of_summary = function
| No_failure -> "passed"
| Some_failure -> "failed"
| All_skipped -> "skipped"

let rec run_test_tree log add_msg behavior env summ ast =
match ast with
| Ast (Environment_statement s :: stmts, subs) ->
begin match interpret_environment_statement env s with
| env ->
run_test_tree log common_prefix behavior env summ (Ast (stmts, subs))
run_test_tree log add_msg behavior env summ (Ast (stmts, subs))
| exception e ->
let line = s.loc.Location.loc_start.Lexing.pos_lnum in
Printf.printf "%s line %d %!" common_prefix line;
Printf.printf "%s\n%!" (report_error s.loc e);
Printf.ksprintf add_msg "line %d %s" line (report_error s.loc e);
Some_failure
end
| Ast (Test (_, name, mods) :: stmts, subs) ->
Expand All @@ -123,7 +127,6 @@ let rec run_test_tree log common_prefix behavior env summ ast =
else
Printf.sprintf "line %d" name.loc.Location.loc_start.Lexing.pos_lnum
in
Printf.printf "%s %s (%s) %!" common_prefix locstr name.node;
let (msg, children_behavior, newenv, result) =
match behavior with
| Skip_all -> ("=> n/a", Skip_all, env, Result.skip)
Expand All @@ -138,13 +141,13 @@ let rec run_test_tree log common_prefix behavior env summ ast =
with e -> (report_error name.loc e, Skip_all, env, Result.fail)
end
in
Printf.printf "%s\n%!" msg;
Printf.ksprintf add_msg "%s (%s) %s" locstr name.node msg;
let newsumm = join_result summ result in
let newast = Ast (stmts, subs) in
run_test_tree log common_prefix children_behavior newenv newsumm newast
run_test_tree log add_msg children_behavior newenv newsumm newast
| Ast ([], subs) ->
List.fold_left join_summaries summ
(List.map (run_test_tree log common_prefix behavior env All_skipped) subs)
(List.map (run_test_tree log add_msg behavior env All_skipped) subs)

let get_test_source_directory test_dirname =
if (Filename.is_relative test_dirname) then
Expand Down Expand Up @@ -238,32 +241,41 @@ let test_file test_filename =
Builtin_variables.promote, promote;
Builtin_variables.timeout, default_timeout;
] in
let common_prefix = " ... testing '" ^ test_basename ^ "' with" in
let initial_status = if skip_test then Skip_all else Run in
let rootenv =
Environments.initialize Environments.Pre log initial_environment
in
let rootenv, initial_status =
let msgs = ref [] in
let add_msg s = msgs := s :: !msgs in
let rootenv, initial_status, initial_summary =
let rec loop env stmts =
match stmts with
| [] -> (env, initial_status)
| [] -> (env, initial_status, All_skipped)
| s :: t ->
begin match interpret_environment_statement env s with
| env -> loop env t
| exception e ->
let line = s.loc.Location.loc_start.Lexing.pos_lnum in
Printf.printf "%s line %d %!" common_prefix line;
Printf.printf "%s\n%!" (report_error s.loc e);
(env, Skip_all)
Printf.ksprintf add_msg "line %d %s" line (report_error s.loc e);
(env, Skip_all, Some_failure)
end
in
loop rootenv rootenv_statements
in
let rootenv = Environments.initialize Environments.Post log rootenv in
let summary =
run_test_tree log common_prefix initial_status rootenv All_skipped
run_test_tree log add_msg initial_status rootenv initial_summary
tsl_ast
in
let common_prefix = " ... testing '" ^ test_basename ^ "'" in
Printf.printf "%s => %s%s\n%!" common_prefix (string_of_summary summary)
(if Options.show_timings && summary = No_failure then
let wall_clock_duration = Unix.gettimeofday () -. start in
Printf.sprintf " (wall clock: %.02fs)" wall_clock_duration
else "");
if summary = Some_failure then
List.iter (Printf.printf "%s with %s\n%!" common_prefix)
(List.rev !msgs);
Actions.clear_all_hooks();
summary
) in
Expand All @@ -275,11 +287,7 @@ let test_file test_filename =
| No_failure | All_skipped ->
if not Options.keep_test_dir_on_success then
clean_test_build_directory ()
end;
if Options.show_timings && summary = No_failure then
let wall_clock_duration = Unix.gettimeofday () -. start in
Printf.eprintf "Wall clock: %s took %.02fs\n%!"
test_filename wall_clock_duration
end

let is_test filename =
let input_channel = open_in filename in
Expand Down
27 changes: 9 additions & 18 deletions testsuite/summarize.awk
View file
Original file line number Diff line number Diff line change
Expand Up @@ -99,34 +99,25 @@ function record_unexp() {
errored = 1;
}

/^ ... testing '[^']*' with / {
if (in_test) record_unexp();
next;
}

/^ ... testing '[^']*'/ {
if (in_test) record_unexp();
match($0, /... testing '[^']*'/);
curfile = substr($0, RSTART+13, RLENGTH-14);
if (match($0, /... testing '[^']*' with [^:=]*/)){
curfile = substr($0, RSTART+12, RLENGTH-12);
if (match($0, /\(wall clock: .*s\)/)){
duration = substr($0, RSTART+13, RLENGTH-15);
if (duration + 0.0 > 10.0)
slow[slowcount++] = sprintf("%s: %s", curfile, duration);
}
key = sprintf ("%s/%s", curdir, curfile);
DIRS[key] = curdir;
in_test = 1;
}

/^ ... testing (with|[^'])/ {
if (in_test) record_unexp();
key = curdir;
DIRS[key] = curdir;
in_test = 1;
}

/^Wall clock:/ {
match($0, /: .* took /);
curfile = substr($0, RSTART+2, RLENGTH-8);
match($0, / took .*s/);
duration = substr($0, RSTART+6, RLENGTH-7);
if (duration + 0.0 > 10.0)
slow[slowcount++] = sprintf("%s: %s", curfile, duration);
}

/=> passed/ {
record_pass();
}
Expand Down

0 comments on commit 43065a8

Please sign in to comment.