libraries/base/tests/T10149.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

import Control.Concurrent
import Control.Exception

main :: IO ()
main = do
    mask $ \unmask -> mask $ \restore ->
      unmask $ restore $ getMaskingState >>= print
    uninterruptibleMask $ \unmask -> uninterruptibleMask $ \restore ->
      unmask $ restore $ getMaskingState >>= print

    mv <- newEmptyMVar
    mask_ $ -- start with exceptions masked
      mask $ \restore -> forkIOWithUnmask $ \unmask -> unmask $
        restore $ getMaskingState >>= print >> putMVar mv ()
    takeMVar mv
    uninterruptibleMask_ $ -- start with exceptions uninterruptibly masked
      uninterruptibleMask $ \restore -> forkIOWithUnmask $ \unmask -> unmask $
        restore $ getMaskingState >>= print >> putMVar mv ()
    takeMVar mv