[project @ 2005-02-04 10:59:55 by simonmar]
authorsimonmar <unknown>
Fri, 4 Feb 2005 10:59:56 +0000 (10:59 +0000)
committersimonmar <unknown>
Fri, 4 Feb 2005 10:59:56 +0000 (10:59 +0000)
Add a timeout to test runs, using a wrapper program (written in
Haskell, using System.Process of course!).

testsuite/Makefile
testsuite/driver/runtests.py
testsuite/driver/testlib.py
testsuite/mk/test.mk
testsuite/timeout/Makefile [new file with mode: 0644]
testsuite/timeout/timeout.hs [new file with mode: 0644]

index f49015d..83ed1b3 100644 (file)
@@ -1,6 +1,8 @@
 TOP = .
 include $(TOP)/mk/boilerplate.mk
 
+SUBDIRS = timeout
+
 CLEAN_FILES += mk/wordsize.mk
 
 all ::
index f0b2cd5..f579810 100644 (file)
@@ -60,7 +60,6 @@ for opt,arg in opts:
             sys.exit(1)
         config.run_ways = filter(eq(arg), config.run_ways + config.other_ways)
         config.compile_ways = filter(eq(arg), config.compile_ways + config.other_ways)
-        
 # -----------------------------------------------------------------------------
 # The main dude
 
index f3919df..173a6a5 100644 (file)
@@ -66,6 +66,10 @@ class TestConfig:
         # Lists of flags for each way
         self.way_flags = {}
 
+        # the timeout program
+        self.timeout_prog = ''
+        self.timeout = 300
+
 global config
 config = TestConfig()
 
@@ -913,11 +917,11 @@ def guess_compiler_flags():
 
 def runCmd( cmd ):
     if_verbose( 1, cmd )
-    return os.system( cmd )
-
-def runCmdNoFail( cmd ):
-    if_verbose( 1, cmd )
-    return os.system( cmd )
+    if (config.timeout_prog == ''):
+        return os.system( cmd )
+    else:
+        return os.spawnv(os.P_WAIT, config.timeout_prog,
+                         [config.timeout_prog,`config.timeout`,cmd] )
 
 def rm_no_fail( file ):
    try:
index 12e4c35..336a6f0 100644 (file)
@@ -76,6 +76,7 @@ RUNTEST_OPTS +=  \
        -e config.platform=\"$(TARGETPLATFORM)\" \
        -e config.wordsize=\"$(WORDSIZE)\" \
        -e default_testopts.cleanup=\"$(CLEANUP)\" \
+       -e config.timeout_prog=\"$(TOP)/timeout/timeout\" \
        $(EXTRA_RUNTEST_OPTS)
 
 TESTS       = 
diff --git a/testsuite/timeout/Makefile b/testsuite/timeout/Makefile
new file mode 100644 (file)
index 0000000..9d438fa
--- /dev/null
@@ -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 (file)
index 0000000..21a58a4
--- /dev/null
@@ -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)
+