Massive overhaul to testsuite structure
[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.IVector as V
7 import qualified Data.Vector
8 import qualified Data.Vector.Unboxed
9 import qualified Data.Vector.Fusion.Stream as S
10
11 import Test.QuickCheck
12
13 import Test.Framework
14 import Test.Framework.Providers.QuickCheck
15
16 import Text.Show.Functions ()
17 import Data.List (foldl', foldl1', unfoldr, find, findIndex)
18
19 #define COMMON_CONTEXT(a, v) \
20 Eq a, Eq (v a), \
21 Show a, Arbitrary a, Model a a, \
22 Show (v a), Arbitrary (v a), Model (v a) [a], V.IVector v a
23
24
25 -- TODO: implement Vector equivalents for some of the commented out list functions from Prelude
26 -- TODO: test and implement some of these other functions:
27 -- mapM *
28 -- mapM_ *
29 -- sequence
30 -- sequence_
31 -- sum *
32 -- product *
33 -- scanl *
34 -- scanl1 *
35 -- scanr *
36 -- scanr1 *
37 -- lookup *
38 -- zip3 *
39 -- zipWith3 *
40 -- unzip *
41 -- unzip3 *
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 testSanity :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test]
50 testSanity _ = [
51 testProperty "fromList.toList == id" prop_fromList_toList,
52 testProperty "toList.fromList == id" prop_toList_fromList,
53 testProperty "unstream.stream == id" prop_unstream_stream,
54 testProperty "stream.unstream == id" prop_stream_unstream
55 ]
56 where
57 prop_fromList_toList (v :: v a) = (V.fromList . V.toList) v == v
58 prop_toList_fromList (l :: [a]) = ((V.toList :: v a -> [a]) . V.fromList) l == l
59 prop_unstream_stream (v :: v a) = (V.unstream . V.stream) v == v
60 prop_stream_unstream (s :: S.Stream a) = ((V.stream :: v a -> S.Stream a) . V.unstream) s == s
61
62 testPolymorphicFunctions :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test]
63 testPolymorphicFunctions _ = $(testProperties [
64 'prop_eq, 'prop_length, 'prop_null, 'prop_reverse,
65 'prop_append, 'prop_concatMap,
66 'prop_empty, 'prop_cons,
67 'prop_head, 'prop_tail, 'prop_init, 'prop_last,
68 'prop_drop, 'prop_dropWhile, 'prop_take, 'prop_takeWhile,
69 'prop_filter, 'prop_map, 'prop_zipWith, 'prop_replicate,
70 'prop_elem, 'prop_notElem,
71 'prop_foldr, 'prop_foldl, 'prop_foldr1, 'prop_foldl1,
72 'prop_foldl', 'prop_foldl1',
73 'prop_find, 'prop_findIndex,
74 'prop_unfoldr,
75 'prop_singleton, 'prop_snoc
76 ])
77 where
78 -- Prelude
79 prop_eq = ((==) :: v a -> v a -> Bool) `eq2` (==)
80 prop_length = (V.length :: v a -> Int) `eq1` length
81 prop_null = (V.null :: v a -> Bool) `eq1` null
82 prop_reverse = (V.reverse :: v a -> v a) `eq1` reverse
83 prop_append = ((V.++) :: v a -> v a -> v a) `eq2` (++)
84 prop_concatMap = (V.concatMap :: (a -> v a) -> v a -> v a) `eq2` concatMap
85 prop_empty = (V.empty :: v a) `eq0` []
86 prop_cons = (V.cons :: a -> v a -> v a) `eq2` (:)
87 --prop_index = compare (V.!) to (!!)
88 prop_head = (V.head :: v a -> a) `eqNotNull1` head
89 prop_tail = (V.tail :: v a -> v a) `eqNotNull1` tail
90 prop_init = (V.init :: v a -> v a) `eqNotNull1` init
91 prop_last = (V.last :: v a -> a) `eqNotNull1` last
92 prop_drop = (V.drop :: Int -> v a -> v a) `eq2` drop
93 prop_dropWhile = (V.dropWhile :: (a -> Bool) -> v a -> v a) `eq2` dropWhile
94 prop_take = (V.take :: Int -> v a -> v a) `eq2` take
95 prop_takeWhile = (V.takeWhile :: (a -> Bool) -> v a -> v a) `eq2` takeWhile
96 prop_filter = (V.filter :: (a -> Bool) -> v a -> v a) `eq2` filter
97 prop_map = (V.map :: (a -> a) -> v a -> v a) `eq2` map
98 --prop_zip = (V.zip :: v a -> v a -> v (a, a)) `eq2` zip
99 prop_zipWith = (V.zipWith :: (a -> a -> a) -> v a -> v a -> v a) `eq3` zipWith
100 prop_replicate = (V.replicate :: Int -> a -> v a) `eq2` replicate
101 --prop_span = (V.span :: (a -> Bool) -> v a -> (v a, v a)) `eq2` span
102 --prop_break = (V.break :: (a -> Bool) -> v a -> (v a, v a)) `eq2` break
103 --prop_splitAt = (V.splitAt :: Int -> v a -> (v a, v a)) `eq2` splitAt
104 prop_elem = (V.elem :: a -> v a -> Bool) `eq2` elem
105 prop_notElem = (V.notElem :: a -> v a -> Bool) `eq2` notElem
106 prop_foldr = (V.foldr :: (a -> a -> a) -> a -> v a -> a) `eq3` foldr
107 prop_foldl = (V.foldl :: (a -> a -> a) -> a -> v a -> a) `eq3` foldl
108 prop_foldr1 = (V.foldr1 :: (a -> a -> a) -> v a -> a) `eqNotNull2` foldr1
109 prop_foldl1 = (V.foldl1 :: (a -> a -> a) -> v a -> a) `eqNotNull2` foldl1
110 --prop_all = (V.all :: (a -> Bool) -> v a -> Bool) `eq2` all
111 --prop_any = (V.any :: (a -> Bool) -> v a -> Bool) `eq2` any
112
113 -- Data.List
114 -- TODO: implement Vector equivalents for some of the commented out list functions from Data.List
115 prop_foldl' = (V.foldl' :: (a -> a -> a) -> a -> v a -> a) `eq3` foldl'
116 prop_foldl1' = (V.foldl1' :: (a -> a -> a) -> v a -> a) `eqNotNull2` foldl1'
117 prop_find = (V.find :: (a -> Bool) -> v a -> Maybe a) `eq2` find
118 prop_findIndex = (V.findIndex :: (a -> Bool) -> v a -> Maybe Int) `eq2` findIndex
119 --prop_findIndices = V.findIndices `eq2` (findIndices :: (a -> Bool) -> v a -> v Int)
120 --prop_isPrefixOf = V.isPrefixOf `eq2` (isPrefixOf :: v a -> v a -> Bool)
121 --prop_elemIndex = V.elemIndex `eq2` (elemIndex :: a -> v a -> Maybe Int)
122 --prop_elemIndices = V.elemIndices `eq2` (elemIndices :: a -> v a -> v Int)
123 --
124 --prop_mapAccumL = eq3
125 -- (V.mapAccumL :: (X -> W -> (X,W)) -> X -> B -> (X, B))
126 -- ( mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))
127 --
128 --prop_mapAccumR = eq3
129 -- (V.mapAccumR :: (X -> W -> (X,W)) -> X -> B -> (X, B))
130 -- ( mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))
131
132 -- Because the vectors are strict, we need to be totally sure that the unfold eventually terminates. This
133 -- is achieved by injecting our own bit of state into the unfold - the maximum number of unfolds allowed.
134 limitUnfolds f (theirs, ours) | ours >= 0
135 , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))
136 | otherwise = Nothing
137 prop_unfoldr = ((\n f a -> V.unfoldr (limitUnfolds f) (a, n)) :: Int -> ((Int, Int) -> Maybe (a, (Int, Int))) -> (Int, Int) -> v a)
138 `eq3` (\n f a -> unfoldr (limitUnfolds f) (a, n))
139
140 -- Extras
141 singleton x = [x]
142 prop_singleton = (V.singleton :: a -> v a) `eq1` singleton
143
144 snoc xs x = xs ++ [x]
145 prop_snoc = (V.snoc :: v a -> a -> v a) `eq2` snoc
146
147 -- TODO: add tests for the other extra functions
148 -- IVector exports still needing tests:
149 -- copy,
150 -- slice,
151 -- (//), update, bpermute,
152 -- prescanl, prescanl',
153 -- new,
154 -- unsafeSlice, unsafeIndex,
155 -- vlength, vnew
156
157 testOrdFunctions :: forall a v. (COMMON_CONTEXT(a, v), Ord a, Ord (v a)) => v a -> [Test]
158 testOrdFunctions _ = $(testProperties ['prop_compare])
159 where
160 prop_compare = (compare :: v a -> v a -> Ordering) `eq2` compare
161 --prop_maximum = (V.maximum :: v a -> a) `eqNotNull1` maximum
162 --prop_minimum = (V.minimum :: v a -> a) `eqNotNull1` minimum
163
164 testEnumFunctions :: forall a v. (COMMON_CONTEXT(a, v), Enum a) => v a -> [Test]
165 testEnumFunctions _ = $(testProperties ['prop_enumFromTo, 'prop_enumFromThenTo])
166 where
167 prop_enumFromTo = (V.enumFromTo :: a -> a -> v a) `eq2` enumFromTo
168 prop_enumFromThenTo = \i j n -> fromEnum i < fromEnum j ==> ((V.enumFromThenTo :: a -> a -> a -> v a) `eq3` enumFromThenTo) i j n
169
170 testBoolFunctions :: forall v. (COMMON_CONTEXT(Bool, v)) => v Bool -> [Test]
171 testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or])
172 where
173 prop_and = (V.and :: v Bool -> Bool) `eq1` and
174 prop_or = (V.or :: v Bool -> Bool) `eq1` or
175
176 testNumFunctions :: forall a v. (COMMON_CONTEXT(a, v), Num a) => v a -> [Test]
177 testNumFunctions _ = $(testProperties [])
178 where
179 --prop_sum = (V.sum :: v Int -> Int) `eq1` sum
180 --prop_product = (V.product :: v Int -> Int) `eq1` product
181
182 testNestedVectorFunctions :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test]
183 testNestedVectorFunctions _ = $(testProperties [])
184 where
185 -- Prelude
186 --prop_concat = (V.concat :: [v a] -> v a) `eq1` concat
187
188 -- Data.List
189 --prop_transpose = V.transpose `eq1` (transpose :: [v a] -> [v a])
190 --prop_group = V.group `eq1` (group :: v a -> [v a])
191 --prop_inits = V.inits `eq1` (inits :: v a -> [v a])
192 --prop_tails = V.tails `eq1` (tails :: v a -> [v a])
193
194
195 testGeneralBoxedVector dummy = concatMap ($ dummy) [
196 testSanity,
197 testPolymorphicFunctions,
198 testOrdFunctions,
199 testEnumFunctions,
200 testNestedVectorFunctions
201 ]
202
203 testBoolBoxedVector dummy = testGeneralBoxedVector dummy ++ testBoolFunctions dummy
204 testNumericBoxedVector dummy = testGeneralBoxedVector dummy ++ testNumFunctions dummy
205
206 testGeneralUnboxedVector dummy = concatMap ($ dummy) [
207 testSanity,
208 testPolymorphicFunctions,
209 testOrdFunctions,
210 testEnumFunctions
211 ]
212
213 testBoolUnboxedVector dummy = testGeneralUnboxedVector dummy ++ testBoolFunctions dummy
214 testNumericUnboxedVector dummy = testGeneralUnboxedVector dummy ++ testNumFunctions dummy
215
216 -- TODO: test non-IVector stuff?
217 tests = [
218 testGroup "Data.Vector.Vector (Bool)" (testBoolBoxedVector (undefined :: Data.Vector.Vector Bool)),
219 testGroup "Data.Vector.Vector (Int)" (testNumericBoxedVector (undefined :: Data.Vector.Vector Int)),
220 testGroup "Data.Vector.Unboxed.Vector (Bool)" (testBoolUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Bool)),
221 testGroup "Data.Vector.Unboxed.Vector (Int)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Int)),
222 testGroup "Data.Vector.Unboxed.Vector (Float)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Float)),
223 testGroup "Data.Vector.Unboxed.Vector (Double)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Double))
224 ]