From f1b63d4a576793b8725a3ea26f0779f77ecfcf34 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Wed, 27 Jul 2016 11:30:26 -0400 Subject: [PATCH] Revert "Merge pull request #378 from bobot/feature/reraise_raw_backtrace_primitive" This reverts commit 5adf895aace5783f0a93521e36b308b9d63c3382, reversing changes made to 38c3db40c7533aece24279317dba28f7ce7d1f5a. The reason for the revert is a continuous integration failure on 32bit arm machines. I don't have the time (or capabilities) to investigate it right now, and we need functional continuous testing for other upcoming merges, so the safest choice is to revert -- and hopefully merge back after the issue is fixed. --- Changes | 4 -- asmrun/backtrace_prim.c | 17 ++--- bytecomp/translcore.ml | 23 ------ byterun/backtrace.c | 43 +---------- byterun/backtrace_prim.c | 14 ++-- byterun/caml/backtrace_prim.h | 3 - stdlib/printexc.ml | 6 +- stdlib/printexc.mli | 19 +---- .../tests/backtrace/backtrace2.byte.reference | 71 ++++++------------- testsuite/tests/backtrace/backtrace2.ml | 66 +++-------------- .../backtrace/backtrace2.native.reference | 71 ++++++------------- .../backtrace/raw_backtrace.byte.reference | 38 +++------- testsuite/tests/backtrace/raw_backtrace.ml | 20 +----- .../backtrace/raw_backtrace.native.reference | 38 +++------- .../tests/lib-threads/backtrace_threads.ml | 18 ----- .../lib-threads/backtrace_threads.reference | 0 16 files changed, 85 insertions(+), 366 deletions(-) delete mode 100644 testsuite/tests/lib-threads/backtrace_threads.ml delete mode 100644 testsuite/tests/lib-threads/backtrace_threads.reference diff --git a/Changes b/Changes index 7145db72c5c1..4f77719b7485 100644 --- a/Changes +++ b/Changes @@ -152,10 +152,6 @@ OCaml 4.04.0: array of floats (Thomas Braibant) -- GPR#378: Add [Printexc.raise_with_backtrace] raise an exception using - an explicit backtrace - (François Bobot, review by Gabriel Scherer, Xavier Leroy, Damien Doligez, - Frédéric Bour) ### Manual and documentation: diff --git a/asmrun/backtrace_prim.c b/asmrun/backtrace_prim.c index 682e082e82b9..2ecf159180dd 100644 --- a/asmrun/backtrace_prim.c +++ b/asmrun/backtrace_prim.c @@ -69,14 +69,6 @@ frame_descr * caml_next_frame_descriptor(uintnat * pc, char ** sp) } } -int caml_alloc_backtrace_buffer(void){ - Assert(caml_backtrace_pos == 0); - caml_backtrace_buffer = malloc(BACKTRACE_BUFFER_SIZE - * sizeof(backtrace_slot)); - if (caml_backtrace_buffer == NULL) return -1; - return 0; -} - /* Stores the return addresses contained in the given stack fragment into the backtrace array ; this version is performance-sensitive as it is called at each [raise] in a program compiled with [-g], so we @@ -89,9 +81,12 @@ void caml_stash_backtrace(value exn, uintnat pc, char * sp, char * trapsp) caml_backtrace_pos = 0; caml_backtrace_last_exn = exn; } - - if (caml_backtrace_buffer == NULL && caml_alloc_backtrace_buffer() == -1) - return; + if (caml_backtrace_buffer == NULL) { + Assert(caml_backtrace_pos == 0); + caml_backtrace_buffer = malloc(BACKTRACE_BUFFER_SIZE + * sizeof(backtrace_slot)); + if (caml_backtrace_buffer == NULL) return; + } /* iterate on each frame */ while (1) { diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml index c2ecb08963d1..476187d589f1 100644 --- a/bytecomp/translcore.ml +++ b/bytecomp/translcore.ml @@ -338,9 +338,6 @@ let primitives_table = create_hashtable 57 [ let find_primitive prim_name = Hashtbl.find primitives_table prim_name -let prim_restore_raw_backtrace = - Primitive.simple ~name:"caml_restore_raw_backtrace" ~arity:2 ~alloc:false - let specialize_comparison table env ty = let (gencomp, intcomp, floatcomp, stringcomp, nativeintcomp, int32comp, int64comp, _) = table in @@ -774,26 +771,6 @@ and transl_exp0 e = match argl with [obj; meth; cache; pos] -> wrap (Lsend(Cached, meth, obj, [cache; pos], e.exp_loc)) | _ -> assert false - else if p.prim_name = "%raise_with_backtrace" then begin - let texn1 = List.hd args (* Should not fail by typing *) in - let texn2,bt = match argl with - | [a;b] -> a,b - | _ -> assert false (* idem *) - in - let vexn = Ident.create "exn" in - Llet(Strict, Pgenval, vexn, texn2, - event_before e begin - Lsequence( - wrap (Lprim (Pccall prim_restore_raw_backtrace, - [Lvar vexn;bt], - e.exp_loc)), - wrap0 (Lprim(Praise Raise_reraise, - [event_after texn1 (Lvar vexn)], - e.exp_loc)) - ) - end - ) - end else begin let prim = transl_primitive_application e.exp_loc p e.exp_env prim_type (Some path) args in diff --git a/byterun/backtrace.c b/byterun/backtrace.c index 2680d4c6a3e5..670f0c480e8f 100644 --- a/byterun/backtrace.c +++ b/byterun/backtrace.c @@ -49,11 +49,9 @@ CAMLprim value caml_record_backtrace(value vflag) caml_backtrace_active = flag; caml_backtrace_pos = 0; caml_backtrace_last_exn = Val_unit; - /* Note: We do lazy initialization of caml_backtrace_buffer when - needed in order to simplify the interface with the thread - library (thread creation doesn't need to allocate - caml_backtrace_buffer). So we don't have to allocate it here. - */ + /* Note: lazy initialization of caml_backtrace_buffer in + caml_stash_backtrace to simplify the interface with the thread + libraries */ } return Val_unit; } @@ -169,41 +167,6 @@ CAMLprim value caml_get_exception_raw_backtrace(value unit) CAMLreturn(res); } -/* Copy back a backtrace and exception to the global state. - This function should be used only with Printexc.raw_backtrace */ -/* noalloc (caml value): so no CAMLparam* CAMLreturn* */ -CAMLprim value caml_restore_raw_backtrace(value exn, value backtrace) -{ - intnat i; - mlsize_t bt_size; - - caml_backtrace_last_exn = exn; - - bt_size = Wosize_val(backtrace); - if(bt_size > BACKTRACE_BUFFER_SIZE){ - bt_size = BACKTRACE_BUFFER_SIZE; - } - - /* We don't allocate if the backtrace is empty (no -g or backtrace - not activated) */ - if(bt_size == 0){ - caml_backtrace_pos = 0; - return Val_unit; - } - - /* Allocate if needed and copy the backtrace buffer */ - if (caml_backtrace_buffer == NULL && caml_alloc_backtrace_buffer() == -1){ - return Val_unit; - } - - caml_backtrace_pos = bt_size; - for(i=0; i < caml_backtrace_pos; i++){ - caml_backtrace_buffer[i] = Backtrace_slot_val(Field(backtrace, i)); - } - - return Val_unit; -} - #define Val_debuginfo(bslot) (Val_long((uintnat)(bslot)>>1)) #define Debuginfo_val(vslot) ((debuginfo)(Long_val(vslot) << 1)) diff --git a/byterun/backtrace_prim.c b/byterun/backtrace_prim.c index 7a46e1d65aa8..c81955a4537b 100644 --- a/byterun/backtrace_prim.c +++ b/byterun/backtrace_prim.c @@ -217,13 +217,6 @@ CAMLprim value caml_remove_debug_info(code_t start) CAMLreturn(Val_unit); } -int caml_alloc_backtrace_buffer(void){ - Assert(caml_backtrace_pos == 0); - caml_backtrace_buffer = malloc(BACKTRACE_BUFFER_SIZE * sizeof(code_t)); - if (caml_backtrace_buffer == NULL) return -1; - return 0; -} - /* Store the return addresses contained in the given stack fragment into the backtrace array */ @@ -235,8 +228,11 @@ void caml_stash_backtrace(value exn, code_t pc, value * sp, int reraise) caml_backtrace_last_exn = exn; } - if (caml_backtrace_buffer == NULL && caml_alloc_backtrace_buffer() == -1) - return; + if (caml_backtrace_buffer == NULL) { + Assert(caml_backtrace_pos == 0); + caml_backtrace_buffer = malloc(BACKTRACE_BUFFER_SIZE * sizeof(code_t)); + if (caml_backtrace_buffer == NULL) return; + } if (caml_backtrace_pos >= BACKTRACE_BUFFER_SIZE) return; /* testing the code region is needed: PR#1554 */ diff --git a/byterun/caml/backtrace_prim.h b/byterun/caml/backtrace_prim.h index 2484b2947cee..025242d0011a 100644 --- a/byterun/caml/backtrace_prim.h +++ b/byterun/caml/backtrace_prim.h @@ -70,9 +70,6 @@ void caml_debuginfo_location(debuginfo dbg, /*out*/ struct caml_loc_info * li); #define Val_backtrace_slot(bslot) (Val_long(((uintnat)(bslot))>>1)) #define Backtrace_slot_val(vslot) ((backtrace_slot)(Long_val(vslot) << 1)) -/* Allocate the caml_backtrace_buffer. Returns 0 on success, -1 otherwise */ -int caml_alloc_backtrace_buffer(void); - #define BACKTRACE_BUFFER_SIZE 1024 /* Besides decoding backtrace info, [backtrace_prim] has two other diff --git a/stdlib/printexc.ml b/stdlib/printexc.ml index d4863129a5f3..83e463e31ecb 100644 --- a/stdlib/printexc.ml +++ b/stdlib/printexc.ml @@ -89,9 +89,6 @@ type raw_backtrace external get_raw_backtrace: unit -> raw_backtrace = "caml_get_exception_raw_backtrace" -external raise_with_backtrace: exn -> raw_backtrace -> 'a - = "%raise_with_backtrace" - type backtrace_slot = | Known_location of { is_raise : bool; @@ -239,7 +236,8 @@ external get_raw_backtrace_next_slot : (* confusingly named: returns the *string* corresponding to the global current backtrace *) -let get_backtrace () = raw_backtrace_to_string (get_raw_backtrace ()) +let get_backtrace () = + backtrace_to_string (convert_raw_backtrace (get_raw_backtrace ())) external record_backtrace: bool -> unit = "caml_record_backtrace" external backtrace_status: unit -> bool = "caml_backtrace_status" diff --git a/stdlib/printexc.mli b/stdlib/printexc.mli index 9192873a8832..faef5d0c6532 100644 --- a/stdlib/printexc.mli +++ b/stdlib/printexc.mli @@ -42,20 +42,13 @@ val print_backtrace: out_channel -> unit on the output channel [oc]. The backtrace lists the program locations where the most-recently raised exception was raised and where it was propagated through function calls. - - If the call is not inside an exception handler, the returned - backtrace is unspecified. If the call is after some - exception-catching code (before in the handler, or in a when-guard - during the matching of the exception handler), the backtrace may - correspond to a later exception than the handled one. - @since 3.11.0 *) val get_backtrace: unit -> string (** [Printexc.get_backtrace ()] returns a string containing the same exception backtrace that [Printexc.print_backtrace] would - print. Same restriction usage than {!print_backtrace}. + print. @since 3.11.0 *) @@ -113,7 +106,7 @@ type raw_backtrace val get_raw_backtrace: unit -> raw_backtrace (** [Printexc.get_raw_backtrace ()] returns the same exception backtrace that [Printexc.print_backtrace] would print, but in - a raw format. Same restriction usage than {!print_backtrace}. + a raw format. @since 4.01.0 *) @@ -132,14 +125,6 @@ val raw_backtrace_to_string: raw_backtrace -> string @since 4.01.0 *) -external raise_with_backtrace: exn -> raw_backtrace -> 'a - = "%raise_with_backtrace" -(** Reraise the exception using the given raw_backtrace for the - origin of the exception - - @since 4.03.0 -*) - (** {6 Current call stack} *) val get_callstack: int -> raw_backtrace diff --git a/testsuite/tests/backtrace/backtrace2.byte.reference b/testsuite/tests/backtrace/backtrace2.byte.reference index ef61b21891b0..82833fd921e6 100644 --- a/testsuite/tests/backtrace/backtrace2.byte.reference +++ b/testsuite/tests/backtrace/backtrace2.byte.reference @@ -2,57 +2,26 @@ a No exception b Uncaught exception Backtrace2.Error("b") -Raised at file "backtrace2.ml", line 8, characters 23-34 -Called from file "backtrace2.ml", line 8, characters 44-55 -Called from file "backtrace2.ml", line 8, characters 44-55 -Called from file "backtrace2.ml", line 8, characters 44-55 -Called from file "backtrace2.ml", line 8, characters 44-55 -Called from file "backtrace2.ml", line 8, characters 44-55 -Called from file "backtrace2.ml", line 13, characters 4-11 -Re-raised at file "backtrace2.ml", line 15, characters 68-71 -Called from file "backtrace2.ml", line 58, characters 11-23 +Raised at file "backtrace2.ml", line 7, characters 21-32 +Called from file "backtrace2.ml", line 7, characters 42-53 +Called from file "backtrace2.ml", line 7, characters 42-53 +Called from file "backtrace2.ml", line 7, characters 42-53 +Called from file "backtrace2.ml", line 7, characters 42-53 +Called from file "backtrace2.ml", line 7, characters 42-53 +Called from file "backtrace2.ml", line 11, characters 4-11 +Re-raised at file "backtrace2.ml", line 13, characters 68-71 +Called from file "backtrace2.ml", line 18, characters 11-23 Uncaught exception Backtrace2.Error("c") -Raised at file "backtrace2.ml", line 16, characters 26-37 -Called from file "backtrace2.ml", line 58, characters 11-23 +Raised at file "backtrace2.ml", line 14, characters 26-37 +Called from file "backtrace2.ml", line 18, characters 11-23 Uncaught exception Backtrace2.Error("d") -Raised at file "backtrace2.ml", line 8, characters 23-34 -Called from file "backtrace2.ml", line 8, characters 44-55 -Called from file "backtrace2.ml", line 8, characters 44-55 -Called from file "backtrace2.ml", line 8, characters 44-55 -Called from file "backtrace2.ml", line 8, characters 44-55 -Called from file "backtrace2.ml", line 8, characters 44-55 -Called from file "backtrace2.ml", line 13, characters 4-11 -Called from file "backtrace2.ml", line 58, characters 11-23 -e -Uncaught exception Backtrace2.Error("e") -Raised at file "backtrace2.ml", line 22, characters 56-59 -Called from file "backtrace2.ml", line 58, characters 11-23 -f -Uncaught exception Backtrace2.Error("f") -Raised at file "backtrace2.ml", line 28, characters 68-71 -Called from file "backtrace2.ml", line 58, characters 11-23 +Raised at file "backtrace2.ml", line 7, characters 21-32 +Called from file "backtrace2.ml", line 7, characters 42-53 +Called from file "backtrace2.ml", line 7, characters 42-53 +Called from file "backtrace2.ml", line 7, characters 42-53 +Called from file "backtrace2.ml", line 7, characters 42-53 +Called from file "backtrace2.ml", line 7, characters 42-53 +Called from file "backtrace2.ml", line 11, characters 4-11 +Called from file "backtrace2.ml", line 18, characters 11-23 Uncaught exception Invalid_argument("index out of bounds") -Raised by primitive operation at file "backtrace2.ml", line 58, characters 14-22 -test_Not_found -Uncaught exception Not_found -Raised at file "hashtbl.ml", line 192, characters 19-28 -Called from file "backtrace2.ml", line 39, characters 9-42 -Re-raised at file "backtrace2.ml", line 39, characters 67-70 -Called from file "backtrace2.ml", line 58, characters 11-23 -Uncaught exception Not_found -Raised at file "backtrace2.ml", line 43, characters 24-33 -Called from file "backtrace2.ml", line 43, characters 43-52 -Called from file "backtrace2.ml", line 43, characters 43-52 -Called from file "backtrace2.ml", line 43, characters 43-52 -Called from file "backtrace2.ml", line 43, characters 43-52 -Called from file "backtrace2.ml", line 43, characters 43-52 -Called from file "camlinternalLazy.ml", line 27, characters 17-27 -Re-raised at file "camlinternalLazy.ml", line 34, characters 10-11 -Called from file "backtrace2.ml", line 58, characters 11-23 -Uncaught exception Not_found -Raised at file "hashtbl.ml", line 192, characters 19-28 -Called from file "backtrace2.ml", line 46, characters 8-41 -Re-raised at file "camlinternalLazy.ml", line 33, characters 62-63 -Called from file "camlinternalLazy.ml", line 27, characters 17-27 -Re-raised at file "camlinternalLazy.ml", line 34, characters 10-11 -Called from file "backtrace2.ml", line 58, characters 11-23 +Raised by primitive operation at file "backtrace2.ml", line 18, characters 14-22 diff --git a/testsuite/tests/backtrace/backtrace2.ml b/testsuite/tests/backtrace/backtrace2.ml index 07cf5ccc86a0..fa0f2119b37a 100644 --- a/testsuite/tests/backtrace/backtrace2.ml +++ b/testsuite/tests/backtrace/backtrace2.ml @@ -3,57 +3,17 @@ exception Error of string -let test_Error msg = - let rec f msg n = - if n = 0 then raise(Error msg) else 1 + f msg (n-1) in - let exception_raised_internally () = - try Hashtbl.find (Hashtbl.create 3) 0 - with Not_found -> false in +let rec f msg n = + if n = 0 then raise(Error msg) else 1 + f msg (n-1) + +let g msg = try f msg 5 with Error "a" -> print_string "a"; print_newline(); 0 | Error "b" as exn -> print_string "b"; print_newline(); raise exn | Error "c" -> raise (Error "c") - (** [Error "d"] not caught *) - (** Test reraise when an exception is used in the middle of the exception - handler. Currently the wrong backtrace is used. *) - | Error "e" as exn -> - print_string "e"; print_newline (); - ignore (exception_raised_internally ()); raise exn - (** Test reraise of backtrace when a `when` clause use exceptions. - Currently the wrong backtrace is used. - *) - | Error "f" when exception_raised_internally () -> - assert false (** absurd: when false *) - | Error "f" as exn -> print_string "f"; print_newline(); raise exn - -let test_Not_found () = - let rec aux n = - if n = 0 then raise Not_found else 1 + aux (n-1) - in - try aux 5 - (** Test the raise to reraise heuristic with included try_with. - Currently the wrong backtrace is used. *) - with exn -> - print_string "test_Not_found"; print_newline(); - (try Hashtbl.find (Hashtbl.create 3) 0 with Not_found -> raise exn) - -let test_lazy = - let rec aux n = - if n = 0 then raise Not_found else 1 + aux (n-1) - in - let exception_raised_internally () = - try Hashtbl.find (Hashtbl.create 3) 0 - with Not_found -> () in - let l = lazy (aux 5) in - (** Test the backtrace obtained from a lazy value. - Currently the second time the value is forced the - wrong backtrace is used. *) - fun () -> - exception_raised_internally (); - Lazy.force l -let run g args = +let run args = try ignore (g args.(0)); print_string "No exception\n" with exn -> @@ -62,14 +22,8 @@ let run g args = let _ = Printexc.record_backtrace true; - run test_Error [| "a" |]; - run test_Error [| "b" |]; - run test_Error [| "c" |]; - run test_Error [| "d" |]; - run test_Error [| "e" |]; - run test_Error [| "f" |]; - run test_Error [| |]; - run test_Not_found [| () |]; - run test_lazy [| () |]; - run test_lazy [| () |]; - () + run [| "a" |]; + run [| "b" |]; + run [| "c" |]; + run [| "d" |]; + run [| |] diff --git a/testsuite/tests/backtrace/backtrace2.native.reference b/testsuite/tests/backtrace/backtrace2.native.reference index 090338c001a0..5c75a66bf8ee 100644 --- a/testsuite/tests/backtrace/backtrace2.native.reference +++ b/testsuite/tests/backtrace/backtrace2.native.reference @@ -2,57 +2,26 @@ a No exception b Uncaught exception Backtrace2.Error("b") -Raised at file "backtrace2.ml", line 8, characters 18-34 -Called from file "backtrace2.ml", line 8, characters 44-55 -Called from file "backtrace2.ml", line 8, characters 44-55 -Called from file "backtrace2.ml", line 8, characters 44-55 -Called from file "backtrace2.ml", line 8, characters 44-55 -Called from file "backtrace2.ml", line 8, characters 44-55 -Called from file "backtrace2.ml", line 13, characters 4-11 -Re-raised at file "backtrace2.ml", line 15, characters 62-71 -Called from file "backtrace2.ml", line 58, characters 11-23 +Raised at file "backtrace2.ml", line 7, characters 16-32 +Called from file "backtrace2.ml", line 7, characters 42-53 +Called from file "backtrace2.ml", line 7, characters 42-53 +Called from file "backtrace2.ml", line 7, characters 42-53 +Called from file "backtrace2.ml", line 7, characters 42-53 +Called from file "backtrace2.ml", line 7, characters 42-53 +Called from file "backtrace2.ml", line 11, characters 4-11 +Re-raised at file "backtrace2.ml", line 13, characters 62-71 +Called from file "backtrace2.ml", line 18, characters 11-23 Uncaught exception Backtrace2.Error("c") -Raised at file "backtrace2.ml", line 16, characters 20-37 -Called from file "backtrace2.ml", line 58, characters 11-23 +Raised at file "backtrace2.ml", line 14, characters 20-37 +Called from file "backtrace2.ml", line 18, characters 11-23 Uncaught exception Backtrace2.Error("d") -Raised at file "backtrace2.ml", line 8, characters 18-34 -Called from file "backtrace2.ml", line 8, characters 44-55 -Called from file "backtrace2.ml", line 8, characters 44-55 -Called from file "backtrace2.ml", line 8, characters 44-55 -Called from file "backtrace2.ml", line 8, characters 44-55 -Called from file "backtrace2.ml", line 8, characters 44-55 -Called from file "backtrace2.ml", line 13, characters 4-11 -Called from file "backtrace2.ml", line 58, characters 11-23 -e -Uncaught exception Backtrace2.Error("e") -Raised at file "backtrace2.ml", line 22, characters 50-59 -Called from file "backtrace2.ml", line 58, characters 11-23 -f -Uncaught exception Backtrace2.Error("f") -Raised at file "backtrace2.ml", line 28, characters 62-71 -Called from file "backtrace2.ml", line 58, characters 11-23 +Raised at file "backtrace2.ml", line 7, characters 16-32 +Called from file "backtrace2.ml", line 7, characters 42-53 +Called from file "backtrace2.ml", line 7, characters 42-53 +Called from file "backtrace2.ml", line 7, characters 42-53 +Called from file "backtrace2.ml", line 7, characters 42-53 +Called from file "backtrace2.ml", line 7, characters 42-53 +Called from file "backtrace2.ml", line 11, characters 4-11 +Called from file "backtrace2.ml", line 18, characters 11-23 Uncaught exception Invalid_argument("index out of bounds") -Raised by primitive operation at file "backtrace2.ml", line 58, characters 14-22 -test_Not_found -Uncaught exception Not_found -Raised at file "hashtbl.ml", line 192, characters 13-28 -Called from file "backtrace2.ml", line 39, characters 9-42 -Re-raised at file "backtrace2.ml", line 39, characters 61-70 -Called from file "backtrace2.ml", line 58, characters 11-23 -Uncaught exception Not_found -Raised at file "backtrace2.ml", line 43, characters 18-33 -Called from file "backtrace2.ml", line 43, characters 43-52 -Called from file "backtrace2.ml", line 43, characters 43-52 -Called from file "backtrace2.ml", line 43, characters 43-52 -Called from file "backtrace2.ml", line 43, characters 43-52 -Called from file "backtrace2.ml", line 43, characters 43-52 -Called from file "camlinternalLazy.ml", line 27, characters 17-27 -Re-raised at file "camlinternalLazy.ml", line 34, characters 4-11 -Called from file "backtrace2.ml", line 58, characters 11-23 -Uncaught exception Not_found -Raised at file "hashtbl.ml", line 192, characters 13-28 -Called from file "backtrace2.ml", line 46, characters 8-41 -Re-raised at file "camlinternalLazy.ml", line 33, characters 56-63 -Called from file "camlinternalLazy.ml", line 27, characters 17-27 -Re-raised at file "camlinternalLazy.ml", line 34, characters 4-11 -Called from file "backtrace2.ml", line 58, characters 11-23 +Raised by primitive operation at file "backtrace2.ml", line 18, characters 14-22 diff --git a/testsuite/tests/backtrace/raw_backtrace.byte.reference b/testsuite/tests/backtrace/raw_backtrace.byte.reference index ba437e3311af..b936523126df 100644 --- a/testsuite/tests/backtrace/raw_backtrace.byte.reference +++ b/testsuite/tests/backtrace/raw_backtrace.byte.reference @@ -8,12 +8,12 @@ Called from file "raw_backtrace.ml", line 7, characters 42-53 Called from file "raw_backtrace.ml", line 7, characters 42-53 Called from file "raw_backtrace.ml", line 7, characters 42-53 Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 16, characters 4-11 -Re-raised at file "raw_backtrace.ml", line 18, characters 68-71 -Called from file "raw_backtrace.ml", line 33, characters 11-23 +Called from file "raw_backtrace.ml", line 11, characters 4-11 +Re-raised at file "raw_backtrace.ml", line 13, characters 68-71 +Called from file "raw_backtrace.ml", line 18, characters 11-23 Uncaught exception Raw_backtrace.Error("c") -Raised at file "raw_backtrace.ml", line 19, characters 26-37 -Called from file "raw_backtrace.ml", line 33, characters 11-23 +Raised at file "raw_backtrace.ml", line 14, characters 26-37 +Called from file "raw_backtrace.ml", line 18, characters 11-23 Uncaught exception Raw_backtrace.Error("d") Raised at file "raw_backtrace.ml", line 7, characters 21-32 Called from file "raw_backtrace.ml", line 7, characters 42-53 @@ -21,29 +21,7 @@ Called from file "raw_backtrace.ml", line 7, characters 42-53 Called from file "raw_backtrace.ml", line 7, characters 42-53 Called from file "raw_backtrace.ml", line 7, characters 42-53 Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 16, characters 4-11 -Called from file "raw_backtrace.ml", line 33, characters 11-23 -e -Uncaught exception Raw_backtrace.Error("e") -Raised at file "raw_backtrace.ml", line 7, characters 21-32 -Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 16, characters 4-11 -Re-raised at file "raw_backtrace.ml", line 25, characters 39-42 -Called from file "raw_backtrace.ml", line 33, characters 11-23 -f -Uncaught exception Raw_backtrace.Localized(_) -Raised at file "raw_backtrace.ml", line 7, characters 21-32 -Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 16, characters 4-11 -Re-raised at file "raw_backtrace.ml", line 29, characters 39-54 -Called from file "raw_backtrace.ml", line 33, characters 11-23 +Called from file "raw_backtrace.ml", line 11, characters 4-11 +Called from file "raw_backtrace.ml", line 18, characters 11-23 Uncaught exception Invalid_argument("index out of bounds") -Raised by primitive operation at file "raw_backtrace.ml", line 33, characters 14-22 +Raised by primitive operation at file "raw_backtrace.ml", line 18, characters 14-22 diff --git a/testsuite/tests/backtrace/raw_backtrace.ml b/testsuite/tests/backtrace/raw_backtrace.ml index 45822751fb21..594a7c56ed51 100644 --- a/testsuite/tests/backtrace/raw_backtrace.ml +++ b/testsuite/tests/backtrace/raw_backtrace.ml @@ -6,27 +6,12 @@ exception Error of string let rec f msg n = if n = 0 then raise(Error msg) else 1 + f msg (n-1) -exception Localized of exn - let g msg = - let exception_raised_internally () = - try Hashtbl.find (Hashtbl.create 3) 0 - with Not_found -> false in try f msg 5 with Error "a" -> print_string "a"; print_newline(); 0 | Error "b" as exn -> print_string "b"; print_newline(); raise exn | Error "c" -> raise (Error "c") - (** [Error "d"] not caught *) - | Error "e" as exn -> - let bt = Printexc.get_raw_backtrace () in - print_string "e"; print_newline (); - ignore (exception_raised_internally ()); - Printexc.raise_with_backtrace exn bt - | Error "f" as exn -> - let bt = Printexc.get_raw_backtrace () in - print_string "f"; print_newline (); - Printexc.raise_with_backtrace (Localized exn) bt let backtrace args = try @@ -45,8 +30,7 @@ let run args = try ignore (f "c" 5); assert false with Error _ -> (); end; Printf.printf "Uncaught exception %s\n" exn; - Printexc.print_raw_backtrace stdout trace; - flush stdout + Printexc.print_raw_backtrace stdout trace let _ = Printexc.record_backtrace true; @@ -54,6 +38,4 @@ let _ = run [| "b" |]; run [| "c" |]; run [| "d" |]; - run [| "e" |]; - run [| "f" |]; run [| |] diff --git a/testsuite/tests/backtrace/raw_backtrace.native.reference b/testsuite/tests/backtrace/raw_backtrace.native.reference index 06f4f164bfbf..b1ff607cb2bd 100644 --- a/testsuite/tests/backtrace/raw_backtrace.native.reference +++ b/testsuite/tests/backtrace/raw_backtrace.native.reference @@ -8,12 +8,12 @@ Called from file "raw_backtrace.ml", line 7, characters 42-53 Called from file "raw_backtrace.ml", line 7, characters 42-53 Called from file "raw_backtrace.ml", line 7, characters 42-53 Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 16, characters 4-11 -Re-raised at file "raw_backtrace.ml", line 18, characters 62-71 -Called from file "raw_backtrace.ml", line 33, characters 11-23 +Called from file "raw_backtrace.ml", line 11, characters 4-11 +Re-raised at file "raw_backtrace.ml", line 13, characters 62-71 +Called from file "raw_backtrace.ml", line 18, characters 11-23 Uncaught exception Raw_backtrace.Error("c") -Raised at file "raw_backtrace.ml", line 19, characters 20-37 -Called from file "raw_backtrace.ml", line 33, characters 11-23 +Raised at file "raw_backtrace.ml", line 14, characters 20-37 +Called from file "raw_backtrace.ml", line 18, characters 11-23 Uncaught exception Raw_backtrace.Error("d") Raised at file "raw_backtrace.ml", line 7, characters 16-32 Called from file "raw_backtrace.ml", line 7, characters 42-53 @@ -21,29 +21,7 @@ Called from file "raw_backtrace.ml", line 7, characters 42-53 Called from file "raw_backtrace.ml", line 7, characters 42-53 Called from file "raw_backtrace.ml", line 7, characters 42-53 Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 16, characters 4-11 -Called from file "raw_backtrace.ml", line 33, characters 11-23 -e -Uncaught exception Raw_backtrace.Error("e") -Raised at file "raw_backtrace.ml", line 7, characters 16-32 -Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 16, characters 4-11 -Re-raised at file "raw_backtrace.ml", line 25, characters 9-45 -Called from file "raw_backtrace.ml", line 33, characters 11-23 -f -Uncaught exception Raw_backtrace.Localized(_) -Raised at file "raw_backtrace.ml", line 7, characters 16-32 -Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 7, characters 42-53 -Called from file "raw_backtrace.ml", line 16, characters 4-11 -Re-raised at file "raw_backtrace.ml", line 29, characters 9-57 -Called from file "raw_backtrace.ml", line 33, characters 11-23 +Called from file "raw_backtrace.ml", line 11, characters 4-11 +Called from file "raw_backtrace.ml", line 18, characters 11-23 Uncaught exception Invalid_argument("index out of bounds") -Raised by primitive operation at file "raw_backtrace.ml", line 33, characters 14-22 +Raised by primitive operation at file "raw_backtrace.ml", line 18, characters 14-22 diff --git a/testsuite/tests/lib-threads/backtrace_threads.ml b/testsuite/tests/lib-threads/backtrace_threads.ml deleted file mode 100644 index 348a5f7f2de3..000000000000 --- a/testsuite/tests/lib-threads/backtrace_threads.ml +++ /dev/null @@ -1,18 +0,0 @@ - -let () = Printexc.record_backtrace true - -let () = - let bt = - try - Hashtbl.find (Hashtbl.create 1) 1; - assert false - with Not_found -> - Printexc.get_raw_backtrace () - in - let t = Thread.create (fun () -> - try - Printexc.raise_with_backtrace Not_found bt - with Not_found -> () - ) () in - Thread.join t; - flush stdout diff --git a/testsuite/tests/lib-threads/backtrace_threads.reference b/testsuite/tests/lib-threads/backtrace_threads.reference deleted file mode 100644 index e69de29bb2d1..000000000000