Ticket #5055: tvarTest.hs

File tvarTest.hs, 930 bytes (added by guest, 3 years ago)

A simple test that exhibits the bug

Line 
1{-# LANGUAGE ScopedTypeVariables #-}
2import Control.Concurrent.STM
3import Control.Concurrent
4import Control.Exception as X
5import Control.Monad
6
7{-
8-- result: no output at all (terminate after 1 second delay)
9main = do
10        i <- newTVarIO ()
11        b <- newTVarIO False
12        forkIO (printBoolTVar b)
13        gcTVar i b
14        threadDelay 1000000
15-}
16
17-- result: tvarTest: thread blocked indefinitely in an STM transaction
18main = do
19        i <- newTVarIO ()
20        b <- newTVarIO False
21        forkIO $ gcTVar i b
22        printBoolTVar b
23
24printBoolTVar :: TVar Bool -> IO ()
25printBoolTVar b = do
26        res <- atomically $ do
27                r <- readTVar b
28                if not r then retry else return r
29        print res
30
31gcTVar :: TVar () -> TVar Bool -> IO ()
32gcTVar i b =
33        X.catch (forever $ atomically (readTVar i >> retry)) $ \e -> do
34        case fromException e of
35                Just BlockedIndefinitelyOnSTM -> atomically (writeTVar b True)
36                _ -> putStrLn "Something is wrong" >> atomically (writeTVar b True)