D.V.Unboxed tests
[darcs-mirrors/vector.git] / tests / Tests / Vector.hs
1 module Tests.Vector (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.Storable
10 import qualified Data.Vector.Unboxed
11 import qualified Data.Vector.Fusion.Stream as S
12
13 import Test.QuickCheck
14
15 import Test.Framework
16 import Test.Framework.Providers.QuickCheck2
17
18 import Text.Show.Functions ()
19 import Data.List
20 import System.Random (Random)
21
22 #define COMMON_CONTEXT(a, v) \
23 VANILLA_CONTEXT(a, v), VECTOR_CONTEXT(a, v)
24
25 #define VANILLA_CONTEXT(a, v) \
26 Eq a, Show a, Arbitrary a, CoArbitrary a, TestData a, Model a ~ a, EqTest a ~ Property
27
28 #define VECTOR_CONTEXT(a, v) \
29 Eq (v a), Show (v a), Arbitrary (v a), CoArbitrary (v a), TestData (v a), Model (v a) ~ [a], EqTest (v a) ~ Property, V.Vector v a
30
31 -- TODO: implement Vector equivalents of list functions for some of the commented out properties
32
33 -- TODO: test and implement some of these other Prelude functions:
34 -- mapM *
35 -- mapM_ *
36 -- sequence
37 -- sequence_
38 -- sum *
39 -- product *
40 -- scanl *
41 -- scanl1 *
42 -- scanr *
43 -- scanr1 *
44 -- lookup *
45 -- lines
46 -- words
47 -- unlines
48 -- unwords
49 -- NB: this is an exhaustive list of all Prelude list functions that make sense for vectors.
50 -- Ones with *s are the most plausible candidates.
51
52 -- TODO: add tests for the other extra functions
53 -- IVector exports still needing tests:
54 -- copy,
55 -- slice,
56 -- (//), update, bpermute,
57 -- prescanl, prescanl',
58 -- new,
59 -- unsafeSlice, unsafeIndex,
60 -- vlength, vnew
61
62 -- TODO: test non-IVector stuff?
63
64 testSanity :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test]
65 testSanity _ = [
66 testProperty "fromList.toList == id" prop_fromList_toList,
67 testProperty "toList.fromList == id" prop_toList_fromList,
68 testProperty "unstream.stream == id" prop_unstream_stream,
69 testProperty "stream.unstream == id" prop_stream_unstream
70 ]
71 where
72 prop_fromList_toList (v :: v a) = (V.fromList . V.toList) v == v
73 prop_toList_fromList (l :: [a]) = ((V.toList :: v a -> [a]) . V.fromList) l == l
74 prop_unstream_stream (v :: v a) = (V.unstream . V.stream) v == v
75 prop_stream_unstream (s :: S.Stream a) = ((V.stream :: v a -> S.Stream a) . V.unstream) s == s
76
77 testPolymorphicFunctions :: forall a v. (COMMON_CONTEXT(a, v), VECTOR_CONTEXT(Int, v)) => v a -> [Test]
78 testPolymorphicFunctions _ = $(testProperties [
79 'prop_eq,
80
81 'prop_length, 'prop_null,
82
83 'prop_empty, 'prop_singleton, 'prop_replicate,
84 'prop_cons, 'prop_snoc, 'prop_append, 'prop_copy, 'prop_generate,
85
86 'prop_head, 'prop_last, 'prop_index,
87 'prop_unsafeHead, 'prop_unsafeLast, 'prop_unsafeIndex,
88
89 'prop_slice, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop,
90
91 'prop_accum, 'prop_upd, 'prop_backpermute, 'prop_reverse,
92
93 'prop_map, 'prop_zipWith, 'prop_zipWith3,
94 'prop_imap, 'prop_izipWith, 'prop_izipWith3,
95
96 'prop_filter, 'prop_ifilter, 'prop_takeWhile, 'prop_dropWhile,
97 'prop_span, 'prop_break,
98
99 'prop_elem, 'prop_notElem,
100 'prop_find, 'prop_findIndex, 'prop_findIndices,
101 'prop_elemIndex, 'prop_elemIndices,
102
103 'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1',
104 'prop_foldr, 'prop_foldr1,
105 'prop_ifoldl, 'prop_ifoldl', 'prop_ifoldr,
106
107 'prop_all, 'prop_any,
108
109 'prop_prescanl, 'prop_prescanl',
110 'prop_postscanl, 'prop_postscanl',
111 'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1',
112
113 'prop_prescanr, 'prop_prescanr',
114 'prop_postscanr, 'prop_postscanr',
115 'prop_scanr, 'prop_scanr', 'prop_scanr1, 'prop_scanr1',
116
117 'prop_concatMap,
118 'prop_unfoldr
119 ])
120 where
121 -- Prelude
122 prop_eq :: P (v a -> v a -> Bool) = (==) `eq` (==)
123
124 prop_length :: P (v a -> Int) = V.length `eq` length
125 prop_null :: P (v a -> Bool) = V.null `eq` null
126
127 prop_empty :: P (v a) = V.empty `eq` []
128 prop_singleton :: P (a -> v a) = V.singleton `eq` singleton
129 prop_replicate :: P (Int -> a -> v a)
130 = (\n _ -> n < 1000) ===> V.replicate `eq` replicate
131 prop_cons :: P (a -> v a -> v a) = V.cons `eq` (:)
132 prop_snoc :: P (v a -> a -> v a) = V.snoc `eq` snoc
133 prop_append :: P (v a -> v a -> v a) = (V.++) `eq` (++)
134 prop_copy :: P (v a -> v a) = V.copy `eq` id
135 prop_generate :: P (Int -> (Int -> a) -> v a)
136 = (\n _ -> n < 1000) ===> V.generate `eq` generate
137
138 prop_head :: P (v a -> a) = not . V.null ===> V.head `eq` head
139 prop_last :: P (v a -> a) = not . V.null ===> V.last `eq` last
140 prop_index = \xs ->
141 not (V.null xs) ==>
142 forAll (choose (0, V.length xs-1)) $ \i ->
143 unP prop xs i
144 where
145 prop :: P (v a -> Int -> a) = (V.!) `eq` (!!)
146 prop_unsafeHead :: P (v a -> a) = not . V.null ===> V.unsafeHead `eq` head
147 prop_unsafeLast :: P (v a -> a) = not . V.null ===> V.unsafeLast `eq` last
148 prop_unsafeIndex = \xs ->
149 not (V.null xs) ==>
150 forAll (choose (0, V.length xs-1)) $ \i ->
151 unP prop xs i
152 where
153 prop :: P (v a -> Int -> a) = V.unsafeIndex `eq` (!!)
154
155 prop_slice = \xs ->
156 forAll (choose (0, V.length xs)) $ \i ->
157 forAll (choose (0, V.length xs - i)) $ \n ->
158 unP prop i n xs
159 where
160 prop :: P (Int -> Int -> v a -> v a) = V.slice `eq` slice
161
162 prop_tail :: P (v a -> v a) = not . V.null ===> V.tail `eq` tail
163 prop_init :: P (v a -> v a) = not . V.null ===> V.init `eq` init
164 prop_take :: P (Int -> v a -> v a) = V.take `eq` take
165 prop_drop :: P (Int -> v a -> v a) = V.drop `eq` drop
166
167 prop_accum = \f xs ->
168 forAll (index_value_pairs (V.length xs)) $ \ps ->
169 unP prop f xs ps
170 where
171 prop :: P ((a -> a -> a) -> v a -> [(Int,a)] -> v a)
172 = V.accum `eq` accum
173
174 prop_upd = \xs ->
175 forAll (index_value_pairs (V.length xs)) $ \ps ->
176 unP prop xs ps
177 where
178 prop :: P (v a -> [(Int,a)] -> v a) = (V.//) `eq` (//)
179
180 prop_backpermute = \xs ->
181 forAll (indices (V.length xs)) $ \is ->
182 unP prop xs (V.fromList is)
183 where
184 prop :: P (v a -> v Int -> v a) = V.backpermute `eq` backpermute
185
186 prop_reverse :: P (v a -> v a) = V.reverse `eq` reverse
187
188 prop_map :: P ((a -> a) -> v a -> v a) = V.map `eq` map
189 prop_zipWith :: P ((a -> a -> a) -> v a -> v a -> v a) = V.zipWith `eq` zipWith
190 prop_zipWith3 :: P ((a -> a -> a -> a) -> v a -> v a -> v a -> v a)
191 = V.zipWith3 `eq` zipWith3
192 prop_imap :: P ((Int -> a -> a) -> v a -> v a) = V.imap `eq` imap
193 prop_izipWith :: P ((Int -> a -> a -> a) -> v a -> v a -> v a) = V.izipWith `eq` izipWith
194 prop_izipWith3 :: P ((Int -> a -> a -> a -> a) -> v a -> v a -> v a -> v a)
195 = V.izipWith3 `eq` izipWith3
196
197 prop_filter :: P ((a -> Bool) -> v a -> v a) = V.filter `eq` filter
198 prop_ifilter :: P ((Int -> a -> Bool) -> v a -> v a) = V.ifilter `eq` ifilter
199 prop_takeWhile :: P ((a -> Bool) -> v a -> v a) = V.takeWhile `eq` takeWhile
200 prop_dropWhile :: P ((a -> Bool) -> v a -> v a) = V.dropWhile `eq` dropWhile
201 prop_span :: P ((a -> Bool) -> v a -> (v a, v a)) = V.span `eq` span
202 prop_break :: P ((a -> Bool) -> v a -> (v a, v a)) = V.break `eq` break
203
204 prop_elem :: P (a -> v a -> Bool) = V.elem `eq` elem
205 prop_notElem :: P (a -> v a -> Bool) = V.notElem `eq` notElem
206 prop_find :: P ((a -> Bool) -> v a -> Maybe a) = V.find `eq` find
207 prop_findIndex :: P ((a -> Bool) -> v a -> Maybe Int)
208 = V.findIndex `eq` findIndex
209 prop_findIndices :: P ((a -> Bool) -> v a -> v Int)
210 = V.findIndices `eq` findIndices
211 prop_elemIndex :: P (a -> v a -> Maybe Int) = V.elemIndex `eq` elemIndex
212 prop_elemIndices :: P (a -> v a -> v Int) = V.elemIndices `eq` elemIndices
213
214 prop_foldl :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl `eq` foldl
215 prop_foldl1 :: P ((a -> a -> a) -> v a -> a) = notNull2 ===>
216 V.foldl1 `eq` foldl1
217 prop_foldl' :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl' `eq` foldl'
218 prop_foldl1' :: P ((a -> a -> a) -> v a -> a) = notNull2 ===>
219 V.foldl1' `eq` foldl1'
220 prop_foldr :: P ((a -> a -> a) -> a -> v a -> a) = V.foldr `eq` foldr
221 prop_foldr1 :: P ((a -> a -> a) -> v a -> a) = notNull2 ===>
222 V.foldr1 `eq` foldr1
223 prop_ifoldl :: P ((a -> Int -> a -> a) -> a -> v a -> a)
224 = V.ifoldl `eq` ifoldl
225 prop_ifoldl' :: P ((a -> Int -> a -> a) -> a -> v a -> a)
226 = V.ifoldl' `eq` ifoldl
227 prop_ifoldr :: P ((Int -> a -> a -> a) -> a -> v a -> a)
228 = V.ifoldr `eq` ifoldr
229
230 prop_all :: P ((a -> Bool) -> v a -> Bool) = V.all `eq` all
231 prop_any :: P ((a -> Bool) -> v a -> Bool) = V.any `eq` any
232
233 prop_prescanl :: P ((a -> a -> a) -> a -> v a -> v a)
234 = V.prescanl `eq` prescanl
235 prop_prescanl' :: P ((a -> a -> a) -> a -> v a -> v a)
236 = V.prescanl' `eq` prescanl
237 prop_postscanl :: P ((a -> a -> a) -> a -> v a -> v a)
238 = V.postscanl `eq` postscanl
239 prop_postscanl' :: P ((a -> a -> a) -> a -> v a -> v a)
240 = V.postscanl' `eq` postscanl
241 prop_scanl :: P ((a -> a -> a) -> a -> v a -> v a)
242 = V.scanl `eq` scanl
243 prop_scanl' :: P ((a -> a -> a) -> a -> v a -> v a)
244 = V.scanl' `eq` scanl
245 prop_scanl1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>
246 V.scanl1 `eq` scanl1
247 prop_scanl1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>
248 V.scanl1' `eq` scanl1
249
250 prop_prescanr :: P ((a -> a -> a) -> a -> v a -> v a)
251 = V.prescanr `eq` prescanr
252 prop_prescanr' :: P ((a -> a -> a) -> a -> v a -> v a)
253 = V.prescanr' `eq` prescanr
254 prop_postscanr :: P ((a -> a -> a) -> a -> v a -> v a)
255 = V.postscanr `eq` postscanr
256 prop_postscanr' :: P ((a -> a -> a) -> a -> v a -> v a)
257 = V.postscanr' `eq` postscanr
258 prop_scanr :: P ((a -> a -> a) -> a -> v a -> v a)
259 = V.scanr `eq` scanr
260 prop_scanr' :: P ((a -> a -> a) -> a -> v a -> v a)
261 = V.scanr' `eq` scanr
262 prop_scanr1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>
263 V.scanr1 `eq` scanr1
264 prop_scanr1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>
265 V.scanr1' `eq` scanr1
266
267 prop_concatMap = forAll arbitrary $ \xs ->
268 forAll (sized (\n -> resize (n `div` V.length xs) arbitrary)) $ \f -> unP prop f xs
269 where
270 prop :: P ((a -> v a) -> v a -> v a) = V.concatMap `eq` concatMap
271
272 --prop_span = (V.span :: (a -> Bool) -> v a -> (v a, v a)) `eq2` span
273 --prop_break = (V.break :: (a -> Bool) -> v a -> (v a, v a)) `eq2` break
274 --prop_splitAt = (V.splitAt :: Int -> v a -> (v a, v a)) `eq2` splitAt
275 --prop_all = (V.all :: (a -> Bool) -> v a -> Bool) `eq2` all
276 --prop_any = (V.any :: (a -> Bool) -> v a -> Bool) `eq2` any
277
278 -- Data.List
279 --prop_findIndices = V.findIndices `eq2` (findIndices :: (a -> Bool) -> v a -> v Int)
280 --prop_isPrefixOf = V.isPrefixOf `eq2` (isPrefixOf :: v a -> v a -> Bool)
281 --prop_elemIndex = V.elemIndex `eq2` (elemIndex :: a -> v a -> Maybe Int)
282 --prop_elemIndices = V.elemIndices `eq2` (elemIndices :: a -> v a -> v Int)
283 --
284 --prop_mapAccumL = eq3
285 -- (V.mapAccumL :: (X -> W -> (X,W)) -> X -> B -> (X, B))
286 -- ( mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))
287 --
288 --prop_mapAccumR = eq3
289 -- (V.mapAccumR :: (X -> W -> (X,W)) -> X -> B -> (X, B))
290 -- ( mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))
291
292 -- Because the vectors are strict, we need to be totally sure that the unfold eventually terminates. This
293 -- is achieved by injecting our own bit of state into the unfold - the maximum number of unfolds allowed.
294 limitUnfolds f (theirs, ours) | ours >= 0
295 , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))
296 | otherwise = Nothing
297 prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> v a)
298 = (\n f a -> V.unfoldr (limitUnfolds f) (a, n))
299 `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n))
300
301
302 testTuplyFunctions:: forall a v. (COMMON_CONTEXT(a, v), VECTOR_CONTEXT((a, a), v), VECTOR_CONTEXT((a, a, a), v)) => v a -> [Test]
303 testTuplyFunctions _ = $(testProperties ['prop_zip, 'prop_zip3, 'prop_unzip, 'prop_unzip3])
304 where
305 prop_zip :: P (v a -> v a -> v (a, a)) = V.zip `eq` zip
306 prop_zip3 :: P (v a -> v a -> v a -> v (a, a, a)) = V.zip3 `eq` zip3
307 prop_unzip :: P (v (a, a) -> (v a, v a)) = V.unzip `eq` unzip
308 prop_unzip3 :: P (v (a, a, a) -> (v a, v a, v a)) = V.unzip3 `eq` unzip3
309
310 testOrdFunctions :: forall a v. (COMMON_CONTEXT(a, v), Ord a, Ord (v a)) => v a -> [Test]
311 testOrdFunctions _ = $(testProperties
312 ['prop_compare,
313 'prop_maximum, 'prop_minimum,
314 'prop_minIndex, 'prop_maxIndex ])
315 where
316 prop_compare :: P (v a -> v a -> Ordering) = compare `eq` compare
317 prop_maximum :: P (v a -> a) = not . V.null ===> V.maximum `eq` maximum
318 prop_minimum :: P (v a -> a) = not . V.null ===> V.minimum `eq` minimum
319 prop_minIndex :: P (v a -> Int) = not . V.null ===> V.minIndex `eq` minIndex
320 prop_maxIndex :: P (v a -> Int) = not . V.null ===> V.maxIndex `eq` maxIndex
321
322 testEnumFunctions :: forall a v. (COMMON_CONTEXT(a, v), Enum a, Ord a, Num a, Random a) => v a -> [Test]
323 testEnumFunctions _ = $(testProperties ['prop_enumFromTo, 'prop_enumFromThenTo])
324 where
325 prop_enumFromTo = \m ->
326 forAll (choose (-2,100)) $ \n ->
327 unP prop m (m+n)
328 where
329 prop :: P (a -> a -> v a) = V.enumFromTo `eq` enumFromTo
330
331 prop_enumFromThenTo = \i j ->
332 j /= i ==>
333 forAll (choose (ks i j)) $ \k ->
334 unP prop i j k
335 where
336 prop :: P (a -> a -> a -> v a) = V.enumFromThenTo `eq` enumFromThenTo
337
338 ks i j | j < i = (i-d*100, i+d*2)
339 | otherwise = (i-d*2, i+d*100)
340 where
341 d = abs (j-i)
342
343 testBoolFunctions :: forall v. (COMMON_CONTEXT(Bool, v)) => v Bool -> [Test]
344 testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or])
345 where
346 prop_and :: P (v Bool -> Bool) = V.and `eq` and
347 prop_or :: P (v Bool -> Bool) = V.or `eq` or
348
349 testNumFunctions :: forall a v. (COMMON_CONTEXT(a, v), Num a) => v a -> [Test]
350 testNumFunctions _ = $(testProperties ['prop_sum, 'prop_product])
351 where
352 prop_sum :: P (v a -> a) = V.sum `eq` sum
353 prop_product :: P (v a -> a) = V.product `eq` product
354
355 testNestedVectorFunctions :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test]
356 testNestedVectorFunctions _ = $(testProperties [])
357 where
358 -- Prelude
359 --prop_concat = (V.concat :: [v a] -> v a) `eq1` concat
360
361 -- Data.List
362 --prop_transpose = V.transpose `eq1` (transpose :: [v a] -> [v a])
363 --prop_group = V.group `eq1` (group :: v a -> [v a])
364 --prop_inits = V.inits `eq1` (inits :: v a -> [v a])
365 --prop_tails = V.tails `eq1` (tails :: v a -> [v a])
366
367
368 testGeneralBoxedVector dummy = concatMap ($ dummy) [
369 testSanity,
370 testPolymorphicFunctions,
371 testOrdFunctions,
372 testTuplyFunctions,
373 testNestedVectorFunctions
374 ]
375
376 testBoolBoxedVector dummy = concatMap ($ dummy)
377 [
378 testGeneralBoxedVector
379 , testBoolFunctions
380 ]
381
382 testNumericBoxedVector dummy = concatMap ($ dummy)
383 [
384 testGeneralBoxedVector
385 , testNumFunctions
386 , testEnumFunctions
387 ]
388
389
390
391 testGeneralPrimitiveVector dummy = concatMap ($ dummy) [
392 testSanity,
393 testPolymorphicFunctions,
394 testOrdFunctions
395 ]
396
397 testBoolPrimitiveVector dummy = concatMap ($ dummy)
398 [
399 testGeneralPrimitiveVector
400 , testBoolFunctions
401 ]
402
403 testNumericPrimitiveVector dummy = concatMap ($ dummy)
404 [
405 testGeneralPrimitiveVector
406 , testNumFunctions
407 , testEnumFunctions
408 ]
409
410
411
412 testGeneralStorableVector dummy = concatMap ($ dummy) [
413 testSanity,
414 testPolymorphicFunctions,
415 testOrdFunctions
416 ]
417
418 testNumericStorableVector dummy = concatMap ($ dummy)
419 [
420 testGeneralStorableVector
421 , testNumFunctions
422 , testEnumFunctions
423 ]
424
425
426
427 testGeneralUnboxedVector dummy = concatMap ($ dummy) [
428 testSanity,
429 testPolymorphicFunctions
430 ]
431
432 testOrdUnboxedVector dummy = concatMap ($ dummy)
433 [
434 testOrdFunctions
435 ]
436
437 testBoolUnboxedVector dummy = concatMap ($ dummy)
438 [
439 testGeneralUnboxedVector
440 , testBoolFunctions
441 ]
442
443 testNumericUnboxedVector dummy = concatMap ($ dummy)
444 [
445 testGeneralUnboxedVector
446 , testNumFunctions
447 , testEnumFunctions
448 ]
449
450 tests = [
451 testGroup "Data.Vector.Vector (Bool)" (testBoolBoxedVector (undefined :: Data.Vector.Vector Bool)),
452 testGroup "Data.Vector.Vector (Int)" (testNumericBoxedVector (undefined :: Data.Vector.Vector Int)),
453
454 testGroup "Data.Vector.Primitive.Vector (Int)" (testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Int)),
455 testGroup "Data.Vector.Primitive.Vector (Float)" (testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Float)),
456 testGroup "Data.Vector.Primitive.Vector (Double)" (testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Double)),
457
458 testGroup "Data.Vector.Storable.Vector (Int)" (testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Int)),
459 testGroup "Data.Vector.Storable.Vector (Float)" (testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Float)),
460 testGroup "Data.Vector.Storable.Vector (Double)" (testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Double)),
461
462 testGroup "Data.Vector.Unboxed.Vector (Int)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Int)),
463 testGroup "Data.Vector.Unboxed.Vector (Float)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Float)),
464 testGroup "Data.Vector.Unboxed.Vector (Double)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Double))
465
466 ]
467