From 10c5447608501f52cff1e95a7ec4f5dd1327bc29 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 6 Apr 2018 11:37:19 +0800 Subject: [PATCH 1/3] Print backtrace in case of uncaught exception Otherwise uncaught by configurator are hard to debug --- src/configurator/configurator.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/configurator/configurator.ml b/src/configurator/configurator.ml index 7b676e8c..3eefb311 100644 --- a/src/configurator/configurator.ml +++ b/src/configurator/configurator.ml @@ -452,4 +452,4 @@ let main ?(args=[]) ~name f = | Fatal_error msg -> eprintf "Error: %s\n%!" msg; exit 1 - | exn -> raise exn + | _ -> Exn.reraise exn From 52a3833e0e353f6e245aaa0e3c3402a358d62720 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 6 Apr 2018 22:26:49 +0800 Subject: [PATCH 2/3] Add Exn.raise_with_backtrace --- src/stdune/exn.ml | 10 ++++++++++ src/stdune/exn.mli | 2 ++ 2 files changed, 12 insertions(+) diff --git a/src/stdune/exn.ml b/src/stdune/exn.ml index c42025bb..469de331 100644 --- a/src/stdune/exn.ml +++ b/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)) diff --git a/src/stdune/exn.mli b/src/stdune/exn.mli index c30f0674..6df3fa9f 100644 --- a/src/stdune/exn.mli +++ b/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 -> _ From c0c69b44db82142cc693937b6342299071f4a41e Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 6 Apr 2018 22:27:47 +0800 Subject: [PATCH 3/3] Update configurator to use Exn.raise_with_backtrace --- src/configurator/configurator.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/configurator/configurator.ml b/src/configurator/configurator.ml index 3eefb311..1a159b40 100644 --- a/src/configurator/configurator.ml +++ b/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.reraise exn + | _ -> Exn.raise_with_backtrace exn bt