Clerk reports: add verbosity flags

`--summary`
`--short`
`--failures` (default)
`--verbose`

(`--debug` also adds some detail, e.g. the commands to reproduce non-failing
tests, or the files without failures in the default mode)

build_system/clerk_driver.ml

@@ -208,6 +208,34 @@ module Cli = struct
             "Flags or targets to forward to Ninja directly (use $(b,-- \
              ninja_flags) to separate Ninja flags from Clerk flags)")
 
+  let report_verbosity =
+    Arg.(
+      value
+      & vflag `Failures
+          [
+            ( `Summary,
+              info ["summary"] ~doc:"Only display a summary of the test results"
+            );
+            ( `Short,
+              info ["short"] ~doc:"Don't display detailed test failures diff" );
+            ( `Failures,
+              info ["failures"]
+                ~doc:"Show details of files with failed tests only" );
+            ( `Verbose,
+              info ["verbose"; "v"]
+                ~doc:"Display the full list of tests that have been run" );
+          ])
+
+  let use_patdiff =
+    Arg.(
+      value
+      & flag
+      & info ["patdiff"]
+          ~env:(Cmd.Env.info "CATALA_USE_PATDIFF")
+          ~doc:
+            "Enable use of the 'patdiff' command for showing test failure \
+             details (no effect if the command is not available)")
+
   let ninja_flags =
     let env =
       Cmd.Env.info
@@ -870,13 +898,25 @@ let build_cmd =
     Term.(
       const run $ Cli.Global.term ninja_init $ Cli.targets $ Cli.ninja_flags)
 
+let set_report_verbosity = function
+  | `Summary -> Clerk_report.set_display_flags ~files:`None ~tests:`None ()
+  | `Short ->
+    Clerk_report.set_display_flags ~files:`Failed ~tests:`Failed ~diffs:false ()
+  | `Failures ->
+    if Global.options.debug then Clerk_report.set_display_flags ~files:`All ()
+  | `Verbose -> Clerk_report.set_display_flags ~files:`All ~tests:`All ()
+
 let test_cmd =
   let run
       ninja_init
       (files_or_folders : string list)
       (reset_test_outputs : bool)
       (test_flags : string list)
+      verbosity
+      (use_patdiff : bool)
       (ninja_flags : string list) =
+    set_report_verbosity verbosity;
+    Clerk_report.set_display_flags ~use_patdiff ();
     ninja_init ~extra:Seq.empty ~test_flags
     @@ fun build_dir nin_file ->
     let targets =
@@ -945,6 +985,8 @@ let test_cmd =
       $ Cli.files_or_folders
       $ Cli.reset_test_outputs
       $ Cli.test_flags
+      $ Cli.report_verbosity
+      $ Cli.use_patdiff
       $ Cli.ninja_flags)
 
 let run_cmd =
@@ -1007,9 +1049,11 @@ let runtest_cmd =
       $ Cli.single_file)
 
 let report_cmd =
-  let run color debug build_dir file =
+  let run color debug verbosity use_patdiff build_dir file =
     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 ~use_patdiff ();
     let open Clerk_report in
     let tests = read_many file in
     let success = summary ~build_dir tests in
@@ -1024,6 +1068,8 @@ let report_cmd =
       const run
       $ Cli.Global.color
       $ Cli.Global.debug
+      $ Cli.report_verbosity
+      $ Cli.use_patdiff
       $ Cli.build_dir
       $ Cli.single_file)
 

build_system/clerk_report.ml

@@ -28,17 +28,16 @@ type test = {
 }
 
 type file = { name : File.t; successful : int; total : int; tests : test list }
