From e4d5bdc8ca4ed31d0f0a36452262395356e7cea7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Beno=C3=AEt=20Montagu?= Date: Wed, 4 Jan 2023 11:18:20 +0100 Subject: [PATCH] feature: option to print a new line between error messages MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Whenever --display-separate-messages is passed, dune will separate error messages by blank lines Signed-off-by: Benoît Montagu --- CHANGES.md | 3 + bin/common.ml | 9 ++ src/dune_console/dune_console.ml | 45 +++++++++ src/dune_console/dune_console.mli | 4 + .../test-cases/error_messages_separated.t | 95 +++++++++++++++++++ 5 files changed, 156 insertions(+) create mode 100644 test/blackbox-tests/test-cases/error_messages_separated.t diff --git a/CHANGES.md b/CHANGES.md index 6d1936474c9b..760a64106728 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -7,6 +7,9 @@ Unreleased - Invoke preprocessor commands from directory of dune file containing the commands rather than from the workspace root (#7057, fixes #7043, @gridbugs) +- Add the `--display-separate-messages` flag to separate the error messages + produced by commands with a blank line. (#6823, fixes #6158, @esope) + 3.7.0 (2023-02-17) ------------------ diff --git a/bin/common.ml b/bin/common.ml index b24287ddc45e..8dad94ed3cfe 100644 --- a/bin/common.ml +++ b/bin/common.ml @@ -525,6 +525,7 @@ module Builder = struct ; workspace_config : Dune_rules.Workspace.Clflags.t ; cache_debug_flags : Dune_engine.Cache_debug_flags.t ; report_errors_config : Dune_engine.Report_errors_config.t + ; separate_error_messages : bool ; require_dune_project_file : bool ; insignificant_changes : [ `React | `Ignore ] ; build_dir : string @@ -804,6 +805,12 @@ module Builder = struct ~doc: "react to insignificant file system changes; this is only useful \ for benchmarking dune") + and+ separate_error_messages = + Arg.( + value & flag + & info + [ "display-separate-messages" ] + ~doc:"Separate error messages with a blank line.") in { debug_dep_path ; debug_backtraces @@ -840,6 +847,7 @@ module Builder = struct } ; cache_debug_flags ; report_errors_config + ; separate_error_messages ; require_dune_project_file ; insignificant_changes = (if react_to_insignificant_changes then `React else `Ignore) @@ -1034,6 +1042,7 @@ let init ?log_file c = [ Pp.textf "Workspace root: %s" (Path.to_absolute_filename Path.root |> String.maybe_quoted) ]; + Dune_console.separate_messages c.builder.separate_error_messages; config let footer = diff --git a/src/dune_console/dune_console.ml b/src/dune_console/dune_console.ml index 9007c19d619f..be75361c5c4b 100644 --- a/src/dune_console/dune_console.ml +++ b/src/dune_console/dune_console.ml @@ -24,8 +24,49 @@ module Backend = struct let progress_no_flush = Progress.no_flush end +(* Flag that controls whether messages should be separated by a blank line *) +let separate_messages_flag = ref false + +(* A user message that solely contains a blank line *) +let blank_line_msg = + { User_message.paragraphs = [ Pp.cut ] + ; hints = [] + ; annots = User_message.Annots.empty + ; loc = None + } + +(** Prints a blank line *) +let print_blank_line () = + let (module M : Backend_intf.S) = !Backend.main in + M.print_user_message blank_line_msg + +let first_msg = ref true + +let separate_messages = ref false + +(* If the [separate_messages = false], then [print_blank_line ()] does nothing. + When [separate_messages = true], [print_blank_line ()] does nothing the + first time it is called, whereas subsequent calls print a new line. Note + that calls to [reset] or [reset_flush_history] will erase the information + of whether some message has already been printed. As a consequence, after a + call to [reset] or [reset_flush_history], [print_blank_line] will behave as + if it has never been called before. *) +let print_blank_line () = + if !separate_messages_flag then + (* only do something when the flag is on, i.e. the first time + the function is called *) + if !first_msg then + (* do not print anything the first time the function is + called, but remember it has been called at least once *) + first_msg := false + else + (* if the function has already been called at least once, + print a blank line *) + print_blank_line () + let print_user_message msg = let (module M : Backend_intf.S) = !Backend.main in + print_blank_line (); M.print_user_message msg let print paragraphs = print_user_message (User_message.make paragraphs) @@ -41,10 +82,14 @@ let print_if_no_status_line line = M.print_if_no_status_line line let reset () = + (* forget that [print_user_message] has ever been called *) + first_msg := true; let (module M : Backend_intf.S) = !Backend.main in M.reset () let reset_flush_history () = + (* forget that [print_user_message] has ever been called *) + first_msg := true; let (module M : Backend_intf.S) = !Backend.main in M.reset_flush_history () diff --git a/src/dune_console/dune_console.mli b/src/dune_console/dune_console.mli index 02f5c88de942..1e26fcf7f642 100644 --- a/src/dune_console/dune_console.mli +++ b/src/dune_console/dune_console.mli @@ -34,6 +34,10 @@ module type Backend = sig val finish : unit -> unit end +(** [separate_messages b] changes the behavior of [print_user_message], so that + it separates messages with a blank line when [b = true]. *) +val separate_messages : bool -> unit + module Backend : sig type t = (module Backend) diff --git a/test/blackbox-tests/test-cases/error_messages_separated.t b/test/blackbox-tests/test-cases/error_messages_separated.t new file mode 100644 index 000000000000..6b3522eae1e3 --- /dev/null +++ b/test/blackbox-tests/test-cases/error_messages_separated.t @@ -0,0 +1,95 @@ +Tests for how error messages are displayed +========================================== + +The purpose of these tests is to check that errors are displayed with +a separating blank line (issue #6158, PR #6823). + +Test setup +---------- + + $ cat >dune-project < (lang dune 2.3) + > EOF + + $ cat >dune < (library + > (name lib)) + > EOF + + $ cat >a.ml < let f x y z = () + > (* this should produce 3 warnings for unused variables *) + > EOF + + $ cat >b.ml < let () = 1 + > (* this should produce a type error *) + > EOF + + $ cat >c.ml < let x = + + > (* this should produce a syntax error *) + > EOF + +Actual tests +------------ + +We check that the errors reported for different files are separated by +blank lines. If a file generates several errors (which is the case for +the `a.ml` file, then no blank lines are inserted between them, +because this is the exact message that is reported by the Ocaml +compiler, and we do not parse or modify such messages. + +Without the --display-separate-messages flag, no blank line is put +between error messages for different files, as expected. + + $ dune build + File "c.ml", line 3, characters 0-0: + Error: Syntax error + File "a.ml", line 1, characters 6-7: + 1 | let f x y z = () + ^ + Error (warning 27 [unused-var-strict]): unused variable x. + File "a.ml", line 1, characters 8-9: + 1 | let f x y z = () + ^ + Error (warning 27 [unused-var-strict]): unused variable y. + File "a.ml", line 1, characters 10-11: + 1 | let f x y z = () + ^ + Error (warning 27 [unused-var-strict]): unused variable z. + File "b.ml", line 1, characters 9-10: + 1 | let () = 1 + ^ + Error: This expression has type int but an expression was expected of type + unit + [1] + +With the --display-separate-messages flag, a blank line is put between +error messages for different files. No blank line is inserted before +the first message, and no blank line is inserted after the last +message either. + + $ dune build --display-separate-messages + File "c.ml", line 3, characters 0-0: + Error: Syntax error + + File "a.ml", line 1, characters 6-7: + 1 | let f x y z = () + ^ + Error (warning 27 [unused-var-strict]): unused variable x. + File "a.ml", line 1, characters 8-9: + 1 | let f x y z = () + ^ + Error (warning 27 [unused-var-strict]): unused variable y. + File "a.ml", line 1, characters 10-11: + 1 | let f x y z = () + ^ + Error (warning 27 [unused-var-strict]): unused variable z. + + File "b.ml", line 1, characters 9-10: + 1 | let () = 1 + ^ + Error: This expression has type int but an expression was expected of type + unit + [1]