summaryrefslogtreecommitdiff
path: root/testsuite/timeout
diff options
context:
space:
mode:
authorIan Lynagh <igloo@earth.li>2009-10-13 12:42:04 +0000
committerIan Lynagh <igloo@earth.li>2009-10-13 12:42:04 +0000
commit52f1b64d2552b9110a73b23a4a3e6d45b1eb8308 (patch)
tree8b2a514a2cb46d97018d55de4d071b747a57f95e /testsuite/timeout
parent04a88067070d6f58a540d4e34e10d9a007308580 (diff)
downloadhaskell-52f1b64d2552b9110a73b23a4a3e6d45b1eb8308.tar.gz
Add some diagnostics to timeout
Diffstat (limited to 'testsuite/timeout')
-rw-r--r--testsuite/timeout/timeout.hs12
1 files changed, 9 insertions, 3 deletions
diff --git a/testsuite/timeout/timeout.hs b/testsuite/timeout/timeout.hs
index b1a0192f3a..ca2eaf7a41 100644
--- a/testsuite/timeout/timeout.hs
+++ b/testsuite/timeout/timeout.hs
@@ -28,9 +28,15 @@ main :: IO ()
main = do
args <- getArgs
case args of
- [secs,cmd] -> run (read secs) cmd
- _ -> do hPutStrLn stderr $ "timeout: bad arguments " ++ show args
- exitWith (ExitFailure 1)
+ [secs,cmd] ->
+ case reads secs of
+ [(secs', "")] -> run secs' cmd
+ _ -> die ("Can't parse " ++ show secs ++ " as a number of seconds")
+ _ -> die ("Bad arguments " ++ show args)
+
+die :: String -> IO ()
+die msg = do hPutStrLn stderr ("timeout: " ++ msg)
+ exitWith (ExitFailure 1)
timeoutMsg :: String
timeoutMsg = "Timeout happened...killing process..."