File: HashSetProperties.hs

package info (click to toggle)
haskell-unordered-containers 0.2.1.0-1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 172 kB
  • sloc: haskell: 1,880; ansic: 267; makefile: 2
file content (164 lines) | stat: -rw-r--r-- 4,948 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Tests for the 'Data.HashSet' module.  We test functions by
-- comparing them to a simpler model, a list.

module Main (main) where

import qualified Data.Foldable as Foldable
import Data.Hashable (Hashable(hash))
import qualified Data.List as L
import qualified Data.HashSet as S
import qualified Data.Set as Set
import Test.QuickCheck (Arbitrary)
import Test.Framework (Test, defaultMain, testGroup)
import Test.Framework.Providers.QuickCheck2 (testProperty)

-- Key type that generates more hash collisions.
newtype Key = K { unK :: Int }
            deriving (Arbitrary, Enum, Eq, Integral, Num, Ord, Show, Real)

instance Hashable Key where
    hash k = hash (unK k) `mod` 20

------------------------------------------------------------------------
-- * Properties

------------------------------------------------------------------------
-- ** Instances

pEq :: [Key] -> [Key] -> Bool
pEq xs = (Set.fromList xs ==) `eq` (S.fromList xs ==)

pNeq :: [Key] -> [Key] -> Bool
pNeq xs = (Set.fromList xs /=) `eq` (S.fromList xs /=)

pFoldable :: [Int] -> Bool
pFoldable = (L.sort . Foldable.foldr (:) []) `eq`
            (L.sort . Foldable.foldr (:) [])

------------------------------------------------------------------------
-- ** Basic interface

pSize :: [Key] -> Bool
pSize = Set.size `eq` S.size

pMember :: Key -> [Key] -> Bool
pMember k = Set.member k `eq` S.member k

pInsert :: Key -> [Key] -> Bool
pInsert a = Set.insert a `eq_` S.insert a

pDelete :: Key -> [Key] -> Bool
pDelete a = Set.delete a `eq_` S.delete a

------------------------------------------------------------------------
-- ** Combine

pUnion :: [Key] -> [Key] -> Bool
pUnion xs ys = Set.union (Set.fromList xs) `eq_`
               S.union (S.fromList xs) $ ys

------------------------------------------------------------------------
-- ** Transformations

pMap :: [Key] -> Bool
pMap = Set.map (+ 1) `eq_` S.map (+ 1)

------------------------------------------------------------------------
-- ** Folds

pFoldr :: [Int] -> Bool
pFoldr = (L.sort . Set.foldr (:) []) `eq`
         (L.sort . S.foldr (:) [])

pFoldl' :: Int -> [Int] -> Bool
pFoldl' z0 = Set.foldl' (+) z0 `eq` S.foldl' (+) z0

------------------------------------------------------------------------
-- ** Filter

pFilter :: [Key] -> Bool
pFilter = Set.filter odd `eq_` S.filter odd

------------------------------------------------------------------------
-- ** Conversions

pToList :: [Key] -> Bool
pToList = Set.toAscList `eq` toAscList

------------------------------------------------------------------------
-- * Test list

tests :: [Test]
tests =
    [
    -- Instances
      testGroup "instances"
      [ testProperty "==" pEq
      , testProperty "/=" pNeq
      , testProperty "Foldable" pFoldable
      ]
    -- Basic interface
    , testGroup "basic interface"
      [ testProperty "size" pSize
      , testProperty "member" pMember
      , testProperty "insert" pInsert
      , testProperty "delete" pDelete
      ]
    -- Combine
    , testProperty "union" pUnion
    -- Transformations
    , testProperty "map" pMap
    -- Folds
    , testGroup "folds"
      [ testProperty "foldr" pFoldr
      , testProperty "foldl'" pFoldl'
      ]
    -- Filter
    , testGroup "filter"
      [ testProperty "filter" pFilter
      ]
    -- Conversions
    , testGroup "conversions"
      [ testProperty "toList" pToList
      ]
    ]

------------------------------------------------------------------------
-- * Model

-- Invariant: the list is sorted in ascending order, by key.
type Model a = Set.Set a

-- | Check that a function operating on a 'HashMap' is equivalent to
-- one operating on a 'Model'.
eq :: (Eq a, Hashable a, Ord a, Eq b)
   => (Model a -> b)      -- ^ Function that modifies a 'Model' in the same
                          -- way
   -> (S.HashSet a -> b)  -- ^ Function that modified a 'HashSet'
   -> [a]                 -- ^ Initial content of the 'HashSet' and 'Model'
   -> Bool                -- ^ True if the functions are equivalent
eq f g xs = g (S.fromList xs) == f (Set.fromList xs)

eq_ :: (Eq a, Hashable a, Ord a)
    => (Model a -> Model a)          -- ^ Function that modifies a 'Model'
    -> (S.HashSet a -> S.HashSet a)  -- ^ Function that modified a
                                     -- 'HashSet' in the same way
    -> [a]                           -- ^ Initial content of the 'HashSet'
                                     -- and 'Model'
    -> Bool                          -- ^ True if the functions are
                                     -- equivalent
eq_ f g = (Set.toAscList . f) `eq` (toAscList . g)

------------------------------------------------------------------------
-- * Test harness

main :: IO ()
main = defaultMain tests

------------------------------------------------------------------------
-- * Helpers

toAscList :: Ord a => S.HashSet a -> [a]
toAscList = L.sort . S.toList