summaryrefslogtreecommitdiff
path: root/testsuite/tests/concurrent/should_run/mask001.hs
blob: 96bbf53c739604d4986ece0a4598a6380d50f623 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
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 ()