add test for #2411
authorSimon Marlow <marlowsd@gmail.com>
Fri, 26 Sep 2008 23:38:49 +0000 (23:38 +0000)
committerSimon Marlow <marlowsd@gmail.com>
Fri, 26 Sep 2008 23:38:49 +0000 (23:38 +0000)
tests/2411.hs [new file with mode: 0644]
tests/all.T

diff --git a/tests/2411.hs b/tests/2411.hs
new file mode 100644 (file)
index 0000000..d0fce29
--- /dev/null
@@ -0,0 +1,17 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}
+module Main where
+import Control.Concurrent.STM
+import GHC.Conc
+import Control.Exception
+import Data.List
+
+main = do
+  tv <- atomically $ newTVar "test"
+  mapM_ (go tv) (map show ([1..100] ++ [1..1000] :: [Int]))
+        where go tv s = forkIO $ do
+                          x <- atomically $ (do
+                                   writeTVar tv "testing"
+                                   if read s `mod` 25 == 0
+                                     then throw $ AssertionFailed ("SimulatedException " ++ s)
+                                     else return s) `catchSTM` (\e -> return (show e))
+                          putStrLn x
index 83bd76e..290f7d9 100644 (file)
@@ -32,3 +32,4 @@ test('conc060', normal, compile_and_run, ['-package stm'])
 test('conc061', normal, compile_and_run, ['-package stm'])
 test('conc062', normal, compile_and_run, ['-package stm'])
 test('conc063', skip_if_fast, compile_and_run, ['-package stm'])
+test('2411', ignore_output, compile_and_run, ['-package stm'])