[commit: packages/process] master: GH77: fix compile errors. (ae57e8c)

[git at git.haskell.org]

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

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

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

commit ae57e8c22b4e7f8356b1f21744add5b2f4d462b1
Author: Tamar Christina <tamar at zhox.com>
Date:   Mon Jan 2 20:30:50 2017 +0000

    GH77: fix compile errors.


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

ae57e8c22b4e7f8356b1f21744add5b2f4d462b1
 System/Process/Windows.hsc | 29 +++++++++++++++++++++++++----
 cbits/runProcess.c         | 15 ++++++++++++---
 include/runProcess.h       |  5 ++++-
 tests/T9775/T9775_good.hs  |  8 ++------
 4 files changed, 43 insertions(+), 14 deletions(-)

diff --git a/System/Process/Windows.hsc b/System/Process/Windows.hsc
index b9c4eae..ff8d3a7 100644
--- a/System/Process/Windows.hsc
+++ b/System/Process/Windows.hsc
@@ -22,6 +22,7 @@ import System.Process.Common
 import Control.Concurrent
 import Control.Exception
 import Data.Bits
+import Data.Maybe
 import Foreign.C
 import Foreign.Marshal
 import Foreign.Ptr
@@ -197,14 +198,32 @@ waitForJobCompletion :: PHANDLE
                      -> CUInt
                      -> IO (Maybe CInt)
 waitForJobCompletion job io timeout =
-            alloca $ \p_exitCode -> do ret <- c_waitForJobCompletion job io timeout p_exitCode
-                                       if ret == 0
-                                          then Just <$> peek p_exitCode
-                                          else return Nothing
+            alloca $ \p_exitCode -> do
+              items <- newMVar $ []
+              setter <- mkSetter (insertItem items)
+              getter <- mkGetter (getItem items)
+              ret <- c_waitForJobCompletion job io timeout p_exitCode setter getter
+              if ret == 0
+                 then Just <$> peek p_exitCode
+                 else return Nothing
+
+insertItem :: Eq k => MVar [(k, v)] -> k -> v -> IO ()
+insertItem env_ k v = modifyMVar_ env_ (return . ((k, v):))
+
+getItem :: Eq k => MVar [(k, v)] -> k -> IO v
+getItem env_ k = withMVar env_ (\m -> return $ fromJust $ lookup k m)
 
 -- ----------------------------------------------------------------------------
 -- Interface to C bits
 
+type SetterDef = CUInt -> Ptr () -> IO ()
+type GetterDef = CUInt -> IO (Ptr ())
+
+foreign import ccall "wrapper"
+  mkSetter :: SetterDef -> IO (FunPtr SetterDef)
+foreign import ccall "wrapper"
+  mkGetter :: GetterDef -> IO (FunPtr GetterDef)
+
 foreign import WINDOWS_CCONV unsafe "TerminateJobObject"
   c_terminateJobObject
         :: PHANDLE
@@ -217,6 +236,8 @@ foreign import ccall interruptible "waitForJobCompletion" -- NB. safe - can bloc
         -> PHANDLE
         -> CUInt
         -> Ptr CInt
+        -> FunPtr (SetterDef)
+        -> FunPtr (GetterDef)
         -> IO CInt
 
 foreign import ccall unsafe "runInteractiveProcess"
diff --git a/cbits/runProcess.c b/cbits/runProcess.c
index 43e3d7a..17463d6 100644
--- a/cbits/runProcess.c
+++ b/cbits/runProcess.c
@@ -792,8 +792,9 @@ waitForProcess (ProcHandle handle, int *pret)
     return -1;
 }
 
+
 int
-waitForJobCompletion (HANDLE hJob, HANDLE ioPort, DWORD timeout, int *pExitCode)
+waitForJobCompletion ( HANDLE hJob, HANDLE ioPort, DWORD timeout, int *pExitCode, setterDef set, getterDef get )
 {
     DWORD CompletionCode;
     ULONG_PTR CompletionKey;
@@ -813,15 +814,23 @@ waitForJobCompletion (HANDLE hJob, HANDLE ioPort, DWORD timeout, int *pExitCode)
         switch (CompletionCode)
         {
             case JOB_OBJECT_MSG_NEW_PROCESS:
+            {
                 // A new child process is born.
-                break;
+                // Retrieve and save the process handle from the process id.
+                // We'll need it for later but we can't retrieve it after the
+                // process has exited.
+                DWORD pid    = (DWORD)(uintptr_t)Overlapped;
+                HANDLE pHwnd = OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, TRUE, pid);
+                set(pid, pHwnd);
+            }
+            break;
             case JOB_OBJECT_MSG_ABNORMAL_EXIT_PROCESS:
             case JOB_OBJECT_MSG_EXIT_PROCESS:
             {
                 // 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.
-                HANDLE pHwnd = OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, TRUE, (DWORD)(uintptr_t)Overlapped);
+                HANDLE pHwnd = get((DWORD)(uintptr_t)Overlapped);
                 if (GetExitCodeProcess(pHwnd, (DWORD *)pExitCode) == 0)
                 {
                     maperrno();
diff --git a/include/runProcess.h b/include/runProcess.h
index 1662a62..3807389 100644
--- a/include/runProcess.h
+++ b/include/runProcess.h
@@ -85,8 +85,11 @@ extern ProcHandle runInteractiveProcess( wchar_t *cmd,
                                          HANDLE *hJob,
                                          HANDLE *hIOcpPort );
 
+typedef void(*setterDef)(DWORD, HANDLE);
+typedef HANDLE(*getterDef)(DWORD);
+
 extern int terminateJob( ProcHandle handle );
-extern int waitForJobCompletion( HANDLE hJob, HANDLE ioPort, DWORD timeout, int *pExitCode );
+extern int waitForJobCompletion( HANDLE hJob, HANDLE ioPort, DWORD timeout, int *pExitCode, setterDef set, getterDef get );
 
 #endif
 
diff --git a/tests/T9775/T9775_good.hs b/tests/T9775/T9775_good.hs
index 9461754..6634ad3 100644
--- a/tests/T9775/T9775_good.hs
+++ b/tests/T9775/T9775_good.hs
@@ -1,11 +1,7 @@
 module Main where
 
 import System.Process
-import System.Process.Internals
-import System.Exit
 
 main
- = do (_,_,_,_,Just j,Just io) <- createProcessExt_ "T9775_good" True (proc "main" [])
-      maybe (ExitFailure (-1)) mkExitCode <$> waitForJobCompletion j io timeout_Infinite >>= print
-        where mkExitCode code | code == 0 = ExitSuccess
-                              | otherwise = ExitFailure $ fromIntegral code
+ = do (_,_,_,p) <- createProcess_ "T9775_good" (proc "main" []{ use_process_jobs = True })
+      waitForProcess p >>= print