From bafd615e40c2a11af1390e736f6122033eecc4c6 Mon Sep 17 00:00:00 2001
From: Thomas Miedema <thomasmiedema@gmail.com>
Date: Tue, 28 Jun 2016 11:58:33 +0200
Subject: [PATCH] Testsuite: do not print timeout message
This is a followup to e1293bbfb1fa1fdeb56446a7b957d6f628042e71, but then
for Windows timeout.
---
testsuite/timeout/timeout.hs | 7 +------
1 file changed, 1 insertion(+), 6 deletions(-)
diff --git a/testsuite/timeout/timeout.hs b/testsuite/timeout/timeout.hs
index 3532497eef90..3684b9174c15 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
--
GitLab