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 ()
|