Merge pull request #679 from rgrinberg/configurator-backtrace

Print backtrace in case of uncaught exception

src/configurator/configurator.ml

@@ -447,9 +447,10 @@ let main ?(args=[]) ~name f =
   try
     f t
   with exn ->
+    let bt = Printexc.get_raw_backtrace () in
     List.iter (List.rev !log_db) ~f:(eprintf "%s\n");
     match exn with
     | Fatal_error msg ->
       eprintf "Error: %s\n%!" msg;
       exit 1
-    | exn -> raise exn
+    | _ -> Exn.raise_with_backtrace exn bt

src/stdune/exn.ml

@@ -10,3 +10,13 @@ let protectx x ~f ~finally =
   | exception e -> finally x; raise e
 
 let protect ~f ~finally = protectx () ~f ~finally
+
+include
+  ((struct
+    [@@@warning "-32-3"]
+    let raise_with_backtrace exn _ = reraise exn
+    include Printexc
+    let raise_with_backtrace exn bt = raise_with_backtrace exn bt
+  end) : (sig
+     val raise_with_backtrace: exn -> Printexc.raw_backtrace -> _
+   end))

src/stdune/exn.mli

@@ -8,3 +8,5 @@ external reraise       : exn -> _ = "%reraise"
 
 val protect : f:(unit -> 'a) -> finally:(unit -> unit) -> 'a
 val protectx : 'a -> f:('a -> 'b) -> finally:('a -> unit) -> 'b
+
+val raise_with_backtrace: exn -> Printexc.raw_backtrace -> _