[project @ 2005-02-04 10:59:55 by simonmar]

Add a timeout to test runs, using a wrapper program (written in
Haskell, using System.Process of course!).

2 files changed, 37 insertions, 0 deletions

diff --git a/testsuite/timeout/Makefile b/testsuite/timeout/Makefile
new file mode 100644
index 0000000000..9d438fa8c6
--- /dev/null
+++ b/testsuite/timeout/Makefile
@@ -0,0 +1,12 @@
+TOP = ..
+include $(TOP)/mk/boilerplate.mk
+
+HC = $(GHC_INPLACE)
+MKDEPENDHS = $(GHC_INPLACE)
+SRC_HC_OPTS += -threaded
+
+HS_PROG = timeout
+
+boot :: $(HS_PROG)
+
+include $(TOP)/mk/target.mk
diff --git a/testsuite/timeout/timeout.hs b/testsuite/timeout/timeout.hs
new file mode 100644
index 0000000000..21a58a430a
--- /dev/null
+++ b/testsuite/timeout/timeout.hs
@@ -0,0 +1,25 @@
+import Control.Concurrent
+import System.Environment
+import System.Process
+import System.Exit
+
+main = do
+  args <- getArgs
+  case args of 
+    [secs,cmd] -> do
+	p <- runCommand cmd
+	m <- newEmptyMVar
+	forkIO (do threadDelay (read secs * 1000000)
+		   putMVar m Nothing
+	       )
+	forkIO (do r <- waitForProcess p
+		   putMVar m (Just r))
+	r <- takeMVar m
+	case r of
+	  Nothing -> do
+		terminateProcess p
+		exitWith (ExitFailure 99)	
+	  Just r -> do
+		exitWith r
+    _other -> exitWith (ExitFailure 1)
+