Clerk report: add JUnit-compatible XML output

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 @{<bold>--xml@} and @{<bold>--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]

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 "@{<cyan>%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 "@,@[<h>$ @{<yellow>%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 "@[<v><?xml version=\"1.0\" encoding=\"UTF-8\"?>@,";
+  Format.fprintf ppf "@[<v 2><testsuites tests=\"%d\" failures=\"%d\">@,"
+    success (total - success);
+  Format.pp_print_list
+    (fun ppf f ->
+      Format.fprintf ppf
+        "@[<v 2>@[<hov 1><testsuite@ name=\"%a\"@ tests=\"%d\"@ \
+         failures=\"%d\">@]@,"
+        ffile f.name f.total (f.total - f.successful);
+      Format.pp_print_list
+        (fun ppf t ->
+          Format.fprintf ppf "@[<v 2><testcase line=\"%d\">"
+            (fst t.expected).Lexing.pos_lnum;
+          Format.fprintf ppf
+            "@,\
+             @[<hv 2><property name=\"description\">@,\
+             @[<hov 2>%a@]@;\
+             <0 -2></property>@]"
+            (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
+              "@,@[<v 2><failure message=\"Output differs from reference\">@,";
+            print_diff ppf t.expected t.result;
+            Format.fprintf ppf "@]@,</failure>");
+          Format.fprintf ppf "@]@,</testcase>")
+        ppf f.tests;
+      Format.fprintf ppf "@]@,</testsuite>")
+    ppf tests;
+  Format.fprintf ppf "@]@,</testsuites>@,@]@.";
+  success = total

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 ] ->