Typo
[packages/base.git] / tests / qsemn001.hs
1 import Control.Concurrent
2 import Control.Exception
3 import Control.Monad
4 import Data.List
5
6 new = newQSemN
7 wait = waitQSemN
8 signal = signalQSemN
9
10 --------
11 -- dummy test-framework
12
13 type Assertion = IO ()
14
15 x @?= y = when (x /= y) $ error (show x ++ " /= " ++ show y)
16
17 testCase :: String -> IO () -> IO ()
18 testCase n io = putStrLn ("test " ++ n) >> io
19
20 defaultMain = sequence
21 ------
22
23 main = defaultMain tests
24
25 tests = [
26 testCase "semn" semn,
27 testCase "semn2" semn2,
28 testCase "semn3" semn3,
29 testCase "semn_kill" semn_kill,
30 testCase "semn_bracket" sem_bracket
31 ]
32
33 semn :: Assertion
34 semn = do
35 c <- newEmptyMVar
36 q <- new 0
37 t1 <- forkIO $ do wait q 1; putMVar c 'a'
38 threadDelay 10000
39 t2 <- forkIO $ do wait q 2; putMVar c 'b'
40 threadDelay 10000
41 t3 <- forkIO $ do wait q 3; putMVar c 'c'
42 threadDelay 10000
43 signal q 1
44 a <- takeMVar c
45 signal q 2
46 b <- takeMVar c
47 signal q 3
48 c <- takeMVar c
49 [a,b,c] @?= "abc"
50
51 semn2 :: Assertion
52 semn2 = do
53 c <- newEmptyMVar
54 q <- new 0
55 t1 <- forkIO $ do wait q 1; putMVar c 'a'
56 threadDelay 10000
57 t2 <- forkIO $ do wait q 2; putMVar c 'b'
58 threadDelay 10000
59 t3 <- forkIO $ do wait q 3; putMVar c 'c'
60 threadDelay 10000
61 signal q 6
62 a <- takeMVar c
63 b <- takeMVar c
64 c <- takeMVar c
65 sort [a,b,c] @?= "abc"
66
67 semn3 :: Assertion
68 semn3 = do
69 c <- newEmptyMVar
70 q <- new 0
71 t1 <- forkIO $ do wait q 1; putMVar c 'a'
72 threadDelay 10000
73 t2 <- forkIO $ do wait q 2; putMVar c 'b'
74 threadDelay 10000
75 t3 <- forkIO $ do wait q 3; putMVar c 'c'
76 threadDelay 10000
77 signal q 3
78 a <- takeMVar c
79 b <- takeMVar c
80 threadDelay 10000
81 sort [a,b] @?= "ab"
82 d <- isEmptyMVar c
83 d @?= True
84 signal q 1
85 threadDelay 10000
86 d <- isEmptyMVar c
87 d @?= True
88 signal q 2
89 x <- takeMVar c
90 x @?= 'c'
91
92 semn_kill :: Assertion
93 semn_kill = do
94 q <- new 0
95 t <- forkIO $ do wait q 1
96 threadDelay 10000
97 killThread t
98 m <- newEmptyMVar
99 t <- forkIO $ do wait q 1; putMVar m ()
100 signal q 1
101 takeMVar m
102
103 sem_bracket :: Assertion
104 sem_bracket = do
105 q <- new 1
106 ts <- forM [1..100000] $ \n -> do
107 forkIO $ do bracket_ (wait q 1) (signal q 1) (return ())
108 mapM_ killThread ts
109 wait q 1