summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorIan Lynagh <ian@well-typed.com>2013-02-19 18:46:40 +0000
committerIan Lynagh <ian@well-typed.com>2013-02-19 18:46:40 +0000
commit887b9f0b5337155d6dcd99ab95cc559192504f95 (patch)
tree37c6592b9f3a2a2f52c0a909ac5ffe939cc2bb4d
parent9cfc862fc569ba0705a617a5b9a3f9e0b6ce41e0 (diff)
downloadhaskell-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.hs22
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