diff --git a/CHANGES.md b/CHANGES.md index 553fc6f7480..7cc157547a0 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -88,8 +88,11 @@ Unreleased - Fields allowed in the config file are now also allowed in the workspace file (#4426, @jeremiedimino) -- Add an option to swallow the output of actions when they succeed, to - reduce noise of large builds (#4422, @jeremiedimino) +- Add options to control how Dune should handle stdout and stderr of + actions when then succeed. It is now possible to ask Dune to ignore + the stdout of actions when they succeed or to request that the + stderr of actions must be empty. This allows to reduce the noise of + large builds (#4422, #4515, @jeremiedimino) - Add the possibility to use `locks` with the cram tests stanza (#4397, @voodoos) diff --git a/bin/common.ml b/bin/common.ml index ed3254e1b88..4c9b274618e 100644 --- a/bin/common.ml +++ b/bin/common.ml @@ -612,12 +612,32 @@ let shared_with_config_file = ~docs ~env:(Arg.env_var ~doc "DUNE_CACHE_CHECK_PROBABILITY") ~doc) - and+ swallow_stdout_on_success = + and+ action_stdout_on_success = Arg.( - value & flag + value + & opt (some (enum Dune_config.Action_output_on_success.all)) None & info - [ "swallow-stdout-on-success" ] - ~doc:"Swallow the output of an action when it succeeds.") + [ "action-stdout-on-success" ] + ~doc: + "Specify how to deal with the standard output of actions when they \ + succeed. Possible values are: $(b,print) to just print it to \ + Dune's output, $(b,swallow) to completely ignore it and \ + $(b,must-be-empty) to enforce that the action printed nothing. \ + With $(b,must-be-empty), Dune will consider that the action \ + failed if it printed something to its standard output. The \ + default is $(b,print).") + and+ action_stderr_on_success = + Arg.( + value + & opt (some (enum Dune_config.Action_output_on_success.all)) None + & info + [ "action-stderr-on-success" ] + ~doc: + "Same as $(b,--action-stdout-on-success) but for the standard \ + output for error messages. A good default for large \ + mono-repositories is $(b,--action-stdout-on-success=swallow \ + --action-stderr-on-success=must-be-empty). This ensures that a \ + successful build has a \"clean\" empty output.") in { Dune_config.Partial.display ; concurrency @@ -628,7 +648,8 @@ let shared_with_config_file = Option.map cache_check_probability ~f:Dune_cache.Config.Reproducibility_check.check_with_probability ; cache_storage_mode - ; swallow_stdout_on_success = Option.some_if swallow_stdout_on_success true + ; action_stdout_on_success + ; action_stderr_on_success } let term = diff --git a/src/dune_config/dune_config.ml b/src/dune_config/dune_config.ml index 3a35c6073e6..0d44bcec408 100644 --- a/src/dune_config/dune_config.ml +++ b/src/dune_config/dune_config.ml @@ -132,6 +132,12 @@ module Cache = struct end end +module Action_output_on_success = struct + include Dune_engine.Execution_parameters.Action_output_on_success + + let decode = enum all +end + module type S = sig type 'a field @@ -144,7 +150,8 @@ module type S = sig ; cache_reproducibility_check : Dune_cache.Config.Reproducibility_check.t field ; cache_storage_mode : Cache.Storage_mode.t field - ; swallow_stdout_on_success : bool field + ; action_stdout_on_success : Action_output_on_success.t field + ; action_stderr_on_success : Action_output_on_success.t field } end @@ -167,8 +174,10 @@ struct ; cache_reproducibility_check = field a.cache_reproducibility_check b.cache_reproducibility_check ; cache_storage_mode = field a.cache_storage_mode b.cache_storage_mode - ; swallow_stdout_on_success = - field a.swallow_stdout_on_success b.swallow_stdout_on_success + ; action_stdout_on_success = + field a.action_stdout_on_success b.action_stdout_on_success + ; action_stderr_on_success = + field a.action_stderr_on_success b.action_stderr_on_success } end @@ -187,7 +196,8 @@ struct ; cache_enabled ; cache_reproducibility_check ; cache_storage_mode - ; swallow_stdout_on_success + ; action_stdout_on_success + ; action_stderr_on_success } = Dyn.Encoder.record [ ("display", field Scheduler.Config.Display.to_dyn display) @@ -202,8 +212,10 @@ struct cache_reproducibility_check ) ; ( "cache_storage_mode" , field Cache.Storage_mode.to_dyn cache_storage_mode ) - ; ( "swallow_stdout_on_success" - , field Dyn.Encoder.bool swallow_stdout_on_success ) + ; ( "action_stdout_on_success" + , field Action_output_on_success.to_dyn action_stdout_on_success ) + ; ( "action_stderr_on_success" + , field Action_output_on_success.to_dyn action_stderr_on_success ) ] end @@ -224,7 +236,8 @@ module Partial = struct ; cache_enabled = None ; cache_reproducibility_check = None ; cache_storage_mode = None - ; swallow_stdout_on_success = None + ; action_stdout_on_success = None + ; action_stderr_on_success = None } include @@ -277,7 +290,8 @@ let default = ; cache_enabled = Disabled ; cache_reproducibility_check = Skip ; cache_storage_mode = None - ; swallow_stdout_on_success = false + ; action_stdout_on_success = Print + ; action_stderr_on_success = Print } let decode_generic ~min_dune_version = @@ -320,9 +334,10 @@ let decode_generic ~min_dune_version = (Dune_lang.Syntax.deleted_in Stanza.syntax (3, 0) ~extra_info:"To trim the cache, use the 'dune cache trim' command." >>> Dune_lang.Decoder.bytes_unit) - and+ swallow_stdout_on_success = - field_o_b "swallow-stdout-on-success" - ~check:(Dune_lang.Syntax.since Stanza.syntax (3, 0)) + and+ action_stdout_on_success = + field_o "action_stdout_on_success" (3, 0) Action_output_on_success.decode + and+ action_stderr_on_success = + field_o "action_stderr_on_success" (3, 0) Action_output_on_success.decode in let cache_storage_mode = Option.merge cache_duplication cache_storage_mode ~f:(fun _ _ -> @@ -340,7 +355,8 @@ let decode_generic ~min_dune_version = ; cache_enabled ; cache_reproducibility_check ; cache_storage_mode - ; swallow_stdout_on_success + ; action_stdout_on_success + ; action_stderr_on_success } let decode = diff --git a/src/dune_config/dune_config.mli b/src/dune_config/dune_config.mli index b30bc272672..bf36ad5b937 100644 --- a/src/dune_config/dune_config.mli +++ b/src/dune_config/dune_config.mli @@ -48,6 +48,12 @@ module Terminal_persistence : sig val all : (string * t) list end +module Action_output_on_success : sig + include module type of struct + include Dune_engine.Execution_parameters.Action_output_on_success + end +end + module type S = sig type 'a field @@ -60,7 +66,8 @@ module type S = sig ; cache_reproducibility_check : Dune_cache.Config.Reproducibility_check.t field ; cache_storage_mode : Cache.Storage_mode.t field - ; swallow_stdout_on_success : bool field + ; action_stdout_on_success : Action_output_on_success.t field + ; action_stderr_on_success : Action_output_on_success.t field } end diff --git a/src/dune_engine/action_exec.ml b/src/dune_engine/action_exec.ml index 5e6ef7196c0..b1f63e5b9e6 100644 --- a/src/dune_engine/action_exec.ml +++ b/src/dune_engine/action_exec.ml @@ -544,12 +544,11 @@ let exec ~targets ~root ~context ~env ~rule_loc ~build_deps { working_dir = Path.root ; env ; stdout_to = - (if Execution_parameters.swallow_stdout_on_success execution_parameters - then - Process.Io.stdout_swallow_on_success - else - Process.Io.stdout) - ; stderr_to = Process.Io.stderr + Process.Io.make_stdout + (Execution_parameters.action_stdout_on_success execution_parameters) + ; stderr_to = + Process.Io.make_stderr + (Execution_parameters.action_stderr_on_success execution_parameters) ; stdin_from = Process.Io.null In ; prepared_dependencies = DAP.Dependency.Set.empty ; exit_codes = Predicate_lang.Element 0 diff --git a/src/dune_engine/build_system.ml b/src/dune_engine/build_system.ml index 3e726eeda5e..27b3c3da5d9 100644 --- a/src/dune_engine/build_system.ml +++ b/src/dune_engine/build_system.ml @@ -1381,9 +1381,10 @@ end = struct (* The current version of the rule digest scheme. We should increment it when making any changes to the scheme, to avoid collisions. *) - let rule_digest_version = 5 + let rule_digest_version = 6 - let compute_rule_digest (rule : Rule.t) ~deps ~action ~sandbox_mode = + let compute_rule_digest (rule : Rule.t) ~deps ~action ~sandbox_mode + ~execution_parameters = let { Action.Full.action; env; locks; can_go_in_shared_cache } = action in let trace = ( rule_digest_version (* Update when changing the rule digest scheme. *) @@ -1392,7 +1393,9 @@ end = struct , Option.map rule.context ~f:(fun c -> c.name) , Action.for_shell action , can_go_in_shared_cache - , List.map locks ~f:Path.to_string ) + , List.map locks ~f:Path.to_string + , Execution_parameters.action_stdout_on_success execution_parameters + , Execution_parameters.action_stderr_on_success execution_parameters ) in Digest.generic trace @@ -1618,7 +1621,10 @@ end = struct let force_rerun = !Clflags.force && is_test in force_rerun || Dep.Map.has_universe deps in - let rule_digest = compute_rule_digest rule ~deps ~action ~sandbox_mode in + let rule_digest = + compute_rule_digest rule ~deps ~action ~sandbox_mode + ~execution_parameters + in let can_go_in_shared_cache = action.can_go_in_shared_cache && not diff --git a/src/dune_engine/execution_parameters.ml b/src/dune_engine/execution_parameters.ml index 29678c34d4d..d2582c5c5fc 100644 --- a/src/dune_engine/execution_parameters.ml +++ b/src/dune_engine/execution_parameters.ml @@ -1,34 +1,70 @@ open Stdune +module Action_output_on_success = struct + type t = + | Print + | Swallow + | Must_be_empty + + let all = + [ ("print", Print); ("swallow", Swallow); ("must-be-empty", Must_be_empty) ] + + let to_dyn = function + | Print -> Dyn.Variant ("Print", []) + | Swallow -> Variant ("Swallow", []) + | Must_be_empty -> Variant ("Must_be_empty", []) + + let equal = Poly.equal + + let hash = Poly.hash +end + module T = struct type t = { dune_version : Dune_lang.Syntax.Version.t - ; swallow_stdout_on_success : bool + ; action_stdout_on_success : Action_output_on_success.t + ; action_stderr_on_success : Action_output_on_success.t } - let equal { dune_version; swallow_stdout_on_success } t = + let equal { dune_version; action_stdout_on_success; action_stderr_on_success } + t = Dune_lang.Syntax.Version.equal dune_version t.dune_version - && Bool.equal swallow_stdout_on_success t.swallow_stdout_on_success + && Action_output_on_success.equal action_stdout_on_success + t.action_stdout_on_success + && Action_output_on_success.equal action_stderr_on_success + t.action_stderr_on_success - let hash { dune_version; swallow_stdout_on_success } = + let hash { dune_version; action_stdout_on_success; action_stderr_on_success } + = Hashtbl.hash - (Dune_lang.Syntax.Version.hash dune_version, swallow_stdout_on_success) + ( Dune_lang.Syntax.Version.hash dune_version + , Action_output_on_success.hash action_stdout_on_success + , Action_output_on_success.hash action_stderr_on_success ) - let to_dyn { dune_version; swallow_stdout_on_success } = + let to_dyn + { dune_version; action_stdout_on_success; action_stderr_on_success } = Dyn.Record [ ("dune_version", Dune_lang.Syntax.Version.to_dyn dune_version) - ; ("swallow_stdout_on_success", Bool swallow_stdout_on_success) + ; ( "action_stdout_on_success" + , Action_output_on_success.to_dyn action_stdout_on_success ) + ; ( "action_stderr_on_success" + , Action_output_on_success.to_dyn action_stderr_on_success ) ] end include T let builtin_default = - { dune_version = Stanza.latest_version; swallow_stdout_on_success = false } + { dune_version = Stanza.latest_version + ; action_stdout_on_success = Print + ; action_stderr_on_success = Print + } let set_dune_version x t = { t with dune_version = x } -let set_swallow_stdout_on_success x t = { t with swallow_stdout_on_success = x } +let set_action_stdout_on_success x t = { t with action_stdout_on_success = x } + +let set_action_stderr_on_success x t = { t with action_stderr_on_success = x } let dune_version t = t.dune_version @@ -37,7 +73,9 @@ let should_remove_write_permissions_on_generated_files t = let should_expand_aliases_when_sandboxing t = t.dune_version >= (3, 0) -let swallow_stdout_on_success t = t.swallow_stdout_on_success +let action_stdout_on_success t = t.action_stdout_on_success + +let action_stderr_on_success t = t.action_stderr_on_success let default = Fdecl.create Dyn.Encoder.opaque diff --git a/src/dune_engine/execution_parameters.mli b/src/dune_engine/execution_parameters.mli index 08c5ce75601..c9ee81a63c7 100644 --- a/src/dune_engine/execution_parameters.mli +++ b/src/dune_engine/execution_parameters.mli @@ -23,13 +23,34 @@ val hash : t -> int val to_dyn : t -> Dyn.t +module Action_output_on_success : sig + (** How to deal with the output (stdout/stderr) of actions when they succeed. *) + type t = + | Print (** Print it to the terminal. *) + | Swallow + (** Completely ignore it. There is no way for the user to access it but + the output of Dune is clean. *) + | Must_be_empty + (** Require it to be empty. Treat the action as failed if it is not. *) + + val all : (string * t) list + + val equal : t -> t -> bool + + val hash : t -> int + + val to_dyn : t -> Dyn.t +end + (** {1 Constructors} *) val builtin_default : t val set_dune_version : Dune_lang.Syntax.Version.t -> t -> t -val set_swallow_stdout_on_success : bool -> t -> t +val set_action_stdout_on_success : Action_output_on_success.t -> t -> t + +val set_action_stderr_on_success : Action_output_on_success.t -> t -> t (** As configured by [init] *) val default : t Memo.Build.t @@ -42,7 +63,9 @@ val should_remove_write_permissions_on_generated_files : t -> bool val should_expand_aliases_when_sandboxing : t -> bool -val swallow_stdout_on_success : t -> bool +val action_stdout_on_success : t -> Action_output_on_success.t + +val action_stderr_on_success : t -> Action_output_on_success.t (** {1 Initialisation} *) diff --git a/src/dune_engine/process.ml b/src/dune_engine/process.ml index a8c2765a10d..b590af2ace0 100644 --- a/src/dune_engine/process.ml +++ b/src/dune_engine/process.ml @@ -4,6 +4,7 @@ open Fiber.O module Json = Chrome_trace.Json module Event = Chrome_trace.Event module Timestamp = Event.Timestamp +module Action_output_on_success = Execution_parameters.Action_output_on_success type ('a, 'b) failure_mode = | Strict : ('a, 'a) failure_mode @@ -38,11 +39,9 @@ module Io = struct | File of Path.t | Null | Terminal of - { swallow_on_success : bool - (* This argument makes no sense for inputs, but it seems annoying - to change, especially as this code is meant to change again in - #4435. *) - } + (* This argument make no sense for inputs, but it seems annoying to + change, especially as this code is meant to change again in #4435. *) + Action_output_on_success.t type status = | Keep_open @@ -79,23 +78,26 @@ module Io = struct ; mutable status : status } - let terminal ch ~swallow_on_success = + let terminal ch output_on_success = let fd = descr_of_channel ch in - { kind = Terminal { swallow_on_success } + { kind = Terminal output_on_success ; mode = mode_of_channel ch ; fd = lazy fd ; channel = lazy ch ; status = Keep_open } - let stdout_swallow_on_success = - terminal (Out_chan stdout) ~swallow_on_success:true + let make_stdout output_on_success = + terminal (Out_chan stdout) output_on_success - let stdout = terminal (Out_chan stdout) ~swallow_on_success:false + let stdout = make_stdout Print - let stderr = terminal (Out_chan stderr) ~swallow_on_success:false + let make_stderr output_on_success = + terminal (Out_chan stderr) output_on_success - let stdin = terminal (In_chan stdin) ~swallow_on_success:false + let stderr = make_stderr Print + + let stdin = terminal (In_chan stdin) Print let null (type a) (mode : a mode) : a t = let fd = @@ -412,7 +414,8 @@ module Exit_status = struct fun output -> loop output 0 (String.length output) [ 'F'; 'i'; 'l'; 'e'; ' ' ] - let handle_non_verbose t ~display ~purpose ~output ~prog ~command_line = + let handle_non_verbose t ~display ~purpose ~output ~prog ~command_line + ~has_unexpected_stdout ~has_unexpected_stderr = let open Pp.O in let show_command = let show_full_command_on_error = @@ -449,7 +452,17 @@ module Exit_status = struct match err with | Failed n -> if show_command then - sprintf "(exit %d)" n + let unexpected_outputs = + List.filter_map + [ (has_unexpected_stdout, "stdout") + ; (has_unexpected_stderr, "stderr") + ] ~f:(fun (b, name) -> Option.some_if b name) + in + match (n, unexpected_outputs) with + | 0, _ :: _ -> + sprintf "(had unexpected output on %s)" + (String.enumerate_and unexpected_outputs) + | _ -> sprintf "(exit %d)" n else fail (Option.to_list output) | Signaled signame -> sprintf "(got signal %s)" signame @@ -531,13 +544,13 @@ let run_internal ?dir ?(stdout_to = Io.stdout) ?(stderr_to = Io.stderr) (args, None) in let argv = prog_str :: args in - let swallow_on_success (out : Io.output Io.t) = + let output_on_success (out : Io.output Io.t) = match out.kind with - | Terminal { swallow_on_success } -> swallow_on_success - | _ -> false + | Terminal x -> x + | _ -> Print in - let swallow_stdout_on_success = swallow_on_success stdout_to in - let swallow_stderr_on_success = swallow_on_success stderr_to in + let stdout_on_success = output_on_success stdout_to in + let stderr_on_success = output_on_success stderr_to in let (stdout_capture, stdout_to), (stderr_capture, stderr_to) = match (stdout_to.kind, stderr_to.kind) with | Terminal _, _ @@ -556,9 +569,13 @@ let run_internal ?dir ?(stdout_to = Io.stdout) ?(stderr_to = Io.stderr) in let stderr = match (stdout_to.kind, stderr_to.kind) with - | ( Terminal { swallow_on_success = a } - , Terminal { swallow_on_success = b } ) - when Bool.equal a b -> + | Terminal Print, Terminal Print + | Terminal Swallow, Terminal Swallow -> + (* We don't merge when both are [Must_be_empty]. If we did and an + action had unexpected output on both stdout and stderr the + error message would be "has unexpected output on stdout". With + the current code, it is "has unexpected output on stdout and + stderr", which is more precise. *) Io.flush stderr_to; (`Merged_with_stdout, snd stdout) | _, Terminal _ -> @@ -601,20 +618,49 @@ let run_internal ?dir ?(stdout_to = Io.stdout) ?(stderr_to = Io.stderr) | None, None -> () | _, _ -> assert false); Option.iter response_file ~f:Path.unlink; + let actual_stdout = + match stdout_capture with + | `No_capture -> lazy "" + | `Capture fn -> lazy (Stdune.Io.read_file fn) + in + let actual_stderr = + match stderr_capture with + | `No_capture + | `Merged_with_stdout -> + lazy "" + | `Capture fn -> lazy (Stdune.Io.read_file fn) + in + let has_unexpected_output (on_success : Action_output_on_success.t) + actual_output = + match on_success with + | Must_be_empty -> Lazy.force actual_output <> "" + | Print + | Swallow -> + false + in + let has_unexpected_stdout = + has_unexpected_output stdout_on_success actual_stdout + and has_unexpected_stderr = + has_unexpected_output stderr_on_success actual_stderr + in let exit_status' : Exit_status.t = match exit_status with - | WEXITED n when ok_codes n -> Ok n + | WEXITED n + when (not has_unexpected_stdout) + && (not has_unexpected_stderr) + && ok_codes n -> + Ok n | WEXITED n -> Error (Failed n) | WSIGNALED n -> Error (Signaled (Signal.name n)) | WSTOPPED _ -> assert false in let success = Result.is_ok exit_status' in - let read_and_destroy fn ~swallow_on_success = + let swallow_on_success_if_requested fn actual_output + (on_success : Action_output_on_success.t) = let s = - if success && swallow_on_success then - "" - else - Stdune.Io.read_file fn + match (success, on_success) with + | true, Swallow -> "" + | _ -> Lazy.force actual_output in Temp.destroy File fn; s @@ -623,14 +669,15 @@ let run_internal ?dir ?(stdout_to = Io.stdout) ?(stderr_to = Io.stderr) match stdout_capture with | `No_capture -> "" | `Capture fn -> - read_and_destroy fn ~swallow_on_success:swallow_stdout_on_success + swallow_on_success_if_requested fn actual_stdout stdout_on_success in let stderr = match stderr_capture with - | `No_capture -> "" + | `No_capture + | `Merged_with_stdout -> + "" | `Capture fn -> - read_and_destroy fn ~swallow_on_success:swallow_stderr_on_success - | `Merged_with_stdout -> "" + swallow_on_success_if_requested fn actual_stderr stderr_on_success in let output = stdout ^ stderr in Log.command ~command_line ~output ~exit_status; @@ -641,7 +688,8 @@ let run_internal ?dir ?(stdout_to = Io.stdout) ?(stderr_to = Io.stderr) ~command_line:fancy_command_line ~output | _ -> Exit_status.handle_non_verbose exit_status' ~prog:prog_str ~command_line - ~output ~purpose ~display) + ~output ~purpose ~display ~has_unexpected_stdout + ~has_unexpected_stderr) let run ?dir ?stdout_to ?stderr_to ?stdin_from ?env ?(purpose = Internal_job) fail_mode prog args = diff --git a/src/dune_engine/process.mli b/src/dune_engine/process.mli index 0b6febb9597..d9f9788f19a 100644 --- a/src/dune_engine/process.mli +++ b/src/dune_engine/process.mli @@ -24,12 +24,12 @@ module Io : sig val stdout : output t - (** Same as [stdout], but drop it rather than redirect it to the terminal if - the command succeeds. *) - val stdout_swallow_on_success : output t + val make_stdout : Execution_parameters.Action_output_on_success.t -> output t val stderr : output t + val make_stderr : Execution_parameters.Action_output_on_success.t -> output t + val stdin : input t val null : 'a mode -> 'a t diff --git a/src/dune_rules/workspace.ml b/src/dune_rules/workspace.ml index fe81b99bc3a..3d808630df6 100644 --- a/src/dune_rules/workspace.ml +++ b/src/dune_rules/workspace.ml @@ -662,7 +662,10 @@ let workspace = Memo.exec memo let update_execution_parameters t ep = - Execution_parameters.set_swallow_stdout_on_success - t.config.swallow_stdout_on_success ep + ep + |> Execution_parameters.set_action_stdout_on_success + t.config.action_stdout_on_success + |> Execution_parameters.set_action_stderr_on_success + t.config.action_stderr_on_success let build_contexts t = List.concat_map t.contexts ~f:Context.build_contexts diff --git a/test/blackbox-tests/test-cases/actions/action-stdxxx-on-success.t b/test/blackbox-tests/test-cases/actions/action-stdxxx-on-success.t new file mode 100644 index 00000000000..de61f8de5e3 --- /dev/null +++ b/test/blackbox-tests/test-cases/actions/action-stdxxx-on-success.t @@ -0,0 +1,257 @@ +Test for --action-stdxxx-on-success +==================================== + + $ export BUILD_PATH_PREFIX_MAP="sh=$(which sh):$BUILD_PATH_PREFIX_MAP" + + $ echo '(lang dune 3.0)' > dune-project + + $ cat > dune < (rule + > (alias default) + > (action (system "echo 'Hello, world!'"))) + > + > (rule + > (alias default) + > (action (system "echo 'Something went wrong!' >&2"))) + > + > (rule + > (alias both-stdout-and-stderr-output) + > (action (system "echo stdout; echo stderr >&2"))) + > EOF + +By default, stdout and stderr are always printed: + + $ dune build + sh alias default + Hello, world! + sh alias default + Something went wrong! + +swallow tests +------------- + + $ dune clean + $ dune build --action-stdout-on-success=swallow --action-stderr-on-success=swallow + +must-be-empty tests +---------------------- + +In the two above tests, we ask Dune to enforce that the the stdout +(resp. stderr) of actions is empty via the must-be-empty setting. +Since the first rule has a non-empty stdout and the second has a +non-empty stderr, we observe that in each case the build fails +printing the output of the action that had a non-empty output. + + $ dune clean + $ dune build --action-stdout-on-success=must-be-empty + sh alias default + Something went wrong! + File "dune", line 1, characters 0-65: + 1 | (rule + 2 | (alias default) + 3 | (action (system "echo 'Hello, world!'"))) + sh alias default (had unexpected output on stdout) + (cd _build/default && sh -c 'echo '\''Hello, world!'\''') + Hello, world! + [1] + + $ dune clean + $ dune build --action-stderr-on-success=must-be-empty + sh alias default + Hello, world! + File "dune", line 5, characters 0-77: + 5 | (rule + 6 | (alias default) + 7 | (action (system "echo 'Something went wrong!' >&2"))) + sh alias default (had unexpected output on stderr) + (cd _build/default && sh -c 'echo '\''Something went wrong!'\'' >&2') + Something went wrong! + [1] + +Same but with output on both stdout and stderr: + + $ dune clean + $ dune build @both-stdout-and-stderr-output \ + > --action-stdout-on-success=must-be-empty \ + > --action-stderr-on-success=must-be-empty + File "dune", line 9, characters 0-95: + 9 | (rule + 10 | (alias both-stdout-and-stderr-output) + 11 | (action (system "echo stdout; echo stderr >&2"))) + sh alias both-stdout-and-stderr-output (had unexpected output on stdout and stderr) + (cd _build/default && sh -c 'echo stdout; echo stderr >&2') + stdout + stderr + [1] + + +Incremental builds +------------------ + +Dune handles --action-stdxxx-on-success in such a way that if +changing the status of one of the two option changes what is printed +to the terminal, then the action is re-executed. + + $ dune clean + $ dune build \ + > --action-stdout-on-success=swallow \ + > --action-stderr-on-success=swallow + +For instance, if we previously swallowed stdout/stderr and stop doing +it, actions that printed something to stdout or stderr are +re-executed: + + $ dune build + sh alias default + Hello, world! + sh alias default + Something went wrong! + +However, we currently re-execute too much. In particular, we +re-execute actions whose outcome is not affected by the change: + + $ cat > dune < (rule + > (alias default) + > (action (system "echo a.stdout; echo a.stderr >&2"))) + > + > (rule + > (alias default) + > (action (system "echo b.stderr >&2"))) + > EOF + + $ dune clean + $ dune build --action-stdout-on-success=swallow + sh alias default + a.stderr + sh alias default + b.stderr + +You can observe in the bellow call that both actions are being +re-executed: + + $ dune build + sh alias default + a.stdout + a.stderr + sh alias default + b.stderr + +However, re-executing the second action was not necessary given that +its stdout was empty. Dune could have recorded the fact that the +second action had an empty stdout and so was unaffected by the status +of --action-stdout-on-success. Dune could also cache the +stdout/stderr of actions accross builds and only re-print them rather +than re-execute actions entirely. + +In case of errors +----------------- + +In case of errors, we print everything no matter what. + + $ cat > dune < (rule + > (alias default) + > (action (system "echo 'Hello, world!'; exit 1"))) + > EOF + + $ dune build + File "dune", line 1, characters 0-73: + 1 | (rule + 2 | (alias default) + 3 | (action (system "echo 'Hello, world!'; exit 1"))) + sh alias default (exit 1) + (cd _build/default && sh -c 'echo '\''Hello, world!'\''; exit 1') + Hello, world! + [1] + + $ dune clean + $ dune build --action-stdout=swallow + File "dune", line 1, characters 0-73: + 1 | (rule + 2 | (alias default) + 3 | (action (system "echo 'Hello, world!'; exit 1"))) + sh alias default (exit 1) + (cd _build/default && sh -c 'echo '\''Hello, world!'\''; exit 1') + Hello, world! + [1] + + $ dune clean + $ dune build --action-stdout=must-be-empty + File "dune", line 1, characters 0-73: + 1 | (rule + 2 | (alias default) + 3 | (action (system "echo 'Hello, world!'; exit 1"))) + sh alias default (exit 1) + (cd _build/default && sh -c 'echo '\''Hello, world!'\''; exit 1') + Hello, world! + [1] + +With compound actions +--------------------- + +At the moment, the behavior is a bit odd. We swallow the stdout of the +first command but not the second: + + $ cat > dune < (rule + > (alias default) + > (action + > (progn + > (system "echo 1") + > (system "echo 2; exit 1")))) + > EOF + + $ dune build --action-stdout-on-success=swallow + File "dune", line 1, characters 0-93: + 1 | (rule + 2 | (alias default) + 3 | (action + 4 | (progn + 5 | (system "echo 1") + 6 | (system "echo 2; exit 1")))) + sh alias default (exit 1) + (cd _build/default && sh -c 'echo 2; exit 1') + 2 + [1] + +For must-be-empty, if two programs print something without failing we +stop at the first program. That's not terrible, but it would seem +better if we stop at the end of the whole action. + + $ cat > dune < (rule + > (alias default) + > (action + > (progn + > (system "echo 1") + > (system "echo 2")))) + > EOF + + $ dune build --action-stdout-on-success=must-be-empty + File "dune", line 1, characters 0-85: + 1 | (rule + 2 | (alias default) + 3 | (action + 4 | (progn + 5 | (system "echo 1") + 6 | (system "echo 2")))) + sh alias default (had unexpected output on stdout) + (cd _build/default && sh -c 'echo 1') + 1 + [1] + +With builtin actions +-------------------- + +We currently never swallow the output of builtin actions such as +`echo`, which is odd: + + $ cat > dune < (rule + > (alias default) + > (action (echo "Hello, world!\n"))) + > EOF + + $ dune build --action-stdout-on-success=swallow + Hello, world! diff --git a/test/blackbox-tests/test-cases/actions/swallog-stdout-on-success.t b/test/blackbox-tests/test-cases/actions/swallog-stdout-on-success.t deleted file mode 100644 index d9158479a4c..00000000000 --- a/test/blackbox-tests/test-cases/actions/swallog-stdout-on-success.t +++ /dev/null @@ -1,98 +0,0 @@ -Test for --swallow-stdout-on-success -==================================== - - $ export BUILD_PATH_PREFIX_MAP="sh=$(which sh):$BUILD_PATH_PREFIX_MAP" - - $ echo '(lang dune 3.0)' > dune-project - - $ cat > dune < (rule - > (alias default) - > (action (system "echo 'Hello, world!'"))) - > EOF - -By default, stdout is always printed: - - $ dune build - sh alias default - Hello, world! - -With the option, stdout is swallowed when the action succeeds: - - $ dune clean - $ dune build --swallow-stdout-on-success - -Now with an action that fails: - - $ cat > dune < (rule - > (alias default) - > (action (system "echo 'Hello, world!'; exit 1"))) - > EOF - -It is always printed in case of error: - - $ dune build - File "dune", line 1, characters 0-73: - 1 | (rule - 2 | (alias default) - 3 | (action (system "echo 'Hello, world!'; exit 1"))) - sh alias default (exit 1) - (cd _build/default && sh -c 'echo '\''Hello, world!'\''; exit 1') - Hello, world! - [1] - - $ dune clean - $ dune build --swallow-stdout-on-success - File "dune", line 1, characters 0-73: - 1 | (rule - 2 | (alias default) - 3 | (action (system "echo 'Hello, world!'; exit 1"))) - sh alias default (exit 1) - (cd _build/default && sh -c 'echo '\''Hello, world!'\''; exit 1') - Hello, world! - [1] - -With compound actions ---------------------- - -At the moment, the behavior is a bit odd. We swallow the stdout of the -first command but not the second: - - - $ cat > dune < (rule - > (alias default) - > (action - > (progn - > (system "echo 1") - > (system "echo 2; exit 1")))) - > EOF - - $ dune build --swallow-stdout-on-success - File "dune", line 1, characters 0-93: - 1 | (rule - 2 | (alias default) - 3 | (action - 4 | (progn - 5 | (system "echo 1") - 6 | (system "echo 2; exit 1")))) - sh alias default (exit 1) - (cd _build/default && sh -c 'echo 2; exit 1') - 2 - [1] - -With builtin actions --------------------- - -We currently never swallow the output of builtin actions such as -`echo`, which is odd: - - $ cat > dune < (rule - > (alias default) - > (action (echo "Hello, world!\n"))) - > EOF - - $ dune build --swallow-stdout-on-success - Hello, world! diff --git a/test/blackbox-tests/test-cases/dune-cache/repro-check.t/run.t b/test/blackbox-tests/test-cases/dune-cache/repro-check.t/run.t index 3a9c1481f6e..5a6de933e9a 100644 --- a/test/blackbox-tests/test-cases/dune-cache/repro-check.t/run.t +++ b/test/blackbox-tests/test-cases/dune-cache/repro-check.t/run.t @@ -67,7 +67,7 @@ Set 'cache-check-probability' to 1.0, which should trigger the check > EOF $ rm -rf _build $ dune build --config-file config reproducible non-reproducible - Warning: cache store error [d7a59c882db29d4533f0ebd369764a7f]: ((in_cache + Warning: cache store error [6ec44a424c52333d35bc6365f2e7f23c]: ((in_cache ((non-reproducible 1c8fc4744d4cef1bd2b8f5e915b36be9))) (computed ((non-reproducible 6cfaa7a90747882bcf4ffe7252c1cf89)))) after executing (echo 'build non-reproducible';cp dep non-reproducible) @@ -119,7 +119,7 @@ Test that the environment variable and the command line flag work too $ rm -rf _build $ DUNE_CACHE_CHECK_PROBABILITY=1.0 dune build --cache=enabled reproducible non-reproducible - Warning: cache store error [d7a59c882db29d4533f0ebd369764a7f]: ((in_cache + Warning: cache store error [6ec44a424c52333d35bc6365f2e7f23c]: ((in_cache ((non-reproducible 1c8fc4744d4cef1bd2b8f5e915b36be9))) (computed ((non-reproducible 6cfaa7a90747882bcf4ffe7252c1cf89)))) after executing (echo 'build non-reproducible';cp dep non-reproducible) @@ -131,7 +131,7 @@ Test that the environment variable and the command line flag work too $ rm -rf _build $ dune build --cache=enabled --cache-check-probability=1.0 reproducible non-reproducible - Warning: cache store error [d7a59c882db29d4533f0ebd369764a7f]: ((in_cache + Warning: cache store error [6ec44a424c52333d35bc6365f2e7f23c]: ((in_cache ((non-reproducible 1c8fc4744d4cef1bd2b8f5e915b36be9))) (computed ((non-reproducible 6cfaa7a90747882bcf4ffe7252c1cf89)))) after executing (echo 'build non-reproducible';cp dep non-reproducible) diff --git a/test/blackbox-tests/test-cases/dune-cache/trim.t/run.t b/test/blackbox-tests/test-cases/dune-cache/trim.t/run.t index 8c41f0aedd5..63d6435e7ea 100644 --- a/test/blackbox-tests/test-cases/dune-cache/trim.t/run.t +++ b/test/blackbox-tests/test-cases/dune-cache/trim.t/run.t @@ -77,10 +77,10 @@ You will also need to make sure that the cache trimmer treats new and old cache entries uniformly. $ (cd "$PWD/.xdg-cache/dune/db/meta/v5"; grep -rws . -e 'metadata' | sort) - ./71/71a631749bd743e4c107ba109224c12f:((8:metadata)(5:files(8:target_b32:8a53bfae3829b48866079fa7f2d97781))) - ./a7/a70b2a31baf647239dabd57aa93ccf57:((8:metadata)(5:files(8:target_a32:5637dd9730e430c7477f52d46de3909c))) + ./3c/3c88ff1c5f6067928e7e90902e6defa2:((8:metadata)(5:files(8:target_a32:5637dd9730e430c7477f52d46de3909c))) + ./c3/c31593b485b2e11105d5c897464ea8e4:((8:metadata)(5:files(8:target_b32:8a53bfae3829b48866079fa7f2d97781))) - $ dune_cmd stat size "$PWD/.xdg-cache/dune/db/meta/v5/71/71a631749bd743e4c107ba109224c12f" + $ dune_cmd stat size "$PWD/.xdg-cache/dune/db/meta/v5/3c/3c88ff1c5f6067928e7e90902e6defa2" 70 Trimming the cache at this point should not remove any file entries because all diff --git a/test/expect-tests/dune_config/dune_config_test.ml b/test/expect-tests/dune_config/dune_config_test.ml index 33ff1b0d852..6d16a87ede3 100644 --- a/test/expect-tests/dune_config/dune_config_test.ml +++ b/test/expect-tests/dune_config/dune_config_test.ml @@ -27,7 +27,8 @@ let%expect_test "cache-check-probability 0.1" = ; cache_enabled = Disabled ; cache_reproducibility_check = Check_with_probability 0.1 ; cache_storage_mode = None - ; swallow_stdout_on_success = false + ; action_stdout_on_success = Print + ; action_stderr_on_success = Print } |}] @@ -42,7 +43,8 @@ let%expect_test "cache-storage-mode copy" = ; cache_enabled = Disabled ; cache_reproducibility_check = Skip ; cache_storage_mode = Some Copy - ; swallow_stdout_on_success = false + ; action_stdout_on_success = Print + ; action_stderr_on_success = Print } |}] @@ -57,6 +59,7 @@ let%expect_test "cache-storage-mode hardlink" = ; cache_enabled = Disabled ; cache_reproducibility_check = Skip ; cache_storage_mode = Some Hardlink - ; swallow_stdout_on_success = false + ; action_stdout_on_success = Print + ; action_stderr_on_success = Print } |}]