Testsuite: do not print timeout message
authorThomas Miedema <thomasmiedema@gmail.com>
Tue, 28 Jun 2016 09:58:33 +0000 (11:58 +0200)
committerThomas Miedema <thomasmiedema@gmail.com>
Tue, 28 Jun 2016 10:25:29 +0000 (12:25 +0200)
This is a followup to e1293bbfb1fa1fdeb56446a7b957d6f628042e71, but then
for Windows timeout.

testsuite/timeout/timeout.hs

index 3532497..3684b91 100644 (file)
@@ -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