summaryrefslogtreecommitdiff
path: root/testsuite/tests/lib-runtime-events/test_caml_reentry.ml
blob: 81e38e208a721e07039a2f2b169f8140a7e1ec75 (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
(* TEST
 include runtime_events;
*)
open Runtime_events

let () =
    start ();
    let cursor = create_cursor None in
    let empty_callbacks = Callbacks.create () in
    let runtime_begin domain_id ts phase =
      match phase with
      | EV_MINOR ->
        ignore(read_poll cursor empty_callbacks None)
      | _ -> () in
    let callbacks = Callbacks.create ~runtime_begin ()
    in
    Gc.full_major ();
    try begin
      ignore(read_poll cursor callbacks None);
      Printf.printf "Exception ignored"
    end with
      Failure(_) ->
        (* Got an exception because we tried to reenter *)
        Printf.printf "OK"