summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThomas Miedema <thomasmiedema@gmail.com>2016-06-28 11:58:33 +0200
committerThomas Miedema <thomasmiedema@gmail.com>2016-06-28 12:25:29 +0200
commitbafd615e40c2a11af1390e736f6122033eecc4c6 (patch)
tree6f71f9a4270131deedbc673a59c780314efc36e7
parent206b4a1d0e82e8f0f40f6e36cf657146a8d4b36a (diff)
downloadhaskell-bafd615e40c2a11af1390e736f6122033eecc4c6.tar.gz
Testsuite: do not print timeout message
This is a followup to e1293bbfb1fa1fdeb56446a7b957d6f628042e71, but then for Windows timeout.
-rw-r--r--testsuite/timeout/timeout.hs7
1 files changed, 1 insertions, 6 deletions
diff --git a/testsuite/timeout/timeout.hs b/testsuite/timeout/timeout.hs
index 3532497eef..3684b9174c 100644
--- a/testsuite/timeout/timeout.hs
+++ b/testsuite/timeout/timeout.hs
@@ -33,9 +33,6 @@ main = do
_ -> die ("Can't parse " ++ show secs ++ " as a number of seconds")
_ -> die ("Bad arguments " ++ show args)
-timeoutMsg :: String -> String
-timeoutMsg cmd = "Timeout happened...killing process "++cmd++"..."
-
run :: Int -> String -> IO ()
#if !defined(mingw32_HOST_OS)
run secs cmd = do
@@ -61,7 +58,6 @@ run secs cmd = do
r <- takeMVar m
case r of
Nothing -> do
- hPutStrLn stderr (timeoutMsg cmd)
killProcess pid
exitWith (ExitFailure 99)
Just (Exited r) -> exitWith r
@@ -122,8 +118,7 @@ run secs cmd =
let millisecs = secs * 1000
rc <- waitForSingleObject handle (fromIntegral millisecs)
if rc == cWAIT_TIMEOUT
- then do hPutStrLn stderr (timeoutMsg cmd)
- terminateJobObject job 99
+ then do terminateJobObject job 99
exitWith (ExitFailure 99)
else alloca $ \p_exitCode ->
do r <- getExitCodeProcess handle p_exitCode