[commit: packages/process] master: GH77: Finish implementation. (282aa2e)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/process

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/282aa2e3a4893da8b685d86c8bdb498350010843/process

>---------------------------------------------------------------

commit 282aa2e3a4893da8b685d86c8bdb498350010843
Author: Tamar Christina <tamar at zhox.com>
Date:   Sat Dec 10 21:35:31 2016 +0000

    GH77: Finish implementation.


>---------------------------------------------------------------

282aa2e3a4893da8b685d86c8bdb498350010843
 System/Process.hs           |  2 +-
 System/Process/Internals.hs |  1 +
 System/Process/Windows.hsc  |  4 ++++
 cbits/runProcess.c          | 10 ++++------
 tests/T9775/T9775_fail.hs   |  0
 tests/T9775/T9775_good.hs   |  2 +-
 6 files changed, 11 insertions(+), 8 deletions(-)

diff --git a/System/Process.hs b/System/Process.hs
index 44a4362..aa868f4 100644
--- a/System/Process.hs
+++ b/System/Process.hs
@@ -879,7 +879,7 @@ executeAndWait :: String -> CreateProcess -> IO ExitCode
 executeAndWait name proc_ = do
 #if defined(WINDOWS)
   (_,_,_,_,Just job,Just iocp) <- createProcessExt_ name True proc_
-  maybe (ExitFailure (-1)) mkExitCode <$> waitForJobCompletion job iocp (-1)
+  maybe (ExitFailure (-1)) mkExitCode <$> waitForJobCompletion job iocp timeout_Infinite
     where mkExitCode code | code == 0 = ExitSuccess
                           | otherwise = ExitFailure $ fromIntegral code
 #else
diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs
index c3dd4bd..29e348d 100644
--- a/System/Process/Internals.hs
+++ b/System/Process/Internals.hs
@@ -37,6 +37,7 @@ module System.Process.Internals (
 #else
     terminateJob,
     waitForJobCompletion,
+    timeout_Infinite,
 #endif
     withFilePathException, withCEnvironment,
     translate,
diff --git a/System/Process/Windows.hsc b/System/Process/Windows.hsc
index cb40a3e..c28ff07 100644
--- a/System/Process/Windows.hsc
+++ b/System/Process/Windows.hsc
@@ -16,6 +16,7 @@ module System.Process.Windows
     , interruptProcessGroupOfInternal
     , terminateJob
     , waitForJobCompletion
+    , timeout_Infinite
     ) where
 
 import System.Process.Common
@@ -196,6 +197,9 @@ terminateJob jh ecode =
             ClosedHandle _ -> return False
             OpenHandle   h -> c_terminateJobObject h ecode
 
+timeout_Infinite :: CUInt
+timeout_Infinite = 0xFFFFFFFF
+
 waitForJobCompletion :: ProcessHandle
                      -> ProcessHandle
                      -> CUInt
diff --git a/cbits/runProcess.c b/cbits/runProcess.c
index cb87dc8..43e3d7a 100644
--- a/cbits/runProcess.c
+++ b/cbits/runProcess.c
@@ -798,8 +798,7 @@ waitForJobCompletion (HANDLE hJob, HANDLE ioPort, DWORD timeout, int *pExitCode)
     DWORD CompletionCode;
     ULONG_PTR CompletionKey;
     LPOVERLAPPED Overlapped;
-    *pExitCode = 5;
-    HANDLE lastProc;
+    *pExitCode = 0;
 
     // We have to loop here. It's a blocking call, but
     // we get notified on each completion event. So if it's
@@ -815,7 +814,6 @@ waitForJobCompletion (HANDLE hJob, HANDLE ioPort, DWORD timeout, int *pExitCode)
         {
             case JOB_OBJECT_MSG_NEW_PROCESS:
                 // A new child process is born.
-                lastProc = OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, TRUE, (DWORD)(uintptr_t)Overlapped);
                 break;
             case JOB_OBJECT_MSG_ABNORMAL_EXIT_PROCESS:
             case JOB_OBJECT_MSG_EXIT_PROCESS:
@@ -823,12 +821,12 @@ waitForJobCompletion (HANDLE hJob, HANDLE ioPort, DWORD timeout, int *pExitCode)
                 // A child process has just exited.
                 // Read exit code, We assume the last process to exit
                 // is the process whose exit code we're interested in.
-                if (GetExitCodeProcess (lastProc, (DWORD *)pExitCode) == 0)
+                HANDLE pHwnd = OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, TRUE, (DWORD)(uintptr_t)Overlapped);
+                if (GetExitCodeProcess(pHwnd, (DWORD *)pExitCode) == 0)
                 {
                     maperrno();
-                    return -1;
+                    return 1;
                 }
-                printf("Exit(0x%x): %d\n", (HANDLE)Overlapped, *pExitCode);
             }
             break;
             case JOB_OBJECT_MSG_ACTIVE_PROCESS_ZERO:
diff --git a/tests/T9775/T9775_good.hs b/tests/T9775/T9775_good.hs
index 48b7376..07600e5 100644
--- a/tests/T9775/T9775_good.hs
+++ b/tests/T9775/T9775_good.hs
@@ -6,7 +6,7 @@ import System.Exit
 
 main
  = do (_,_,_,_,Just j,Just io) <- createProcessExt_ "T9775_good" True (proc "main" [])
-      maybe (ExitFailure (-7)) mkExitCode <$> waitForJobCompletion j io 0xFFFFFFFF >>= print
+      maybe (ExitFailure (-1)) mkExitCode <$> waitForJobCompletion j io timeout_Infinite >>= print
         where mkExitCode code | code == 0 = ExitSuccess
                               | otherwise = ExitFailure $ fromIntegral code
       
\ No newline at end of file