Ticket #2411: stmc2.hs

File stmc2.hs, 712 bytes (added by sclv, 6 years ago)

simplified testcase

Line 
1{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}
2module Main where
3import Control.Concurrent.STM
4import GHC.Conc
5import Control.Exception
6import Data.List
7
8main = do
9  tv <- atomically $ newTVar "test"
10  mapM_ (go tv) (map show ([1..100] ++ [1..1000] :: [Int]))
11        where go tv s = forkIO $ do
12                          x <- atomically $ (do
13                                   writeTVar tv "testing"
14                                   if read s `mod` 25 == 0
15                                     then throw $ AssertionFailed ("SimulatedException " ++ s)
16                                     else return s) `catchSTM` (\e -> return (show e))
17                          putStrLn x