diff options
Diffstat (limited to 'testsuite/tests/concurrent/should_run/mask002.hs')
-rw-r--r-- | testsuite/tests/concurrent/should_run/mask002.hs | 32 |
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 () + |