Add test properties for splitRoot.
[packages/containers.git] / tests / intset-properties.hs
1 {-# LANGUAGE CPP #-}
2 #if MIN_VERSION_base(4,5,0)
3 import Data.Bits ((.&.), popCount)
4 import Data.Word (Word)
5 #else
6 import Data.Bits ((.&.))
7 #endif
8 import Data.IntSet
9 import Data.List (nub,sort)
10 import qualified Data.List as List
11 import Data.Monoid (mempty)
12 import qualified Data.Set as Set
13 import Prelude hiding (lookup, null, map, filter, foldr, foldl)
14 import Test.Framework
15 import Test.Framework.Providers.HUnit
16 import Test.Framework.Providers.QuickCheck2
17 import Test.HUnit hiding (Test, Testable)
18 import Test.QuickCheck hiding ((.&.))
19
20 main :: IO ()
21 main = defaultMain [ testCase "lookupLT" test_lookupLT
22 , testCase "lookupGT" test_lookupGT
23 , testCase "lookupLE" test_lookupLE
24 , testCase "lookupGE" test_lookupGE
25 , testCase "split" test_split
26 , testProperty "prop_Single" prop_Single
27 , testProperty "prop_Member" prop_Member
28 , testProperty "prop_NotMember" prop_NotMember
29 , testProperty "prop_LookupLT" prop_LookupLT
30 , testProperty "prop_LookupGT" prop_LookupGT
31 , testProperty "prop_LookupLE" prop_LookupLE
32 , testProperty "prop_LookupGE" prop_LookupGE
33 , testProperty "prop_InsertDelete" prop_InsertDelete
34 , testProperty "prop_MemberFromList" prop_MemberFromList
35 , testProperty "prop_UnionInsert" prop_UnionInsert
36 , testProperty "prop_UnionAssoc" prop_UnionAssoc
37 , testProperty "prop_UnionComm" prop_UnionComm
38 , testProperty "prop_Diff" prop_Diff
39 , testProperty "prop_Int" prop_Int
40 , testProperty "prop_Ordered" prop_Ordered
41 , testProperty "prop_List" prop_List
42 , testProperty "prop_DescList" prop_DescList
43 , testProperty "prop_AscDescList" prop_AscDescList
44 , testProperty "prop_fromList" prop_fromList
45 , testProperty "prop_MaskPow2" prop_MaskPow2
46 , testProperty "prop_Prefix" prop_Prefix
47 , testProperty "prop_LeftRight" prop_LeftRight
48 , testProperty "prop_isProperSubsetOf" prop_isProperSubsetOf
49 , testProperty "prop_isProperSubsetOf2" prop_isProperSubsetOf2
50 , testProperty "prop_isSubsetOf" prop_isSubsetOf
51 , testProperty "prop_isSubsetOf2" prop_isSubsetOf2
52 , testProperty "prop_size" prop_size
53 , testProperty "prop_findMax" prop_findMax
54 , testProperty "prop_findMin" prop_findMin
55 , testProperty "prop_ord" prop_ord
56 , testProperty "prop_readShow" prop_readShow
57 , testProperty "prop_foldR" prop_foldR
58 , testProperty "prop_foldR'" prop_foldR'
59 , testProperty "prop_foldL" prop_foldL
60 , testProperty "prop_foldL'" prop_foldL'
61 , testProperty "prop_map" prop_map
62 , testProperty "prop_maxView" prop_maxView
63 , testProperty "prop_minView" prop_minView
64 , testProperty "prop_split" prop_split
65 , testProperty "prop_splitMember" prop_splitMember
66 , testProperty "prop_splitRoot" prop_splitRoot
67 , testProperty "prop_partition" prop_partition
68 , testProperty "prop_filter" prop_filter
69 #if MIN_VERSION_base(4,5,0)
70 , testProperty "prop_bitcount" prop_bitcount
71 #endif
72 ]
73
74 ----------------------------------------------------------------
75 -- Unit tests
76 ----------------------------------------------------------------
77
78 test_lookupLT :: Assertion
79 test_lookupLT = do
80 lookupLT 3 (fromList [3, 5]) @?= Nothing
81 lookupLT 5 (fromList [3, 5]) @?= Just 3
82
83 test_lookupGT :: Assertion
84 test_lookupGT = do
85 lookupGT 4 (fromList [3, 5]) @?= Just 5
86 lookupGT 5 (fromList [3, 5]) @?= Nothing
87
88 test_lookupLE :: Assertion
89 test_lookupLE = do
90 lookupLE 2 (fromList [3, 5]) @?= Nothing
91 lookupLE 4 (fromList [3, 5]) @?= Just 3
92 lookupLE 5 (fromList [3, 5]) @?= Just 5
93
94 test_lookupGE :: Assertion
95 test_lookupGE = do
96 lookupGE 3 (fromList [3, 5]) @?= Just 3
97 lookupGE 4 (fromList [3, 5]) @?= Just 5
98 lookupGE 6 (fromList [3, 5]) @?= Nothing
99
100 test_split :: Assertion
101 test_split = do
102 split 3 (fromList [1..5]) @?= (fromList [1,2], fromList [4,5])
103
104 {--------------------------------------------------------------------
105 Arbitrary, reasonably balanced trees
106 --------------------------------------------------------------------}
107 instance Arbitrary IntSet where
108 arbitrary = do{ xs <- arbitrary
109 ; return (fromList xs)
110 }
111
112
113 {--------------------------------------------------------------------
114 Single, Member, Insert, Delete, Member, FromList
115 --------------------------------------------------------------------}
116 prop_Single :: Int -> Bool
117 prop_Single x
118 = (insert x empty == singleton x)
119
120 prop_Member :: [Int] -> Int -> Bool
121 prop_Member xs n =
122 let m = fromList xs
123 in all (\k -> k `member` m == (k `elem` xs)) (n : xs)
124
125 prop_NotMember :: [Int] -> Int -> Bool
126 prop_NotMember xs n =
127 let m = fromList xs
128 in all (\k -> k `notMember` m == (k `notElem` xs)) (n : xs)
129
130 test_LookupSomething :: (Int -> IntSet -> Maybe Int) -> (Int -> Int -> Bool) -> [Int] -> Bool
131 test_LookupSomething lookup' cmp xs =
132 let odd_sorted_xs = filter_odd $ nub $ sort xs
133 t = fromList odd_sorted_xs
134 test x = case List.filter (`cmp` x) odd_sorted_xs of
135 [] -> lookup' x t == Nothing
136 cs | 0 `cmp` 1 -> lookup' x t == Just (last cs) -- we want largest such element
137 | otherwise -> lookup' x t == Just (head cs) -- we want smallest such element
138 in all test xs
139
140 where filter_odd [] = []
141 filter_odd [_] = []
142 filter_odd (_ : o : xs) = o : filter_odd xs
143
144 prop_LookupLT :: [Int] -> Bool
145 prop_LookupLT = test_LookupSomething lookupLT (<)
146
147 prop_LookupGT :: [Int] -> Bool
148 prop_LookupGT = test_LookupSomething lookupGT (>)
149
150 prop_LookupLE :: [Int] -> Bool
151 prop_LookupLE = test_LookupSomething lookupLE (<=)
152
153 prop_LookupGE :: [Int] -> Bool
154 prop_LookupGE = test_LookupSomething lookupGE (>=)
155
156 prop_InsertDelete :: Int -> IntSet -> Property
157 prop_InsertDelete k t
158 = not (member k t) ==> delete k (insert k t) == t
159
160 prop_MemberFromList :: [Int] -> Bool
161 prop_MemberFromList xs
162 = all (`member` t) abs_xs && all ((`notMember` t) . negate) abs_xs
163 where abs_xs = [abs x | x <- xs, x /= 0]
164 t = fromList abs_xs
165
166 {--------------------------------------------------------------------
167 Union
168 --------------------------------------------------------------------}
169 prop_UnionInsert :: Int -> IntSet -> Bool
170 prop_UnionInsert x t
171 = union t (singleton x) == insert x t
172
173 prop_UnionAssoc :: IntSet -> IntSet -> IntSet -> Bool
174 prop_UnionAssoc t1 t2 t3
175 = union t1 (union t2 t3) == union (union t1 t2) t3
176
177 prop_UnionComm :: IntSet -> IntSet -> Bool
178 prop_UnionComm t1 t2
179 = (union t1 t2 == union t2 t1)
180
181 prop_Diff :: [Int] -> [Int] -> Bool
182 prop_Diff xs ys
183 = toAscList (difference (fromList xs) (fromList ys))
184 == List.sort ((List.\\) (nub xs) (nub ys))
185
186 prop_Int :: [Int] -> [Int] -> Bool
187 prop_Int xs ys
188 = toAscList (intersection (fromList xs) (fromList ys))
189 == List.sort (nub ((List.intersect) (xs) (ys)))
190
191 {--------------------------------------------------------------------
192 Lists
193 --------------------------------------------------------------------}
194 prop_Ordered
195 = forAll (choose (5,100)) $ \n ->
196 let xs = concat [[i-n,i-n]|i<-[0..2*n :: Int]]
197 in fromAscList xs == fromList xs
198
199 prop_List :: [Int] -> Bool
200 prop_List xs
201 = (sort (nub xs) == toAscList (fromList xs))
202
203 prop_DescList :: [Int] -> Bool
204 prop_DescList xs = (reverse (sort (nub xs)) == toDescList (fromList xs))
205
206 prop_AscDescList :: [Int] -> Bool
207 prop_AscDescList xs = toAscList s == reverse (toDescList s)
208 where s = fromList xs
209
210 prop_fromList :: [Int] -> Bool
211 prop_fromList xs
212 = case fromList xs of
213 t -> t == fromAscList sort_xs &&
214 t == fromDistinctAscList nub_sort_xs &&
215 t == List.foldr insert empty xs
216 where sort_xs = sort xs
217 nub_sort_xs = List.map List.head $ List.group sort_xs
218
219 {--------------------------------------------------------------------
220 Bin invariants
221 --------------------------------------------------------------------}
222 powersOf2 :: IntSet
223 powersOf2 = fromList [2^i | i <- [0..63]]
224
225 -- Check the invariant that the mask is a power of 2.
226 prop_MaskPow2 :: IntSet -> Bool
227 prop_MaskPow2 (Bin _ msk left right) = member msk powersOf2 && prop_MaskPow2 left && prop_MaskPow2 right
228 prop_MaskPow2 _ = True
229
230 -- Check that the prefix satisfies its invariant.
231 prop_Prefix :: IntSet -> Bool
232 prop_Prefix s@(Bin prefix msk left right) = all (\elem -> match elem prefix msk) (toList s) && prop_Prefix left && prop_Prefix right
233 prop_Prefix _ = True
234
235 -- Check that the left elements don't have the mask bit set, and the right
236 -- ones do.
237 prop_LeftRight :: IntSet -> Bool
238 prop_LeftRight (Bin _ msk left right) = and [x .&. msk == 0 | x <- toList left] && and [x .&. msk == msk | x <- toList right]
239 prop_LeftRight _ = True
240
241 {--------------------------------------------------------------------
242 IntSet operations are like Set operations
243 --------------------------------------------------------------------}
244 toSet :: IntSet -> Set.Set Int
245 toSet = Set.fromList . toList
246
247 -- Check that IntSet.isProperSubsetOf is the same as Set.isProperSubsetOf.
248 prop_isProperSubsetOf :: IntSet -> IntSet -> Bool
249 prop_isProperSubsetOf a b = isProperSubsetOf a b == Set.isProperSubsetOf (toSet a) (toSet b)
250
251 -- In the above test, isProperSubsetOf almost always returns False (since a
252 -- random set is almost never a subset of another random set). So this second
253 -- test checks the True case.
254 prop_isProperSubsetOf2 :: IntSet -> IntSet -> Bool
255 prop_isProperSubsetOf2 a b = isProperSubsetOf a c == (a /= c) where
256 c = union a b
257
258 prop_isSubsetOf :: IntSet -> IntSet -> Bool
259 prop_isSubsetOf a b = isSubsetOf a b == Set.isSubsetOf (toSet a) (toSet b)
260
261 prop_isSubsetOf2 :: IntSet -> IntSet -> Bool
262 prop_isSubsetOf2 a b = isSubsetOf a (union a b)
263
264 prop_size :: IntSet -> Bool
265 prop_size s = size s == List.length (toList s)
266
267 prop_findMax :: IntSet -> Property
268 prop_findMax s = not (null s) ==> findMax s == maximum (toList s)
269
270 prop_findMin :: IntSet -> Property
271 prop_findMin s = not (null s) ==> findMin s == minimum (toList s)
272
273 prop_ord :: IntSet -> IntSet -> Bool
274 prop_ord s1 s2 = s1 `compare` s2 == toList s1 `compare` toList s2
275
276 prop_readShow :: IntSet -> Bool
277 prop_readShow s = s == read (show s)
278
279 prop_foldR :: IntSet -> Bool
280 prop_foldR s = foldr (:) [] s == toList s
281
282 prop_foldR' :: IntSet -> Bool
283 prop_foldR' s = foldr' (:) [] s == toList s
284
285 prop_foldL :: IntSet -> Bool
286 prop_foldL s = foldl (flip (:)) [] s == List.foldl (flip (:)) [] (toList s)
287
288 prop_foldL' :: IntSet -> Bool
289 prop_foldL' s = foldl' (flip (:)) [] s == List.foldl' (flip (:)) [] (toList s)
290
291 prop_map :: IntSet -> Bool
292 prop_map s = map id s == s
293
294 prop_maxView :: IntSet -> Bool
295 prop_maxView s = case maxView s of
296 Nothing -> null s
297 Just (m,s') -> m == maximum (toList s) && s == insert m s' && m `notMember` s'
298
299 prop_minView :: IntSet -> Bool
300 prop_minView s = case minView s of
301 Nothing -> null s
302 Just (m,s') -> m == minimum (toList s) && s == insert m s' && m `notMember` s'
303
304 prop_split :: IntSet -> Int -> Bool
305 prop_split s i = case split i s of
306 (s1,s2) -> all (<i) (toList s1) && all (>i) (toList s2) && i `delete` s == union s1 s2
307
308 prop_splitMember :: IntSet -> Int -> Bool
309 prop_splitMember s i = case splitMember i s of
310 (s1,t,s2) -> all (<i) (toList s1) && all (>i) (toList s2) && t == i `member` s && i `delete` s == union s1 s2
311
312 prop_splitRoot :: IntSet -> Bool
313 prop_splitRoot s = (s == unions (splitRoot s))
314
315 prop_partition :: IntSet -> Int -> Bool
316 prop_partition s i = case partition odd s of
317 (s1,s2) -> all odd (toList s1) && all even (toList s2) && s == s1 `union` s2
318
319 prop_filter :: IntSet -> Int -> Bool
320 prop_filter s i = partition odd s == (filter odd s, filter even s)
321
322 #if MIN_VERSION_base(4,5,0)
323 prop_bitcount :: Int -> Word -> Bool
324 prop_bitcount a w = bitcount_orig a w == bitcount_new a w
325 where
326 bitcount_orig a0 x0 = go a0 x0
327 where go a 0 = a
328 go a x = go (a + 1) (x .&. (x-1))
329 bitcount_new a x = a + popCount x
330 #endif