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