summaryrefslogtreecommitdiff
path: root/testsuite/tests/rts/T4850.hs
blob: fa06ffbea2b7f42d7d82791f937014dffc1c78fe (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
32
{-# 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 5 OS threads only:
--   one for main
--   worker 1 for the IO manager
--   worker 1 for the timeout manager
--   worker 3 to run the first forkIO
--   worker 4 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