[commit: testsuite] master: unbreak tests (removal of block/unblock) (1527869)
Simon Marlow
marlowsd at gmail.com
Fri May 10 10:41:29 CEST 2013
Repository : ssh://darcs.haskell.org//srv/darcs/testsuite
On branch : master
https://github.com/ghc/testsuite/commit/1527869432fab778c8d58ce0d54313c404e76410
>---------------------------------------------------------------
commit 1527869432fab778c8d58ce0d54313c404e76410
Author: Simon Marlow <marlowsd at gmail.com>
Date: Fri May 10 09:41:20 2013 +0100
unbreak tests (removal of block/unblock)
>---------------------------------------------------------------
tests/concurrent/should_run/conc015.hs | 11 +++++------
tests/concurrent/should_run/conc015.stdout | 6 +++---
tests/concurrent/should_run/conc017.hs | 5 ++---
tests/concurrent/should_run/conc020.hs | 2 +-
tests/concurrent/should_run/conc035.hs | 2 +-
tests/concurrent/should_run/conc058.hs | 2 +-
tests/concurrent/should_run/conc065.hs | 2 +-
tests/concurrent/should_run/conc066.hs | 4 ++--
tests/concurrent/should_run/conc068.hs | 2 +-
9 files changed, 17 insertions(+), 19 deletions(-)
diff --git a/tests/concurrent/should_run/conc015.hs b/tests/concurrent/should_run/conc015.hs
index 7574e15..6356688 100644
--- a/tests/concurrent/should_run/conc015.hs
+++ b/tests/concurrent/should_run/conc015.hs
@@ -12,7 +12,7 @@ import Control.Exception
main = do
main_thread <- myThreadId
- print =<< blocked -- False
+ print =<< getMaskingState -- False
m <- newEmptyMVar
m2 <- newEmptyMVar
forkIO (do takeMVar m
@@ -21,19 +21,18 @@ main = do
putMVar m2 ()
)
( do
- block (do
+ mask $ \restore -> do
putMVar m ()
- print =<< blocked -- True
+ print =<< getMaskingState -- True
sum [1..1] `seq` -- give 'foo' a chance to be raised
- (unblock $ myDelay 500000)
+ (restore $ myDelay 500000)
`Control.Exception.catch`
\e -> putStrLn ("caught1: " ++ show (e::SomeException))
- )
threadDelay 10000
takeMVar m2
)
`Control.Exception.catch`
- \e -> do print =<< blocked
+ \e -> do print =<< getMaskingState
putStrLn ("caught2: " ++ show (e::SomeException))
-- compensate for the fact that threadDelay is non-interruptible
diff --git a/tests/concurrent/should_run/conc015.stdout b/tests/concurrent/should_run/conc015.stdout
index be6aa71..63f67ce 100644
--- a/tests/concurrent/should_run/conc015.stdout
+++ b/tests/concurrent/should_run/conc015.stdout
@@ -1,5 +1,5 @@
-False
-True
+Unmasked
+MaskedInterruptible
caught1: foo
-True
+MaskedInterruptible
caught2: bar
diff --git a/tests/concurrent/should_run/conc017.hs b/tests/concurrent/should_run/conc017.hs
index 30d8a1c..c1ca4e7 100644
--- a/tests/concurrent/should_run/conc017.hs
+++ b/tests/concurrent/should_run/conc017.hs
@@ -17,9 +17,9 @@ main = do
putMVar m3 ()
)
(do
- block (do
+ mask $ \restore -> do
(do putMVar m1 ()
- unblock (
+ restore (
-- unblocked, "foo" delivered to "caught1"
myDelay 100000
)
@@ -30,7 +30,6 @@ main = do
(sum [1..10000] `seq` return ())
`Control.Exception.catch`
\e -> putStrLn ("caught2: " ++ show (e::SomeException))
- )
-- unblocked here, "bar" delivered to "caught3"
takeMVar m3
)
diff --git a/tests/concurrent/should_run/conc020.hs b/tests/concurrent/should_run/conc020.hs
index 956b761..71ad2ac 100644
--- a/tests/concurrent/should_run/conc020.hs
+++ b/tests/concurrent/should_run/conc020.hs
@@ -3,7 +3,7 @@ import Control.Exception
main = do
m <- newEmptyMVar
- t <- forkIO (block $ takeMVar m)
+ t <- forkIO (mask_ $ takeMVar m)
threadDelay 100000
throwTo t (ErrorCall "I'm Interruptible")
threadDelay 100000
diff --git a/tests/concurrent/should_run/conc035.hs b/tests/concurrent/should_run/conc035.hs
index fcb2d5c..05e4817 100644
--- a/tests/concurrent/should_run/conc035.hs
+++ b/tests/concurrent/should_run/conc035.hs
@@ -5,7 +5,7 @@ import qualified Control.Exception as E
trapHandler :: MVar Int -> MVar () -> IO ()
trapHandler inVar caughtVar =
- (do E.block $ do
+ (do E.mask_ $ do
trapMsg <- takeMVar inVar
putStrLn ("Handler got: " ++ show trapMsg)
trapHandler inVar caughtVar
diff --git a/tests/concurrent/should_run/conc058.hs b/tests/concurrent/should_run/conc058.hs
index 5fbe4e5..5ee74c6 100644
--- a/tests/concurrent/should_run/conc058.hs
+++ b/tests/concurrent/should_run/conc058.hs
@@ -6,7 +6,7 @@ import Control.Exception
-- not interruptible.
main = do
m <- newEmptyMVar
- t <- forkIO (block $ threadDelay 1000000)
+ t <- forkIO (mask_ $ threadDelay 1000000)
threadDelay 100000
throwTo t (ErrorCall "I'm Interruptible")
threadDelay 100000
diff --git a/tests/concurrent/should_run/conc065.hs b/tests/concurrent/should_run/conc065.hs
index db6d7cf..8f6c18b 100644
--- a/tests/concurrent/should_run/conc065.hs
+++ b/tests/concurrent/should_run/conc065.hs
@@ -6,7 +6,7 @@ import Control.Exception
-- This loop spends most of its time printing stuff, and very occasionally
-- pops outside 'block'. This test ensures that an thread trying to
-- throwTo this thread will eventually succeed.
-loop = block (print "alive") >> loop
+loop = mask_ (print "alive") >> loop
main = do tid <- forkIO loop
threadDelay 1
diff --git a/tests/concurrent/should_run/conc066.hs b/tests/concurrent/should_run/conc066.hs
index 81638df..0f3a699 100644
--- a/tests/concurrent/should_run/conc066.hs
+++ b/tests/concurrent/should_run/conc066.hs
@@ -6,8 +6,8 @@ import Control.Exception
-- This loop spends most of its time printing stuff, and very occasionally
-- executes 'unblock (return ())'. This test ensures that a thread waiting
-- to throwTo this thread is not blocked indefinitely.
-loop = do unblock (return ()); print "alive"; loop
+loop restore = do restore (return ()); print "alive"; loop restore
-main = do tid <- forkIO (block loop)
+main = do tid <- forkIO (mask $ \restore -> loop restore)
yield
killThread tid
diff --git a/tests/concurrent/should_run/conc068.hs b/tests/concurrent/should_run/conc068.hs
index eb90d06..60b9652 100644
--- a/tests/concurrent/should_run/conc068.hs
+++ b/tests/concurrent/should_run/conc068.hs
@@ -6,7 +6,7 @@ import GHC.Conc
main = do
main_thread <- myThreadId
m <- newEmptyMVar
- sub_thread <- block $ forkIO $
+ sub_thread <- mask_ $ forkIO $
sum [1..100000] `seq`
throwTo main_thread (ErrorCall "foo")
killThread sub_thread
More information about the ghc-commits
mailing list