Commit 6bd85ede authored by simonmar's avatar simonmar
Browse files

[project @ 2005-11-11 12:02:40 by simonmar]

Make it work on Windows again.
parent d8dbb62a
......@@ -8,24 +8,25 @@ import System.Cmd (system)
import System.Environment (getArgs)
import System.Exit (exitWith, ExitCode(ExitFailure))
import System.IO (hPutStrLn, stderr)
import System.Process (waitForProcess, getProcessExitCode)
#if !defined(mingw32_HOST_OS)
import System.Process
import Control.Monad (when)
#if !defined(mingw32_HOST_OS)
import System.Process.Internals (ProcessHandle(ProcessHandle))
import System.Posix.Process (forkProcess, createSession)
import System.Posix.Signals (installHandler, Handler(Catch),
signalProcessGroup, sigINT, sigTERM, sigKILL )
#endif
#if !defined(mingw32_HOST_OS)
main = do
args <- getArgs
case args of
[secs,cmd] -> do
m <- newEmptyMVar
mp <- newEmptyMVar
#if !defined(mingw32_HOST_OS)
installHandler sigINT (Catch (putMVar m Nothing)) Nothing
#endif
forkIO (do threadDelay (read secs * 1000000)
putMVar m Nothing
)
......@@ -37,6 +38,7 @@ main = do
r <- waitForProcess (ProcessHandle p)
putMVar m (Just r))
return ())
p <- takeMVar mp
r <- takeMVar m
case r of
......@@ -48,7 +50,6 @@ main = do
_other -> do hPutStrLn stderr "timeout: bad arguments"
exitWith (ExitFailure 1)
#if !defined(mingw32_HOST_OS)
killProcess p = do
try (signalProcessGroup sigTERM p)
checkReallyDead 10
......@@ -60,10 +61,38 @@ killProcess p = do
when (isNothing m) $ do
try (signalProcessGroup sigKILL p)
checkReallyDead n
#else
main = do
args <- getArgs
case args of
[secs,cmd] -> do
m <- newEmptyMVar
mp <- newEmptyMVar
forkIO (do threadDelay (read secs * 1000000)
putMVar m Nothing
)
forkIO (do p <- runCommand cmd
putMVar mp p
r <- waitForProcess p
putMVar m (Just r))
p <- takeMVar mp
r <- takeMVar m
case r of
Nothing -> do
killProcess p
exitWith (ExitFailure 99)
Just r -> do
exitWith r
_other -> do hPutStrLn stderr "timeout: bad arguments"
exitWith (ExitFailure 1)
killProcess p = do
terminateProcess p
-- ToDo: we should kill the process and its descendents on Win32
threadDelay (3*100000) -- 3/10 sec
m <- getProcessExitCode p
when (isNothing m) $ killProcess p
#endif
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment