summaryrefslogtreecommitdiff
path: root/testsuite/tests/concurrent/should_run/T13916.hs
blob: e81aabb5a8e5ffda6db8e8a8d2b8896f9d8e15e7 (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
33
module Main where

import Data.IORef
import System.IO.Unsafe
import Control.Concurrent.STM
import Control.Concurrent.Async
import Control.Concurrent
import System.IO
import System.Directory
import System.FilePath
import T13916_Bracket

type Thing = MVar Bool

main :: IO ()
main = do
    withEnvCache limit spawner $ \cache ->
        forConcurrently_ [1..1000 :: Int] $ \n -> withEnv cache (\handle -> put handle n)
    where
        limit :: Limit
        limit = Hard 1

        put handle n = return ()

spawner :: Spawner Thing
spawner = Spawner
    { maker  = mkhandle
    , killer = \thing -> takeMVar thing >> putMVar thing True
    , isDead = \thing -> readMVar thing
    }

mkhandle :: IO Thing
mkhandle = newMVar False