diff options
Diffstat (limited to 'testsuite/tests/concurrent/should_run/mask001.hs')
-rw-r--r-- | testsuite/tests/concurrent/should_run/mask001.hs | 70 |
1 files changed, 70 insertions, 0 deletions
diff --git a/testsuite/tests/concurrent/should_run/mask001.hs b/testsuite/tests/concurrent/should_run/mask001.hs new file mode 100644 index 0000000000..96bbf53c73 --- /dev/null +++ b/testsuite/tests/concurrent/should_run/mask001.hs @@ -0,0 +1,70 @@ +import Control.Exception +import Text.Printf + +-- Test all the various combinations of nesting mask/uninterruptibleMask + +main = do + stat 1 Unmasked + mask_ $ stat 2 MaskedInterruptible + mask $ \restore -> do + stat 3 MaskedInterruptible + restore $ stat 4 Unmasked + restore $ restore $ stat 5 Unmasked + stat 6 MaskedInterruptible + uninterruptibleMask $ \restore -> do + stat 7 MaskedUninterruptible + restore $ stat 8 MaskedInterruptible + restore $ restore $ stat 9 MaskedInterruptible + stat 10 MaskedUninterruptible + mask $ \restore -> do + stat 11 MaskedUninterruptible + restore $ stat 12 MaskedUninterruptible + restore $ restore $ stat 13 MaskedUninterruptible + stat 14 MaskedUninterruptible + stat 15 MaskedUninterruptible + stat 16 MaskedInterruptible + stat 17 Unmasked + + uninterruptibleMask $ \restore -> do + stat 20 MaskedUninterruptible + restore $ stat 21 Unmasked + restore $ restore $ stat 22 Unmasked + stat 23 MaskedUninterruptible + mask $ \restore -> do + stat 24 MaskedUninterruptible + restore $ stat 25 MaskedUninterruptible + restore $ restore $ stat 26 MaskedUninterruptible + stat 27 MaskedUninterruptible + uninterruptibleMask $ \restore -> do + stat 28 MaskedUninterruptible + restore $ stat 29 MaskedUninterruptible + restore $ restore $ stat 30 MaskedUninterruptible + stat 31 MaskedUninterruptible + stat 32 MaskedUninterruptible + stat 33 MaskedUninterruptible + stat 34 Unmasked + + -- it is possible to call a restore from a mask that is not the + -- innermost enclosing one, although this is not a recommended use + -- of the API. + mask $ \restore0 -> do + stat 41 MaskedInterruptible + -- it is possible to call a restore from a mask that is not the + uninterruptibleMask $ \restore1 -> do + stat 42 MaskedUninterruptible + restore0 $ stat 43 Unmasked + restore0 $ restore0 $ stat 44 Unmasked + restore1 $ stat 45 MaskedInterruptible + restore1 $ restore1 $ stat 46 MaskedInterruptible + restore0 $ restore1 $ stat 47 MaskedInterruptible + restore1 $ restore0 $ stat 48 Unmasked + stat 49 MaskedUninterruptible + stat 50 MaskedInterruptible + stat 51 Unmasked + +stat :: Int -> MaskingState -> IO () +stat n m = do + s <- getMaskingState + if (s /= m) + then error (printf "%2d: %s\n" n (show s)) + else return () |