1{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}
2
3-- | Tests for the 'Data.HashSet' module.  We test functions by
4-- comparing them to a simpler model, a list.
5
6module Main (main) where
7
8import qualified Data.Foldable as Foldable
9import Data.Hashable (Hashable(hashWithSalt))
10import qualified Data.List as L
11import qualified Data.HashSet as S
12import qualified Data.Set as Set
13import Data.Ord (comparing)
14import Test.QuickCheck (Arbitrary, Property, (==>), (===))
15import Test.Framework (Test, defaultMain, testGroup)
16import Test.Framework.Providers.QuickCheck2 (testProperty)
17
18-- Key type that generates more hash collisions.
19newtype Key = K { unK :: Int }
20            deriving (Arbitrary, Enum, Eq, Integral, Num, Ord, Read, Show, Real)
21
22instance Hashable Key where
23    hashWithSalt salt k = hashWithSalt salt (unK k) `mod` 20
24
25------------------------------------------------------------------------
26-- * Properties
27
28------------------------------------------------------------------------
29-- ** Instances
30
31pEq :: [Key] -> [Key] -> Bool
32pEq xs = (Set.fromList xs ==) `eq` (S.fromList xs ==)
33
34pNeq :: [Key] -> [Key] -> Bool
35pNeq xs = (Set.fromList xs /=) `eq` (S.fromList xs /=)
36
37-- We cannot compare to `Data.Map` as ordering is different.
38pOrd1 :: [Key] -> Bool
39pOrd1 xs = compare x x == EQ
40  where
41    x = S.fromList xs
42
43pOrd2 :: [Key] -> [Key] -> [Key] -> Bool
44pOrd2 xs ys zs = case (compare x y, compare y z) of
45    (EQ, o)  -> compare x z == o
46    (o,  EQ) -> compare x z == o
47    (LT, LT) -> compare x z == LT
48    (GT, GT) -> compare x z == GT
49    (LT, GT) -> True -- ys greater than xs and zs.
50    (GT, LT) -> True
51  where
52    x = S.fromList xs
53    y = S.fromList ys
54    z = S.fromList zs
55
56pOrd3 :: [Key] -> [Key] -> Bool
57pOrd3 xs ys = case (compare x y, compare y x) of
58    (EQ, EQ) -> True
59    (LT, GT) -> True
60    (GT, LT) -> True
61    _        -> False
62  where
63    x = S.fromList xs
64    y = S.fromList ys
65
66pOrdEq :: [Key] -> [Key] -> Bool
67pOrdEq xs ys = case (compare x y, x == y) of
68    (EQ, True)  -> True
69    (LT, False) -> True
70    (GT, False) -> True
71    _           -> False
72  where
73    x = S.fromList xs
74    y = S.fromList ys
75
76pReadShow :: [Key] -> Bool
77pReadShow xs = Set.fromList xs == read (show (Set.fromList xs))
78
79pFoldable :: [Int] -> Bool
80pFoldable = (L.sort . Foldable.foldr (:) []) `eq`
81            (L.sort . Foldable.foldr (:) [])
82
83pPermutationEq :: [Key] -> [Int] -> Bool
84pPermutationEq xs is = S.fromList xs == S.fromList ys
85  where
86    ys = shuffle is xs
87    shuffle idxs = L.map snd
88                 . L.sortBy (comparing fst)
89                 . L.zip (idxs ++ [L.maximum (0:is) + 1 ..])
90
91pHashable :: [Key] -> [Int] -> Int -> Property
92pHashable xs is salt =
93    x == y ==> hashWithSalt salt x === hashWithSalt salt y
94  where
95    xs' = L.nub xs
96    ys = shuffle is xs'
97    x = S.fromList xs'
98    y = S.fromList ys
99    shuffle idxs = L.map snd
100                 . L.sortBy (comparing fst)
101                 . L.zip (idxs ++ [L.maximum (0:is) + 1 ..])
102
103------------------------------------------------------------------------
104-- ** Basic interface
105
106pSize :: [Key] -> Bool
107pSize = Set.size `eq` S.size
108
109pMember :: Key -> [Key] -> Bool
110pMember k = Set.member k `eq` S.member k
111
112pInsert :: Key -> [Key] -> Bool
113pInsert a = Set.insert a `eq_` S.insert a
114
115pDelete :: Key -> [Key] -> Bool
116pDelete a = Set.delete a `eq_` S.delete a
117
118------------------------------------------------------------------------
119-- ** Combine
120
121pUnion :: [Key] -> [Key] -> Bool
122pUnion xs ys = Set.union (Set.fromList xs) `eq_`
123               S.union (S.fromList xs) $ ys
124
125------------------------------------------------------------------------
126-- ** Transformations
127
128pMap :: [Key] -> Bool
129pMap = Set.map (+ 1) `eq_` S.map (+ 1)
130
131------------------------------------------------------------------------
132-- ** Folds
133
134pFoldr :: [Int] -> Bool
135pFoldr = (L.sort . foldrSet (:) []) `eq`
136         (L.sort . S.foldr (:) [])
137
138foldrSet :: (a -> b -> b) -> b -> Set.Set a -> b
139#if MIN_VERSION_containers(0,4,2)
140foldrSet = Set.foldr
141#else
142foldrSet = Foldable.foldr
143#endif
144
145pFoldl' :: Int -> [Int] -> Bool
146pFoldl' z0 = foldl'Set (+) z0 `eq` S.foldl' (+) z0
147
148foldl'Set :: (a -> b -> a) -> a -> Set.Set b -> a
149#if MIN_VERSION_containers(0,4,2)
150foldl'Set = Set.foldl'
151#else
152foldl'Set = Foldable.foldl'
153#endif
154
155------------------------------------------------------------------------
156-- ** Filter
157
158pFilter :: [Key] -> Bool
159pFilter = Set.filter odd `eq_` S.filter odd
160
161------------------------------------------------------------------------
162-- ** Conversions
163
164pToList :: [Key] -> Bool
165pToList = Set.toAscList `eq` toAscList
166
167------------------------------------------------------------------------
168-- * Test list
169
170tests :: [Test]
171tests =
172    [
173    -- Instances
174      testGroup "instances"
175      [ testProperty "==" pEq
176      , testProperty "Permutation ==" pPermutationEq
177      , testProperty "/=" pNeq
178      , testProperty "compare reflexive" pOrd1
179      , testProperty "compare transitive" pOrd2
180      , testProperty "compare antisymmetric" pOrd3
181      , testProperty "Ord => Eq" pOrdEq
182      , testProperty "Read/Show" pReadShow
183      , testProperty "Foldable" pFoldable
184      , testProperty "Hashable" pHashable
185      ]
186    -- Basic interface
187    , testGroup "basic interface"
188      [ testProperty "size" pSize
189      , testProperty "member" pMember
190      , testProperty "insert" pInsert
191      , testProperty "delete" pDelete
192      ]
193    -- Combine
194    , testProperty "union" pUnion
195    -- Transformations
196    , testProperty "map" pMap
197    -- Folds
198    , testGroup "folds"
199      [ testProperty "foldr" pFoldr
200      , testProperty "foldl'" pFoldl'
201      ]
202    -- Filter
203    , testGroup "filter"
204      [ testProperty "filter" pFilter
205      ]
206    -- Conversions
207    , testGroup "conversions"
208      [ testProperty "toList" pToList
209      ]
210    ]
211
212------------------------------------------------------------------------
213-- * Model
214
215-- Invariant: the list is sorted in ascending order, by key.
216type Model a = Set.Set a
217
218-- | Check that a function operating on a 'HashMap' is equivalent to
219-- one operating on a 'Model'.
220eq :: (Eq a, Hashable a, Ord a, Eq b)
221   => (Model a -> b)      -- ^ Function that modifies a 'Model' in the same
222                          -- way
223   -> (S.HashSet a -> b)  -- ^ Function that modified a 'HashSet'
224   -> [a]                 -- ^ Initial content of the 'HashSet' and 'Model'
225   -> Bool                -- ^ True if the functions are equivalent
226eq f g xs = g (S.fromList xs) == f (Set.fromList xs)
227
228eq_ :: (Eq a, Hashable a, Ord a)
229    => (Model a -> Model a)          -- ^ Function that modifies a 'Model'
230    -> (S.HashSet a -> S.HashSet a)  -- ^ Function that modified a
231                                     -- 'HashSet' in the same way
232    -> [a]                           -- ^ Initial content of the 'HashSet'
233                                     -- and 'Model'
234    -> Bool                          -- ^ True if the functions are
235                                     -- equivalent
236eq_ f g = (Set.toAscList . f) `eq` (toAscList . g)
237
238------------------------------------------------------------------------
239-- * Test harness
240
241main :: IO ()
242main = defaultMain tests
243
244------------------------------------------------------------------------
245-- * Helpers
246
247toAscList :: Ord a => S.HashSet a -> [a]
248toAscList = L.sort . S.toList
249