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