diff options
-rw-r--r-- | testsuite/timeout/timeout.hs | 7 |
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 |