GH196: Fix terminateJob

System/Process.hs

@@ -817,7 +817,7 @@ terminateProcess ph = do
     case p_ of
       ClosedHandle  _ -> return ()
 #if defined(WINDOWS)
-      OpenExtHandle{} -> terminateJob ph 1 >> return ()
+      OpenExtHandle{} -> terminateJobUnsafe p_ 1 >> return ()
 #else
       OpenExtHandle{} -> error "terminateProcess with OpenExtHandle should not happen on POSIX."
 #endif

System/Process/Internals.hs

@@ -41,6 +41,7 @@ module System.Process.Internals (
     unwrapHandles,
 #ifdef WINDOWS
     terminateJob,
+    terminateJobUnsafe,
     waitForJobCompletion,
     timeout_Infinite,
 #else

System/Process/Windows.hsc

@@ -14,6 +14,7 @@ module System.Process.Windows
     , createPipeInternalFd
     , interruptProcessGroupOfInternal
     , terminateJob
+    , terminateJobUnsafe
     , waitForJobCompletion
     , timeout_Infinite
     ) where
@@ -278,14 +279,18 @@ stopDelegateControlC = return ()
 -- ----------------------------------------------------------------------------
 -- Interface to C I/O CP bits
 
-terminateJob :: ProcessHandle -> CUInt -> IO Bool
-terminateJob jh ecode =
-    withProcessHandle jh $ \p_ -> do
+-- | Variant of terminateJob that is not thread-safe
+terminateJobUnsafe :: ProcessHandle__ -> CUInt -> IO Bool
+terminateJobUnsafe p_  ecode = do
         case p_ of
             ClosedHandle      _ -> return False
             OpenHandle        _ -> return False
             OpenExtHandle _ job -> c_terminateJobObject job ecode
 
+terminateJob :: ProcessHandle -> CUInt -> IO Bool
+terminateJob jh ecode =
+    withProcessHandle jh $ \p_ -> terminateJobUnsafe p_ ecode
+
 timeout_Infinite :: CUInt
 timeout_Infinite = 0xFFFFFFFF
 

changelog.md

@@ -4,6 +4,7 @@
 
 * Windows: Add support for new I/O manager in GHC 8.12[#177](https://github.com/haskell/process/pull/177)
 * Deprecate use of `createPipeFd` in favor of `createPipe`
+* Fix MVar re-entrant problem on Windows with `terminateProcess` and process jobs. See [#199](https://github.com/haskell/process/pull/199)
 
 ## 1.6.10.0 *June 2020*
 

process.cabal

@@ -95,3 +95,5 @@ test-suite test
                , process
   ghc-options: -threaded
                -with-rtsopts "-N"
+  if os(windows)
+        cpp-options: -DWINDOWS

test/main.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 import Control.Exception
 import Control.Monad (guard, unless, void)
 import System.Exit
@@ -97,7 +98,11 @@ main = do
 
     putStrLn "testing getPid"
     do
+#ifdef WINDOWS
+      (_, Just out, _, p) <- createProcess $ (proc "sh" ["-c", "z=$$; cat /proc/$z/winpid"]) {std_out = CreatePipe}
+#else
       (_, Just out, _, p) <- createProcess $ (proc "sh" ["-c", "echo $$"]) {std_out = CreatePipe}
+#endif
       pid <- getPid p
       line <- hGetContents out
       putStrLn $ " queried PID: " ++ show pid