fix: better cancelled jobs handling

* do not print output of cancelled jobs
* [Process.run] will not return with a value signalling success if the
  job was cancelled after the process terminated.

Signed-off-by: Rudi Grinberg <[email protected]>

ps-id: F1DB0788-E5E1-4B5E-9544-D53F147D7B5A

CHANGES.md

@@ -1,6 +1,9 @@
 3.2.0 (Unreleased)
 -----------------
 
+- The output of jobs that finished but were cancelled is now omitted. (#5631,
+  fixes #5482, @rgrinberg)
+
 - Allows to configure all the default destination directories with `./configure`
   (adds `bin`, `sbin`, `data`, `libexec`). Use `OPAM_SWITCH_PREFIX` instead of
   calling the `opam` binaries in `dune install`. Fix handling of multiple

src/dune_engine/process.ml

@@ -616,7 +616,7 @@ let set_temp_dir_when_running_actions = ref true
 let run_internal ?dir ?(stdout_to = Io.stdout) ?(stderr_to = Io.stderr)
     ?(stdin_from = Io.null In) ?(env = Env.initial)
     ?(metadata = default_metadata) fail_mode prog args =
-  Scheduler.with_job_slot (fun (config : Scheduler.Config.t) ->
+  Scheduler.with_job_slot (fun cancel (config : Scheduler.Config.t) ->
       let display = config.display in
       let dir =
         match dir with
@@ -801,20 +801,32 @@ let run_internal ?dir ?(stdout_to = Io.stdout) ?(stderr_to = Io.stderr)
         | `Capture fn ->
           swallow_on_success_if_requested fn actual_stderr stderr_on_success
       in
-      let output = stdout ^ stderr in
-      Log.command ~command_line ~output ~exit_status:process_info.status;
-      let res =
-        match (display.verbosity, exit_status', output) with
-        | Quiet, Ok n, "" -> n (* Optimisation for the common case *)
-        | Verbose, _, _ ->
-          Handle_exit_status.verbose exit_status' ~id ~metadata ~dir
-            ~command_line:fancy_command_line ~output
-        | _ ->
-          Handle_exit_status.non_verbose exit_status' ~prog:prog_str ~dir
-            ~command_line ~output ~metadata ~verbosity:display.verbosity
-            ~has_unexpected_stdout ~has_unexpected_stderr
-      in
-      (res, times))
+      if Fiber.Cancel.fired cancel then
+        (* if the cancellation token was fired, then we:
+
+           1) aren't interested in printing the output from the cancelled job
+
+           2) allowing callers to continue work with the already stale value
+           we're about to return. We reuse [Already_reported] to signal that
+           this exception is propagated without being reported. It's not the
+           original intention of [Already_reported] but it works adequately
+           here. *)
+        raise Dune_util.Report_error.Already_reported
+      else
+        let output = stdout ^ stderr in
+        Log.command ~command_line ~output ~exit_status:process_info.status;
+        let res =
+          match (display.verbosity, exit_status', output) with
+          | Quiet, Ok n, "" -> n (* Optimisation for the common case *)
+          | Verbose, _, _ ->
+            Handle_exit_status.verbose exit_status' ~id ~metadata ~dir
+              ~command_line:fancy_command_line ~output
+          | _ ->
+            Handle_exit_status.non_verbose exit_status' ~prog:prog_str ~dir
+              ~command_line ~output ~metadata ~verbosity:display.verbosity
+              ~has_unexpected_stdout ~has_unexpected_stderr
+        in
+        (res, times))
 
 let run ?dir ?stdout_to ?stderr_to ?stdin_from ?env ?metadata fail_mode prog
     args =

src/dune_engine/scheduler.ml

@@ -910,7 +910,7 @@ let with_job_slot f =
   let* t = t () in
   Fiber.Throttle.run t.job_throttle ~f:(fun () ->
       check_cancelled t;
-      f t.config)
+      f t.cancel t.config)
 
 (* We use this version privately in this module whenever we can pass the
    scheduler explicitly *)

src/dune_engine/scheduler.mli

@@ -113,8 +113,9 @@ type t
 val t : unit -> t Fiber.t
 
 (** [with_job_slot f] waits for one job slot (as per [-j <jobs] to become
-    available and then calls [f]. *)
-val with_job_slot : (Config.t -> 'a Fiber.t) -> 'a Fiber.t
+    available and then calls [f]. The cancellation token is provided to [f] to
+    avoid doing some work if the job's result is no longer necessary. *)
+val with_job_slot : (Fiber.Cancel.t -> Config.t -> 'a Fiber.t) -> 'a Fiber.t
 
 (** Wait for the following process to terminate. If [is_process_group_leader] is
     true, kill the entire process group instead of just the process in case of

test/expect-tests/scheduler_tests.ml

@@ -30,7 +30,7 @@ let%expect_test "cancelling a build" =
              let* () = Fiber.Ivar.read build_cancelled in
              let* res =
                Fiber.collect_errors (fun () ->
-                   Scheduler.with_job_slot (fun _ -> Fiber.return ()))
+                   Scheduler.with_job_slot (fun _ _ -> Fiber.return ()))
              in
              print_endline
                (match res with
@@ -68,7 +68,7 @@ let%expect_test "cancelling a build: effect on other fibers" =
           let* () = Scheduler.wait_for_build_input_change () in
           let* res =
             Fiber.collect_errors (fun () ->
-                Scheduler.with_job_slot (fun _ -> Fiber.return ()))
+                Scheduler.with_job_slot (fun _ _ -> Fiber.return ()))
           in
           print_endline
             (match res with