commons/backtrace.ml

   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.
   8  * update: Normally no more needed in OCaml 3.11 as part of the
   9  *  default runtime.
  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   ]