[commit: packages/process] master: Test multithreaded bug (962d5f1)

[git at git.haskell.org]

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

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

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

commit 962d5f14d2bb4fda38d8bba689952076a3080213
Author: Charles Cooper <cooper.charles.m at gmail.com>
Date:   Fri Feb 3 10:33:05 2017 -0500

    Test multithreaded bug


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

962d5f14d2bb4fda38d8bba689952076a3080213
 process.cabal |  2 ++
 test/main.hs  | 15 ++++++++++++++-
 2 files changed, 16 insertions(+), 1 deletion(-)

diff --git a/process.cabal b/process.cabal
index 0ef5b91..30d25bb 100644
--- a/process.cabal
+++ b/process.cabal
@@ -82,3 +82,5 @@ test-suite test
                , bytestring
                , directory
                , process
+  ghc-options: -threaded
+               -with-rtsopts "-N"
diff --git a/test/main.hs b/test/main.hs
index 9ea0524..f89f3ef 100644
--- a/test/main.hs
+++ b/test/main.hs
@@ -1,10 +1,12 @@
 import Control.Exception
-import Control.Monad (unless)
+import Control.Monad (unless, void)
 import System.Exit
 import System.IO.Error
 import System.Directory (getCurrentDirectory, setCurrentDirectory)
 import System.Process
+import Control.Concurrent
 import Data.List (isInfixOf)
+import Data.Maybe (isNothing)
 import System.IO (hClose, openBinaryTempFile)
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Char8 as S8
@@ -66,6 +68,17 @@ main = do
         unless (bs == res')
             $ error $ "Unexpected result: " ++ show res'
 
+    do -- multithreaded waitForProcess
+      (_, _, _, p) <- createProcess (proc "sleep" ["0.1"])
+      me1 <- newEmptyMVar
+      forkIO . void $ waitForProcess p >>= putMVar me1
+      -- check for race / deadlock between waitForProcess and getProcessExitCode
+      e3 <- getProcessExitCode p
+      e2 <- waitForProcess p
+      e1 <- readMVar me1
+      unless (isNothing e3 && e1 == ExitSuccess && e2 == ExitSuccess)
+            $ error "sleep exited with non-zero exit code!"
+
     putStrLn "Tests passed successfully"
 
 withCurrentDirectory :: FilePath -> IO a -> IO a