add test for #4057
[packages/stm.git] / tests / 4057.hs
1 import Control.Monad
2 import GHC.Conc
3 import System.IO
4
5 modifyTVar :: TVar Integer -> (Integer -> Integer) -> STM ()
6 modifyTVar t f = readTVar t >>= writeTVar t . f
7
8 main :: IO ()
9 main = do
10 hSetBuffering stdout LineBuffering
11 t <- newTVarIO 0
12 let f = atomically $ do always (liftM2 (<=) (readTVar t) (return 5))
13 modifyTVar t succ
14 putStrLn "f1"
15 f
16 putStrLn "f2"
17 f
18 putStrLn "v"
19 v <- atomically $ readTVar t
20 print v