stdlib/fedora.gl: Simpler quicker way to work out dependencies.

[goals.git] / src / jobs.ml

diff --git a/src/jobs.ml b/src/jobs.ml
index 2e8735e..0a698ef 100644 (file)
--- a/src/jobs.ml
+++ b/src/jobs.ml
@@ -21,11 +21,7 @@ open Utils
 
 type 'a next = Job of 'a * (unit -> unit) | Complete | Not_ready
 
-type 'a retire = 'a -> unit
-
-type 'a to_string = 'a -> string
-
-let run next_job retire_job string_of_job =
+let run next_job retire_job fail_job string_of_job =
   (* Number of running threads <= Cmdline.nr_jobs. *)
   let running = ref 0 in
 
@@ -33,7 +29,7 @@ let run next_job retire_job string_of_job =
   let lock = Mutex.create () and cond = Condition.create () in
 
   (* If a job throws an exception it is saved here. *)
-  let last_exn = ref None in
+  let last_exn = ref [] in
 
   (* This is the background thread which runs each job. *)
   let runner (job, f) =
@@ -42,7 +38,9 @@ let run next_job retire_job string_of_job =
     Mutex.lock lock;
     (match exn with
      | None -> retire_job job
-     | Some exn -> last_exn := Some exn
+     | Some exn ->
+        last_exn := exn :: !last_exn;
+        fail_job job
     );
     decr running;
     Condition.signal cond;
@@ -50,7 +48,8 @@ let run next_job retire_job string_of_job =
   in
 
   let rec loop () =
-    if !last_exn = None then (
+    let continue = !last_exn = [] || Cmdline.keep_going () in
+    if continue then (
       match next_job () with
       | Complete -> ()
       | Not_ready ->
@@ -82,10 +81,19 @@ let run next_job retire_job string_of_job =
     Condition.wait cond lock
   done;
 
-  let exn = !last_exn in
+  let exns = !last_exn in
   Mutex.unlock lock;
 
-  (* Re-raise the saved exception from the job which failed. *)
-  match exn with
-  | None -> ()
-  | Some exn -> raise exn
+  (* Re-raise the saved exception(s) from the job(s) which failed. *)
+  match exns with
+  | [] -> ()
+  | [exn] -> raise exn
+  | exns ->
+     (* Combine the multiple exceptions into a single Failure exn. *)
+     let exns = List.rev exns in
+     let exn_to_string = function
+       | Failure s -> s
+       | exn -> Printexc.to_string exn in
+     let exns = List.map exn_to_string exns in
+     let exns = String.concat "\n" exns in
+     raise (Failure exns)