Adapt tests to new names and modules
[darcs-mirrors/vector.git] / tests / Tests / Bundle.hs
1 module Tests.Bundle ( tests ) where
2
3 import Boilerplater
4 import Utilities
5
6 import qualified Data.Vector.Fusion.Bundle as S
7
8 import Test.QuickCheck
9
10 import Test.Framework
11 import Test.Framework.Providers.QuickCheck2
12
13 import Text.Show.Functions ()
14 import Data.List (foldl', foldl1', unfoldr, find, findIndex)
15 import System.Random (Random)
16
17 #define COMMON_CONTEXT(a) \
18 VANILLA_CONTEXT(a)
19
20 #define VANILLA_CONTEXT(a) \
21 Eq a, Show a, Arbitrary a, CoArbitrary a, TestData a, Model a ~ a, EqTest a ~ Property
22
23 testSanity :: forall v a. (COMMON_CONTEXT(a)) => S.Bundle v a -> [Test]
24 testSanity _ = [
25 testProperty "fromList.toList == id" prop_fromList_toList,
26 testProperty "toList.fromList == id" prop_toList_fromList
27 ]
28 where
29 prop_fromList_toList :: P (S.Bundle v a -> S.Bundle v a)
30 = (S.fromList . S.toList) `eq` id
31 prop_toList_fromList :: P ([a] -> [a])
32 = (S.toList . (S.fromList :: [a] -> S.Bundle v a)) `eq` id
33
34 testPolymorphicFunctions :: forall v a. (COMMON_CONTEXT(a)) => S.Bundle v a -> [Test]
35 testPolymorphicFunctions _ = $(testProperties [
36 'prop_eq,
37
38 'prop_length, 'prop_null,
39
40 'prop_empty, 'prop_singleton, 'prop_replicate,
41 'prop_cons, 'prop_snoc, 'prop_append,
42
43 'prop_head, 'prop_last, 'prop_index,
44
45 'prop_extract, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop,
46
47 'prop_map, 'prop_zipWith, 'prop_zipWith3,
48 'prop_filter, 'prop_takeWhile, 'prop_dropWhile,
49
50 'prop_elem, 'prop_notElem,
51 'prop_find, 'prop_findIndex,
52
53 'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1',
54 'prop_foldr, 'prop_foldr1,
55
56 'prop_prescanl, 'prop_prescanl',
57 'prop_postscanl, 'prop_postscanl',
58 'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1',
59
60 'prop_concatMap,
61 'prop_unfoldr
62 ])
63 where
64 -- Prelude
65 prop_eq :: P (S.Bundle v a -> S.Bundle v a -> Bool) = (==) `eq` (==)
66
67 prop_length :: P (S.Bundle v a -> Int) = S.length `eq` length
68 prop_null :: P (S.Bundle v a -> Bool) = S.null `eq` null
69 prop_empty :: P (S.Bundle v a) = S.empty `eq` []
70 prop_singleton :: P (a -> S.Bundle v a) = S.singleton `eq` singleton
71 prop_replicate :: P (Int -> a -> S.Bundle v a)
72 = (\n _ -> n < 1000) ===> S.replicate `eq` replicate
73 prop_cons :: P (a -> S.Bundle v a -> S.Bundle v a) = S.cons `eq` (:)
74 prop_snoc :: P (S.Bundle v a -> a -> S.Bundle v a) = S.snoc `eq` snoc
75 prop_append :: P (S.Bundle v a -> S.Bundle v a -> S.Bundle v a) = (S.++) `eq` (++)
76
77 prop_head :: P (S.Bundle v a -> a) = not . S.null ===> S.head `eq` head
78 prop_last :: P (S.Bundle v a -> a) = not . S.null ===> S.last `eq` last
79 prop_index = \xs ->
80 not (S.null xs) ==>
81 forAll (choose (0, S.length xs-1)) $ \i ->
82 unP prop xs i
83 where
84 prop :: P (S.Bundle v a -> Int -> a) = (S.!!) `eq` (!!)
85
86 prop_extract = \xs ->
87 forAll (choose (0, S.length xs)) $ \i ->
88 forAll (choose (0, S.length xs - i)) $ \n ->
89 unP prop i n xs
90 where
91 prop :: P (Int -> Int -> S.Bundle v a -> S.Bundle v a) = S.slice `eq` slice
92
93 prop_tail :: P (S.Bundle v a -> S.Bundle v a) = not . S.null ===> S.tail `eq` tail
94 prop_init :: P (S.Bundle v a -> S.Bundle v a) = not . S.null ===> S.init `eq` init
95 prop_take :: P (Int -> S.Bundle v a -> S.Bundle v a) = S.take `eq` take
96 prop_drop :: P (Int -> S.Bundle v a -> S.Bundle v a) = S.drop `eq` drop
97
98 prop_map :: P ((a -> a) -> S.Bundle v a -> S.Bundle v a) = S.map `eq` map
99 prop_zipWith :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a) = S.zipWith `eq` zipWith
100 prop_zipWith3 :: P ((a -> a -> a -> a) -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a)
101 = S.zipWith3 `eq` zipWith3
102
103 prop_filter :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.filter `eq` filter
104 prop_takeWhile :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.takeWhile `eq` takeWhile
105 prop_dropWhile :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.dropWhile `eq` dropWhile
106
107 prop_elem :: P (a -> S.Bundle v a -> Bool) = S.elem `eq` elem
108 prop_notElem :: P (a -> S.Bundle v a -> Bool) = S.notElem `eq` notElem
109 prop_find :: P ((a -> Bool) -> S.Bundle v a -> Maybe a) = S.find `eq` find
110 prop_findIndex :: P ((a -> Bool) -> S.Bundle v a -> Maybe Int)
111 = S.findIndex `eq` findIndex
112
113 prop_foldl :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldl `eq` foldl
114 prop_foldl1 :: P ((a -> a -> a) -> S.Bundle v a -> a) = notNullS2 ===>
115 S.foldl1 `eq` foldl1
116 prop_foldl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldl' `eq` foldl'
117 prop_foldl1' :: P ((a -> a -> a) -> S.Bundle v a -> a) = notNullS2 ===>
118 S.foldl1' `eq` foldl1'
119 prop_foldr :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldr `eq` foldr
120 prop_foldr1 :: P ((a -> a -> a) -> S.Bundle v a -> a) = notNullS2 ===>
121 S.foldr1 `eq` foldr1
122
123 prop_prescanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)
124 = S.prescanl `eq` prescanl
125 prop_prescanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)
126 = S.prescanl' `eq` prescanl
127 prop_postscanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)
128 = S.postscanl `eq` postscanl
129 prop_postscanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)
130 = S.postscanl' `eq` postscanl
131 prop_scanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)
132 = S.scanl `eq` scanl
133 prop_scanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)
134 = S.scanl' `eq` scanl
135 prop_scanl1 :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a) = notNullS2 ===>
136 S.scanl1 `eq` scanl1
137 prop_scanl1' :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a) = notNullS2 ===>
138 S.scanl1' `eq` scanl1
139
140 prop_concatMap = forAll arbitrary $ \xs ->
141 forAll (sized (\n -> resize (n `div` S.length xs) arbitrary)) $ \f -> unP prop f xs
142 where
143 prop :: P ((a -> S.Bundle v a) -> S.Bundle v a -> S.Bundle v a) = S.concatMap `eq` concatMap
144
145 limitUnfolds f (theirs, ours) | ours >= 0
146 , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))
147 | otherwise = Nothing
148 prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> S.Bundle v a)
149 = (\n f a -> S.unfoldr (limitUnfolds f) (a, n))
150 `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n))
151
152 testBoolFunctions :: forall v. S.Bundle v Bool -> [Test]
153 testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or ])
154 where
155 prop_and :: P (S.Bundle v Bool -> Bool) = S.and `eq` and
156 prop_or :: P (S.Bundle v Bool -> Bool) = S.or `eq` or
157
158 testBundleFunctions = testSanity (undefined :: S.Bundle v Int)
159 ++ testPolymorphicFunctions (undefined :: S.Bundle v Int)
160 ++ testBoolFunctions (undefined :: S.Bundle v Bool)
161
162 tests = [ testGroup "Data.Vector.Fusion.Bundle" testBundleFunctions ]
163