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