packages feed

massiv-test 0.1.2 → 0.1.3

raw patch · 9 files changed

+222/−68 lines, 9 filesdep +mwc-randomdep ~massiv

Dependencies added: mwc-random

Dependency ranges changed: massiv

Files

massiv-test.cabal view
@@ -1,5 +1,5 @@ name:                massiv-test-version:             0.1.2+version:             0.1.3 synopsis:            Library that contains generators, properties and tests for Massiv Array Library. description:         This library is designed for users of massiv library that need random generators for writing custom property tests and reusing some of the predefined ones. homepage:            https://github.com/lehins/massiv@@ -32,7 +32,7 @@                      , exceptions                      , QuickCheck                      , hspec-                     , massiv >= 0.4.5+                     , massiv >= 0.5.0                      , scheduler                      , primitive                      , unliftio@@ -57,6 +57,7 @@                     , Test.Massiv.Array.MutableSpec                     , Test.Massiv.Array.Ops.TransformSpec                     , Test.Massiv.Array.Ops.SortSpec+                    , Test.Massiv.VectorSpec                       -- TODO: Below should be moved to Test.Massiv.Array                     , Data.Massiv.Array.Delayed.InterleavedSpec                     , Data.Massiv.Array.Delayed.PushSpec@@ -79,6 +80,7 @@                     , genvalidity-hspec                     , massiv                     , massiv-test+                    , mwc-random                     , hspec                     , scheduler                     , QuickCheck
src/Test/Massiv/Array/Delayed.hs view
@@ -12,17 +12,17 @@   , prop_toStream   , prop_toStreamIsList   , prop_toStreamFoldable-  , prop_filterS-  , prop_mapMaybeS+  , prop_sfilter+  , prop_smapMaybe   , prop_takeDrop-  , prop_unfoldr+  , prop_sunfoldr   ) where   import Data.Maybe as M import Data.Foldable as F import Data.Massiv.Array as A-import qualified Data.Massiv.Array.Manifest.Vector.Stream as S+import qualified Data.Massiv.Vector.Stream as S import Test.Massiv.Core.Common () import Test.Massiv.Utils as T import qualified GHC.Exts as Exts@@ -60,60 +60,85 @@   F.toList arr === S.toList (toStream arr)  -prop_filterS ::+prop_sfilter ::      forall r ix e. (Eq e, Show e, Stream r ix e, Foldable (Array r ix))   => Array r ix e   -> Fun e Bool   -> Property-prop_filterS arr f =-  compareAsListAndLoaded (A.filterS (apply f) arr) (L.filter (apply f) (F.toList arr))+prop_sfilter arr f =+  compareAsListAndLoaded (A.sfilter (apply f) arr) (L.filter (apply f) (F.toList arr)) -prop_mapMaybeS ::+prop_smapMaybe ::      forall r ix e a. (Eq a, Show a, Stream r ix e, Foldable (Array r ix))   => Array r ix e   -> Fun e (Maybe a)   -> Property-prop_mapMaybeS arr f =-  compareAsListAndLoaded (A.mapMaybeS (apply f) arr) (M.mapMaybe (apply f) (F.toList arr))+prop_smapMaybe arr f =+  compareAsListAndLoaded (A.smapMaybe (apply f) arr) (M.mapMaybe (apply f) (F.toList arr))  -prop_unfoldr ::+prop_sunfoldr ::      forall e s. (Eq e, Show e)   => Fun s (Maybe (e, s))   -> s   -> NonNegative Int   -> Property-prop_unfoldr f s0 (NonNegative n) =+prop_sunfoldr f s0 (NonNegative n) =   compareAsListAndLoaded-    (A.takeS (Sz n) (A.unfoldr (apply f) s0))+    (A.stake (Sz n) (A.sunfoldr (apply f) s0))     (L.take n (L.unfoldr (apply f) s0)) -prop_unfoldrN ::+prop_sunfoldrN ::      forall e s. (Eq e, Show e)   => Fun s (Maybe (e, s))   -> s   -> Int   -> Property-prop_unfoldrN f s0 n =-  compareAsListAndLoaded (A.unfoldrN (Sz n) (apply f) s0) (L.take n (L.unfoldr (apply f) s0))+prop_sunfoldrN f s0 n =+  compareAsListAndLoaded (A.sunfoldrN (Sz n) (apply f) s0) (L.take n (L.unfoldr (apply f) s0)) ++prop_stakesDrop ::+     forall r e.+     ( Eq e+     , Show e+     , Stream r Ix1 e+     , Foldable (Array r Ix1)+     )+  => Vector r e+  -> Int+  -> Int+  -> Property+prop_stakesDrop arr t d =+  conjoin+    [ stoList (A.stake (Sz t) (A.sdrop (Sz d) arr)) === L.take t (L.drop d (F.toList arr))+    , stoList (A.sdrop (Sz d) (A.stake (Sz t) arr)) === L.drop d (L.take t (F.toList arr))+    ]+ prop_takeDrop ::-     forall r ix e. (Eq e, Show e, Stream r ix e, Foldable (Array r ix))-  => Array r ix e+     forall r e.+     ( Eq e+     , Show e+     , Source r Ix1 e+     , Foldable (Array r Ix1)+     )+  => Vector r e   -> Int   -> Int   -> Property prop_takeDrop arr t d =-  Exts.toList (A.takeS (Sz t) (A.dropS (Sz d) arr)) === take t (drop d (F.toList arr)) .&&.-  Exts.toList (A.dropS (Sz d) (A.takeS (Sz t) arr)) ===-  drop d (take t (F.toList arr))-+  conjoin+    [ A.toList (A.take (Sz t) (A.drop (Sz d) arr)) === L.take t (L.drop d (F.toList arr))+    , A.toList (A.drop (Sz d) (A.take (Sz t) arr)) === L.drop d (L.take t (F.toList arr))+    ]  delayedStreamSpec :: Spec-delayedStreamSpec =+delayedStreamSpec = do+  describe "D Spec" $+    it "takeDrop" $ property (prop_takeDrop @D @Int)   describe "DS Spec" $ do-    it "filterS" $ property (prop_filterS @DS @Ix1 @Int)-    it "mapMaybeS" $ property (prop_mapMaybeS @DS @Ix1 @Int @Word)-    it "unfoldr" $ property (prop_unfoldr @Int @Word)-    it "unfoldrN" $ property (prop_unfoldrN @Int @Word)-    it "takeDrop" $ property (prop_takeDrop @DS @Ix1 @Int)+    it "sfilter" $ property (prop_sfilter @DS @Ix1 @Int)+    it "smapMaybe" $ property (prop_smapMaybe @DS @Ix1 @Int @Word)+    it "sunfoldr" $ property (prop_sunfoldr @Int @Word)+    it "sunfoldrN" $ property (prop_sunfoldrN @Int @Word)+    it "stakesDrop" $ property (prop_stakesDrop @DS @Int)
src/Test/Massiv/Array/Mutable.hs view
@@ -9,6 +9,11 @@     mutableSpec   , prop_GenerateArray   , prop_iMapiMapM+  , prop_Shrink+  , prop_GrowShrink+  , prop_unfoldrList+  , prop_unfoldrReverseUnfoldl+  , prop_toStreamArrayMutable   -- * Atomic ops spec   , atomicIntSpec   ) where@@ -17,7 +22,7 @@ import Data.Functor.Identity import Data.List as L import Data.Massiv.Array as A-import qualified Data.Massiv.Array.Manifest.Vector.Stream as S+import qualified Data.Massiv.Vector.Stream as S import Data.Massiv.Array.Mutable.Atomic import Data.Massiv.Array.Unsafe import Test.Massiv.Core.Common@@ -77,6 +82,7 @@     sarr <- unsafeFreeze (getComp arr) =<< unsafeLinearShrink marr (Sz ix)     pure (A.foldlS (.&&.) (property True) $ A.zipWith (==) (flatten arr) (flatten sarr)) +-- TODO: Improve runtime speed! prop_GrowShrink ::      forall r ix e.      ( Eq (Array r ix e)@@ -119,7 +125,7 @@   => Property prop_unfoldrList =   property $ \comp sz f (i :: Word) ->-    let xs = runST (unfoldrPrimM_ comp sz (pure . apply f) i) :: Array r ix e+    let xs = runST (unfoldrPrimM_ sz (pure . apply f) i) :: Array r ix e         ys = A.fromList comp (L.take (totalElem sz) (L.unfoldr (Just . apply f) i))      in flatten xs === ys @@ -136,12 +142,12 @@      )   => Property prop_unfoldrReverseUnfoldl =-  property $ \ comp sz f (i :: Word) ->+  property $ \ sz f (i :: Word) ->     let swapTuple (x, y) = (y, x)         rev a =           compute @r (backpermute' sz (liftIndex pred . liftIndex2 (-) (unSz sz)) a)-     in do a1 :: Array r ix e <- unfoldrPrimM_ @r comp sz (pure . apply f) i-           a2 <- unfoldlPrimM_ @r comp sz (pure . swapTuple . apply f) i+     in do a1 :: Array r ix e <- unfoldrPrimM_ @r sz (pure . apply f) i+           a2 <- unfoldlPrimM_ @r sz (pure . swapTuple . apply f) i            rev a1 `shouldBe` a2  prop_toStreamArrayMutable ::
src/Test/Massiv/Core/Mutable.hs view
@@ -63,7 +63,7 @@   => Property prop_UnsafeInitializeNew =   property $ \comp sz e ->-    (A.replicate comp sz e :: Array r ix e) ===+    (compute (A.replicate comp sz e) :: Array r ix e) ===     runST (unsafeFreeze comp =<< initializeNew (Just e) sz)  prop_UnsafeInitialize ::@@ -100,13 +100,12 @@  prop_UnsafeLinearCopyPart ::      forall r ix e.-     ( Eq (Array r ix e)+     ( Eq (Vector r e)+     , Show (Vector r e)+     , Eq (Array r ix e)      , Show (Array r ix e)-     , Eq (Array (R r) Ix1 e)-     , Show (Array (R r) Ix1 e)      , Mutable r ix e      , Mutable r Ix1 e-     , Extract r Ix1 e      , Resize r ix      )   => ArrIx r ix e@@ -114,7 +113,7 @@   -> Ix1   -> Property prop_UnsafeLinearCopyPart (ArrIx arr ix) (NonNegative delta) toOffset =-  arr === arrs .&&. extract' i k (flatten arr) === extract' j k arrd+  arr === arrs .&&. slice' i k (flatten arr) === slice' j k arrd   where     sz = size arr     i = toLinearIndex sz ix@@ -144,11 +143,10 @@  prop_UnsafeArrayLinearCopyPart ::      forall r ix e.-     ( Eq (Array (R r) Ix1 e)-     , Show (Array (R r) Ix1 e)+     ( Eq (Vector r e)+     , Show (Vector r e)      , Mutable r ix e      , Mutable r Ix1 e-     , Extract r Ix1 e      , Resize r ix      )   => ArrIx r ix e@@ -156,7 +154,7 @@   -> Ix1   -> Property prop_UnsafeArrayLinearCopyPart (ArrIx arr ix) (NonNegative delta) toOffset =-  extract' i k (flatten arr) === extract' j k arr'+  slice' i k (flatten arr) === slice' j k arr'   where     sz = size arr     i = toLinearIndex sz ix@@ -171,10 +169,10 @@  prop_UnsafeLinearSet ::      forall r ix e.-     ( Eq (Array (R r) Ix1 e)-     , Show (Array (R r) Ix1 e)+     ( Eq (Vector r e)+     , Show (Vector r e)      , Mutable r ix e-     , Extract r Ix1 e+     , Mutable r Ix1 e      , Resize r ix      )   => Comp@@ -183,8 +181,8 @@   -> e   -> Property prop_UnsafeLinearSet comp (SzIx sz ix) (NonNegative delta) e =-  extract' i k (flatten (A.replicate Seq sz e :: Array r ix e)) ===-  extract' i k (flatten (arrd :: Array r ix e))+  compute (A.replicate Seq k e) ===+  slice' i k (flatten (arrd :: Array r ix e))   where     i = toLinearIndex sz ix     k = Sz (totalElem sz - i - delta)@@ -196,16 +194,16 @@  prop_UnsafeLinearShrink ::      forall r ix e.-     ( Eq (Array (R r) Ix1 e)-     , Show (Array (R r) Ix1 e)+     ( Eq (Vector r e)+     , Show (Vector r e)      , Mutable r ix e-     , Extract r Ix1 e+     , Source r Ix1 e      , Resize r ix      )   => ArrIx r ix e   -> Property prop_UnsafeLinearShrink (ArrIx arr ix) =-  extract' 0 k (flatten arr) === extract' 0 k (flatten arr')+  slice' 0 k (flatten arr) === slice' 0 k (flatten arr')   where     sz = size arr     sz' = Sz (liftIndex2 (-) (unSz sz) ix)@@ -220,17 +218,17 @@      forall r ix e.      ( Eq (Array r ix e)      , Show (Array r ix e)-     , Eq (Array (R r) Ix1 e)-     , Show (Array (R r) Ix1 e)+     , Eq (Vector r e)+     , Show (Vector r e)      , Mutable r ix e-     , Extract r Ix1 e+     , Source r Ix1 e      , Resize r ix      )   => ArrIx r ix e   -> e   -> Property prop_UnsafeLinearGrow (ArrIx arr ix) e =-  extract' 0 k (flatten arr) === extract' 0 k (flatten arrGrown) .&&.+  slice' 0 k (flatten arr) === slice' 0 k (flatten arrGrown) .&&.   arrCopied === arrGrown   where     sz = size arr@@ -250,8 +248,8 @@  unsafeMutableSpec ::      forall r ix e.-     ( Eq (Array (R r) Ix1 e)-     , Show (Array (R r) Ix1 e)+     ( Eq (Vector r e)+     , Show (Vector r e)      , Eq (Array r ix e)      , Show (Array r ix e)      , Mutable r ix e@@ -262,7 +260,6 @@      , Arbitrary ix      , Typeable e      , Typeable ix-     , Extract r Ix1 e      , Resize r ix      )   => Spec
src/Test/Massiv/Utils.hs view
@@ -22,6 +22,7 @@ import Test.QuickCheck as X hiding ((.&.)) import Test.QuickCheck.Monadic as X import Test.Hspec as X+import Test.Hspec.QuickCheck as X import Test.QuickCheck.Function as X import Control.DeepSeq as X (NFData, deepseq) import UnliftIO.Exception (Exception(..), SomeException, catch, catchAny)
tests/Data/Massiv/Array/StencilSpec.hs view
@@ -11,7 +11,7 @@ import Control.DeepSeq (deepseq) import Data.Default (Default(def)) import Data.Massiv.Array as A-import Data.Massiv.Array.Stencil.Unsafe as A+import Data.Massiv.Array.Unsafe as A import Test.Massiv.Core  avg3x3Stencil :: Fractional a => Stencil Ix2 a a@@ -74,9 +74,9 @@ prop_MapEqApplyStencil stride (SzTiny sz) b arr =   forAll (elements (P.zip [0 ..] (toList $ A.map (\(n, _, _) -> n) stencils))) $ \(i, _) ->     let (_, stencil, g) = stencils ! i-     in computeAs P (mapStencilUnsafe b sz zeroIndex g arr) ===+     in computeAs P (unsafeMapStencil b sz zeroIndex (const g) arr) ===         computeAs P (applyStencil (samePadding stencil b) stencil arr) .&&.-        computeWithStrideAs P stride (mapStencilUnsafe b sz zeroIndex g arr) ===+        computeWithStrideAs P stride (unsafeMapStencil b sz zeroIndex (const g) arr) ===         computeWithStrideAs P stride (applyStencil (samePadding stencil b) stencil arr)   where     stencils = mkCommonStencils sz
tests/Test/Massiv/Array/MutableSpec.hs view
@@ -108,7 +108,7 @@           arr' <- freeze (getComp arr) marr'           indexM arr' ix `shouldReturn` e -          arr'' <- withMArray arr (\_ ma -> write_ ma ix e)+          arr'' <- withMArray_ arr (\_ ma -> write_ ma ix e)           index' arr'' ix `shouldBe` e  @@ -140,7 +140,7 @@           arr' <- freezeS marr'           indexM arr' ix `shouldReturn` fe -          arr'' <- withMArrayS arr (\ma -> modify_ ma fM ix)+          arr'' <- withMArrayS_ arr (\ma -> modify_ ma fM ix)           index' arr'' ix `shouldBe` fe  prop_Swap :: (Mutable r ix e, Eq e, Show e) => Array r ix e -> ix -> ix -> Property@@ -178,7 +178,7 @@           indexM arr' ix1 `shouldReturn` e2           indexM arr' ix2 `shouldReturn` e1 -          let arr'' = withMArrayST arr (\ma -> swap_ ma ix1 ix2)+          let arr'' = withMArrayST_ arr (\ma -> swap_ ma ix1 ix2)           index' arr'' ix1 `shouldBe` e2           index' arr'' ix2 `shouldBe` e1
tests/Test/Massiv/Array/Ops/TransformSpec.hs view
@@ -124,7 +124,7 @@   -> Property prop_ZoomWithGridStrideCompute arr stride defVal =   (computeWithStride @r stride' arr' ===-   A.replicate Seq (Sz (liftIndex (+ 1) $ unSz (size arr))) defVal) .&&.+   compute (A.replicate Seq (Sz (liftIndex (+ 1) $ unSz (size arr))) defVal)) .&&.   (computeWithStride @r stride' (extract' (pureIndex 1) sz' arr') === compute arr)   where     arr' = compute @r (zoomWithGrid defVal stride arr)
+ tests/Test/Massiv/VectorSpec.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+module Test.Massiv.VectorSpec (spec) where++import Control.Exception+import Data.Bits+import Data.Massiv.Array as A+import Data.Massiv.Vector as V+import qualified Data.Vector.Primitive as VP+import Data.Word+import Test.Massiv.Core++import System.Random.MWC as MWC++infix 4 !==!, !!==!!++sizeException :: SizeException -> Bool+sizeException _ = True++(!==!) :: (Eq e, Show e, Prim e, Load r Ix1 e) => V.Vector r e -> VP.Vector e -> Property+(!==!) arr vec = toPrimitiveVector (convert arr) === vec++(!!==!!) :: (Eq e, Show e, Prim e, Source r Ix1 e) => V.Vector r e -> VP.Vector e -> Property+(!!==!!) arr vec = property $ do+  eRes <- try (pure $! vec)+  case eRes of+    Right vec' -> toPrimitiveVector (computeSource arr) `shouldBe` vec'+    Left (_exc :: ErrorCall) ->+      shouldThrow (pure $! toPrimitiveVector (computeSource arr)) sizeException++newtype SeedVector = SeedVector (VP.Vector Word32) deriving (Eq, Show)++instance Arbitrary SeedVector where+  arbitrary = SeedVector . VP.fromList <$> arbitrary++withSeed :: forall a. SeedVector -> (forall s. MWC.Gen s -> ST s a) -> a+withSeed (SeedVector seed) f = runST $ do+  gen <- MWC.initialize seed+  f gen++prop_sreplicateM :: SeedVector -> Int -> Property+prop_sreplicateM seed k =+  withSeed @(V.Vector DS Word) seed (V.sreplicateM (Sz k) . uniform)+  !==! withSeed seed (VP.replicateM k . uniform)++prop_sgenerateM :: SeedVector -> Int -> Fun Int Word -> Property+prop_sgenerateM seed k f =+  withSeed @(V.Vector DS Word) seed (genWith (V.sgenerateM (Sz k)))+  !==! withSeed seed (genWith (VP.generateM k))+  where+    genWith :: PrimMonad f => ((Int -> f Word) -> t) -> MWC.Gen (PrimState f) -> t+    genWith genM gen = genM (\i -> xor (apply f i) <$> uniform gen)+++prop_siterateNM :: SeedVector -> Int -> Word -> Property+prop_siterateNM seed k a =+  withSeed @(V.Vector DS Word) seed (genWith (\action -> V.siterateNM (Sz k) action a))+  !==! withSeed seed (genWith (\action -> VP.iterateNM k action a))+  where+    genWith :: PrimMonad f => ((Word -> f Word) -> t) -> MWC.Gen (PrimState f) -> t+    genWith genM gen = genM (\prev -> xor prev <$> uniform gen)+++spec :: Spec+spec = do+  describe "Vector" $ do+    describe "same-as-vector-package" $ do+      describe "Accessors" $ do+        describe "Slicing" $ do+          prop "slice'" $ \i sz (arr :: Array P Ix1 Word) ->+            V.slice' i sz arr !!==!! VP.slice i (unSz sz) (toPrimitiveVector arr)+          prop "init'" $ \(arr :: Array P Ix1 Word) ->+            V.init' arr !!==!! VP.init (toPrimitiveVector arr)+          prop "tail'" $ \(arr :: Array P Ix1 Word) ->+            V.tail' arr !!==!! VP.tail (toPrimitiveVector arr)+          prop "take" $ \n (arr :: Array P Ix1 Word) ->+            V.take (Sz n) arr !==! VP.take n (toPrimitiveVector arr)+          prop "stake" $ \n (arr :: Array P Ix1 Word) ->+            V.stake (Sz n) arr !==! VP.take n (toPrimitiveVector arr)+          prop "drop" $ \n (arr :: Array P Ix1 Word) ->+            V.drop (Sz n) arr !==! VP.drop n (toPrimitiveVector arr)+          prop "sdrop" $ \n (arr :: Array P Ix1 Word) ->+            V.sdrop (Sz n) arr !==! VP.drop n (toPrimitiveVector arr)+          prop "sliceAt" $ \sz (arr :: Array P Ix1 Word) ->+            let (larr, rarr) = V.sliceAt (Sz sz) arr+                (lvec, rvec) = VP.splitAt sz (toPrimitiveVector arr)+             in (larr !==! lvec) .&&. (rarr !==! rvec)+      describe "Constructors" $ do+        describe "Initialization" $ do+          it "empty" $ toPrimitiveVector (V.empty :: V.Vector P Word) `shouldBe` VP.empty+          prop "singleton" $ \e -> (V.singleton e :: V.Vector P Word) !==! VP.singleton e+          prop "ssingleton" $ \(e :: Word) -> V.ssingleton e !==! VP.singleton e+          prop "replicate" $ \comp k (e :: Word) -> V.replicate comp (Sz k) e !==! VP.replicate k e+          prop "sreplicate" $ \k (e :: Word) -> V.sreplicate (Sz k) e !==! VP.replicate k e+          prop "generate" $ \comp k (f :: Fun Int Word) ->+            V.generate comp (Sz k) (apply f) !==! VP.generate k (apply f)+          prop "sgenerate" $ \k (f :: Fun Int Word) ->+            V.sgenerate (Sz k) (apply f) !==! VP.generate k (apply f)+          prop "siterateN" $ \n (f :: Fun Word Word) a ->+            V.siterateN (Sz n) (apply f) a !==! VP.iterateN n (apply f) a+        describe "Monadic initialization" $ do+          prop "sreplicateM" prop_sreplicateM+          prop "sgenerateM" prop_sgenerateM+          prop "siterateNM" prop_siterateNM+        describe "Unfolding" $ do+          prop "sunfoldr" $ \(a :: Word) ->+            let f b+                  | b > 10000 || b `div` 17 == 0 = Nothing+                  | otherwise = Just (b * b, b + 1)+             in V.sunfoldr f a !==! VP.unfoldr f a+          prop "sunfoldrN" $ \n (a :: Word) ->+            let f b+                  | b > 10000 || b `div` 19 == 0 = Nothing+                  | otherwise = Just (b * b, b + 1)+             in V.sunfoldrN (Sz n) f a !==! VP.unfoldrN n f a