From 29ae7b9325b9c9366c9a38cde777d24cf7edf896 Mon Sep 17 00:00:00 2001 From: Etienne Marais Date: Wed, 19 Jun 2024 09:45:54 +0200 Subject: [PATCH] pkg: simplify the display logs Only logs the standard output when the command fails or the user explicitly requests it. Add new flag `--debug-package-logs`, which force dune to display the stdout logs when dealing with package management. Signed-off-by: Etienne Marais Signed-off-by: Christine Rose Signed-off-by: Etienne Millon --- bin/common.ml | 13 +++ doc/changes/10662.md | 3 + src/dune_rules/clflags.ml | 1 + src/dune_rules/clflags.mli | 3 + src/dune_rules/pkg_rules.ml | 110 ++++++++++++++---- .../test-cases/pkg/build-package-logs.t | 48 ++++++++ test/blackbox-tests/test-cases/pkg/dune | 5 + .../pin-stanza/update-non-dune-local-pin.t | 10 +- 8 files changed, 170 insertions(+), 23 deletions(-) create mode 100644 doc/changes/10662.md create mode 100644 test/blackbox-tests/test-cases/pkg/build-package-logs.t diff --git a/bin/common.ml b/bin/common.ml index 66278b666ac..46aed1da17c 100644 --- a/bin/common.ml +++ b/bin/common.ml @@ -567,6 +567,7 @@ module Builder = struct ; debug_artifact_substitution : bool ; debug_load_dir : bool ; debug_digests : bool + ; debug_package_logs : bool ; wait_for_filesystem_clock : bool ; only_packages : Only_packages.Clflags.t ; capture_outputs : bool @@ -666,6 +667,16 @@ module Builder = struct [ "debug-digests" ] ~docs ~doc:"Explain why Dune decides to re-digest some files") + and+ debug_package_logs = + let doc = "Always print the standard logs when building packages" in + Arg.( + value + & flag + & info + [ "debug-package-logs" ] + ~docs + ~doc + ~env:(Cmd.Env.info ~doc "DUNE_DEBUG_PACKAGE_LOGS")) and+ no_buffer = let doc = "Do not buffer the output of commands executed by dune. By default dune buffers \ @@ -970,6 +981,7 @@ module Builder = struct ; debug_artifact_substitution ; debug_load_dir ; debug_digests + ; debug_package_logs ; wait_for_filesystem_clock ; only_packages ; capture_outputs = not no_buffer @@ -1236,6 +1248,7 @@ let init (builder : Builder.t) = Dune_engine.Clflags.debug_load_dir := c.builder.debug_load_dir; Dune_engine.Clflags.debug_fs_cache := c.builder.cache_debug_flags.fs_cache; Dune_digest.Clflags.debug_digests := c.builder.debug_digests; + Dune_rules.Clflags.debug_package_logs := c.builder.debug_package_logs; Dune_digest.Clflags.wait_for_filesystem_clock := c.builder.wait_for_filesystem_clock; Dune_engine.Clflags.capture_outputs := c.builder.capture_outputs; Dune_engine.Clflags.diff_command := c.builder.diff_command; diff --git a/doc/changes/10662.md b/doc/changes/10662.md new file mode 100644 index 00000000000..2c4257a9c0b --- /dev/null +++ b/doc/changes/10662.md @@ -0,0 +1,3 @@ +- pkg: only logs the standard output when the command fails or the user explicitly requests it. + Add new flag `--debug-package-logs`, which force dune to display the stdout logs when dealing + with package management (#10662, @maiste) diff --git a/src/dune_rules/clflags.ml b/src/dune_rules/clflags.ml index e2b8609e820..31b2eb48285 100644 --- a/src/dune_rules/clflags.ml +++ b/src/dune_rules/clflags.ml @@ -4,6 +4,7 @@ let promote_install_files = ref false let display = Dune_engine.Clflags.display let capture_outputs = Dune_engine.Clflags.capture_outputs let debug_artifact_substitution = ref false +let debug_package_logs = ref false let ignore_lock_dir = ref false type on_missing_dune_project_file = diff --git a/src/dune_rules/clflags.mli b/src/dune_rules/clflags.mli index 13b1ab9cf6f..642eb08c6c8 100644 --- a/src/dune_rules/clflags.mli +++ b/src/dune_rules/clflags.mli @@ -16,6 +16,9 @@ val capture_outputs : bool ref (** Print debug info about artifact substitution *) val debug_artifact_substitution : bool ref +(** Print package output when building with package management *) +val debug_package_logs : bool ref + (** Whether we are ignoring "dune.lock/". *) val ignore_lock_dir : bool ref diff --git a/src/dune_rules/pkg_rules.ml b/src/dune_rules/pkg_rules.ml index e96c155e907..60d80b6f466 100644 --- a/src/dune_rules/pkg_rules.ml +++ b/src/dune_rules/pkg_rules.ml @@ -9,6 +9,7 @@ include struct module Checksum = Checksum module Source = Source module Build_command = Lock_dir.Build_command + module Display = Dune_engine.Display end module Variable = struct @@ -405,7 +406,8 @@ module Expander0 = struct include Expander0 type t = - { paths : Paths.t + { name : Dune_pkg.Package_name.t + ; paths : Paths.t ; artifacts : Path.t Filename.Map.t ; depends : (Variable.value Package_variable_name.Map.t * Paths.t) Package.Name.Map.t ; context : Context_name.t @@ -514,6 +516,63 @@ module Substitute = struct end module Run_with_path = struct + module Output : sig + type error + + val io : error -> Process.Io.output Process.Io.t + + val with_error + : accepted_exit_codes:int Predicate.t + -> pkg:Dune_pkg.Package_name.t * Loc.t + -> display:Display.t + -> (error -> 'a) + -> 'a + + val prerr : rc:int -> error -> unit + end = struct + type error = + { pkg : Dune_pkg.Package_name.t * Loc.t + ; filename : Dpath.t + ; io : Process.Io.output Process.Io.t + ; accepted_exit_codes : int Predicate.t + ; display : Display.t + } + + let io t = t.io + + let with_error ~accepted_exit_codes ~pkg ~display f = + let filename = Temp.create File ~prefix:"dune-pkg" ~suffix:"stderr" in + let io = Process.Io.(file filename Out) in + let t = { filename; io; accepted_exit_codes; display; pkg } in + let result = f t in + Temp.destroy File filename; + result + ;; + + let to_paragraphs t error = + let pp_pkg = + let pkg_name = Dune_pkg.Package_name.to_string (fst t.pkg) in + Pp.textf "Logs for package %s" pkg_name + in + let loc = snd t.pkg in + [ pp_pkg; Pp.verbatim error ], loc + ;; + + let prerr ~rc error = + match Predicate.test error.accepted_exit_codes rc, error.display with + | false, _ -> + let paragraphs, loc = Stdune.Io.read_file error.filename |> to_paragraphs error in + User_warning.emit ~loc ~is_error:true paragraphs + | true, Display.Verbose -> + let content = Stdune.Io.read_file error.filename in + if not (String.is_empty content) + then ( + let paragraphs, loc = to_paragraphs error content in + User_warning.emit ~loc paragraphs) + | true, _ -> () + ;; + end + module Spec = struct type 'path chunk = | String of string @@ -525,6 +584,7 @@ module Run_with_path = struct { prog : Action.Prog.t ; args : 'path arg Array.Immutable.t ; ocamlfind_destdir : 'path + ; pkg : Dune_pkg.Package_name.t * Loc.t } let name = "run-with-path" @@ -545,7 +605,7 @@ module Run_with_path = struct let is_useful_to ~memoize:_ = true - let encode { prog; args; ocamlfind_destdir } path _ : Dune_lang.t = + let encode { prog; args; ocamlfind_destdir; pkg = _ } path _ : Dune_lang.t = let prog = Dune_lang.atom_or_quoted_string @@ @@ -567,11 +627,12 @@ module Run_with_path = struct ;; let action - { prog; args; ocamlfind_destdir } + { prog; args; ocamlfind_destdir; pkg } ~(ectx : Action.Ext.context) ~(eenv : Action.Ext.env) = let open Fiber.O in + let display = !Clflags.display in match prog with | Error e -> Action.Prog.Not_found.raise e | Ok prog -> @@ -589,31 +650,37 @@ module Run_with_path = struct ~var:"OCAMLFIND_DESTDIR" ~value:(Path.to_absolute_filename ocamlfind_destdir) in - Process.run - (Accept eenv.exit_codes) - prog - args - ~display:!Clflags.display - ~metadata - ~stdout_to:eenv.stdout_to - ~stderr_to:eenv.stderr_to - ~stdin_from:eenv.stdin_from - ~dir:eenv.working_dir - ~env - >>= (function - | Error _ -> Fiber.return () - | Ok () -> Fiber.return ()) + Output.with_error ~accepted_exit_codes:eenv.exit_codes ~pkg ~display (fun error -> + let stdout_to = + match !Clflags.debug_package_logs, display with + | true, _ | false, Display.Verbose -> eenv.stdout_to + | _ -> Process.Io.(null Out) + in + Process.run + Return + prog + args + ~display + ~metadata + ~stdout_to + ~stderr_to:(Output.io error) + ~stdin_from:eenv.stdin_from + ~dir:eenv.working_dir + ~env + >>= fun (_, rc) -> + Output.prerr ~rc error; + Fiber.return ()) ;; end - let action prog args ~ocamlfind_destdir = + let action ~pkg prog args ~ocamlfind_destdir = let module M = struct type path = Path.t type target = Path.Build.t module Spec = Spec - let v = { Spec.prog; args; ocamlfind_destdir } + let v = { Spec.prog; args; ocamlfind_destdir; pkg } end in Action.Extension (module M) @@ -742,7 +809,7 @@ module Action_expander = struct ;; let expand_pform - { env = _; paths; artifacts = _; context; depends; version = _ } + { name = _; env = _; paths; artifacts = _; context; depends; version = _ } ~source (pform : Pform.t) : (Value.t list, [ `Undefined_pkg_var of Package_variable_name.t ]) result Memo.t @@ -877,7 +944,7 @@ module Action_expander = struct let ocamlfind_destdir = (Lazy.force expander.paths.install_roots).lib_root |> Path.build in - Run_with_path.action exe args ~ocamlfind_destdir) + Run_with_path.action ~pkg:(expander.name, prog_loc) exe args ~ocamlfind_destdir) | Progn t -> let+ args = Memo.parallel_map t ~f:(expand ~expander) in Action.Progn args @@ -1007,6 +1074,7 @@ module Action_expander = struct (Pkg_info.variables pkg.info, pkg.paths) in { Expander.paths = pkg.paths + ; name = pkg.info.name ; artifacts = binaries ; context ; depends diff --git a/test/blackbox-tests/test-cases/pkg/build-package-logs.t b/test/blackbox-tests/test-cases/pkg/build-package-logs.t new file mode 100644 index 00000000000..9b8fe0b5aaa --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/build-package-logs.t @@ -0,0 +1,48 @@ +Test the error message when installing package that fails. + + $ . ./helpers.sh + $ make_lockdir + $ export DUNE_DEBUG_PACKAGE_LOGS=0 + +Make a project with two packages, one successful and one that fails: + + $ cat > dune-project << EOF + > (lang dune 3.12) + > EOF + +Create a package with a failing command that throws an error: + + $ make_lockpkg x << EOF + > (version 0.0.1) + > (build + > (progn + > (run cat i_dont_exist))) + > EOF + +Building the package should fail and print an error: + + $ build_pkg x 2>&1 | sed -E 's#/.*/cat#cat#g' + File "dune.lock/x.pkg", line 4, characters 11-14: + 4 | (run cat i_dont_exist))) + ^^^ + Error: Logs for package x + cat: i_dont_exist: No such file or directory + + +Create a package with a succeeding command that displays some text: + + $ make_lockpkg y << EOF + > (version 0.0.1) + > (build + > (progn + > (run echo "Success!"))) + > EOF + +Building the package should succeed and print no output: + + $ build_pkg y + +Checks the package is installed: + + $ show_pkg_cookie y + { files = map {}; variables = [] } diff --git a/test/blackbox-tests/test-cases/pkg/dune b/test/blackbox-tests/test-cases/pkg/dune index b9e0333a512..88db4dce538 100644 --- a/test/blackbox-tests/test-cases/pkg/dune +++ b/test/blackbox-tests/test-cases/pkg/dune @@ -2,6 +2,11 @@ (alias pkg) (applies_to :whole_subtree)) +(env + (_ + (env-vars + (DUNE_DEBUG_PACKAGE_LOGS 1)))) + (cram (deps helpers.sh) (applies_to :whole_subtree)) diff --git a/test/blackbox-tests/test-cases/pkg/pin-stanza/update-non-dune-local-pin.t b/test/blackbox-tests/test-cases/pkg/pin-stanza/update-non-dune-local-pin.t index 6fbbecae7bf..b41af4f064e 100644 --- a/test/blackbox-tests/test-cases/pkg/pin-stanza/update-non-dune-local-pin.t +++ b/test/blackbox-tests/test-cases/pkg/pin-stanza/update-non-dune-local-pin.t @@ -41,7 +41,10 @@ Attempt to build the package the first time: echo aaa aaa false - -> required by _build/_private/default/.pkg/foo/target/cookie + File "dune.lock/foo.pkg", line 4, characters 6-13: + ^^^^^^^ + Error: Logs for package foo + Update the message that gets printed while building foo: $ cat >foo/Makefile < required by _build/_private/default/.pkg/foo/target/cookie + File "dune.lock/foo.pkg", line 4, characters 6-13: + ^^^^^^^ + Error: Logs for package foo +