summaryrefslogtreecommitdiff
path: root/testsuite/tests/concurrent/should_run/mask002.hs
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/concurrent/should_run/mask002.hs')
-rw-r--r--testsuite/tests/concurrent/should_run/mask002.hs32
1 files changed, 32 insertions, 0 deletions
diff --git a/testsuite/tests/concurrent/should_run/mask002.hs b/testsuite/tests/concurrent/should_run/mask002.hs
new file mode 100644
index 0000000000..15b2e64a00
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/mask002.hs
@@ -0,0 +1,32 @@
+import Control.Exception
+import Control.Concurrent
+import Text.Printf
+import Prelude hiding(catch)
+
+-- Test combinations of nesting mask/uninterruptibleMask with
+-- forkIO/forkIOUnmask
+
+main = do
+ m <- newEmptyMVar
+ t1 <- mask_ $ forkIO $ do
+ takeMVar m `catch` \e -> do stat 1 MaskedInterruptible
+ print (e::SomeException)
+ throwIO e
+ killThread t1
+ t2 <- uninterruptibleMask_ $ forkIO $ do
+ takeMVar m `catch` \e -> do stat 2 MaskedUninterruptible
+ print (e::SomeException)
+ throwIO e
+ killThread t2
+ t3 <- mask_ $ forkIOUnmasked $ do stat 3 Unmasked; putMVar m ()
+ takeMVar m
+ t4 <- uninterruptibleMask_ $ forkIOUnmasked $ do stat 4 Unmasked; putMVar m ()
+ takeMVar m
+
+stat :: Int -> MaskingState -> IO ()
+stat n m = do
+ s <- getMaskingState
+ if (s /= m)
+ then error (printf "%2d: %s\n" n (show s))
+ else return ()
+