Rigorous backtrace across compiler-libs

Author: bobzhang

jscomp/ext/ext_obj.ml

@@ -108,3 +108,23 @@ let pp_any fmt v =
   (dump v )
 
 
+let bt () = 
+  let raw_bt = Printexc.backtrace_slots (Printexc.get_raw_backtrace()) in       
+  match raw_bt with 
+  | None -> ()
+  | Some raw_bt ->
+    let acc = ref [] in 
+    (for i =  Array.length raw_bt - 1  downto 0 do 
+       let slot =  raw_bt.(i) in 
+       match Printexc.Slot.location slot with 
+       | None
+         -> ()
+       | Some bt ->
+         (match !acc with 
+          | [] -> acc := [bt]
+          | hd::tl -> if hd <> bt then acc := bt :: !acc )
+
+     done); 
+    Ext_list.iter !acc (fun bt ->       
+        Printf.eprintf "File \"%s\", line %d, characters %d-%d\n"
+          bt.filename bt.line_number bt.start_char bt.end_char )

jscomp/ext/ext_obj.mli

@@ -23,3 +23,4 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 val dump : 'a -> string 
 val pp_any : Format.formatter -> 'a -> unit 
+val bt : unit -> unit

jscomp/main/js_main.ml

@@ -347,7 +347,7 @@ let _ =
   with x -> 
     begin
 #if undefined BS_RELEASE_BUILD then      
-      Printexc.print_backtrace stderr;
+      Ext_obj.bt ();
 #end
       Location.report_exception ppf x;
       exit 2

jscomp/test/recursive_unbound_module_test.js

@@ -12,7 +12,7 @@ function Make(X) {
 
 var B = Caml_module.init_mod([
       "recursive_unbound_module_test.ml",
-      15,
+      18,
       0
     ], [[[[0]]]]);
 

lib/4.02.3/unstable/all_ounit_tests.ml

@@ -10579,7 +10579,7 @@ module Ext_obj : sig
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 val dump : 'a -> string 
 val pp_any : Format.formatter -> 'a -> unit 
-
+val bt : unit -> unit
 end = struct
 #1 "ext_obj.ml"
 (* Copyright (C) 2019-Present Authors of BuckleScript 
@@ -10692,6 +10692,26 @@ let pp_any fmt v =
   (dump v )
 
 
+let bt () = 
+  let raw_bt = Printexc.backtrace_slots (Printexc.get_raw_backtrace()) in       
+  match raw_bt with 
+  | None -> ()
+  | Some raw_bt ->
+    let acc = ref [] in 
+    (for i =  Array.length raw_bt - 1  downto 0 do 
+       let slot =  raw_bt.(i) in 
+       match Printexc.Slot.location slot with 
+       | None
+         -> ()
+       | Some bt ->
+         (match !acc with 
+          | [] -> acc := [bt]
+          | hd::tl -> if hd <> bt then acc := bt :: !acc )
+
+     done); 
+    Ext_list.iter !acc (fun bt ->       
+        Printf.eprintf "File \"%s\", line %d, characters %d-%d\n"
+          bt.filename bt.line_number bt.start_char bt.end_char )
 
 end
 module Ounit_hashtbl_tests