From 859a602c0bc9440c5b1bd33e88d4a1706c157cc0 Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Wed, 19 Jun 2024 12:14:26 +0200 Subject: [PATCH] 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 | 48 ++++++++++++++++++++++- build_system/clerk_report.ml | 72 +++++++++++++++++++++-------------- build_system/clerk_report.mli | 6 +-- 3 files changed, 92 insertions(+), 34 deletions(-) diff --git a/build_system/clerk_driver.ml b/build_system/clerk_driver.ml index b7d74cad..5e19a7e2 100644 --- a/build_system/clerk_driver.ml +++ b/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) diff --git a/build_system/clerk_report.ml b/build_system/clerk_report.ml index ef83c31c..a5423ed1 100644 --- a/build_system/clerk_report.ml +++ b/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 tests : disp_toggle; + mutable files : [ `All | `Failed | `None ]; + 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 ( - if disp_flags.tests = DAll then - Format.fprintf ppf "@{■@} %a passed" pp_pos t.expected) - else ( - Format.pp_open_vbox ppf 2; - Format.fprintf ppf "@{■@} %a failed@," pp_pos t.expected; - Format.fprintf ppf "@[$ @{%a@}@]@," + let print_command () = + Format.fprintf ppf "@,@[$ @{%a@}@]" (Format.pp_print_list ~pp_sep:Format.pp_print_space Format.pp_print_string) - command_line_cleaned; - if disp_flags.diffs then + command_line_cleaned + in + Format.pp_open_vbox ppf 2; + if t.success then ( + Format.fprintf ppf "@{■@} %a passed" pp_pos t.expected; + if Global.options.debug then print_command ()) + else ( + Format.fprintf ppf "@{■@} %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_close_box ppf ()) + |> Format.pp_print_list Format.pp_print_string 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 "@{ @} @{%s@}: @{%d@} / %d tests \ - passed@," - (pfile t.name) t.successful t.total) - else ( - (function + passed" + (pfile t.name) t.successful t.total; + if disp_flags.tests = `All then print_tests t.tests; + Format.pp_print_cut ppf ())) + else + let () = + match t.successful with | 0 -> Format.fprintf ppf "@{ @}" - | _ -> Format.fprintf ppf "@{ @}") - t.successful; + | _ -> Format.fprintf ppf "@{ @}" + in Format.fprintf ppf " @{%s@}: " (pfile t.name); (function | 0 -> Format.fprintf ppf "@{0@}" | n -> Format.fprintf ppf "@{%d@}" n) t.successful; Format.fprintf ppf " / %d tests passed" t.total; - Format.pp_print_break ppf 0 3; - if disp_flags.tests <> DNone then ( - 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 ()) + if disp_flags.tests <> `None then print_tests t.tests; + 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 diff --git a/build_system/clerk_report.mli b/build_system/clerk_report.mli index 3d4781be..b7936c16 100644 --- a/build_system/clerk_report.mli +++ b/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 -> - ?tests:disp_toggle -> + ?files:[ `All | `Failed | `None ] -> + ?tests:[ `All | `FailedFile | `Failed | `None ] -> ?diffs:bool -> ?use_patdiff:bool -> unit ->