diff --git a/massiv-test.cabal b/massiv-test.cabal --- a/massiv-test.cabal +++ b/massiv-test.cabal @@ -1,5 +1,5 @@ name: massiv-test -version: 0.1.0 +version: 0.1.1 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 @@ -20,6 +20,7 @@ , Test.Massiv.Core.Common , Test.Massiv.Core.Index , Test.Massiv.Core.Mutable + , Test.Massiv.Array.Delayed , Test.Massiv.Array.Mutable , Test.Massiv.Utils @@ -31,7 +32,7 @@ , exceptions , QuickCheck , hspec - , massiv == 0.4.* + , massiv >= 0.4.2 , scheduler , primitive , unliftio @@ -50,7 +51,9 @@ main-is: Main.hs other-modules: Spec , Test.Massiv.Core.IndexSpec + , Test.Massiv.Core.ListSpec , Test.Massiv.Core.SchedulerSpec + , Test.Massiv.Array.Delayed.StreamSpec , Test.Massiv.Array.MutableSpec -- TODO: Below should be moved to Test.Massiv.Array , Data.Massiv.Array.Delayed.InterleavedSpec diff --git a/src/Test/Massiv/Array/Delayed.hs b/src/Test/Massiv/Array/Delayed.hs new file mode 100644 --- /dev/null +++ b/src/Test/Massiv/Array/Delayed.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +module Test.Massiv.Array.Delayed + ( -- * Spec for safe Mutable instance + delayedStreamSpec + -- * Useful properties for testing toList conversion + , prop_toStream + , prop_toStreamIsList + , prop_toStreamFoldable + , prop_filterS + , prop_mapMaybeS + , prop_takeDrop + , prop_unfoldr + ) 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 Test.Massiv.Core.Common () +import Test.Massiv.Utils as T +import qualified GHC.Exts as Exts +import Data.List as L + +compareAsListAndLoaded :: + (Eq e, Show e, Foldable (Array r' Ix1), Load r' Ix1 e) => Array r' Ix1 e -> [e] -> Property +compareAsListAndLoaded str ls = + F.toList str === ls .&&. computeAs B str === A.fromList Seq ls + +-- | Compare `toStream` and `A.toList` +prop_toStream :: + forall r ix e. (Source r ix e, Stream r ix e, Show e, Eq e) + => Array r ix e + -> Property +prop_toStream arr = + A.toList arr === S.toList (toStream arr) + +-- | Compare `toStream` and `Exts.toList` +prop_toStreamIsList :: + forall r e. + (Exts.Item (Array r Ix1 e) ~ e, Exts.IsList (Array r Ix1 e), Stream r Ix1 e, Show e, Eq e) + => Array r Ix1 e + -> Property +prop_toStreamIsList arr = + Exts.toList arr === S.toList (toStream arr) + +-- | Compare `toStream` and `F.toList` +prop_toStreamFoldable :: + forall r ix e. + (Foldable (Array r ix), Stream r ix e, Show e, Eq e) + => Array r ix e + -> Property +prop_toStreamFoldable arr = + F.toList arr === S.toList (toStream arr) + + +prop_filterS :: + 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_mapMaybeS :: + 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_unfoldr :: + forall e s. (Eq e, Show e) + => Fun s (Maybe (e, s)) + -> s + -> NonNegative Int + -> Property +prop_unfoldr f s0 (NonNegative n) = + compareAsListAndLoaded + (A.takeS (Sz n) (A.unfoldr (apply f) s0)) + (L.take n (L.unfoldr (apply f) s0)) + +prop_unfoldrN :: + 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_takeDrop :: + forall r ix e. (Eq e, Show e, Stream r ix e, Foldable (Array r ix)) + => Array r ix 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)) + + +delayedStreamSpec :: Spec +delayedStreamSpec = + 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) diff --git a/src/Test/Massiv/Array/Mutable.hs b/src/Test/Massiv/Array/Mutable.hs --- a/src/Test/Massiv/Array/Mutable.hs +++ b/src/Test/Massiv/Array/Mutable.hs @@ -13,15 +13,16 @@ , atomicIntSpec ) where -import UnliftIO.Async import Data.Bits 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 Data.Massiv.Array.Mutable.Atomic import Data.Massiv.Array.Unsafe import Test.Massiv.Core.Common import Test.Massiv.Utils as T +import UnliftIO.Async -- prop_MapMapM :: forall r ix(Show (Array r ix Word), Eq (Array r ix Word), Mutable r ix Word) => @@ -143,7 +144,12 @@ a2 <- unfoldlPrimM_ @r comp sz (pure . swapTuple . apply f) i rev a1 `shouldBe` a2 +prop_toStreamArrayMutable :: + (Mutable r ix e, Show (Array r ix e), Eq (Array r ix e)) => Array r ix e -> Property +prop_toStreamArrayMutable arr = + arr === S.unstreamExact (size arr) (S.stepsStream (toSteps (toStreamArray arr))) + mutableSpec :: forall r ix e. ( Show (Array D ix e) @@ -177,8 +183,8 @@ describe "Unfolding" $ do it "unfoldrList" $ prop_unfoldrList @r @ix @e it "unfoldrReverseUnfoldl" $ prop_unfoldrReverseUnfoldl @r @ix @e - - + describe "Stream" $ + it "toStreamArrayMutable" $ property (prop_toStreamArrayMutable @r @ix @e) -- | Try to write many elements into the same array cell concurrently, while keeping the -- previous element for each write. With atomic writes, not a single element should be lost. diff --git a/tests/Data/Massiv/Array/DelayedSpec.hs b/tests/Data/Massiv/Array/DelayedSpec.hs --- a/tests/Data/Massiv/Array/DelayedSpec.hs +++ b/tests/Data/Massiv/Array/DelayedSpec.hs @@ -38,9 +38,7 @@ -> ArrIx D ix Int -> Property prop_computeWithStrideWindowedEqDownsample _ stride (ArrIx arr _) = - computeWithStride stride (insertWindow arr (Window zeroIndex (size arr) (unsafeIndex arr) Nothing)) === - -- Below triggers a bug in ghc-8.0 which results in a deadlock. - -- computeWithStride stride (makeWindowedArray arr zeroIndex (size arr) (unsafeIndex arr)) === + computeWithStride stride (makeWindowedArray arr zeroIndex (size arr) (unsafeIndex arr)) === computeAs U (downsampleArr stride arr) diff --git a/tests/Data/Massiv/Array/Ops/MapSpec.hs b/tests/Data/Massiv/Array/Ops/MapSpec.hs --- a/tests/Data/Massiv/Array/Ops/MapSpec.hs +++ b/tests/Data/Massiv/Array/Ops/MapSpec.hs @@ -60,7 +60,7 @@ (Index ix, Show (Array U ix Int)) => Array D ix Int -> Fun (ix, Int) Int -> Property prop_itraverseA arr fun = alt_imapM (\ix -> Just . applyFun2Compat fun ix) arr === - itraverseAR U (\ix -> Just . applyFun2Compat fun ix) arr + itraverseA @U (\ix -> Just . applyFun2Compat fun ix) arr mapSpec :: @@ -81,9 +81,9 @@ it "zipFlip" $ property $ prop_zipFlip @ix it "zipUnzip3" $ property $ prop_zipUnzip3 @ix it "zipFlip3" $ property $ prop_zipFlip3 @ix - describe "Traversing" $ do + describe "Traversing" $ it "itraverseA" $ property $ prop_itraverseA @ix - describe "StatefulMapping" $ do + describe "StatefulMapping" $ it "mapWS" $ property $ prop_MapWS @ix spec :: Spec diff --git a/tests/Data/Massiv/Array/StencilSpec.hs b/tests/Data/Massiv/Array/StencilSpec.hs --- a/tests/Data/Massiv/Array/StencilSpec.hs +++ b/tests/Data/Massiv/Array/StencilSpec.hs @@ -64,13 +64,11 @@ it "Ix4" $ property $ prop_DangerousStencil (Proxy :: Proxy Ix4) -stencilDirection :: (Default a, Unbox a, Manifest r Ix2 a) => Ix2 -> Array r Ix2 a -> Array U Ix2 a -stencilDirection ix = - computeAs U . mapStencil (Fill def) (makeStencil (Sz 3) (1 :. 1) $ \f -> f ix) +stencilDirection :: Ix2 -> Array U Ix2 Int -> Array U Ix2 Int +stencilDirection ix = computeAs U . mapStencil (Fill def) (makeStencil (Sz 3) (1 :. 1) $ \f -> f ix) -stencilCorners :: - (Default a, Unbox a, Manifest r Ix2 a) => Ix2 -> Ix2 -> Array r Ix2 a -> Array U Ix2 a +stencilCorners :: Ix2 -> Ix2 -> Array U Ix2 Int -> Array U Ix2 Int stencilCorners ixC ix = computeAs U . mapStencil (Fill def) (makeStencil (Sz 3) ixC $ \f -> f ix) @@ -91,60 +89,63 @@ ysConvXs4' = [4, 10, 20, 30, 34] ysCorrXs4' = [20, 30, 40, 26, 14] xs4f' f = f (-1) 1 . f 0 2 . f 1 3 . f 2 4 - applyStencil s = computeAs U . mapStencil (Fill 0) s + applyStencil1 :: Stencil Ix1 Int Int -> Array U Ix1 Int -> Array U Ix1 Int + applyStencil1 s = computeAs U . mapStencil (Fill 0) s + applyStencil2 :: Stencil Ix2 Int Int -> Array U Ix2 Int -> Array U Ix2 Int + applyStencil2 s = computeAs U . mapStencil (Fill 0) s describe "makeConvolutionStencilFromKernel" $ do - it "1x3" $ applyStencil (makeConvolutionStencilFromKernel xs3) ys `shouldBe` ysConvXs3 - it "1x4" $ applyStencil (makeConvolutionStencilFromKernel xs4) ys `shouldBe` ysConvXs4 + it "1x3" $ applyStencil1 (makeConvolutionStencilFromKernel xs3) ys `shouldBe` ysConvXs3 + it "1x4" $ applyStencil1 (makeConvolutionStencilFromKernel xs4) ys `shouldBe` ysConvXs4 describe "makeCorrelationStencilFromKernel" $ do - it "1x3" $ applyStencil (makeCorrelationStencilFromKernel xs3) ys `shouldBe` ysCorrXs3 - it "1x4" $ applyStencil (makeCorrelationStencilFromKernel xs4) ys `shouldBe` ysCorrXs4 + it "1x3" $ applyStencil1 (makeCorrelationStencilFromKernel xs3) ys `shouldBe` ysCorrXs3 + it "1x4" $ applyStencil1 (makeCorrelationStencilFromKernel xs4) ys `shouldBe` ysCorrXs4 describe "makeConvolutionStencil" $ do - it "1x3" $ applyStencil (makeConvolutionStencil (Sz1 3) 1 xs3f) ys `shouldBe` ysConvXs3 - it "1x4" $ applyStencil (makeConvolutionStencil (Sz1 4) 2 xs4f) ys `shouldBe` ysConvXs4 - it "1x4" $ applyStencil (makeConvolutionStencil (Sz1 4) 1 xs4f') ys `shouldBe` ysConvXs4' + it "1x3" $ applyStencil1 (makeConvolutionStencil (Sz1 3) 1 xs3f) ys `shouldBe` ysConvXs3 + it "1x4" $ applyStencil1 (makeConvolutionStencil (Sz1 4) 2 xs4f) ys `shouldBe` ysConvXs4 + it "1x4" $ applyStencil1 (makeConvolutionStencil (Sz1 4) 1 xs4f') ys `shouldBe` ysConvXs4' describe "makeCorrelationStencil" $ do - it "1x3" $ applyStencil (makeCorrelationStencil (Sz1 3) 1 xs3f) ys `shouldBe` ysCorrXs3 - it "1x4" $ applyStencil (makeCorrelationStencil (Sz1 4) 2 xs4f) ys `shouldBe` ysCorrXs4 - it "1x4" $ applyStencil (makeCorrelationStencil (Sz1 4) 1 xs4f') ys `shouldBe` ysCorrXs4' + it "1x3" $ applyStencil1 (makeCorrelationStencil (Sz1 3) 1 xs3f) ys `shouldBe` ysCorrXs3 + it "1x4" $ applyStencil1 (makeCorrelationStencil (Sz1 4) 2 xs4f) ys `shouldBe` ysCorrXs4 + it "1x4" $ applyStencil1 (makeCorrelationStencil (Sz1 4) 1 xs4f') ys `shouldBe` ysCorrXs4' describe "makeConvolutionStencil == makeConvolutionStencilFromKernel" $ do it "Sobel Horizontal" $ property $ \(arr :: Array U Ix2 Int) -> - applyStencil (makeConvolutionStencil (Sz 3) 1 sobelX) arr === - applyStencil (makeConvolutionStencilFromKernel sobelKernelX) arr + applyStencil2 (makeConvolutionStencil (Sz 3) 1 sobelX) arr === + applyStencil2 (makeConvolutionStencilFromKernel sobelKernelX) arr it "1x3" $ property $ \(arr :: Array U Ix1 Int) -> - applyStencil (makeConvolutionStencil (Sz1 3) 1 xs3f) arr === - applyStencil (makeConvolutionStencilFromKernel xs3) arr + applyStencil1 (makeConvolutionStencil (Sz1 3) 1 xs3f) arr === + applyStencil1 (makeConvolutionStencilFromKernel xs3) arr it "1x4" $ property $ \(arr :: Array U Ix1 Int) -> - applyStencil (makeConvolutionStencil (Sz1 4) 2 xs4f) arr === - applyStencil (makeConvolutionStencilFromKernel xs4) arr + applyStencil1 (makeConvolutionStencil (Sz1 4) 2 xs4f) arr === + applyStencil1 (makeConvolutionStencilFromKernel xs4) arr describe "makeCorrelationStencil == makeCorrelationStencilFromKernel" $ do it "Sobel Horizontal" $ property $ \(arr :: Array U Ix2 Int) -> - applyStencil (makeCorrelationStencil (Sz 3) 1 sobelX) arr === - applyStencil (makeCorrelationStencilFromKernel sobelKernelX) arr + applyStencil2 (makeCorrelationStencil (Sz 3) 1 sobelX) arr === + applyStencil2 (makeCorrelationStencilFromKernel sobelKernelX) arr it "1x3" $ property $ \(arr :: Array U Ix1 Int) -> - applyStencil (makeCorrelationStencil (Sz1 3) 1 xs3f) arr === - applyStencil (makeCorrelationStencilFromKernel xs3) arr + applyStencil1 (makeCorrelationStencil (Sz1 3) 1 xs3f) arr === + applyStencil1 (makeCorrelationStencilFromKernel xs3) arr it "1x4" $ property $ \(arr :: Array U Ix1 Int) -> - applyStencil (makeCorrelationStencil (Sz1 4) 2 xs4f) arr === - applyStencil (makeCorrelationStencilFromKernel xs4) arr + applyStencil1 (makeCorrelationStencil (Sz1 4) 2 xs4f) arr === + applyStencil1 (makeCorrelationStencilFromKernel xs4) arr describe "makeConvolutionStencil == makeCorrelationStencil . rotate180" $ do it "Sobel Horizontal" $ property $ \(arr :: Array U Ix2 Int) -> - applyStencil (makeConvolutionStencilFromKernel sobelKernelX) arr === - applyStencil (makeCorrelationStencilFromKernel (rotate180 sobelKernelX)) arr + applyStencil2 (makeConvolutionStencilFromKernel sobelKernelX) arr === + applyStencil2 (makeCorrelationStencilFromKernel (rotate180 sobelKernelX)) arr it "1x3" $ property $ \(arr :: Array U Ix1 Int) -> - applyStencil (makeConvolutionStencilFromKernel xs3) arr === - applyStencil (makeCorrelationStencilFromKernel (rotate180 xs3)) arr - -- it "1x4" $ - -- property $ \(arr :: Array U Ix1 Int) -> - -- applyStencil (makeConvolutionStencilFromKernel xs4) arr === - -- applyStencil (makeCorrelationStencilFromKernel (rotate180 xs4)) arr + applyStencil1 (makeConvolutionStencilFromKernel xs3) arr === + applyStencil1 (makeCorrelationStencilFromKernel (rotate180 xs3)) arr + it "1x5" $ + property $ \(arr :: Array U Ix1 Int) -> + applyStencil1 (makeConvolutionStencilFromKernel ys) arr === + applyStencil1 (makeCorrelationStencilFromKernel (rotate180 ys)) arr spec :: Spec spec = do diff --git a/tests/Test/Massiv/Array/Delayed/StreamSpec.hs b/tests/Test/Massiv/Array/Delayed/StreamSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Test/Massiv/Array/Delayed/StreamSpec.hs @@ -0,0 +1,8 @@ +module Test.Massiv.Array.Delayed.StreamSpec (spec) where + +import Test.Massiv.Core +import Test.Massiv.Array.Delayed + + +spec :: Spec +spec = delayedStreamSpec diff --git a/tests/Test/Massiv/Array/MutableSpec.hs b/tests/Test/Massiv/Array/MutableSpec.hs --- a/tests/Test/Massiv/Array/MutableSpec.hs +++ b/tests/Test/Massiv/Array/MutableSpec.hs @@ -4,16 +4,21 @@ {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} module Test.Massiv.Array.MutableSpec (spec) where import Data.Massiv.Array import Test.Massiv.Core import Test.Massiv.Core.Mutable +import Test.Massiv.Array.Delayed import Test.Massiv.Array.Mutable +import GHC.Exts type MutableArraySpec r ix e - = ( Eq (Array r ix e) + = ( Show e + , Eq e + , Eq (Array r ix e) , Show (Array r ix e) , Eq (Array (R r) Ix1 e) , Show (Array (R r) Ix1 e) @@ -22,21 +27,27 @@ , Resize r ix , Arbitrary (Array r ix e) , Mutable r ix e + , Stream r ix e , Construct r ix e) type MutableSpec r e - = ( Show e - , Eq e - , Typeable e + = ( Typeable e , Arbitrary e , CoArbitrary e , Function e + , IsList (Array r Ix1 e) + , Item (Array r Ix1 e) ~ e , MutableArraySpec r Ix1 e , MutableArraySpec r Ix2 e , MutableArraySpec r Ix3 e , MutableArraySpec r Ix4 e , MutableArraySpec r Ix5 e) +streamSpecR :: forall r ix e. (MutableArraySpec r ix e) => Spec +streamSpecR = + describe "toStream/toList" $ + it "toStream" $ property (prop_toStream @r @ix @e) + specMutableR :: forall r e. MutableSpec r e => Spec specMutableR = do unsafeMutableSpec @r @Ix1 @e @@ -48,6 +59,12 @@ mutableSpec @r @Ix2 @e mutableSpec @r @Ix3 @e mutableSpec @r @Ix4 @e + streamSpecR @r @Ix1 @e + streamSpecR @r @Ix2 @e + streamSpecR @r @Ix3 @e + streamSpecR @r @Ix4 @e + describe "toStream/toList" $ + it "toStreamIsList" $ property (prop_toStreamIsList @r @e) --mutableSpec @r @Ix5 @e -- slows down the test suite diff --git a/tests/Test/Massiv/Core/ListSpec.hs b/tests/Test/Massiv/Core/ListSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Test/Massiv/Core/ListSpec.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +module Test.Massiv.Core.ListSpec (spec) where + +import Data.Massiv.Array +import Test.Massiv.Core +import Test.Massiv.Array.Delayed + + +spec :: Spec +spec = do + describe "L" $ + it "toStream" $ property (prop_toStreamIsList @L @Int) + describe "LN" $ + it "toStream" $ property (prop_toStreamIsList @LN @Int)