Ticket #2401: teststmhangs.hs
| File teststmhangs.hs, 384 bytes (added by sclv, 5 years ago) |
|---|
| Line | |
|---|---|
| 1 | module Main where |
| 2 | import GHC.Conc |
| 3 | import Control.Concurrent.STM |
| 4 | |
| 5 | main = do |
| 6 | x <- mapM go . swapRev =<< mapM (atomically . newTVar) ([1..1000] :: [Int]) |
| 7 | print $ length x |
| 8 | where go v = forkIO . atomically $ do |
| 9 | x <- readTVar v |
| 10 | unsafeIOToSTM $ putStr (show x ++ ", ") |
| 11 | writeTVar v (x+1) |
| 12 | swapRev xs = reverse xs ++ xs |
