rts: Expose interface for configuring EventLogWriters

This exposes a set of interfaces from the GHC API for configuring
EventLogWriters. These can be used by consumers like
[ghc-eventlog-socket](https://github.com/bgamari/ghc-eventlog-socket).

4 files changed, 55 insertions, 0 deletions

diff --git a/testsuite/tests/rts/InitEventLogging.hs b/testsuite/tests/rts/InitEventLogging.hs
new file mode 100644
index 0000000000..1ec1e65028
--- /dev/null
+++ b/testsuite/tests/rts/InitEventLogging.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+-- Test that the startEventLog interface works as expected.
+main :: IO ()
+main = do
+  putStrLn "Starting eventlog..."
+  c_init_eventlog
+  putStrLn "done"
+
+foreign import ccall unsafe "init_eventlog"
+  c_init_eventlog :: IO ()
diff --git a/testsuite/tests/rts/InitEventLogging.stdout b/testsuite/tests/rts/InitEventLogging.stdout
new file mode 100644
index 0000000000..7cbab8fe59
--- /dev/null
+++ b/testsuite/tests/rts/InitEventLogging.stdout
@@ -0,0 +1,8 @@
+Starting eventlog...
+done
+init
+write
+write
+write
+write
+stop
diff --git a/testsuite/tests/rts/InitEventLogging_c.c b/testsuite/tests/rts/InitEventLogging_c.c
new file mode 100644
index 0000000000..47e4520fc4
--- /dev/null
+++ b/testsuite/tests/rts/InitEventLogging_c.c
@@ -0,0 +1,33 @@
+#include <stdio.h>
+#include <Rts.h>
+
+void test_init(void) {
+  printf("init\n");
+}
+
+bool test_write(void *eventlog, size_t eventlog_size) {
+  printf("write\n");
+  return true;
+}
+
+void test_flush(void) {
+  printf("flush\n");
+}
+
+void test_stop(void) {
+  printf("stop\n");
+}
+
+const EventLogWriter writer = {
+  .initEventLogWriter = test_init,
+  .writeEventLog = test_write,
+  .flushEventLog = test_flush,
+  .stopEventLogWriter = test_stop
+};
+
+void init_eventlog(void) {
+  if (!startEventLogging(&writer)) {
+    printf("failed to start eventlog\n");
+  }
+}
+
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index bd634d1e56..0bbddfba3e 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -406,3 +406,6 @@ test('T13676',
      [when(opsys('darwin') or opsys('mingw32'), expect_broken(17447)),
       extra_files(['T13676.hs'])],
      ghci_script, ['T13676.script'])
+test('InitEventLogging',
+     [only_ways(['normal']), extra_run_opts('+RTS -RTS')],
+     compile_and_run, ['-eventlog InitEventLogging_c.c'])