[commit: testsuite] master: Update a few more tests to use mask rather than block/unblock (8c6e8a4)

Ian Lynagh igloo at earth.li
Tue Feb 19 22:08:02 CET 2013


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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/8c6e8a4c773844ef5cc8ecf4163e30a2bccbd428

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

commit 8c6e8a4c773844ef5cc8ecf4163e30a2bccbd428
Author: Ian Lynagh <ian at well-typed.com>
Date:   Tue Feb 19 18:50:49 2013 +0000

    Update a few more tests to use mask rather than block/unblock

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

 tests/concurrent/should_run/conc069.hs    |    4 ++--
 tests/concurrent/should_run/throwto002.hs |    8 ++++----
 tests/concurrent/should_run/throwto003.hs |    2 +-
 3 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/tests/concurrent/should_run/conc069.hs b/tests/concurrent/should_run/conc069.hs
index fd75713..d2947a2 100644
--- a/tests/concurrent/should_run/conc069.hs
+++ b/tests/concurrent/should_run/conc069.hs
@@ -6,11 +6,11 @@ main = do
   m <- newEmptyMVar
   forkIO (do stat; putMVar m ())
   takeMVar m
-  block $ forkIO (do stat; putMVar m ())
+  mask $ \_ -> forkIO (do stat; putMVar m ())
   takeMVar m
   forkOS (do stat; putMVar m ())
   takeMVar m
-  block $ forkOS (do stat; putMVar m ())
+  mask $ \_ -> forkOS (do stat; putMVar m ())
   takeMVar m
 
 stat = do
diff --git a/tests/concurrent/should_run/throwto002.hs b/tests/concurrent/should_run/throwto002.hs
index db67c24..e7fcc36 100644
--- a/tests/concurrent/should_run/throwto002.hs
+++ b/tests/concurrent/should_run/throwto002.hs
@@ -11,14 +11,14 @@ import Data.IORef
 main = do
   r <- newIORef 0
   rec
-    t1 <- block $ forkIO (thread r t2)
-    t2 <- block $ forkIO (thread r t1)
+    t1 <- mask $ \restore -> forkIO (thread restore r t2)
+    t2 <- mask $ \restore -> forkIO (thread restore r t1)
   threadDelay 1000000
   readIORef r >>= print . (/= 0)
 
-thread r t = run
+thread restore r t = run
   where 
-    run = (unblock $ forever $ do killThread t
+    run = (restore $ forever $ do killThread t
                                   i <- atomicModifyIORef r (\i -> (i + 1, i))
                                   evaluate i)
              `catch` \(e::SomeException) -> run
diff --git a/tests/concurrent/should_run/throwto003.hs b/tests/concurrent/should_run/throwto003.hs
index 7a7582f..8f62fb3 100644
--- a/tests/concurrent/should_run/throwto003.hs
+++ b/tests/concurrent/should_run/throwto003.hs
@@ -12,5 +12,5 @@ main = do
 
 thread m = run
   where 
-    run = (unblock $ forever $ modifyMVar_ m $ \v -> if v `mod` 2 == 1 then return (v*2) else return (v-1))
+    run = (forever $ modifyMVar_ m $ \v -> if v `mod` 2 == 1 then return (v*2) else return (v-1))
              `catch` \(e::SomeException) -> run





More information about the ghc-commits mailing list