Silence display in non-user processes

<!-- ps-id: b395597c-06aa-4a7f-bacb-067c3180e6f2 -->

Signed-off-by: Ali Caglayan <alizter@gmail.com>

bench/bench.ml

@@ -76,9 +76,8 @@ module Package = struct
     let stdout_to = Process.Io.make_stdout Swallow in
     let stderr_to = Process.Io.make_stderr Swallow in
     let stdin_from = Process.Io.(null In) in
-    Process.run Strict
-      ~display:!Dune_engine.Clflags.display
-      ~stdout_to ~stderr_to ~stdin_from (Lazy.force git)
+    Process.run Strict ~display:Quiet ~stdout_to ~stderr_to ~stdin_from
+      (Lazy.force git)
       [ "clone"; uri t ]
 end
 
@@ -98,9 +97,7 @@ let dune_build () =
   let stderr_to = Process.Io.make_stderr Swallow in
   let open Fiber.O in
   let+ times =
-    Process.run_with_times dune
-      ~display:!Dune_engine.Clflags.display
-      ~stdin_from ~stdout_to ~stderr_to
+    Process.run_with_times dune ~display:Quiet ~stdin_from ~stdout_to ~stderr_to
       [ "build"; "@install"; "--release" ]
   in
   times.elapsed_time
@@ -128,7 +125,7 @@ let () =
   Path.Build.set_build_dir (Path.Outside_build_dir.of_string "_build");
   let module Scheduler = Dune_engine.Scheduler in
   let config =
