[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