[project @ 2006-01-05 09:16:28 by simonmar]

Add test for "scavenge_stack" bug fixed in rev 1.16 of Exception.cmm

testsuite/tests/ghc-regress/concurrent/should_run/all.T

@@ -116,3 +116,4 @@ test('conc052', normal, compile_and_run, ['-package stm'])
 test('conc053', only_ways(['threaded','smp']), compile_and_run, ['-package stm'])
 test('conc054', normal, compile_and_run, ['-package stm'])
 test('conc055', exit_code(1), compile_and_run, ['-package stm'])
+test('conc056', only_ways(['threaded']), compile_and_run, ['-package stm -package network'])

testsuite/tests/ghc-regress/concurrent/should_run/conc056.hs

+-- Exposed a bug in 6.4.1, fixed in rev. 1.16 of ghc/rts/Exception.cmm
+
+import Network
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Monad
+import Control.Exception
+
+inc :: TVar Int -> STM ()
+inc tv = do
+  v <- readTVar tv
+  writeTVar tv (v + 1)
+
+bad :: MVar () -> IO ()
+bad m = do { connectTo "0.0.0.0" (Service "http"); return () }
+	 `finally` putMVar m ()
+
+main :: IO ()
+main = do
+  tv <- atomically (newTVar 0)
+  m <- newEmptyMVar
+  forkOS (sequence_ $ repeat $ atomically (inc tv))
+  forkOS (bad m)
+  takeMVar m

testsuite/tests/ghc-regress/concurrent/should_run/conc056.stderr

+conc056: connect: does not exist (Connection refused)
+