Use a python timeout for the testsuite when we don't have a threaded RTS

2 files changed, 36 insertions, 0 deletions

diff --git a/testsuite/timeout/Makefile b/testsuite/timeout/Makefile
index 06281e04cb..f3424ad679 100644
--- a/testsuite/timeout/Makefile
+++ b/testsuite/timeout/Makefile
@@ -11,6 +11,14 @@ endif
 
 HS_PROG = timeout
 
+ifeq "$(findstring thr,$(GhcRTSWays))" "thr"
 boot :: $(HS_PROG)
+else
+boot :: python-timeout
+endif
+
+python-timeout:
+	cp timeout.py timeout
+	chmod +x timeout
 
 include $(TOP)/mk/target.mk
diff --git a/testsuite/timeout/timeout.py b/testsuite/timeout/timeout.py
new file mode 100644
index 0000000000..212cf4abdb
--- /dev/null
+++ b/testsuite/timeout/timeout.py
@@ -0,0 +1,28 @@
+#!/usr/bin/python
+
+import os
+import signal
+import sys
+
+secs = int(sys.argv[1])
+cmd = sys.argv[2]
+
+pid = os.fork()
+# XXX error checking
+if pid == 0:
+    # child
+    os.setpgrp()
+    os.execvp('/bin/sh', ['/bin/sh', '-c', cmd])
+else:
+    # parent
+    def handler(signum, frame):
+        os.killpg(pid, signal.SIGKILL) # XXX Kill better like .hs
+        sys.exit(99)
+    old = signal.signal(signal.SIGALRM, handler)
+    signal.alarm(secs)
+    (pid2, res) = os.waitpid(pid, 0)
+    if (os.WIFEXITED(res)):
+        sys.exit(os.WEXITSTATUS(res))
+    else:
+        sys.exit(res)
+