summaryrefslogtreecommitdiff
path: root/testsuite/tests/statmemprof/exception_callback.ml
blob: f9f02f690f7d633c70323adcf8f333921e680e46 (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
(* TEST
   exit_status = "2"
   * skip
   reason = "port stat-mem-prof : https://github.com/ocaml/ocaml/pull/8634"
*)

open Gc.Memprof

let alloc_tracker on_alloc =
  { null_tracker with
    alloc_minor = (fun info -> on_alloc info; None);
    alloc_major = (fun info -> on_alloc info; None);
  }

(* We don't want to print the backtrace. We just want to make sure the
   exception is printed.
   This also makes sure [Printexc] is loaded, otherwise we don't use
   its uncaught exception handler. *)
let _ = Printexc.record_backtrace false

let () =
  start ~callstack_size:10 ~sampling_rate:1.
    (alloc_tracker (fun _ -> stop ()));
  ignore (Sys.opaque_identity (Array.make 200 0))

let _ =
  start ~callstack_size:10 ~sampling_rate:1.
    (alloc_tracker (fun _ -> failwith "callback failed"));
  ignore (Sys.opaque_identity (Array.make 200 0));
  stop ()