[commit: testsuite] master: Update T3279 to use mask rather than block (a6d80ce)

Ian Lynagh igloo at earth.li
Tue Feb 19 22:07:58 CET 2013


Repository : ssh://darcs.haskell.org//srv/darcs/testsuite

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/a6d80ce5fb2211af8dafc425705fefb316702802

>---------------------------------------------------------------

commit a6d80ce5fb2211af8dafc425705fefb316702802
Author: Ian Lynagh <ian at well-typed.com>
Date:   Tue Feb 19 18:46:40 2013 +0000

    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.

>---------------------------------------------------------------

 tests/concurrent/should_run/T3279.hs |   22 ++++++++++++++--------
 1 files changed, 14 insertions(+), 8 deletions(-)

diff --git a/tests/concurrent/should_run/T3279.hs b/tests/concurrent/should_run/T3279.hs
index f479704..46e9b03 100644
--- a/tests/concurrent/should_run/T3279.hs
+++ b/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
     





More information about the ghc-commits mailing list