Introduced regression tests for #17
[packages/stm.git] / testsuite / src / Issue17.hs
1 {-# LANGUAGE CPP #-}
2
3 -- see https://github.com/haskell/stm/pull/19
4 --
5 -- Test-case contributed by Alexey Kuleshevich <alexey@kukeshevi.ch>
6 --
7 -- This bug is observable in all versions with TBQueue from `stm-2.4` to
8 -- `stm-2.4.5.1` inclusive.
9
10 module Issue17 (main) where
11
12 import Control.Concurrent.STM
13 import Test.HUnit.Base (assertBool, assertEqual)
14
15 #if MIN_VERSION_stm(2,5,0)
16 main :: IO ()
17 main = do
18 -- New queue capacity is set to a negative numer
19 queueIO <- newTBQueueIO (-1 :: Int)
20 assertNoCapacityTBQueue queueIO
21
22 -- Same as above, except created within STM and different negative number
23 queueSTM <- atomically $ newTBQueue (minBound :: Int)
24 assertNoCapacityTBQueue queueSTM
25
26 assertNoCapacityTBQueue :: TBQueue Int -> IO ()
27 assertNoCapacityTBQueue queue = do
28 assertEmptyTBQueue queue
29 assertFullTBQueue queue
30
31 -- Attempt to write into the queue.
32 eValWrite <- atomically $ orElse (fmap Left (writeTBQueue queue 217))
33 (fmap Right (tryReadTBQueue queue))
34 assertEqual "Expected queue with no capacity: writeTBQueue" eValWrite (Right Nothing)
35 eValUnGet <- atomically $ orElse (fmap Left (unGetTBQueue queue 218))
36 (fmap Right (tryReadTBQueue queue))
37 assertEqual "Expected queue with no capacity: unGetTBQueue" eValUnGet (Right Nothing)
38
39 -- Make sure that attempt to write didn't affect the queue
40 assertEmptyTBQueue queue
41 assertFullTBQueue queue
42
43
44 assertEmptyTBQueue :: TBQueue Int -> IO ()
45 assertEmptyTBQueue queue = do
46 atomically (isEmptyTBQueue queue) >>=
47 assertBool "Expected empty: isEmptyTBQueue should return True"
48
49 atomically (tryReadTBQueue queue) >>=
50 assertEqual "Expected empty: tryReadTBQueue should return Nothing" Nothing
51
52 atomically (tryPeekTBQueue queue) >>=
53 assertEqual "Expected empty: tryPeekTBQueue should return Nothing" Nothing
54
55 atomically (flushTBQueue queue) >>=
56 assertEqual "Expected empty: flushTBQueue should return []" []
57
58
59 assertFullTBQueue :: TBQueue Int -> IO ()
60 assertFullTBQueue queue = do
61 atomically (isFullTBQueue queue) >>=
62 assertBool "Expected full: isFullTBQueue shoule return True"
63
64 #else
65 -- test-case above will fail for 2.4.5.1 and prior
66 main :: IO ()
67 main = return ()
68 #endif