diff --git a/testsuite/tests/lib-runtime-events/test_user_event_signal.ml b/testsuite/tests/lib-runtime-events/test_user_event_signal.ml new file mode 100644 index 000000000000..ce7e86ac5e2a --- /dev/null +++ b/testsuite/tests/lib-runtime-events/test_user_event_signal.ml @@ -0,0 +1,31 @@ +(* TEST + include runtime_events; + include unix; +*) + +(* Check that emitting a custom event from a signal handler works (see #12900). + *) + +let unit = + let encode _buf () = + print_endline "Start encoding event"; + Unix.sleepf 1.5; + print_endline "Finished encoding event"; + 0 + in + let decode _buf _len = () in + Runtime_events.Type.register ~encode ~decode + +type Runtime_events.User.tag += My_event +let my_event = Runtime_events.User.register "event" My_event unit + +let handle_signal _ = + print_endline "Signal handler called; writing trace event..."; + Runtime_events.User.write my_event () + +let () = + Runtime_events.start (); + Sys.set_signal Sys.sigalrm (Signal_handle handle_signal); + ignore (Unix.alarm 1 : int); + Runtime_events.User.write my_event (); + print_endline "Done" diff --git a/testsuite/tests/lib-runtime-events/test_user_event_signal.reference b/testsuite/tests/lib-runtime-events/test_user_event_signal.reference new file mode 100644 index 000000000000..ba0b149ad266 --- /dev/null +++ b/testsuite/tests/lib-runtime-events/test_user_event_signal.reference @@ -0,0 +1,6 @@ +Start encoding event +Signal handler called; writing trace event... +Start encoding event +Finished encoding event +Finished encoding event +Done