Test multithreaded bug
authorCharles Cooper <cooper.charles.m@gmail.com>
Fri, 3 Feb 2017 15:33:05 +0000 (10:33 -0500)
committerCharles Cooper <cooper.charles.m@gmail.com>
Fri, 3 Feb 2017 15:47:01 +0000 (10:47 -0500)
process.cabal
test/main.hs

index 0ef5b91..30d25bb 100644 (file)
@@ -82,3 +82,5 @@ test-suite test
                , bytestring
                , directory
                , process
+  ghc-options: -threaded
+               -with-rtsopts "-N"
index 9ea0524..f89f3ef 100644 (file)
@@ -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