Nicer properties and QuickCheck2
[darcs-mirrors/vector.git] / tests / Properties.hs
1 module Properties (tests) where
2
3 import Boilerplater
4 import Utilities
5
6 import qualified Data.Vector.Generic as V
7 import qualified Data.Vector
8 import qualified Data.Vector.Primitive
9 import qualified Data.Vector.Fusion.Stream as S
10
11 import Test.QuickCheck
12
13 import Test.Framework
14 import Test.Framework.Providers.QuickCheck2
15
16 import Text.Show.Functions ()
17 import Data.List (foldl', foldl1', unfoldr, find, findIndex)
18
19 #define COMMON_CONTEXT(a, v) \
20 VANILLA_CONTEXT(a, v), VECTOR_CONTEXT(a, v)
21
22 #define VANILLA_CONTEXT(a, v) \
23 Eq a, Show a, Arbitrary a, CoArbitrary a, Modelled a, Model a ~ a, EqTestable a (Pty a), Pty a ~ Property
24
25 #define VECTOR_CONTEXT(a, v) \
26 Eq (v a), Show (v a), Arbitrary (v a), CoArbitrary (v a), Modelled (v a), Model (v a) ~ [a], EqTestable (v a) (Pty (v a)), Pty (v a) ~ Property, V.Vector v a
27
28 -- TODO: implement Vector equivalents of list functions for some of the commented out properties
29
30 -- TODO: test and implement some of these other Prelude functions:
31 -- mapM *
32 -- mapM_ *
33 -- sequence
34 -- sequence_
35 -- sum *
36 -- product *
37 -- scanl *
38 -- scanl1 *
39 -- scanr *
40 -- scanr1 *
41 -- lookup *
42 -- lines
43 -- words
44 -- unlines
45 -- unwords
46 -- NB: this is an exhaustive list of all Prelude list functions that make sense for vectors.
47 -- Ones with *s are the most plausible candidates.
48
49 -- TODO: add tests for the other extra functions
50 -- IVector exports still needing tests:
51 -- copy,
52 -- slice,
53 -- (//), update, bpermute,
54 -- prescanl, prescanl',
55 -- new,
56 -- unsafeSlice, unsafeIndex,
57 -- vlength, vnew
58
59 -- TODO: test non-IVector stuff?
60
61 testSanity :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test]
62 testSanity _ = [
63 testProperty "fromList.toList == id" prop_fromList_toList,
64 testProperty "toList.fromList == id" prop_toList_fromList,
65 testProperty "unstream.stream == id" prop_unstream_stream,
66 testProperty "stream.unstream == id" prop_stream_unstream
67 ]
68 where
69 prop_fromList_toList (v :: v a) = (V.fromList . V.toList) v == v
70 prop_toList_fromList (l :: [a]) = ((V.toList :: v a -> [a]) . V.fromList) l == l
71 prop_unstream_stream (v :: v a) = (V.unstream . V.stream) v == v
72 prop_stream_unstream (s :: S.Stream a) = ((V.stream :: v a -> S.Stream a) . V.unstream) s == s
73
74 testPolymorphicFunctions :: forall a v. (COMMON_CONTEXT(a, v), VECTOR_CONTEXT(Int, v)) => v a -> [Test]
75 testPolymorphicFunctions _ = $(testProperties [
76 'prop_eq,
77
78 'prop_length, 'prop_null,
79
80 'prop_empty, 'prop_singleton, 'prop_replicate,
81 'prop_cons, 'prop_snoc, 'prop_append, 'prop_copy,
82
83 'prop_head, 'prop_last, 'prop_index,
84
85 {- 'prop_slice, -} 'prop_init, 'prop_tail, 'prop_take, 'prop_drop,
86
87 {- 'prop_accum, 'prop_write, 'prop_backpermute, -} 'prop_reverse,
88
89 'prop_map, 'prop_zipWith, 'prop_zipWith3,
90 'prop_filter, 'prop_takeWhile, 'prop_dropWhile,
91
92 'prop_elem, 'prop_notElem,
93 'prop_find, 'prop_findIndex,
94
95 'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1',
96 'prop_foldr, 'prop_foldr1,
97
98 'prop_prescanl, 'prop_prescanl',
99 'prop_postscanl, 'prop_postscanl',
100 'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1',
101
102 'prop_concatMap,
103 'prop_unfoldr
104 ])
105 where
106 -- Prelude
107 prop_eq :: P (v a -> v a -> Bool) = (==) `eq` (==)
108
109 prop_length :: P (v a -> Int) = V.length `eq` length
110 prop_null :: P (v a -> Bool) = V.null `eq` null
111
112 prop_empty :: P (v a) = V.empty `eq` []
113 prop_singleton :: P (a -> v a) = V.singleton `eq` singleton
114 prop_replicate :: P (Int -> a -> v a) = (\n _ -> n< 1000) ===> V.replicate `eq` replicate
115 prop_cons :: P (a -> v a -> v a) = V.cons `eq` (:)
116 prop_snoc :: P (v a -> a -> v a) = V.snoc `eq` snoc
117 prop_append :: P (v a -> v a -> v a) = (V.++) `eq` (++)
118 prop_copy :: P (v a -> v a) = V.copy `eq` id
119
120 prop_head = not . V.null ===>
121 (V.head :: v a -> a) `eq` head
122 prop_last = not . V.null ===>
123 (V.last :: v a -> a) `eq` last
124 prop_index = forAll arbitrary $ \xs ->
125 not (V.null xs) ==>
126 forAll (choose (0, V.length xs-1)) $ \i ->
127 unP prop xs i
128 where
129 prop :: P (v a -> Int -> a) = (V.!) `eq` (!!)
130
131
132 prop_slice = forAll arbitrary $ \xs ->
133 forAll (choose (0, V.length xs)) $ \i ->
134 forAll (choose (0, V.length xs - i)) $ \n ->
135 unP prop xs i n
136 where
137 prop :: P (v a -> Int -> Int -> v a) = V.slice `eq` slice
138
139 prop_tail = not . V.null ===>
140 (V.tail :: v a -> v a) `eq` tail
141 prop_init = not . V.null ===>
142 (V.init :: v a -> v a) `eq` init
143 prop_take = (V.take :: Int -> v a -> v a) `eq` take
144 prop_drop = (V.drop :: Int -> v a -> v a) `eq` drop
145
146 --prop_accum = forAll arbitrary $ \f ->
147 -- forAll arbitrary $ \xs ->
148 -- forAll (index_value_pairs (V.length xs)) $ \ps ->
149 -- ((V.accum :: (a -> a -> a) -> v a -> [(Int,a)] -> v a)
150 -- `eq` accum) f xs ps
151 --prop_write = forAll arbitrary $ \xs ->
152 -- forAll (index_value_pairs (V.length xs)) $ \ps ->
153 -- (((V.//) :: v a -> [(Int,a)] -> v a) `eq` (//)) xs ps
154 --prop_backpermute = forAll arbitrary $ \xs ->
155 -- forAll (indices (V.length xs)) $ \is ->
156 -- ((V.backpermute :: v a -> v Int -> v a) `eq` backpermute)
157 -- xs (V.fromList is)
158 prop_reverse = (V.reverse :: v a -> v a) `eq` reverse
159
160 prop_map = (V.map :: (a -> a) -> v a -> v a) `eq` map
161 prop_zipWith = (V.zipWith :: (a -> a -> a) -> v a -> v a -> v a) `eq` zipWith
162 prop_zipWith3 = (V.zipWith3 :: (a -> a -> a -> a) -> v a -> v a -> v a -> v a) `eq` zipWith3
163
164 prop_filter = (V.filter :: (a -> Bool) -> v a -> v a) `eq` filter
165 prop_takeWhile = (V.takeWhile :: (a -> Bool) -> v a -> v a) `eq` takeWhile
166 prop_dropWhile = (V.dropWhile :: (a -> Bool) -> v a -> v a) `eq` dropWhile
167
168 prop_elem = (V.elem :: a -> v a -> Bool) `eq` elem
169 prop_notElem = (V.notElem :: a -> v a -> Bool) `eq` notElem
170 prop_find = (V.find :: (a -> Bool) -> v a -> Maybe a) `eq` find
171 prop_findIndex = (V.findIndex :: (a -> Bool) -> v a -> Maybe Int) `eq` findIndex
172
173 prop_foldl = (V.foldl :: (a -> a -> a) -> a -> v a -> a) `eq` foldl
174 prop_foldl1 = notNull2 ===>
175 (V.foldl1 :: (a -> a -> a) -> v a -> a) `eq` foldl1
176 prop_foldl' = (V.foldl' :: (a -> a -> a) -> a -> v a -> a) `eq` foldl'
177 prop_foldl1' = notNull2 ===>
178 (V.foldl1' :: (a -> a -> a) -> v a -> a) `eq` foldl1'
179 prop_foldr = (V.foldr :: (a -> a -> a) -> a -> v a -> a) `eq` foldr
180 prop_foldr1 = notNull2 ===>
181 (V.foldr1 :: (a -> a -> a) -> v a -> a) `eq` foldr1
182
183 prop_prescanl = (V.prescanl :: (a -> a -> a) -> a -> v a -> v a) `eq` prescanl
184 prop_prescanl' = (V.prescanl' :: (a -> a -> a) -> a -> v a -> v a) `eq` prescanl
185 prop_postscanl = (V.postscanl :: (a -> a -> a) -> a -> v a -> v a) `eq` postscanl
186 prop_postscanl' = (V.postscanl' :: (a -> a -> a) -> a -> v a -> v a) `eq` postscanl
187 prop_scanl = (V.scanl :: (a -> a -> a) -> a -> v a -> v a) `eq` scanl
188 prop_scanl' = (V.scanl' :: (a -> a -> a) -> a -> v a -> v a) `eq` scanl
189 prop_scanl1 = notNull2 ===>
190 (V.scanl1 :: (a -> a -> a) -> v a -> v a) `eq` scanl1
191 prop_scanl1' = notNull2 ===>
192 (V.scanl1' :: (a -> a -> a) -> v a -> v a) `eq` scanl1
193
194 prop_concatMap = forAll arbitrary $ \xs ->
195 forAll (sized (\n -> resize (n `div` V.length xs) arbitrary)) $ \f -> unP prop f xs
196 where
197 prop :: P ((a -> v a) -> v a -> v a) = V.concatMap `eq` concatMap
198
199 --prop_span = (V.span :: (a -> Bool) -> v a -> (v a, v a)) `eq2` span
200 --prop_break = (V.break :: (a -> Bool) -> v a -> (v a, v a)) `eq2` break
201 --prop_splitAt = (V.splitAt :: Int -> v a -> (v a, v a)) `eq2` splitAt
202 --prop_all = (V.all :: (a -> Bool) -> v a -> Bool) `eq2` all
203 --prop_any = (V.any :: (a -> Bool) -> v a -> Bool) `eq2` any
204
205 -- Data.List
206 --prop_findIndices = V.findIndices `eq2` (findIndices :: (a -> Bool) -> v a -> v Int)
207 --prop_isPrefixOf = V.isPrefixOf `eq2` (isPrefixOf :: v a -> v a -> Bool)
208 --prop_elemIndex = V.elemIndex `eq2` (elemIndex :: a -> v a -> Maybe Int)
209 --prop_elemIndices = V.elemIndices `eq2` (elemIndices :: a -> v a -> v Int)
210 --
211 --prop_mapAccumL = eq3
212 -- (V.mapAccumL :: (X -> W -> (X,W)) -> X -> B -> (X, B))
213 -- ( mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))
214 --
215 --prop_mapAccumR = eq3
216 -- (V.mapAccumR :: (X -> W -> (X,W)) -> X -> B -> (X, B))
217 -- ( mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))
218
219 -- Because the vectors are strict, we need to be totally sure that the unfold eventually terminates. This
220 -- is achieved by injecting our own bit of state into the unfold - the maximum number of unfolds allowed.
221 limitUnfolds f (theirs, ours) | ours >= 0
222 , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))
223 | otherwise = Nothing
224 prop_unfoldr = ((\n f a -> V.unfoldr (limitUnfolds f) (a, n)) :: Int -> ((Int, Int) -> Maybe (a, (Int, Int))) -> (Int, Int) -> v a)
225 `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n))
226
227
228 testTuplyFunctions:: forall a v. (COMMON_CONTEXT(a, v), VECTOR_CONTEXT((a, a), v), VECTOR_CONTEXT((a, a, a), v)) => v a -> [Test]
229 testTuplyFunctions _ = $(testProperties ['prop_zip, 'prop_zip3, 'prop_unzip, 'prop_unzip3])
230 where
231 prop_zip = (V.zip :: v a -> v a -> v (a, a)) `eq` zip
232 prop_zip3 = (V.zip3 :: v a -> v a -> v a -> v (a, a, a)) `eq` zip3
233 prop_unzip = (V.unzip :: v (a, a) -> (v a, v a)) `eq` unzip
234 prop_unzip3 = (V.unzip3 :: v (a, a, a) -> (v a, v a, v a)) `eq` unzip3
235
236 testOrdFunctions :: forall a v. (COMMON_CONTEXT(a, v), Ord a, Ord (v a)) => v a -> [Test]
237 testOrdFunctions _ = $(testProperties ['prop_compare, 'prop_maximum, 'prop_minimum])
238 where
239 prop_compare = (compare :: v a -> v a -> Ordering) `eq` compare
240 prop_maximum = not . V.null ===>
241 (V.maximum :: v a -> a) `eq` maximum
242 prop_minimum = not . V.null ===>
243 (V.minimum :: v a -> a) `eq` minimum
244
245 testEnumFunctions :: forall a v. (COMMON_CONTEXT(a, v), Enum a, Ord a, Num a) => v a -> [Test]
246 testEnumFunctions _ = $(testProperties ['prop_enumFromTo {- 'prop_enumFromThenTo -}])
247 where
248 prop_enumFromTo = forAll arbitrary $ \m ->
249 forAll (elements [-2 .. 100]) $ \n ->
250 unP prop m (m+n)
251 where
252 prop :: P (a -> a -> v a) = V.enumFromTo `eq` enumFromTo
253 -- prop_enumFromThenTo = \i j n -> fromEnum i < fromEnum j ==> ((V.enumFromThenTo :: a -> a -> a -> v a) `eq` enumFromThenTo) i j n
254
255 testBoolFunctions :: forall v. (COMMON_CONTEXT(Bool, v)) => v Bool -> [Test]
256 testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or])
257 where
258 prop_and = (V.and :: v Bool -> Bool) `eq` and
259 prop_or = (V.or :: v Bool -> Bool) `eq` or
260
261 testNumFunctions :: forall a v. (COMMON_CONTEXT(a, v), Num a) => v a -> [Test]
262 testNumFunctions _ = $(testProperties ['prop_sum, 'prop_product])
263 where
264 prop_sum = (V.sum :: v a -> a) `eq` sum
265 prop_product = (V.product :: v a -> a) `eq` product
266
267 testNestedVectorFunctions :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test]
268 testNestedVectorFunctions _ = $(testProperties [])
269 where
270 -- Prelude
271 --prop_concat = (V.concat :: [v a] -> v a) `eq1` concat
272
273 -- Data.List
274 --prop_transpose = V.transpose `eq1` (transpose :: [v a] -> [v a])
275 --prop_group = V.group `eq1` (group :: v a -> [v a])
276 --prop_inits = V.inits `eq1` (inits :: v a -> [v a])
277 --prop_tails = V.tails `eq1` (tails :: v a -> [v a])
278
279
280 testGeneralBoxedVector dummy = concatMap ($ dummy) [
281 testSanity,
282 testPolymorphicFunctions,
283 testOrdFunctions,
284 testTuplyFunctions,
285 testNestedVectorFunctions
286 ]
287
288 testBoolBoxedVector dummy = testGeneralBoxedVector dummy ++ testBoolFunctions dummy
289 testNumericBoxedVector dummy = testGeneralBoxedVector dummy ++ testNumFunctions dummy ++ testEnumFunctions dummy
290
291 testGeneralPrimitiveVector dummy = concatMap ($ dummy) [
292 testSanity,
293 testPolymorphicFunctions,
294 testOrdFunctions
295 ]
296
297 testBoolPrimitiveVector dummy = testGeneralPrimitiveVector dummy ++ testBoolFunctions dummy
298 testNumericPrimitiveVector dummy = testGeneralPrimitiveVector dummy ++ testNumFunctions dummy ++ testEnumFunctions dummy
299
300 tests = [
301 testGroup "Data.Vector.Vector (Bool)" (testBoolBoxedVector (undefined :: Data.Vector.Vector Bool)),
302 testGroup "Data.Vector.Vector (Int)" (testNumericBoxedVector (undefined :: Data.Vector.Vector Int)),
303 testGroup "Data.Vector.Primitive.Vector (Int)" (testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Int)),
304 testGroup "Data.Vector.Primitive.Vector (Float)" (testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Float)),
305 testGroup "Data.Vector.Primitive.Vector (Double)" (testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Double))
306 ]