Runtime_events tracing system

1 files changed, 42 insertions, 0 deletions

diff --git a/testsuite/tests/lib-runtime-events/test_external.ml b/testsuite/tests/lib-runtime-events/test_external.ml
new file mode 100644
index 0000000000..b7269b7501
--- /dev/null
+++ b/testsuite/tests/lib-runtime-events/test_external.ml
@@ -0,0 +1,42 @@
+(* TEST
+   include runtime_events
+   * libunix
+   ** bytecode
+   ** native *)
+
+let got_major = ref false
+let got_minor = ref false
+let finished = ref false
+
+let runtime_end domain_id ts phase =
+  match phase with
+  | Runtime_events.EV_EXPLICIT_GC_FULL_MAJOR ->
+    got_major := true
+  | Runtime_events.EV_MINOR ->
+    got_minor := true
+  | _ -> ()
+
+let () =
+  (* start runtime_events now to avoid a race *)
+  Runtime_events.start ();
+  let parent_pid = Unix.getpid () in
+  let parent_cwd = Sys.getcwd () in
+  let child_pid = Unix.fork () in
+  if child_pid == 0 then begin
+    (* we are in the child *)
+    let cursor = Runtime_events.create_cursor (Some (parent_cwd, parent_pid)) in
+    let callbacks = Runtime_events.Callbacks.create ~runtime_end () in
+    let started = Unix.gettimeofday () in
+    while (not !finished) && (Unix.gettimeofday () -. started < 10.) do
+      Runtime_events.read_poll cursor callbacks None |> ignore;
+      if !got_major && !got_minor then
+        finished := true
+    done;
+    assert(!got_minor);
+    assert(!got_major);
+  end else begin
+    (* we are in the parent, generate some events *)
+    Gc.full_major ();
+    (* now wait for our child to finish *)
+    Unix.wait () |> ignore
+  end