diff options
Diffstat (limited to 'testsuite/tests/rts/4850.hs')
-rw-r--r-- | testsuite/tests/rts/4850.hs | 31 |
1 files changed, 31 insertions, 0 deletions
diff --git a/testsuite/tests/rts/4850.hs b/testsuite/tests/rts/4850.hs new file mode 100644 index 0000000000..72616d97eb --- /dev/null +++ b/testsuite/tests/rts/4850.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +module Main where + +import Foreign +import Control.Concurrent + +type Fun = Int -> IO Int + +foreign import ccall "wrapper" mkF :: Fun -> IO (FunPtr Fun) + +foreign import ccall "dynamic" callF :: FunPtr Fun -> Fun + +-- This test should create 4 OS threads only: +-- one for main +-- worker 1 for the IO manager +-- worker 2 to run the first forkIO +-- worker 3 created when worker 2 makes its foreign call + +-- Due to #4850, an extra worker was being created because worker 2 was +-- lost after returning from its foreign call. + +main = do + m <- newEmptyMVar + callback m >> takeMVar m >>= print + callback m >> takeMVar m >>= print + +callback m = + forkIO $ do + f <- mkF $ \x -> return (x+1) + r <- callF f 3 + putMVar m r |