summaryrefslogtreecommitdiff
path: root/testsuite/tests/backtrace/backtrace_effects.ml
blob: 762e27549ef773a20903f87bcff248ea18a013ac (plain)
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
(* TEST_BELOW
(* Blank lines added here to preserve locations. *)


*)

open Effect
open Effect.Deep

type _ t += E : unit t

let bar i =
  if i < 0 then begin
    print_endline "(** raise **)";
    raise Exit
  end else begin
    print_endline "(** get_callstack **)";
    let bt = Printexc.get_callstack 100 in
    print_string @@ Printexc.raw_backtrace_to_string bt;
    perform E;
    20
  end

let foo i =
  ignore @@ bar i;
  bar (-1)

let baz () =
  match_with foo 10
  { retc = (fun x -> ());
    exnc = (fun e -> raise e);
    effc = fun (type a) (e : a t) ->
      match e with
      | E -> Some (fun (k : (a, _) continuation) ->
          print_endline "(** get_continuation_callstack **)";
          let bt = Deep.get_callstack k 100 in
          print_string @@ Printexc.raw_backtrace_to_string bt;
          continue k ())
      | _ -> None }

let _ = baz ()

(* TEST
 flags = "-g";
 ocamlrunparam += ",b=1";
 exit_status = "2";
*)