1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
(* TEST_BELOW
(* Blank lines added here to preserve locations. *)
*)
(* A test for stack backtraces *)
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
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 =
try
ignore (g args.(0)); print_string "No exception\n"
with exn ->
Printf.printf "Uncaught exception %s\n" (Printexc.to_string exn);
Printexc.print_backtrace stdout
let _ =
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 [| () |];
()
(* TEST
flags = "-g";
ocamlrunparam += ",b=1";
*)
|
