diff options
author | Ian Lynagh <ian@well-typed.com> | 2013-02-19 18:46:40 +0000 |
---|---|---|
committer | Ian Lynagh <ian@well-typed.com> | 2013-02-19 18:46:40 +0000 |
commit | 887b9f0b5337155d6dcd99ab95cc559192504f95 (patch) | |
tree | 37c6592b9f3a2a2f52c0a909ac5ffe939cc2bb4d | |
parent | 9cfc862fc569ba0705a617a5b9a3f9e0b6ce41e0 (diff) | |
download | haskell-887b9f0b5337155d6dcd99ab95cc559192504f95.tar.gz |
Update T3279 to use mask rather than block
I'm not 100% sure that this is still testing what it's meant to be
testing, but the test still passes.
-rw-r--r-- | testsuite/tests/concurrent/should_run/T3279.hs | 22 |
1 files changed, 14 insertions, 8 deletions
diff --git a/testsuite/tests/concurrent/should_run/T3279.hs b/testsuite/tests/concurrent/should_run/T3279.hs index f479704310..46e9b03674 100644 --- a/testsuite/tests/concurrent/should_run/T3279.hs +++ b/testsuite/tests/concurrent/should_run/T3279.hs @@ -1,24 +1,30 @@ -- test for #3279 +import Data.IORef import System.IO.Unsafe import GHC.Conc import Control.Exception -f :: Int -f = (1 +) . unsafePerformIO $ do - error "foo" `catch` \(SomeException e) -> do - myThreadId >>= flip throwTo e - -- point X - unblock $ return 1 - main :: IO () main = do + restoreRef <- newIORef id + + let f :: Int + f = (1 +) . unsafePerformIO $ do + error "foo" `catch` \(SomeException e) -> do + myThreadId >>= flip throwTo e + -- point X + restore <- readIORef restoreRef + restore $ return 1 + evaluate f `catch` \(SomeException e) -> return 0 -- the evaluation of 'x' is now suspended at point X - tid <- block $ forkIO (evaluate f >> return ()) + tid <- mask $ \restore -> do writeIORef restoreRef restore + forkIO (evaluate f >> return ()) killThread tid -- now execute the 'unblock' above with a pending exception yield + writeIORef restoreRef id -- should print 1 + 1 = 2 print f |