From 1059ecce2a2662e4d8f335bd4db743df70b100b1 Mon Sep 17 00:00:00 2001
From: Pierre-Marie Pédrot
Date: Thu, 30 Jan 2014 15:30:01 +0100
Subject: Fixing backtrace handling here and there.

---
 lib/backtrace.ml  | 13 +++++++++++++
 lib/backtrace.mli |  7 +++++++
 2 files changed, 20 insertions(+)

(limited to 'lib')

diff --git a/lib/backtrace.ml b/lib/backtrace.ml
index d64f42f7f0..19b07d8767 100644
--- a/lib/backtrace.ml
+++ b/lib/backtrace.ml
@@ -96,3 +96,16 @@ let add_backtrace e =
       Exninfo.add e backtrace bt
     end
   else e
+
+let app_backtrace ~src ~dst =
+  if !is_recording then
+    match get_backtrace src with
+    | None -> dst
+    | Some bt ->
+      match get_backtrace dst with
+      | None ->
+        Exninfo.add dst backtrace bt
+      | Some nbt ->
+        let bt = bt @ nbt in
+        Exninfo.add dst backtrace bt
+  else dst
diff --git a/lib/backtrace.mli b/lib/backtrace.mli
index b5a956573d..ecd046b545 100644
--- a/lib/backtrace.mli
+++ b/lib/backtrace.mli
@@ -87,3 +87,10 @@ val add_backtrace : exn -> exn
     I admit that's a bit heavy, but there is not much to do...
 
 *)
+
+val app_backtrace : src:exn -> dst:exn -> exn
+(** Append the backtrace from [src] to [dst]. The returned exception is [dst]
+    except for its backtrace information. This is targeted at container
+    exceptions, that is, exceptions that contain exceptions. This way, one can
+    transfer the backtrace from the container to the underlying exception, as if
+    the latter was the one originally raised. *)
-- 
cgit v1.2.3