From 545656e412edf22bb508b1e496c658a9ca144143 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Wed, 23 Nov 2005 11:47:16 +0000
Subject: [project @ 2005-11-23 11:47:16 by simonmar] Fix up to compile after
 recent changes to System.Process.Internals

---
 testsuite/timeout/timeout.hs | 21 +++++++++++----------
 1 file changed, 11 insertions(+), 10 deletions(-)

(limited to 'testsuite/timeout/timeout.hs')

diff --git a/testsuite/timeout/timeout.hs b/testsuite/timeout/timeout.hs
index 3ac9dfb463..d0c66b1a72 100644
--- a/testsuite/timeout/timeout.hs
+++ b/testsuite/timeout/timeout.hs
@@ -11,7 +11,7 @@ import System.IO (hPutStrLn, stderr)
 import System.Process
 import Control.Monad (when)
 #if !defined(mingw32_HOST_OS)
-import System.Process.Internals (ProcessHandle(ProcessHandle))
+import System.Process.Internals (mkProcessHandle)
 import System.Posix.Process (forkProcess, createSession)
 import System.Posix.Signals (installHandler, Handler(Catch),
                              signalProcessGroup, sigINT, sigTERM, sigKILL )
@@ -30,36 +30,37 @@ main = do
         forkIO (do threadDelay (read secs * 1000000)
                    putMVar m Nothing
                )
-        forkIO (do try (do p <- forkProcess $ do
+        forkIO (do try (do pid <- forkProcess $ do
                                createSession
                                r <- system cmd
                                exitWith r
-                           putMVar mp p
-                           r <- waitForProcess (ProcessHandle p)
+			   ph <- mkProcessHandle pid
+                           putMVar mp (pid,ph)
+                           r <- waitForProcess ph
                            putMVar m (Just r))
                    return ())
 
-        p <- takeMVar mp
+        (pid,ph) <- takeMVar mp
         r <- takeMVar m
         case r of
           Nothing -> do
-                killProcess p
+                killProcess pid ph
                 exitWith (ExitFailure 99)
           Just r -> do
                 exitWith r
     _other -> do hPutStrLn stderr "timeout: bad arguments"
                  exitWith (ExitFailure 1)
 
-killProcess p = do
-  try (signalProcessGroup sigTERM p)
+killProcess pid ph = do
+  try (signalProcessGroup sigTERM pid)
   checkReallyDead 10
   where
     checkReallyDead 0 = hPutStrLn stderr "checkReallyDead: Giving up"
     checkReallyDead (n+1) =
       do threadDelay (3*100000) -- 3/10 sec
-         m <- getProcessExitCode (ProcessHandle p)
+         m <- getProcessExitCode ph
          when (isNothing m) $ do
-             try (signalProcessGroup sigKILL p)
+             try (signalProcessGroup sigKILL pid)
              checkReallyDead n
 
 #else
-- 
cgit v1.2.1