Commit 7111d559 authored by simonmar's avatar simonmar
Browse files

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

Add test for "scavenge_stack" bug fixed in rev 1.16 of Exception.cmm
parent 533a3790
......@@ -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'])
-- 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
conc056: connect: does not exist (Connection refused)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment