49e6d1eaedfe156ebb0f3b069847f3f05b41dabc
[ghc.git] / testsuite / tests / concurrent / should_run / T9379.hs
1 import Control.Exception
2 import Control.Concurrent
3 import Control.Concurrent.STM
4 import Foreign.StablePtr
5
6 main :: IO ()
7 main = do
8 tv <- atomically $ newTVar True
9 _ <- newStablePtr tv
10 t <- mask_ $ forkIO (blockSTM tv)
11 killThread t
12
13 blockSTM :: TVar Bool -> IO ()
14 blockSTM tv = do
15 atomically $ do
16 v <- readTVar tv
17 check $ not v