HCoop / bpt / coccinelle.git / blame
| Commit | Line | Data |
|---|---|---|
| 34e49164 C |
1 | open Common |
| 2 | ||
| 3 | (* This function is especially useful with lablgtk which intercepts | |
| 4 | * the exception and forbid them to reach the toplevel, or with LFS | |
| 5 | * where I can not allow any exception to stop mount.lfs. | |
| 6 | * | |
| 7 | * src: Jane Street Core library. | |
| 485bce71 C |
8 | * update: Normally no more needed in OCaml 3.11 as part of the |
| 9 | * default runtime. | |
| 34e49164 C |
10 | *) |
| 11 | external print : unit -> unit = "print_exception_backtrace_stub" "noalloc" | |
| 12 | ||
| 13 | ||
| 14 | (* ---------------------------------------------------------------------- *) | |
| 15 | (* testing *) | |
| 16 | (* ---------------------------------------------------------------------- *) | |
| 17 | ||
| 18 | exception MyNot_Found | |
| 19 | ||
| 20 | let foo1 () = | |
| 21 | if 1=1 | |
| 22 | then raise MyNot_Found | |
| 23 | else 2 | |
| 24 | ||
| 25 | let foo2 () = | |
| 26 | foo1 () + 2 | |
| 27 | ||
| 28 | let test_backtrace () = | |
| 29 | (try ignore(foo2 ()) | |
| 30 | with exn -> | |
| 31 | pr2 (Common.exn_to_s exn); | |
| 32 | print(); | |
| 33 | failwith "other exn" | |
| 34 | ); | |
| 35 | print_string "ok cool\n"; | |
| 36 | () | |
| 37 | ||
| 38 | let actions () = | |
| 39 | [ | |
| 40 | "-test_backtrace", " ", | |
| 41 | Common.mk_action_0_arg test_backtrace; | |
| 42 | ] |