add test for #4057
authorSimon Marlow <marlowsd@gmail.com>
Tue, 15 Jun 2010 12:38:01 +0000 (12:38 +0000)
committerSimon Marlow <marlowsd@gmail.com>
Tue, 15 Jun 2010 12:38:01 +0000 (12:38 +0000)
tests/4057.hs [new file with mode: 0644]
tests/4057.stdout [new file with mode: 0644]
tests/all.T

diff --git a/tests/4057.hs b/tests/4057.hs
new file mode 100644 (file)
index 0000000..cda40f0
--- /dev/null
@@ -0,0 +1,20 @@
+import Control.Monad
+import GHC.Conc
+import System.IO
+
+modifyTVar :: TVar Integer -> (Integer -> Integer) -> STM ()
+modifyTVar t f = readTVar t >>= writeTVar t . f
+
+main :: IO ()
+main = do
+  hSetBuffering stdout LineBuffering
+  t <- newTVarIO 0
+  let f = atomically $ do always (liftM2 (<=) (readTVar t) (return 5))
+                          modifyTVar t succ
+  putStrLn "f1"
+  f
+  putStrLn "f2"
+  f
+  putStrLn "v"
+  v <- atomically $ readTVar t
+  print v
diff --git a/tests/4057.stdout b/tests/4057.stdout
new file mode 100644 (file)
index 0000000..7276a06
--- /dev/null
@@ -0,0 +1,4 @@
+f1
+f2
+v
+2
index eace3dd..640f9d8 100644 (file)
@@ -34,3 +34,4 @@ test('stm062', normal, compile_and_run, ['-package stm'])
 test('stm063', skip_if_fast, compile_and_run, ['-package stm'])
 test('2411', ignore_output, compile_and_run, ['-package stm'])
 test('3049', normal, compile_and_run, ['-package stm'])
+test('4057', normal, compile_and_run, ['-package stm'])