diff options
Diffstat (limited to 'third_party/bazel/rules_haskell/examples/vector/tests/Tests')
4 files changed, 0 insertions, 966 deletions
diff --git a/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Bundle.hs b/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Bundle.hs deleted file mode 100644 index 09368a1999..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Bundle.hs +++ /dev/null @@ -1,163 +0,0 @@ -module Tests.Bundle ( tests ) where - -import Boilerplater -import Utilities - -import qualified Data.Vector.Fusion.Bundle as S - -import Test.QuickCheck - -import Test.Framework -import Test.Framework.Providers.QuickCheck2 - -import Text.Show.Functions () -import Data.List (foldl', foldl1', unfoldr, find, findIndex) -import System.Random (Random) - -#define COMMON_CONTEXT(a) \ - VANILLA_CONTEXT(a) - -#define VANILLA_CONTEXT(a) \ - Eq a, Show a, Arbitrary a, CoArbitrary a, TestData a, Model a ~ a, EqTest a ~ Property - -testSanity :: forall v a. (COMMON_CONTEXT(a)) => S.Bundle v a -> [Test] -testSanity _ = [ - testProperty "fromList.toList == id" prop_fromList_toList, - testProperty "toList.fromList == id" prop_toList_fromList - ] - where - prop_fromList_toList :: P (S.Bundle v a -> S.Bundle v a) - = (S.fromList . S.toList) `eq` id - prop_toList_fromList :: P ([a] -> [a]) - = (S.toList . (S.fromList :: [a] -> S.Bundle v a)) `eq` id - -testPolymorphicFunctions :: forall v a. (COMMON_CONTEXT(a)) => S.Bundle v a -> [Test] -testPolymorphicFunctions _ = $(testProperties [ - 'prop_eq, - - 'prop_length, 'prop_null, - - 'prop_empty, 'prop_singleton, 'prop_replicate, - 'prop_cons, 'prop_snoc, 'prop_append, - - 'prop_head, 'prop_last, 'prop_index, - - 'prop_extract, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop, - - 'prop_map, 'prop_zipWith, 'prop_zipWith3, - 'prop_filter, 'prop_takeWhile, 'prop_dropWhile, - - 'prop_elem, 'prop_notElem, - 'prop_find, 'prop_findIndex, - - 'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1', - 'prop_foldr, 'prop_foldr1, - - 'prop_prescanl, 'prop_prescanl', - 'prop_postscanl, 'prop_postscanl', - 'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1', - - 'prop_concatMap, - 'prop_unfoldr - ]) - where - -- Prelude - prop_eq :: P (S.Bundle v a -> S.Bundle v a -> Bool) = (==) `eq` (==) - - prop_length :: P (S.Bundle v a -> Int) = S.length `eq` length - prop_null :: P (S.Bundle v a -> Bool) = S.null `eq` null - prop_empty :: P (S.Bundle v a) = S.empty `eq` [] - prop_singleton :: P (a -> S.Bundle v a) = S.singleton `eq` singleton - prop_replicate :: P (Int -> a -> S.Bundle v a) - = (\n _ -> n < 1000) ===> S.replicate `eq` replicate - prop_cons :: P (a -> S.Bundle v a -> S.Bundle v a) = S.cons `eq` (:) - prop_snoc :: P (S.Bundle v a -> a -> S.Bundle v a) = S.snoc `eq` snoc - prop_append :: P (S.Bundle v a -> S.Bundle v a -> S.Bundle v a) = (S.++) `eq` (++) - - prop_head :: P (S.Bundle v a -> a) = not . S.null ===> S.head `eq` head - prop_last :: P (S.Bundle v a -> a) = not . S.null ===> S.last `eq` last - prop_index = \xs -> - not (S.null xs) ==> - forAll (choose (0, S.length xs-1)) $ \i -> - unP prop xs i - where - prop :: P (S.Bundle v a -> Int -> a) = (S.!!) `eq` (!!) - - prop_extract = \xs -> - forAll (choose (0, S.length xs)) $ \i -> - forAll (choose (0, S.length xs - i)) $ \n -> - unP prop i n xs - where - prop :: P (Int -> Int -> S.Bundle v a -> S.Bundle v a) = S.slice `eq` slice - - prop_tail :: P (S.Bundle v a -> S.Bundle v a) = not . S.null ===> S.tail `eq` tail - prop_init :: P (S.Bundle v a -> S.Bundle v a) = not . S.null ===> S.init `eq` init - prop_take :: P (Int -> S.Bundle v a -> S.Bundle v a) = S.take `eq` take - prop_drop :: P (Int -> S.Bundle v a -> S.Bundle v a) = S.drop `eq` drop - - prop_map :: P ((a -> a) -> S.Bundle v a -> S.Bundle v a) = S.map `eq` map - prop_zipWith :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a) = S.zipWith `eq` zipWith - prop_zipWith3 :: P ((a -> a -> a -> a) -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a) - = S.zipWith3 `eq` zipWith3 - - prop_filter :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.filter `eq` filter - prop_takeWhile :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.takeWhile `eq` takeWhile - prop_dropWhile :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.dropWhile `eq` dropWhile - - prop_elem :: P (a -> S.Bundle v a -> Bool) = S.elem `eq` elem - prop_notElem :: P (a -> S.Bundle v a -> Bool) = S.notElem `eq` notElem - prop_find :: P ((a -> Bool) -> S.Bundle v a -> Maybe a) = S.find `eq` find - prop_findIndex :: P ((a -> Bool) -> S.Bundle v a -> Maybe Int) - = S.findIndex `eq` findIndex - - prop_foldl :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldl `eq` foldl - prop_foldl1 :: P ((a -> a -> a) -> S.Bundle v a -> a) = notNullS2 ===> - S.foldl1 `eq` foldl1 - prop_foldl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldl' `eq` foldl' - prop_foldl1' :: P ((a -> a -> a) -> S.Bundle v a -> a) = notNullS2 ===> - S.foldl1' `eq` foldl1' - prop_foldr :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldr `eq` foldr - prop_foldr1 :: P ((a -> a -> a) -> S.Bundle v a -> a) = notNullS2 ===> - S.foldr1 `eq` foldr1 - - prop_prescanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) - = S.prescanl `eq` prescanl - prop_prescanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) - = S.prescanl' `eq` prescanl - prop_postscanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) - = S.postscanl `eq` postscanl - prop_postscanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) - = S.postscanl' `eq` postscanl - prop_scanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) - = S.scanl `eq` scanl - prop_scanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a) - = S.scanl' `eq` scanl - prop_scanl1 :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a) = notNullS2 ===> - S.scanl1 `eq` scanl1 - prop_scanl1' :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a) = notNullS2 ===> - S.scanl1' `eq` scanl1 - - prop_concatMap = forAll arbitrary $ \xs -> - forAll (sized (\n -> resize (n `div` S.length xs) arbitrary)) $ \f -> unP prop f xs - where - prop :: P ((a -> S.Bundle v a) -> S.Bundle v a -> S.Bundle v a) = S.concatMap `eq` concatMap - - limitUnfolds f (theirs, ours) | ours >= 0 - , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1)) - | otherwise = Nothing - prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> S.Bundle v a) - = (\n f a -> S.unfoldr (limitUnfolds f) (a, n)) - `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n)) - -testBoolFunctions :: forall v. S.Bundle v Bool -> [Test] -testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or ]) - where - prop_and :: P (S.Bundle v Bool -> Bool) = S.and `eq` and - prop_or :: P (S.Bundle v Bool -> Bool) = S.or `eq` or - -testBundleFunctions = testSanity (undefined :: S.Bundle v Int) - ++ testPolymorphicFunctions (undefined :: S.Bundle v Int) - ++ testBoolFunctions (undefined :: S.Bundle v Bool) - -tests = [ testGroup "Data.Vector.Fusion.Bundle" testBundleFunctions ] - diff --git a/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Move.hs b/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Move.hs deleted file mode 100644 index 60ea8d3346..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Move.hs +++ /dev/null @@ -1,49 +0,0 @@ -module Tests.Move (tests) where - -import Test.QuickCheck -import Test.Framework.Providers.QuickCheck2 -import Test.QuickCheck.Property (Property(..)) - -import Utilities () - -import Control.Monad (replicateM) -import Control.Monad.ST (runST) -import Data.List (sort,permutations) - -import qualified Data.Vector.Generic as G -import qualified Data.Vector.Generic.Mutable as M - -import qualified Data.Vector as V -import qualified Data.Vector.Primitive as P -import qualified Data.Vector.Storable as S -import qualified Data.Vector.Unboxed as U - -basicMove :: G.Vector v a => v a -> Int -> Int -> Int -> v a -basicMove v dstOff srcOff len - | len > 0 = G.modify (\ mv -> G.copy (M.slice dstOff len mv) (G.slice srcOff len v)) v - | otherwise = v - -testMove :: (G.Vector v a, Show (v a), Eq (v a)) => v a -> Property -testMove v = G.length v > 0 ==> (MkProperty $ do - dstOff <- choose (0, G.length v - 1) - srcOff <- choose (0, G.length v - 1) - len <- choose (1, G.length v - max dstOff srcOff) - expected <- return $ basicMove v dstOff srcOff len - actual <- return $ G.modify (\ mv -> M.move (M.slice dstOff len mv) (M.slice srcOff len mv)) v - unProperty $ counterexample ("Move: " ++ show (v, dstOff, srcOff, len)) (expected == actual)) - -checkPermutations :: Int -> Bool -checkPermutations n = runST $ do - vec <- U.thaw (U.fromList [1..n]) - res <- replicateM (product [1..n]) $ M.nextPermutation vec >> U.freeze vec >>= return . U.toList - return $! ([1..n] : res) == sort (permutations [1..n]) ++ [[n,n-1..1]] - -testPermutations :: Bool -testPermutations = all checkPermutations [1..7] - -tests = - [testProperty "Data.Vector.Mutable (Move)" (testMove :: V.Vector Int -> Property), - testProperty "Data.Vector.Primitive.Mutable (Move)" (testMove :: P.Vector Int -> Property), - testProperty "Data.Vector.Unboxed.Mutable (Move)" (testMove :: U.Vector Int -> Property), - testProperty "Data.Vector.Storable.Mutable (Move)" (testMove :: S.Vector Int -> Property), - testProperty "Data.Vector.Generic.Mutable (nextPermutation)" testPermutations] diff --git a/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Vector.hs b/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Vector.hs deleted file mode 100644 index 46569d9095..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Vector.hs +++ /dev/null @@ -1,706 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -module Tests.Vector (tests) where - -import Boilerplater -import Utilities as Util - -import Data.Functor.Identity -import qualified Data.Traversable as T (Traversable(..)) -import Data.Foldable (Foldable(foldMap)) - -import qualified Data.Vector.Generic as V -import qualified Data.Vector -import qualified Data.Vector.Primitive -import qualified Data.Vector.Storable -import qualified Data.Vector.Unboxed -import qualified Data.Vector.Fusion.Bundle as S - -import Test.QuickCheck - -import Test.Framework -import Test.Framework.Providers.QuickCheck2 - -import Text.Show.Functions () -import Data.List -import Data.Monoid -import qualified Control.Applicative as Applicative -import System.Random (Random) - -import Data.Functor.Identity -import Control.Monad.Trans.Writer - -import Control.Monad.Zip - -type CommonContext a v = (VanillaContext a, VectorContext a v) -type VanillaContext a = ( Eq a , Show a, Arbitrary a, CoArbitrary a - , TestData a, Model a ~ a, EqTest a ~ Property) -type VectorContext a v = ( 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) - --- TODO: implement Vector equivalents of list functions for some of the commented out properties - --- TODO: test and implement some of these other Prelude functions: --- mapM * --- mapM_ * --- sequence --- sequence_ --- sum * --- product * --- scanl * --- scanl1 * --- scanr * --- scanr1 * --- lookup * --- lines --- words --- unlines --- unwords --- NB: this is an exhaustive list of all Prelude list functions that make sense for vectors. --- Ones with *s are the most plausible candidates. - --- TODO: add tests for the other extra functions --- IVector exports still needing tests: --- copy, --- slice, --- (//), update, bpermute, --- prescanl, prescanl', --- new, --- unsafeSlice, unsafeIndex, --- vlength, vnew - --- TODO: test non-IVector stuff? - -#if !MIN_VERSION_base(4,7,0) -instance Foldable ((,) a) where - foldMap f (_, b) = f b - -instance T.Traversable ((,) a) where - traverse f (a, b) = fmap ((,) a) $ f b -#endif - -testSanity :: forall a v. (CommonContext a v) => v a -> [Test] -testSanity _ = [ - testProperty "fromList.toList == id" prop_fromList_toList, - testProperty "toList.fromList == id" prop_toList_fromList, - testProperty "unstream.stream == id" prop_unstream_stream, - testProperty "stream.unstream == id" prop_stream_unstream - ] - where - prop_fromList_toList (v :: v a) = (V.fromList . V.toList) v == v - prop_toList_fromList (l :: [a]) = ((V.toList :: v a -> [a]) . V.fromList) l == l - prop_unstream_stream (v :: v a) = (V.unstream . V.stream) v == v - prop_stream_unstream (s :: S.Bundle v a) = ((V.stream :: v a -> S.Bundle v a) . V.unstream) s == s - -testPolymorphicFunctions :: forall a v. (CommonContext a v, VectorContext Int v) => v a -> [Test] -testPolymorphicFunctions _ = $(testProperties [ - 'prop_eq, - - -- Length information - 'prop_length, 'prop_null, - - -- Indexing (FIXME) - 'prop_index, 'prop_safeIndex, 'prop_head, 'prop_last, - 'prop_unsafeIndex, 'prop_unsafeHead, 'prop_unsafeLast, - - -- Monadic indexing (FIXME) - {- 'prop_indexM, 'prop_headM, 'prop_lastM, - 'prop_unsafeIndexM, 'prop_unsafeHeadM, 'prop_unsafeLastM, -} - - -- Subvectors (FIXME) - 'prop_slice, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop, - 'prop_splitAt, - {- 'prop_unsafeSlice, 'prop_unsafeInit, 'prop_unsafeTail, - 'prop_unsafeTake, 'prop_unsafeDrop, -} - - -- Initialisation (FIXME) - 'prop_empty, 'prop_singleton, 'prop_replicate, - 'prop_generate, 'prop_iterateN, 'prop_iterateNM, - - -- Monadic initialisation (FIXME) - 'prop_createT, - {- 'prop_replicateM, 'prop_generateM, 'prop_create, -} - - -- Unfolding - 'prop_unfoldr, 'prop_unfoldrN, 'prop_unfoldrM, 'prop_unfoldrNM, - 'prop_constructN, 'prop_constructrN, - - -- Enumeration? (FIXME?) - - -- Concatenation (FIXME) - 'prop_cons, 'prop_snoc, 'prop_append, - 'prop_concat, - - -- Restricting memory usage - 'prop_force, - - - -- Bulk updates (FIXME) - 'prop_upd, - {- 'prop_update, 'prop_update_, - 'prop_unsafeUpd, 'prop_unsafeUpdate, 'prop_unsafeUpdate_, -} - - -- Accumulations (FIXME) - 'prop_accum, - {- 'prop_accumulate, 'prop_accumulate_, - 'prop_unsafeAccum, 'prop_unsafeAccumulate, 'prop_unsafeAccumulate_, -} - - -- Permutations - 'prop_reverse, 'prop_backpermute, - {- 'prop_unsafeBackpermute, -} - - -- Elementwise indexing - {- 'prop_indexed, -} - - -- Mapping - 'prop_map, 'prop_imap, 'prop_concatMap, - - -- Monadic mapping - {- 'prop_mapM, 'prop_mapM_, 'prop_forM, 'prop_forM_, -} - 'prop_imapM, 'prop_imapM_, - - -- Zipping - 'prop_zipWith, 'prop_zipWith3, {- ... -} - 'prop_izipWith, 'prop_izipWith3, {- ... -} - 'prop_izipWithM, 'prop_izipWithM_, - {- 'prop_zip, ... -} - - -- Monadic zipping - {- 'prop_zipWithM, 'prop_zipWithM_, -} - - -- Unzipping - {- 'prop_unzip, ... -} - - -- Filtering - 'prop_filter, 'prop_ifilter, {- prop_filterM, -} - 'prop_uniq, - 'prop_mapMaybe, 'prop_imapMaybe, - 'prop_takeWhile, 'prop_dropWhile, - - -- Paritioning - 'prop_partition, {- 'prop_unstablePartition, -} - 'prop_span, 'prop_break, - - -- Searching - 'prop_elem, 'prop_notElem, - 'prop_find, 'prop_findIndex, 'prop_findIndices, - 'prop_elemIndex, 'prop_elemIndices, - - -- Folding - 'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1', - 'prop_foldr, 'prop_foldr1, 'prop_foldr', 'prop_foldr1', - 'prop_ifoldl, 'prop_ifoldl', 'prop_ifoldr, 'prop_ifoldr', - 'prop_ifoldM, 'prop_ifoldM', 'prop_ifoldM_, 'prop_ifoldM'_, - - -- Specialised folds - 'prop_all, 'prop_any, - {- 'prop_maximumBy, 'prop_minimumBy, - 'prop_maxIndexBy, 'prop_minIndexBy, -} - - -- Monadic folds - {- ... -} - - -- Monadic sequencing - {- ... -} - - -- Scans - 'prop_prescanl, 'prop_prescanl', - 'prop_postscanl, 'prop_postscanl', - 'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1', - 'prop_iscanl, 'prop_iscanl', - - 'prop_prescanr, 'prop_prescanr', - 'prop_postscanr, 'prop_postscanr', - 'prop_scanr, 'prop_scanr', 'prop_scanr1, 'prop_scanr1', - 'prop_iscanr, 'prop_iscanr' - ]) - where - -- Prelude - prop_eq :: P (v a -> v a -> Bool) = (==) `eq` (==) - - prop_length :: P (v a -> Int) = V.length `eq` length - prop_null :: P (v a -> Bool) = V.null `eq` null - - prop_empty :: P (v a) = V.empty `eq` [] - prop_singleton :: P (a -> v a) = V.singleton `eq` singleton - prop_replicate :: P (Int -> a -> v a) - = (\n _ -> n < 1000) ===> V.replicate `eq` replicate - prop_cons :: P (a -> v a -> v a) = V.cons `eq` (:) - prop_snoc :: P (v a -> a -> v a) = V.snoc `eq` snoc - prop_append :: P (v a -> v a -> v a) = (V.++) `eq` (++) - prop_concat :: P ([v a] -> v a) = V.concat `eq` concat - prop_force :: P (v a -> v a) = V.force `eq` id - prop_generate :: P (Int -> (Int -> a) -> v a) - = (\n _ -> n < 1000) ===> V.generate `eq` Util.generate - prop_iterateN :: P (Int -> (a -> a) -> a -> v a) - = (\n _ _ -> n < 1000) ===> V.iterateN `eq` (\n f -> take n . iterate f) - prop_iterateNM :: P (Int -> (a -> Writer [Int] a) -> a -> Writer [Int] (v a)) - = (\n _ _ -> n < 1000) ===> V.iterateNM `eq` Util.iterateNM - prop_createT :: P ((a, v a) -> (a, v a)) - prop_createT = (\v -> V.createT (T.mapM V.thaw v)) `eq` id - - prop_head :: P (v a -> a) = not . V.null ===> V.head `eq` head - prop_last :: P (v a -> a) = not . V.null ===> V.last `eq` last - prop_index = \xs -> - not (V.null xs) ==> - forAll (choose (0, V.length xs-1)) $ \i -> - unP prop xs i - where - prop :: P (v a -> Int -> a) = (V.!) `eq` (!!) - prop_safeIndex :: P (v a -> Int -> Maybe a) = (V.!?) `eq` fn - where - fn xs i = case drop i xs of - x:_ | i >= 0 -> Just x - _ -> Nothing - prop_unsafeHead :: P (v a -> a) = not . V.null ===> V.unsafeHead `eq` head - prop_unsafeLast :: P (v a -> a) = not . V.null ===> V.unsafeLast `eq` last - prop_unsafeIndex = \xs -> - not (V.null xs) ==> - forAll (choose (0, V.length xs-1)) $ \i -> - unP prop xs i - where - prop :: P (v a -> Int -> a) = V.unsafeIndex `eq` (!!) - - prop_slice = \xs -> - forAll (choose (0, V.length xs)) $ \i -> - forAll (choose (0, V.length xs - i)) $ \n -> - unP prop i n xs - where - prop :: P (Int -> Int -> v a -> v a) = V.slice `eq` slice - - prop_tail :: P (v a -> v a) = not . V.null ===> V.tail `eq` tail - prop_init :: P (v a -> v a) = not . V.null ===> V.init `eq` init - prop_take :: P (Int -> v a -> v a) = V.take `eq` take - prop_drop :: P (Int -> v a -> v a) = V.drop `eq` drop - prop_splitAt :: P (Int -> v a -> (v a, v a)) = V.splitAt `eq` splitAt - - prop_accum = \f xs -> - forAll (index_value_pairs (V.length xs)) $ \ps -> - unP prop f xs ps - where - prop :: P ((a -> a -> a) -> v a -> [(Int,a)] -> v a) - = V.accum `eq` accum - - prop_upd = \xs -> - forAll (index_value_pairs (V.length xs)) $ \ps -> - unP prop xs ps - where - prop :: P (v a -> [(Int,a)] -> v a) = (V.//) `eq` (//) - - prop_backpermute = \xs -> - forAll (indices (V.length xs)) $ \is -> - unP prop xs (V.fromList is) - where - prop :: P (v a -> v Int -> v a) = V.backpermute `eq` backpermute - - prop_reverse :: P (v a -> v a) = V.reverse `eq` reverse - - prop_map :: P ((a -> a) -> v a -> v a) = V.map `eq` map - prop_zipWith :: P ((a -> a -> a) -> v a -> v a -> v a) = V.zipWith `eq` zipWith - prop_zipWith3 :: P ((a -> a -> a -> a) -> v a -> v a -> v a -> v a) - = V.zipWith3 `eq` zipWith3 - prop_imap :: P ((Int -> a -> a) -> v a -> v a) = V.imap `eq` imap - prop_imapM :: P ((Int -> a -> Identity a) -> v a -> Identity (v a)) - = V.imapM `eq` imapM - prop_imapM_ :: P ((Int -> a -> Writer [a] ()) -> v a -> Writer [a] ()) - = V.imapM_ `eq` imapM_ - prop_izipWith :: P ((Int -> a -> a -> a) -> v a -> v a -> v a) = V.izipWith `eq` izipWith - prop_izipWithM :: P ((Int -> a -> a -> Identity a) -> v a -> v a -> Identity (v a)) - = V.izipWithM `eq` izipWithM - prop_izipWithM_ :: P ((Int -> a -> a -> Writer [a] ()) -> v a -> v a -> Writer [a] ()) - = V.izipWithM_ `eq` izipWithM_ - prop_izipWith3 :: P ((Int -> a -> a -> a -> a) -> v a -> v a -> v a -> v a) - = V.izipWith3 `eq` izipWith3 - - prop_filter :: P ((a -> Bool) -> v a -> v a) = V.filter `eq` filter - prop_ifilter :: P ((Int -> a -> Bool) -> v a -> v a) = V.ifilter `eq` ifilter - prop_mapMaybe :: P ((a -> Maybe a) -> v a -> v a) = V.mapMaybe `eq` mapMaybe - prop_imapMaybe :: P ((Int -> a -> Maybe a) -> v a -> v a) = V.imapMaybe `eq` imapMaybe - prop_takeWhile :: P ((a -> Bool) -> v a -> v a) = V.takeWhile `eq` takeWhile - prop_dropWhile :: P ((a -> Bool) -> v a -> v a) = V.dropWhile `eq` dropWhile - prop_partition :: P ((a -> Bool) -> v a -> (v a, v a)) - = V.partition `eq` partition - prop_span :: P ((a -> Bool) -> v a -> (v a, v a)) = V.span `eq` span - prop_break :: P ((a -> Bool) -> v a -> (v a, v a)) = V.break `eq` break - - prop_elem :: P (a -> v a -> Bool) = V.elem `eq` elem - prop_notElem :: P (a -> v a -> Bool) = V.notElem `eq` notElem - prop_find :: P ((a -> Bool) -> v a -> Maybe a) = V.find `eq` find - prop_findIndex :: P ((a -> Bool) -> v a -> Maybe Int) - = V.findIndex `eq` findIndex - prop_findIndices :: P ((a -> Bool) -> v a -> v Int) - = V.findIndices `eq` findIndices - prop_elemIndex :: P (a -> v a -> Maybe Int) = V.elemIndex `eq` elemIndex - prop_elemIndices :: P (a -> v a -> v Int) = V.elemIndices `eq` elemIndices - - prop_foldl :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl `eq` foldl - prop_foldl1 :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> - V.foldl1 `eq` foldl1 - prop_foldl' :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl' `eq` foldl' - prop_foldl1' :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> - V.foldl1' `eq` foldl1' - prop_foldr :: P ((a -> a -> a) -> a -> v a -> a) = V.foldr `eq` foldr - prop_foldr1 :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> - V.foldr1 `eq` foldr1 - prop_foldr' :: P ((a -> a -> a) -> a -> v a -> a) = V.foldr' `eq` foldr - prop_foldr1' :: P ((a -> a -> a) -> v a -> a) = notNull2 ===> - V.foldr1' `eq` foldr1 - prop_ifoldl :: P ((a -> Int -> a -> a) -> a -> v a -> a) - = V.ifoldl `eq` ifoldl - prop_ifoldl' :: P ((a -> Int -> a -> a) -> a -> v a -> a) - = V.ifoldl' `eq` ifoldl - prop_ifoldr :: P ((Int -> a -> a -> a) -> a -> v a -> a) - = V.ifoldr `eq` ifoldr - prop_ifoldr' :: P ((Int -> a -> a -> a) -> a -> v a -> a) - = V.ifoldr' `eq` ifoldr - prop_ifoldM :: P ((a -> Int -> a -> Identity a) -> a -> v a -> Identity a) - = V.ifoldM `eq` ifoldM - prop_ifoldM' :: P ((a -> Int -> a -> Identity a) -> a -> v a -> Identity a) - = V.ifoldM' `eq` ifoldM - prop_ifoldM_ :: P ((() -> Int -> a -> Writer [a] ()) -> () -> v a -> Writer [a] ()) - = V.ifoldM_ `eq` ifoldM_ - prop_ifoldM'_ :: P ((() -> Int -> a -> Writer [a] ()) -> () -> v a -> Writer [a] ()) - = V.ifoldM'_ `eq` ifoldM_ - - prop_all :: P ((a -> Bool) -> v a -> Bool) = V.all `eq` all - prop_any :: P ((a -> Bool) -> v a -> Bool) = V.any `eq` any - - prop_prescanl :: P ((a -> a -> a) -> a -> v a -> v a) - = V.prescanl `eq` prescanl - prop_prescanl' :: P ((a -> a -> a) -> a -> v a -> v a) - = V.prescanl' `eq` prescanl - prop_postscanl :: P ((a -> a -> a) -> a -> v a -> v a) - = V.postscanl `eq` postscanl - prop_postscanl' :: P ((a -> a -> a) -> a -> v a -> v a) - = V.postscanl' `eq` postscanl - prop_scanl :: P ((a -> a -> a) -> a -> v a -> v a) - = V.scanl `eq` scanl - prop_scanl' :: P ((a -> a -> a) -> a -> v a -> v a) - = V.scanl' `eq` scanl - prop_scanl1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> - V.scanl1 `eq` scanl1 - prop_scanl1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> - V.scanl1' `eq` scanl1 - prop_iscanl :: P ((Int -> a -> a -> a) -> a -> v a -> v a) - = V.iscanl `eq` iscanl - prop_iscanl' :: P ((Int -> a -> a -> a) -> a -> v a -> v a) - = V.iscanl' `eq` iscanl - - prop_prescanr :: P ((a -> a -> a) -> a -> v a -> v a) - = V.prescanr `eq` prescanr - prop_prescanr' :: P ((a -> a -> a) -> a -> v a -> v a) - = V.prescanr' `eq` prescanr - prop_postscanr :: P ((a -> a -> a) -> a -> v a -> v a) - = V.postscanr `eq` postscanr - prop_postscanr' :: P ((a -> a -> a) -> a -> v a -> v a) - = V.postscanr' `eq` postscanr - prop_scanr :: P ((a -> a -> a) -> a -> v a -> v a) - = V.scanr `eq` scanr - prop_scanr' :: P ((a -> a -> a) -> a -> v a -> v a) - = V.scanr' `eq` scanr - prop_iscanr :: P ((Int -> a -> a -> a) -> a -> v a -> v a) - = V.iscanr `eq` iscanr - prop_iscanr' :: P ((Int -> a -> a -> a) -> a -> v a -> v a) - = V.iscanr' `eq` iscanr - prop_scanr1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> - V.scanr1 `eq` scanr1 - prop_scanr1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> - V.scanr1' `eq` scanr1 - - prop_concatMap = forAll arbitrary $ \xs -> - forAll (sized (\n -> resize (n `div` V.length xs) arbitrary)) $ \f -> unP prop f xs - where - prop :: P ((a -> v a) -> v a -> v a) = V.concatMap `eq` concatMap - - prop_uniq :: P (v a -> v a) - = V.uniq `eq` (map head . group) - --prop_span = (V.span :: (a -> Bool) -> v a -> (v a, v a)) `eq2` span - --prop_break = (V.break :: (a -> Bool) -> v a -> (v a, v a)) `eq2` break - --prop_splitAt = (V.splitAt :: Int -> v a -> (v a, v a)) `eq2` splitAt - --prop_all = (V.all :: (a -> Bool) -> v a -> Bool) `eq2` all - --prop_any = (V.any :: (a -> Bool) -> v a -> Bool) `eq2` any - - -- Data.List - --prop_findIndices = V.findIndices `eq2` (findIndices :: (a -> Bool) -> v a -> v Int) - --prop_isPrefixOf = V.isPrefixOf `eq2` (isPrefixOf :: v a -> v a -> Bool) - --prop_elemIndex = V.elemIndex `eq2` (elemIndex :: a -> v a -> Maybe Int) - --prop_elemIndices = V.elemIndices `eq2` (elemIndices :: a -> v a -> v Int) - -- - --prop_mapAccumL = eq3 - -- (V.mapAccumL :: (X -> W -> (X,W)) -> X -> B -> (X, B)) - -- ( mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W])) - -- - --prop_mapAccumR = eq3 - -- (V.mapAccumR :: (X -> W -> (X,W)) -> X -> B -> (X, B)) - -- ( mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W])) - - -- Because the vectors are strict, we need to be totally sure that the unfold eventually terminates. This - -- is achieved by injecting our own bit of state into the unfold - the maximum number of unfolds allowed. - limitUnfolds f (theirs, ours) - | ours > 0 - , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1)) - | otherwise = Nothing - limitUnfoldsM f (theirs, ours) - | ours > 0 = do r <- f theirs - return $ (\(a,b) -> (a,(b,ours - 1))) `fmap` r - | otherwise = return Nothing - - - prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> v a) - = (\n f a -> V.unfoldr (limitUnfolds f) (a, n)) - `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n)) - prop_unfoldrN :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> v a) - = V.unfoldrN `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n)) - prop_unfoldrM :: P (Int -> (Int -> Writer [Int] (Maybe (a,Int))) -> Int -> Writer [Int] (v a)) - = (\n f a -> V.unfoldrM (limitUnfoldsM f) (a,n)) - `eq` (\n f a -> Util.unfoldrM (limitUnfoldsM f) (a, n)) - prop_unfoldrNM :: P (Int -> (Int -> Writer [Int] (Maybe (a,Int))) -> Int -> Writer [Int] (v a)) - = V.unfoldrNM `eq` (\n f a -> Util.unfoldrM (limitUnfoldsM f) (a, n)) - - prop_constructN = \f -> forAll (choose (0,20)) $ \n -> unP prop n f - where - prop :: P (Int -> (v a -> a) -> v a) = V.constructN `eq` constructN [] - - constructN xs 0 _ = xs - constructN xs n f = constructN (xs ++ [f xs]) (n-1) f - - prop_constructrN = \f -> forAll (choose (0,20)) $ \n -> unP prop n f - where - prop :: P (Int -> (v a -> a) -> v a) = V.constructrN `eq` constructrN [] - - constructrN xs 0 _ = xs - constructrN xs n f = constructrN (f xs : xs) (n-1) f - -testTuplyFunctions:: forall a v. (CommonContext a v, VectorContext (a, a) v, VectorContext (a, a, a) v) => v a -> [Test] -testTuplyFunctions _ = $(testProperties [ 'prop_zip, 'prop_zip3 - , 'prop_unzip, 'prop_unzip3 - , 'prop_mzip, 'prop_munzip - ]) - where - prop_zip :: P (v a -> v a -> v (a, a)) = V.zip `eq` zip - prop_zip3 :: P (v a -> v a -> v a -> v (a, a, a)) = V.zip3 `eq` zip3 - prop_unzip :: P (v (a, a) -> (v a, v a)) = V.unzip `eq` unzip - prop_unzip3 :: P (v (a, a, a) -> (v a, v a, v a)) = V.unzip3 `eq` unzip3 - prop_mzip :: P (Data.Vector.Vector a -> Data.Vector.Vector a -> Data.Vector.Vector (a, a)) - = mzip `eq` zip - prop_munzip :: P (Data.Vector.Vector (a, a) -> (Data.Vector.Vector a, Data.Vector.Vector a)) - = munzip `eq` unzip - -testOrdFunctions :: forall a v. (CommonContext a v, Ord a, Ord (v a)) => v a -> [Test] -testOrdFunctions _ = $(testProperties - ['prop_compare, - 'prop_maximum, 'prop_minimum, - 'prop_minIndex, 'prop_maxIndex ]) - where - prop_compare :: P (v a -> v a -> Ordering) = compare `eq` compare - prop_maximum :: P (v a -> a) = not . V.null ===> V.maximum `eq` maximum - prop_minimum :: P (v a -> a) = not . V.null ===> V.minimum `eq` minimum - prop_minIndex :: P (v a -> Int) = not . V.null ===> V.minIndex `eq` minIndex - prop_maxIndex :: P (v a -> Int) = not . V.null ===> V.maxIndex `eq` maxIndex - -testEnumFunctions :: forall a v. (CommonContext a v, Enum a, Ord a, Num a, Random a) => v a -> [Test] -testEnumFunctions _ = $(testProperties - [ 'prop_enumFromN, 'prop_enumFromThenN, - 'prop_enumFromTo, 'prop_enumFromThenTo]) - where - prop_enumFromN :: P (a -> Int -> v a) - = (\_ n -> n < 1000) - ===> V.enumFromN `eq` (\x n -> take n $ scanl (+) x $ repeat 1) - - prop_enumFromThenN :: P (a -> a -> Int -> v a) - = (\_ _ n -> n < 1000) - ===> V.enumFromStepN `eq` (\x y n -> take n $ scanl (+) x $ repeat y) - - prop_enumFromTo = \m -> - forAll (choose (-2,100)) $ \n -> - unP prop m (m+n) - where - prop :: P (a -> a -> v a) = V.enumFromTo `eq` enumFromTo - - prop_enumFromThenTo = \i j -> - j /= i ==> - forAll (choose (ks i j)) $ \k -> - unP prop i j k - where - prop :: P (a -> a -> a -> v a) = V.enumFromThenTo `eq` enumFromThenTo - - ks i j | j < i = (i-d*100, i+d*2) - | otherwise = (i-d*2, i+d*100) - where - d = abs (j-i) - -testMonoidFunctions :: forall a v. (CommonContext a v, Monoid (v a)) => v a -> [Test] -testMonoidFunctions _ = $(testProperties - [ 'prop_mempty, 'prop_mappend, 'prop_mconcat ]) - where - prop_mempty :: P (v a) = mempty `eq` mempty - prop_mappend :: P (v a -> v a -> v a) = mappend `eq` mappend - prop_mconcat :: P ([v a] -> v a) = mconcat `eq` mconcat - -testFunctorFunctions :: forall a v. (CommonContext a v, Functor v) => v a -> [Test] -testFunctorFunctions _ = $(testProperties - [ 'prop_fmap ]) - where - prop_fmap :: P ((a -> a) -> v a -> v a) = fmap `eq` fmap - -testMonadFunctions :: forall a v. (CommonContext a v, Monad v) => v a -> [Test] -testMonadFunctions _ = $(testProperties - [ 'prop_return, 'prop_bind ]) - where - prop_return :: P (a -> v a) = return `eq` return - prop_bind :: P (v a -> (a -> v a) -> v a) = (>>=) `eq` (>>=) - -testApplicativeFunctions :: forall a v. (CommonContext a v, V.Vector v (a -> a), Applicative.Applicative v) => v a -> [Test] -testApplicativeFunctions _ = $(testProperties - [ 'prop_applicative_pure, 'prop_applicative_appl ]) - where - prop_applicative_pure :: P (a -> v a) - = Applicative.pure `eq` Applicative.pure - prop_applicative_appl :: [a -> a] -> P (v a -> v a) - = \fs -> (Applicative.<*>) (V.fromList fs) `eq` (Applicative.<*>) fs - -testAlternativeFunctions :: forall a v. (CommonContext a v, Applicative.Alternative v) => v a -> [Test] -testAlternativeFunctions _ = $(testProperties - [ 'prop_alternative_empty, 'prop_alternative_or ]) - where - prop_alternative_empty :: P (v a) = Applicative.empty `eq` Applicative.empty - prop_alternative_or :: P (v a -> v a -> v a) - = (Applicative.<|>) `eq` (Applicative.<|>) - -testBoolFunctions :: forall v. (CommonContext Bool v) => v Bool -> [Test] -testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or]) - where - prop_and :: P (v Bool -> Bool) = V.and `eq` and - prop_or :: P (v Bool -> Bool) = V.or `eq` or - -testNumFunctions :: forall a v. (CommonContext a v, Num a) => v a -> [Test] -testNumFunctions _ = $(testProperties ['prop_sum, 'prop_product]) - where - prop_sum :: P (v a -> a) = V.sum `eq` sum - prop_product :: P (v a -> a) = V.product `eq` product - -testNestedVectorFunctions :: forall a v. (CommonContext a v) => v a -> [Test] -testNestedVectorFunctions _ = $(testProperties []) - where - -- Prelude - --prop_concat = (V.concat :: [v a] -> v a) `eq1` concat - - -- Data.List - --prop_transpose = V.transpose `eq1` (transpose :: [v a] -> [v a]) - --prop_group = V.group `eq1` (group :: v a -> [v a]) - --prop_inits = V.inits `eq1` (inits :: v a -> [v a]) - --prop_tails = V.tails `eq1` (tails :: v a -> [v a]) - -testGeneralBoxedVector :: forall a. (CommonContext a Data.Vector.Vector, Ord a) => Data.Vector.Vector a -> [Test] -testGeneralBoxedVector dummy = concatMap ($ dummy) [ - testSanity, - testPolymorphicFunctions, - testOrdFunctions, - testTuplyFunctions, - testNestedVectorFunctions, - testMonoidFunctions, - testFunctorFunctions, - testMonadFunctions, - testApplicativeFunctions, - testAlternativeFunctions - ] - -testBoolBoxedVector dummy = concatMap ($ dummy) - [ - testGeneralBoxedVector - , testBoolFunctions - ] - -testNumericBoxedVector :: forall a. (CommonContext a Data.Vector.Vector, Ord a, Num a, Enum a, Random a) => Data.Vector.Vector a -> [Test] -testNumericBoxedVector dummy = concatMap ($ dummy) - [ - testGeneralBoxedVector - , testNumFunctions - , testEnumFunctions - ] - - -testGeneralPrimitiveVector :: forall a. (CommonContext a Data.Vector.Primitive.Vector, Data.Vector.Primitive.Prim a, Ord a) => Data.Vector.Primitive.Vector a -> [Test] -testGeneralPrimitiveVector dummy = concatMap ($ dummy) [ - testSanity, - testPolymorphicFunctions, - testOrdFunctions, - testMonoidFunctions - ] - -testNumericPrimitiveVector :: forall a. (CommonContext a Data.Vector.Primitive.Vector, Data.Vector.Primitive.Prim a, Ord a, Num a, Enum a, Random a) => Data.Vector.Primitive.Vector a -> [Test] -testNumericPrimitiveVector dummy = concatMap ($ dummy) - [ - testGeneralPrimitiveVector - , testNumFunctions - , testEnumFunctions - ] - - -testGeneralStorableVector :: forall a. (CommonContext a Data.Vector.Storable.Vector, Data.Vector.Storable.Storable a, Ord a) => Data.Vector.Storable.Vector a -> [Test] -testGeneralStorableVector dummy = concatMap ($ dummy) [ - testSanity, - testPolymorphicFunctions, - testOrdFunctions, - testMonoidFunctions - ] - -testNumericStorableVector :: forall a. (CommonContext a Data.Vector.Storable.Vector, Data.Vector.Storable.Storable a, Ord a, Num a, Enum a, Random a) => Data.Vector.Storable.Vector a -> [Test] -testNumericStorableVector dummy = concatMap ($ dummy) - [ - testGeneralStorableVector - , testNumFunctions - , testEnumFunctions - ] - - -testGeneralUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a) => Data.Vector.Unboxed.Vector a -> [Test] -testGeneralUnboxedVector dummy = concatMap ($ dummy) [ - testSanity, - testPolymorphicFunctions, - testOrdFunctions, - testMonoidFunctions - ] - -testUnitUnboxedVector dummy = concatMap ($ dummy) - [ - testGeneralUnboxedVector - ] - -testBoolUnboxedVector dummy = concatMap ($ dummy) - [ - testGeneralUnboxedVector - , testBoolFunctions - ] - -testNumericUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a, Num a, Enum a, Random a) => Data.Vector.Unboxed.Vector a -> [Test] -testNumericUnboxedVector dummy = concatMap ($ dummy) - [ - testGeneralUnboxedVector - , testNumFunctions - , testEnumFunctions - ] - -testTupleUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a) => Data.Vector.Unboxed.Vector a -> [Test] -testTupleUnboxedVector dummy = concatMap ($ dummy) - [ - testGeneralUnboxedVector - ] - -tests = [ - testGroup "Data.Vector.Vector (Bool)" (testBoolBoxedVector (undefined :: Data.Vector.Vector Bool)), - testGroup "Data.Vector.Vector (Int)" (testNumericBoxedVector (undefined :: Data.Vector.Vector Int)), - - testGroup "Data.Vector.Primitive.Vector (Int)" (testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Int)), - testGroup "Data.Vector.Primitive.Vector (Double)" (testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Double)), - - testGroup "Data.Vector.Storable.Vector (Int)" (testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Int)), - testGroup "Data.Vector.Storable.Vector (Double)" (testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Double)), - - testGroup "Data.Vector.Unboxed.Vector ()" (testUnitUnboxedVector (undefined :: Data.Vector.Unboxed.Vector ())), - testGroup "Data.Vector.Unboxed.Vector (Bool)" (testBoolUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Bool)), - testGroup "Data.Vector.Unboxed.Vector (Int)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Int)), - testGroup "Data.Vector.Unboxed.Vector (Double)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Double)), - testGroup "Data.Vector.Unboxed.Vector (Int,Bool)" (testTupleUnboxedVector (undefined :: Data.Vector.Unboxed.Vector (Int,Bool))), - testGroup "Data.Vector.Unboxed.Vector (Int,Bool,Int)" (testTupleUnboxedVector (undefined :: Data.Vector.Unboxed.Vector (Int,Bool,Int))) - - ] diff --git a/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Vector/UnitTests.hs b/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Vector/UnitTests.hs deleted file mode 100644 index 5827640d84..0000000000 --- a/third_party/bazel/rules_haskell/examples/vector/tests/Tests/Vector/UnitTests.hs +++ /dev/null @@ -1,48 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} - -module Tests.Vector.UnitTests (tests) where - -import Control.Applicative as Applicative -import qualified Data.Vector.Storable as Storable -import Foreign.Ptr -import Foreign.Storable -import Text.Printf - -import Test.Framework -import Test.Framework.Providers.HUnit (testCase) -import Test.HUnit (Assertion, assertBool) - -newtype Aligned a = Aligned { getAligned :: a } - -instance (Storable a) => Storable (Aligned a) where - sizeOf _ = sizeOf (undefined :: a) - alignment _ = 128 - peek ptr = Aligned Applicative.<$> peek (castPtr ptr) - poke ptr = poke (castPtr ptr) . getAligned - -checkAddressAlignment :: forall a. (Storable a) => Storable.Vector a -> Assertion -checkAddressAlignment xs = Storable.unsafeWith xs $ \ptr -> do - let ptr' = ptrToWordPtr ptr - msg = printf "Expected pointer with alignment %d but got 0x%08x" (toInteger align) (toInteger ptr') - align :: WordPtr - align = fromIntegral $ alignment dummy - assertBool msg $ (ptr' `mod` align) == 0 - where - dummy :: a - dummy = undefined - -tests :: [Test] -tests = - [ testGroup "Data.Vector.Storable.Vector Alignment" - [ testCase "Aligned Double" $ - checkAddressAlignment alignedDoubleVec - , testCase "Aligned Int" $ - checkAddressAlignment alignedIntVec - ] - ] - -alignedDoubleVec :: Storable.Vector (Aligned Double) -alignedDoubleVec = Storable.fromList $ map Aligned [1, 2, 3, 4, 5] - -alignedIntVec :: Storable.Vector (Aligned Int) -alignedIntVec = Storable.fromList $ map Aligned [1, 2, 3, 4, 5] |