blob: 72616d97ebd4cc43037a232f89945a862de42296 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
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
|