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