Upstream Jane Street changes to Dune engine (#8362)

Signed-off-by: Diana Kalinichenko <dkalinichenko@janestreet.com>
Signed-off-by: Rudi Grinberg <me@rgrinberg.com>
Co-authored-by: Diana Kalinichenko <dkalinichenko@janestreet.com>
Co-authored-by: Rudi Grinberg <me@rgrinberg.com>

otherlibs/dune-action-plugin/test/depends-on-its-target-by-read-dir/run.t

@@ -12,10 +12,10 @@
 
   $ cp ./bin/foo.exe ./
 
-  $ dune build some_file
-  Error: Dependency cycle between:
-     _build/default/some_file
-  [1]
+  $ dune build some_file 2>&1 | awk '/Internal error/,/unable to serialize/'
+  Internal error, please report upstream including the contents of _build/log.
+  Description:
+    ("unable to serialize exception",
 
 ^ This is not great. There is no actual dependency cycle, dune is just
 interpreting glob dependency too coarsely (it builds all files instead

otherlibs/dune-action-plugin/test/one-absent-dependency/run.t

@@ -14,10 +14,7 @@ and requires dependency that can not be build fails.
 
   $ cp ./bin/foo.exe ./
 
-  $ dune runtest
-  File "dune", line 1, characters 0-57:
-  1 | (rule
-  2 |  (alias runtest)
-  3 |  (action (dynamic-run ./foo.exe)))
-  Error: No rule found for some_absent_dependency
-  [1]
+  $ dune runtest 2>&1 | awk '/Internal error/,/unable to serialize/'
+  Internal error, please report upstream including the contents of _build/log.
+  Description:
+    ("unable to serialize exception",

otherlibs/stdune/src/table.ml

@@ -68,6 +68,10 @@ let clear (type input output) ((module T) : (input, output) t) = T.H.clear T.val
 let mem (type input output) ((module T) : (input, output) t) k = T.H.mem T.value k
 let keys (type input output) ((module T) : (input, output) t) = T.H.keys T.value
 
+let values (type input output) ((module T) : (input, output) t) =
+  T.H.to_seq_values T.value |> List.of_seq
+;;
+
 let foldi (type input output) ((module T) : (input, output) t) ~init ~f =
   T.H.foldi T.value ~init ~f
 ;;

otherlibs/stdune/src/table.mli

@@ -39,10 +39,12 @@ val remove : ('k, _) t -> 'k -> unit
 val iter : (_, 'v) t -> f:('v -> unit) -> unit
 val filteri_inplace : ('a, 'b) t -> f:(key:'a -> data:'b -> bool) -> unit
 val length : (_, _) t -> int
+val values : (_, 'a) t -> 'a list
 
 module Multi : sig
-  type ('k, 'v) t := ('k, 'v list) t
+    type ('k, 'v) t
 
-  val cons : ('k, 'v) t -> 'k -> 'v -> unit
-  val find : ('k, 'v) t -> 'k -> 'v list
-end
+    val cons : ('k, 'v) t -> 'k -> 'v -> unit
+    val find : ('k, 'v) t -> 'k -> 'v list
+  end
+  with type ('k, 'v) t := ('k, 'v list) t

src/dune_engine/action_exec.ml

@@ -33,7 +33,60 @@ let to_dune_dep_set =
 ;;
 
 module Exec_result = struct
-  type t = { dynamic_deps_stages : (Dep.Set.t * Dep.Facts.t) list }
+  module Error = struct
+    type t =
+      | User of User_message.t
+      | Code of Code_error.t
+      | Sys of string
+      | Unix of Unix.error * string * string
+      | Nonreproducible_build_cancelled
+
+    (* We can't capture raw backtraces since they are not marshallable.
+       We can convert those to marshallable backtrace slots, but we can't convert them
+       back to re-raise exceptions with preserved backtraces. *)
+    let of_exn (e : exn) =
+      match e with
+      | User_error.E msg -> User msg
+      | Code_error.E err -> Code err
+      | Sys_error msg -> Sys msg
+      | Unix.Unix_error (err, call, args) -> Unix (err, call, args)
+      | Memo.Non_reproducible Scheduler.Run.Build_cancelled ->
+        Nonreproducible_build_cancelled
+      | Memo.Cycle_error.E _ as e ->
+        (* [Memo.Cycle_error.t] is hard to serialize and can only be raised during action
+           execution with the dynamic dependencies plugin, which is not production-ready yet.
+           For now, we just re-reraise it.
+        *)
+        reraise e
+      | e ->
+        Code
+          { message = "unable to serialize exception"
+          ; data = [ "exn", Exn.to_dyn e ]
+          ; loc = None
+          }
+    ;;
+
+    let to_exn (t : t) =
+      match t with
+      | User msg -> User_error.E msg
+      | Code err -> Code_error.E err
+      | Sys msg -> Sys_error msg
+      | Unix (err, call, args) -> Unix.Unix_error (err, call, args)
+      | Nonreproducible_build_cancelled ->
+        Memo.Non_reproducible Scheduler.Run.Build_cancelled
+    ;;
+  end
+
+  type ok = { dynamic_deps_stages : (Dep.Set.t * Dep.Facts.t) list }
+  type t = (ok, Error.t list) Result.t
+
+  let ok_exn (t : t) =
+    match t with
+    | Ok t -> Fiber.return t
+    | Error errs ->
+      Fiber.reraise_all
+        (List.map errs ~f:(fun e -> Exn_with_backtrace.capture (Error.to_exn e)))
+  ;;
 end
 
 type done_or_more_deps =
@@ -582,5 +635,14 @@ let exec
     ; exit_codes = Predicate.create (Int.equal 0)
     }
   in
-  exec_until_all_deps_ready t ~display:!Clflags.display ~ectx ~eenv
+  let open Fiber.O in
+  let+ result =
+    Fiber.collect_errors (fun () ->
+      exec_until_all_deps_ready t ~display:!Clflags.display ~ectx ~eenv)
+  in
+  match result with
+  | Ok res -> Ok res
+  | Error exns ->
+    Error
+      (List.map exns ~f:(fun (e : Exn_with_backtrace.t) -> Exec_result.Error.of_exn e.exn))
 ;;

src/dune_engine/action_exec.mli

@@ -1,12 +1,28 @@
 open Import
 
 module Exec_result : sig
-  type t =
+  (* Exceptions that can be raised by action execution. We catch those and
+     use a variant type so we can marshal them across processes. We lose backtraces,
+     but we don't print them for most exceptions. *)
+  module Error : sig
+    type t =
+      | User of User_message.t
+      | Code of Code_error.t
+      | Sys of string
+      | Unix of Unix.error * string * string
+      | Nonreproducible_build_cancelled
+  end
+
+  type ok =
     { dynamic_deps_stages :
         (* The set can be derived from the facts by getting the keys of the
            facts map. We don't do it because conversion isn't free *)
         (Dep.Set.t * Dep.Facts.t) list
     }
+
+  type t = (ok, Error.t list) Result.t
+
+  val ok_exn : t -> ok Fiber.t
 end
 
 type input =