From 29cb1978e0c4c718eb4be29d7f47651646f2171e Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Thu, 4 Jul 2024 14:25:46 +0200 Subject: [PATCH] Clerk report: add JUnit-compatible XML output --- build_system/clerk_driver.ml | 30 ++++++++++-- build_system/clerk_report.ml | 89 ++++++++++++++++++++++++++--------- build_system/clerk_report.mli | 4 ++ 3 files changed, 95 insertions(+), 28 deletions(-) diff --git a/build_system/clerk_driver.ml b/build_system/clerk_driver.ml index 7464fa59..5b8a0122 100644 --- a/build_system/clerk_driver.ml +++ b/build_system/clerk_driver.ml @@ -177,6 +177,12 @@ module Cli = struct & pos_all string [] & info [] ~docv:"FILE(S)" ~doc:"File(s) or folder(s) to process") + let files = + Arg.( + value + & pos_all file [] + & info [] ~docv:"FILE(S)" ~doc:"File(s) to process") + let single_file = Arg.( required @@ -228,6 +234,14 @@ module Cli = struct ~doc:"Display the full list of tests that have been run" ); ]) + let report_xml = + Arg.( + value + & flag + & info ["xml"] + ~env:(Cmd.Env.info "CATALA_XML_REPORT") + ~doc:"Output the test report in JUnit-compatible XML format") + let diff_command = Arg.( value @@ -940,6 +954,7 @@ let test_cmd = (reset_test_outputs : bool) (test_flags : string list) verbosity + xml (diff_command : string option option) (ninja_flags : string list) = set_report_verbosity verbosity; @@ -959,6 +974,9 @@ let test_cmd = let reports = List.flatten (List.map read_many targets) in if reset_test_outputs then let () = + if xml then + Message.error + "Options @{--xml@} and @{--reset@} are incompatible"; let ppf = Message.formatter_of_out_channel stdout () in match List.filter (fun f -> f.successful < f.total) reports with | [] -> @@ -992,7 +1010,7 @@ let test_cmd = (List.length need_reset) in raise (Catala_utils.Cli.Exit_with 0) - else if summary ~build_dir reports then + else if (if xml then print_xml else summary) ~build_dir reports then raise (Catala_utils.Cli.Exit_with 0) else raise (Catala_utils.Cli.Exit_with 1) | 1 -> raise (Catala_utils.Cli.Exit_with 10) (* Ninja build failed *) @@ -1013,6 +1031,7 @@ let test_cmd = $ Cli.reset_test_outputs $ Cli.test_flags $ Cli.report_verbosity + $ Cli.report_xml $ Cli.diff_command $ Cli.ninja_flags) @@ -1076,14 +1095,14 @@ let runtest_cmd = $ Cli.single_file) let report_cmd = - let run color debug verbosity diff_command build_dir file = + let run color debug verbosity xml diff_command build_dir files = let _options = Catala_utils.Global.enforce_options ~debug ~color () in let build_dir = Option.value ~default:"_build" build_dir in set_report_verbosity verbosity; Clerk_report.set_display_flags ~diff_command (); let open Clerk_report in - let tests = read_many file in - let success = summary ~build_dir tests in + let tests = List.flatten (List.map read_many files) in + let success = (if xml then print_xml else summary) ~build_dir tests in exit (if success then 0 else 1) in let doc = @@ -1096,9 +1115,10 @@ let report_cmd = $ Cli.Global.color $ Cli.Global.debug $ Cli.report_verbosity + $ Cli.report_xml $ Cli.diff_command $ Cli.build_dir - $ Cli.single_file) + $ Cli.files) let main_cmd = Cmd.group Cli.info [build_cmd; test_cmd; run_cmd; runtest_cmd; report_cmd] diff --git a/build_system/clerk_report.ml b/build_system/clerk_report.ml index 33aa2a76..38419dc0 100644 --- a/build_system/clerk_report.ml +++ b/build_system/clerk_report.ml @@ -183,38 +183,38 @@ let print_diff ppf p1 p2 = let catala_commands_with_output_flag = ["makefile"; "html"; "latex"; "ocaml"; "python"; "r"; "c"] +let pfile ~build_dir f = + f + |> String.remove_prefix ~prefix:(build_dir ^ Filename.dir_sep) + |> String.remove_prefix ~prefix:(Sys.getcwd () ^ Filename.dir_sep) + +let clean_command_line ~build_dir file cl = + cl + |> List.filter_map (fun s -> + if s = "--directory=" ^ build_dir then None + else Some (pfile ~build_dir s)) + |> (function + | catala :: cmd :: args -> + catala :: cmd :: "-I" :: Filename.dirname file :: args + | cl -> cl) + |> function + | catala :: cmd :: args + when List.mem (String.lowercase_ascii cmd) catala_commands_with_output_flag + -> + (catala :: cmd :: args) @ ["-o -"] + | cl -> cl + let display ~build_dir file ppf t = - let pfile f = - f - |> String.remove_prefix ~prefix:(build_dir ^ Filename.dir_sep) - |> String.remove_prefix ~prefix:(Sys.getcwd () ^ Filename.dir_sep) - in - let command_line_cleaned = - List.filter_map - (fun s -> if s = "--directory=" ^ build_dir then None else Some (pfile s)) - t.command_line - |> (function - | catala :: cmd :: args -> - catala :: cmd :: "-I" :: Filename.dirname file :: args - | cl -> cl) - |> function - | catala :: cmd :: args - when List.mem - (String.lowercase_ascii cmd) - catala_commands_with_output_flag -> - (catala :: cmd :: args) @ ["-o -"] - | cl -> cl - in let pp_pos ppf (start, stop) = assert (start.Lexing.pos_fname = stop.Lexing.pos_fname); Format.fprintf ppf "@{%s:%d-%d@}" - (pfile start.Lexing.pos_fname) + (pfile ~build_dir start.Lexing.pos_fname) start.Lexing.pos_lnum stop.Lexing.pos_lnum in let print_command () = Format.fprintf ppf "@,@[$ @{%a@}@]" (Format.pp_print_list ~pp_sep:Format.pp_print_space Format.pp_print_string) - command_line_cleaned + (clean_command_line ~build_dir file t.command_line) in Format.pp_open_vbox ppf 2; if t.success then ( @@ -345,3 +345,46 @@ let summary ~build_dir tests = Format.pp_close_box ppf (); Format.pp_print_flush ppf (); success = total + +let print_xml ~build_dir tests = + let ffile ppf f = Format.pp_print_string ppf (pfile ~build_dir f) in + let ppf = Message.formatter_of_out_channel stdout () in + let tests = List.filter (fun f -> f.total > 0) tests in + let success, total = + List.fold_left + (fun (success, total) file -> + success + file.successful, total + file.total) + (0, 0) tests + in + Format.fprintf ppf "@[@,"; + Format.fprintf ppf "@[@," + success (total - success); + Format.pp_print_list + (fun ppf f -> + Format.fprintf ppf + "@[@[@]@," + ffile f.name f.total (f.total - f.successful); + Format.pp_print_list + (fun ppf t -> + Format.fprintf ppf "@[" + (fst t.expected).Lexing.pos_lnum; + Format.fprintf ppf + "@,\ + @[@,\ + @[%a@]@;\ + <0 -2>@]" + (Format.pp_print_list ~pp_sep:Format.pp_print_space + Format.pp_print_string) + (clean_command_line ~build_dir f.name t.command_line); + if not t.success then ( + Format.fprintf ppf + "@,@[@,"; + print_diff ppf t.expected t.result; + Format.fprintf ppf "@]@,"); + Format.fprintf ppf "@]@,") + ppf f.tests; + Format.fprintf ppf "@]@,") + ppf tests; + Format.fprintf ppf "@]@,@,@]@."; + success = total diff --git a/build_system/clerk_report.mli b/build_system/clerk_report.mli index 42355aa6..ed7791c5 100644 --- a/build_system/clerk_report.mli +++ b/build_system/clerk_report.mli @@ -39,6 +39,10 @@ val display : build_dir:File.t -> File.t -> Format.formatter -> test -> unit val summary : build_dir:File.t -> file list -> bool (** Displays a summary to stdout; returns true if all tests succeeded *) +val print_xml : build_dir:File.t -> file list -> bool +(** Displays a summary in JUnit XML comptible format to stdout; returns true if + all tests succeeded *) + val set_display_flags : ?files:[ `All | `Failed | `None ] -> ?tests:[ `All | `FailedFile | `Failed | `None ] ->