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