-type disp_toggle = DAll | DFailed | DNone
 
 type disp_flags = {
-  mutable files : disp_toggle;
+  mutable files : [ `All | `Failed | `None ];
-  mutable tests : disp_toggle;
+  mutable tests : [ `All | `FailedFile | `Failed | `None ];
   mutable diffs : bool;
   mutable use_patdiff : bool;
 }
 
 let disp_flags =
-  { files = DFailed; tests = DAll; diffs = true; use_patdiff = false }
+  { files = `Failed; tests = `FailedFile; diffs = true; use_patdiff = false }
 
 let set_display_flags
     ?(files = disp_flags.files)
@@ -150,47 +149,62 @@ let display ~build_dir ppf t =
       (pfile start.Lexing.pos_fname)
       start.Lexing.pos_lnum stop.Lexing.pos_lnum
   in
-  if t.success then (
+  let print_command () =
-    if disp_flags.tests = DAll then
+    Format.fprintf ppf "@,@[<h>$ @{<yellow>%a@}@]"
-      Format.fprintf ppf "@{<green>■@} %a passed" pp_pos t.expected)
-  else (
-    Format.pp_open_vbox ppf 2;
-    Format.fprintf ppf "@{<red>■@} %a failed@," pp_pos t.expected;
-    Format.fprintf ppf "@[<h>$ @{<yellow>%a@}@]@,"
       (Format.pp_print_list ~pp_sep:Format.pp_print_space Format.pp_print_string)
-      command_line_cleaned;
+      command_line_cleaned
-    if disp_flags.diffs then
+  in
+  Format.pp_open_vbox ppf 2;
+  if t.success then (
+    Format.fprintf ppf "@{<green>■@} %a passed" pp_pos t.expected;
+    if Global.options.debug then print_command ())
+  else (
+    Format.fprintf ppf "@{<red>■@} %a failed" pp_pos t.expected;
+    print_command ();
+    if disp_flags.diffs then (
+      Format.pp_print_cut ppf ();
       get_diff t.expected t.result
       |> String.split_on_char '\n'
       |> List.filter (( <> ) "")
-      |> Format.pp_print_list Format.pp_print_string ppf;
+      |> Format.pp_print_list Format.pp_print_string ppf));
-    Format.pp_close_box ppf ())
+  Format.pp_close_box ppf ()
 
 let display_file ~build_dir ppf t =
   let pfile f = String.remove_prefix ~prefix:(build_dir ^ Filename.dir_sep) f in
+  let print_tests tests =
+    let tests =
+      match disp_flags.tests with
+      | `All | `FailedFile -> tests
+      | `Failed -> List.filter (fun t -> not t.success) tests
+      | `None -> assert false
+    in
+    Format.pp_print_break ppf 0 3;
+    Format.pp_open_vbox ppf 0;
+    Format.pp_print_list (display ~build_dir) ppf tests;
+    Format.pp_close_box ppf ()
+  in
   if t.successful = t.total then (
-    if disp_flags.files = DAll then
+    if disp_flags.files = `All then (
       Format.fprintf ppf
         "@{<green;reverse;ul>  @} @{<cyan>%s@}: @{<green;bold>%d@} / %d tests \
-         passed@,"
+         passed"
-        (pfile t.name) t.successful t.total)
+        (pfile t.name) t.successful t.total;
-  else (
+      if disp_flags.tests = `All then print_tests t.tests;
-    (function
+      Format.pp_print_cut ppf ()))
+  else
+    let () =
+      match t.successful with
       | 0 -> Format.fprintf ppf "@{<red;reverse;ul>  @}"
-      | _ -> Format.fprintf ppf "@{<yellow;reverse;ul>  @}")
+      | _ -> Format.fprintf ppf "@{<yellow;reverse;ul>  @}"
-      t.successful;
+    in
     Format.fprintf ppf " @{<cyan>%s@}: " (pfile t.name);
     (function
       | 0 -> Format.fprintf ppf "@{<red;bold>0@}"
       | n -> Format.fprintf ppf "@{<yellow;bold>%d@}" n)
       t.successful;
     Format.fprintf ppf " / %d tests passed" t.total;
-    Format.pp_print_break ppf 0 3;
+    if disp_flags.tests <> `None then print_tests t.tests;
-    if disp_flags.tests <> DNone then (
+    Format.pp_print_cut ppf ()
-      Format.pp_open_vbox ppf 0;
-      Format.pp_print_list (display ~build_dir) ppf t.tests;
-      Format.pp_close_box ppf ());
-    Format.pp_print_cut ppf ())
 
 type box = { print_line : 'a. ('a, Format.formatter, unit) format -> 'a }
 [@@ocaml.unboxed]
@@ -236,7 +250,7 @@ let summary ~build_dir tests =
           total + file.total ))
       (0, 0, 0, 0) tests
   in
-  if disp_flags.files <> DNone then
+  if disp_flags.files <> `None then
     List.iter (fun f -> display_file ~build_dir ppf f) tests;
   let result_box =
     if success < total then

build_system/clerk_report.mli

@@ -39,11 +39,9 @@ val display : build_dir: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 *)
 
-type disp_toggle = DAll | DFailed | DNone
-
 val set_display_flags :
-  ?files:disp_toggle ->
+  ?files:[ `All | `Failed | `None ] ->
-  ?tests:disp_toggle ->
+  ?tests:[ `All | `FailedFile | `Failed | `None ] ->
   ?diffs:bool ->
   ?use_patdiff:bool ->
   unit ->