let format_display_event conf log_event =
match log_event.event with
| GlobalEvent e ->
begin
match e with
| GConf (_, _) | GLog _ | GStart | GEnd -> ""
| GResults (running_time, results, test_case_count) ->
let separator1 = String.make (Format.get_margin ()) '=' in
let separator2 = String.make (Format.get_margin ()) '-' in
let buf = Buffer.create 1024 in
let bprintf fmt = Printf.bprintf buf fmt in
let print_results =
List.iter
(fun (path, test_result, pos_opt) ->
bprintf "%s\n" separator1;
if results_style_1_X conf then begin
bprintf "%s: %s\n\n"
(result_flavour test_result)
(string_of_path path);
end else begin
bprintf "Error: %s.\n\n" (string_of_path path);
begin
match pos_opt with
| Some pos ->
bprintf "%s\nError: %s (in the log).\n\n"
(ocaml_position pos)
(string_of_path path)
| None ->
()
end;
begin
match test_result with
| RError (_, Some backtrace) ->
bprintf "%s\n" backtrace
| RFailure (_, Some pos, _) ->
bprintf "%s\nError: %s (in the code).\n\n"
(ocaml_position pos)
(string_of_path path)
| RFailure (_, _, Some backtrace) ->
bprintf "%s\n" backtrace
| _ ->
()
end;
end;
bprintf "%s\n" (result_msg test_result);
bprintf "%s\n" separator2)
in
let filter f =
let lst =
List.filter
(fun (_, test_result, _) -> f test_result)
results
in
lst, List.length lst
in
let errors, nerrors = filter is_error in
let failures, nfailures = filter is_failure in
let skips, nskips = filter is_skip in
let todos, ntodos = filter is_todo in
let timeouts, ntimeouts = filter is_timeout in
bprintf "\n";
print_results errors;
print_results failures;
print_results timeouts;
bprintf "Ran: %d tests in: %.2f seconds.\n"
(List.length results) running_time;
if was_successful results then
begin
if skips = [] then
bprintf "OK"
else
bprintf "OK: Cases: %d Skip: %d"
test_case_count nskips
end
else
begin
bprintf
"FAILED: Cases: %d Tried: %d Errors: %d Failures: %d Skip: %d Todo: %d Timeouts: %d."
test_case_count
(List.length results)
nerrors
nfailures
nskips
ntodos
ntimeouts;
end;
bprintf "\n";
Buffer.contents buf
end
| TestEvent (_, e) ->
begin
match e with
| EStart _ | EEnd _ | ELog _ | ELogRaw _ -> ""
| EResult RSuccess -> "."
| EResult (RFailure _) -> "F"
| EResult (RError _) -> "E"
| EResult (RSkip _) -> "S"
| EResult (RTodo _) -> "T"
| EResult (RTimeout _) -> "~"
end