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