-    Dune_engine.Clflags.display := Dune_engine.Display.Quiet;
+    Dune_engine.Clflags.display := Quiet;
     { Scheduler.Config.concurrency = 10
     ; stats = None
     ; insignificant_changes = `React

bench/micro/dune_bench/scheduler_bench.ml

@@ -19,8 +19,7 @@ let setup =
 
 let prog = Option.value_exn (Bin.which ~path:(Env_path.path Env.initial) "true")
 
-let run () =
-  Process.run ~display:!Clflags.display ~env:Env.initial Strict prog []
+let run () = Process.run ~display:Quiet ~env:Env.initial Strict prog []
 
 let go ~jobs fiber =
   Scheduler.Run.go

src/dune_engine/print_diff.ml

@@ -59,17 +59,17 @@ end = struct
     | { commands = []; error } -> raise (User_error.E error)
     | { commands = { dir; metadata; prog; args } :: commands; error } ->
       let* () =
-        Process.run ~display:!Clflags.display ~dir ~env:Env.initial Strict prog
-          args ~metadata
+        Process.run ~display:Quiet ~dir ~env:Env.initial Strict prog args
+          ~metadata
       in
       exec { commands; error }
 
   let rec capture = function
     | { commands = []; error } -> Fiber.return (Error error)
     | { commands = { dir; metadata; prog; args } :: commands; error } -> (
       let* output, code =
-        Process.run_capture ~display:!Clflags.display ~dir ~env:Env.initial
-          Return prog args ~metadata
+        Process.run_capture ~display:Quiet ~dir ~env:Env.initial Return prog
+          args ~metadata
       in
       match code with
       | 1 -> Fiber.return (Ok { Diff.output; loc = metadata.loc })

src/dune_engine/vcs.ml

@@ -62,8 +62,8 @@ let prog t =
 let run t args =
   let open Fiber.O in
   let+ s =
-    Process.run_capture ~display:!Clflags.display Strict (prog t) args
-      ~dir:t.root ~env:Env.initial
+    Process.run_capture ~display:Quiet Strict (prog t) args ~dir:t.root
+      ~env:Env.initial
   in
   String.trim s
 
@@ -72,8 +72,8 @@ let git_accept () =
 
 let run_git t args =
   let res =
-    Process.run_capture (git_accept ()) ~display:!Clflags.display (prog t) args
-      ~dir:t.root ~env:Env.initial
+    Process.run_capture (git_accept ()) ~display:Quiet (prog t) args ~dir:t.root
+      ~env:Env.initial
       ~stderr_to:(Process.Io.file Config.dev_null Out)
   in
   let open Fiber.O in
@@ -131,14 +131,14 @@ let commit_id =
 
 let files =
   let run_zero_separated_hg t args =
-    Process.run_capture_zero_separated Strict (prog t) args
-      ~display:!Clflags.display ~dir:t.root ~env:Env.initial
+    Process.run_capture_zero_separated Strict (prog t) args ~display:Quiet
+      ~dir:t.root ~env:Env.initial
   in
   let run_zero_separated_git t args =
     let open Fiber.O in
     let+ res =
       Process.run_capture_zero_separated (git_accept ()) (prog t) args
-        ~display:!Clflags.display ~dir:t.root ~env:Env.initial
+        ~display:Quiet ~dir:t.root ~env:Env.initial
     in
     match res with
     | Ok s -> s

src/dune_rules/artifact_substitution.ml

@@ -52,8 +52,7 @@ type conf =
   }
 
 let mac_codesign_hook ~codesign path =
-  Process.run ~display:!Clflags.display Strict codesign
-    [ "-s"; "-"; Path.to_string path ]
+  Process.run ~display:Quiet Strict codesign [ "-s"; "-"; Path.to_string path ]
 
 let sign_hook_of_context (context : Context.t) =
   let config = context.ocaml_config in

src/dune_rules/context.ml

@@ -186,7 +186,7 @@ end = struct
         | Some opam -> (
           let+ version =
             Memo.of_reproducible_fiber
-              (Process.run_capture_line ~display:!Clflags.display Strict opam
+              (Process.run_capture_line ~display:Quiet Strict opam
                  [ "--version"; "--color=never" ])
           in
           match Scanf.sscanf version "%d.%d.%d" (fun a b c -> (a, b, c)) with
@@ -223,7 +223,7 @@ end = struct
       in
       let+ s =
         Memo.of_reproducible_fiber
-          (Process.run_capture ~display:!Clflags.display ~env Strict opam args)
+          (Process.run_capture ~display:Quiet ~env Strict opam args)
       in
       Dune_lang.Parser.parse_string ~fname:"<opam output>" ~mode:Single s
       |> Dune_lang.Decoder.(
@@ -313,8 +313,7 @@ let ocamlfind_printconf_path ~env ~ocamlfind ~toolchain =
   in
   let+ l =
     Memo.of_reproducible_fiber
-      (Process.run_capture_lines ~display:!Clflags.display ~env Strict ocamlfind
-         args)
+      (Process.run_capture_lines ~display:Quiet ~env Strict ocamlfind args)
   in
   List.map l ~f:Path.of_filename_relative_to_initial_cwd
 
@@ -376,7 +375,7 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets
         | Some s -> Memo.return s
         | None ->
           Memo.of_reproducible_fiber
-            (Process.run_capture_line ~display:!Clflags.display ~env Strict fn
+            (Process.run_capture_line ~display:Quiet ~env Strict fn
                [ "printconf"; "conf" ]))
         >>| Path.External.of_filename_relative_to_initial_cwd)
   in
@@ -484,8 +483,8 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets
       Memo.fork_and_join default_library_search_path (fun () ->
           let+ lines =
             Memo.of_reproducible_fiber
-              (Process.run_capture_lines ~display:!Clflags.display ~env Strict
-                 ocamlc [ "-config" ])
+              (Process.run_capture_lines ~display:Quiet ~env Strict ocamlc
+                 [ "-config" ])
           in
           ocaml_config_ok_exn
             (match Ocaml_config.Vars.of_lines lines with

src/dune_rules/coq/coq_config.ml

@@ -105,7 +105,7 @@ module Version = struct
   let impl_version bin =
     let* _ = Build_system.build_file bin in
     Memo.of_reproducible_fiber
-    @@ Process.run_capture_line ~display:!Clflags.display Process.Strict bin
+    @@ Process.run_capture_line ~display:Quiet Process.Strict bin
          [ "--print-version" ]
 
   let version_memo =
@@ -154,8 +154,7 @@ type t =
 let impl_config bin =
   let* _ = Build_system.build_file bin in
   Memo.of_reproducible_fiber
-  @@ Process.run_capture_lines ~display:!Clflags.display Process.Return bin
-       [ "--config" ]
+  @@ Process.run_capture_lines ~display:Quiet Process.Return bin [ "--config" ]
 
 let config_memo = Memo.create "coq-config" ~input:(module Path) impl_config
 

src/dune_rules/cram/cram_exec.ml

@@ -60,8 +60,7 @@ end = struct
     in
     let open Fiber.O in
     let+ () =
-      Process.run ~display:!Clflags.display ~stdin_from ~stdout_to Strict prog
-        argv
+      Process.run ~display:Quiet ~stdin_from ~stdout_to Strict prog argv
     in
     Io.with_file_in stdout_path ~f:(fun ic ->
         let rec loop acc =
@@ -103,7 +102,7 @@ let translate_path_for_sh =
     match cygpath with
     | None -> User_error.raise [ Pp.text "Unable to find cygpath in PATH" ]
     | Some cygpath ->
-      Process.run_capture_line ~display:!Clflags.display Strict cygpath
+      Process.run_capture_line ~display:Quiet Strict cygpath
         [ Path.to_absolute_filename fn ]
 
 (* Quote a filename for sh, independently of whether we are on Windows or Unix.
@@ -430,7 +429,7 @@ let run ~env ~script lexbuf : string Fiber.t =
       in
       Process.create_metadata ~name ~categories:[ "cram" ] ()
     in
-    Process.run ~display:!Clflags.display ~metadata ~dir:cwd ~env Strict sh
+    Process.run ~display:Quiet ~metadata ~dir:cwd ~env Strict sh
       [ Path.to_string sh_script.script ]
   in
   let raw = read_and_attach_exit_codes sh_script in

src/dune_rules/dune_load.ml

@@ -155,7 +155,7 @@ module Script = struct
     let* () =
       let* (_ : Memo.Run.t) = Memo.current_run () in
       Memo.of_reproducible_fiber
-        (Process.run Strict ~display:!Clflags.display ~dir:(Path.source dir)
+        (Process.run Strict ~display:Quiet ~dir:(Path.source dir)
            ~env:context.env ocaml args)
     in
     if not (Path.Untracked.exists (Path.build generated_dune_file)) then

src/dune_rules/jsoo/jsoo_rules.ml

@@ -121,7 +121,7 @@ module Version = struct
     let open Memo.O in
     let* _ = Build_system.build_file bin in
     Memo.of_reproducible_fiber
-    @@ Process.run_capture_line ~display:!Clflags.display Process.Strict bin
+    @@ Process.run_capture_line ~display:Quiet Process.Strict bin
          [ "--version" ]
     |> Memo.map ~f:of_string
 

src/dune_rules/melange/melange_binary.ml

@@ -10,7 +10,7 @@ let where =
     let* _ = Build_system.build_file bin in
     let+ where =
       Memo.of_reproducible_fiber
-      @@ Process.run_capture_line ~display:!Clflags.display Process.Strict bin
+      @@ Process.run_capture_line ~display:Quiet Process.Strict bin
            [ "--where" ]
     in
     Path.of_string where

test/blackbox-tests/test-cases/cram/git-diff-fail.t

@@ -15,8 +15,10 @@ First we make a cram test:
 We need to avoid the special treatment of the test when INSIDE_DUNE is set:
   $ unset INSIDE_DUNE
 
-We get nonsense internal output in the display:
-
-  $ dune build --root=. --diff-command="exit 1" --display=short @runtest 2>&1 >/dev/null | head -n2
+We do not observe the leaking of the display of internal processes when running
+dune build. Note that we scrub the actual reported error due to the build tool
+being bogus.
+  $ dune build --root=. --diff-command="exit 1; echo" --display=short @runtest | sed '/^(cd/d' 
   File "mytest.t", line 1, characters 0-0:
-            sh (internal) (exit 1)
+  Command exited with code 1.
+  [1]

test/expect-tests/process_tests.ml

@@ -18,17 +18,15 @@ let true_ =
 
 let%expect_test "null input" =
   let stdin_from = Process.(Io.null In) in
-  let run () =
-    Process.run ~display:!Clflags.display ~stdin_from Strict true_ []
-  in
+  let run () = Process.run ~display:Quiet ~stdin_from Strict true_ [] in
   let _res = go run in
   [%expect {||}]
 
 let%expect_test "null output" =
   let stdout_to = Process.(Io.null Out) in
   let stderr_to = Process.(Io.null Out) in
   let run () =
-    Process.run ~display:!Clflags.display ~stdout_to ~stderr_to Strict true_ []
+    Process.run ~display:Quiet ~stdout_to ~stderr_to Strict true_ []
   in
   let _res = go run in
   [%expect {||}]

test/expect-tests/vcs_tests.ml

@@ -36,7 +36,7 @@ let run (vcs : Vcs.t) args =
   printf "$ %s\n"
     (List.map (prog_str :: args) ~f:String.quote_for_shell
     |> String.concat ~sep:" ");
-  Process.run Strict (Lazy.force prog) real_args ~display:!Clflags.display
+  Process.run Strict (Lazy.force prog) real_args ~display:Quiet
     ~env:
       ((* One of the reasons to set GIT_DIR is to override any GIT_DIR set by
           the environment, which helps for example during [git rebase