diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,18 @@ +# 0.1.6 + +* Fix expectations for matrix multiplications. Empty arrays now always produce empty arrays. + # 0.1.5 * Add numeric tests +* Add floating point comparison with epsilon functions: + * `epsilonExpect` + * `epsilonFoldableExpect` + * `epsilonMaybeEq` + * `epsilonEq` + * `epsilonEqDouble` + * `epsilonEqFloat` + # 0.1.4 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.5 +version: 0.1.6 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 @@ -33,7 +33,7 @@ , exceptions , QuickCheck , hspec - , massiv >= 0.5.4 + , massiv >= 0.5.9 , scheduler , primitive , unliftio @@ -51,29 +51,82 @@ hs-source-dirs: tests main-is: Main.hs other-modules: Spec + , Test.Massiv.Array.Delayed.StreamSpec + , Test.Massiv.Array.Delayed.InterleavedSpec + , Test.Massiv.Array.Delayed.PushSpec + , Test.Massiv.Array.Delayed.WindowedSpec + , Test.Massiv.Array.DelayedSpec + , Test.Massiv.Array.MutableSpec + , Test.Massiv.Array.Ops.ConstructSpec + , Test.Massiv.Array.Ops.FoldSpec + , Test.Massiv.Array.Ops.MapSpec + , Test.Massiv.Array.Ops.SliceSpec + , Test.Massiv.Array.Ops.SortSpec + , Test.Massiv.Array.Ops.TransformSpec + , Test.Massiv.Array.Manifest.PrimitiveSpec + , Test.Massiv.Array.Manifest.VectorSpec + , Test.Massiv.Array.ManifestSpec + , Test.Massiv.Array.NumericSpec + , Test.Massiv.Array.Numeric.IntegralSpec + , Test.Massiv.Array.StencilSpec + , Test.Massiv.ArraySpec + , Test.Massiv.VectorSpec , Test.Massiv.Core.IndexSpec , Test.Massiv.Core.ListSpec , Test.Massiv.Core.SchedulerSpec + build-depends: base + , bytestring + , containers + , data-default + , deepseq + , genvalidity-hspec + , massiv >= 0.5.2 + , massiv-test + , mwc-random + , hspec + , primitive + , scheduler + , QuickCheck + , vector + + default-language: Haskell2010 + ghc-options: -Wall + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wredundant-constraints + -fno-warn-orphans + -threaded + -with-rtsopts=-N2 + + +test-suite tests-O0 + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Main.hs + other-modules: Spec , Test.Massiv.Array.Delayed.StreamSpec , Test.Massiv.Array.Delayed.InterleavedSpec , Test.Massiv.Array.Delayed.PushSpec , Test.Massiv.Array.Delayed.WindowedSpec , Test.Massiv.Array.DelayedSpec , Test.Massiv.Array.MutableSpec + , Test.Massiv.Array.Ops.ConstructSpec , Test.Massiv.Array.Ops.FoldSpec , Test.Massiv.Array.Ops.MapSpec + , Test.Massiv.Array.Ops.SliceSpec , Test.Massiv.Array.Ops.SortSpec , Test.Massiv.Array.Ops.TransformSpec + , Test.Massiv.Array.Manifest.PrimitiveSpec + , Test.Massiv.Array.Manifest.VectorSpec + , Test.Massiv.Array.ManifestSpec , Test.Massiv.Array.NumericSpec , Test.Massiv.Array.Numeric.IntegralSpec , Test.Massiv.Array.StencilSpec + , Test.Massiv.ArraySpec , Test.Massiv.VectorSpec - -- TODO: Below should be moved to Test.Massiv.Array - , Data.Massiv.Array.Manifest.VectorSpec - , Data.Massiv.Array.ManifestSpec - , Data.Massiv.Array.Ops.ConstructSpec - , Data.Massiv.Array.Ops.SliceSpec - , Data.Massiv.ArraySpec + , Test.Massiv.Core.IndexSpec + , Test.Massiv.Core.ListSpec + , Test.Massiv.Core.SchedulerSpec build-depends: base , bytestring , containers @@ -97,6 +150,7 @@ -fno-warn-orphans -threaded -with-rtsopts=-N2 + -O0 source-repository head type: git diff --git a/src/Test/Massiv/Array/Numeric.hs b/src/Test/Massiv/Array/Numeric.hs --- a/src/Test/Massiv/Array/Numeric.hs +++ b/src/Test/Massiv/Array/Numeric.hs @@ -26,6 +26,7 @@ error $ "(|*|): Inner array dimensions must agree, but received: " ++ show (size arr1) ++ " and " ++ show (size arr2) + | isEmpty arr1 || isEmpty arr2 = empty | otherwise = makeArrayR D Seq (Sz (m1 :. n2)) $ \(i :. j) -> A.foldlS (+) 0 (A.zipWith (*) (arr1 !> i) (arr2 Fun Int e -> Matrix r e @@ -88,6 +91,7 @@ let Sz2 m _ = size arr v = makeArray Seq (Sz m) (applyFun f) v ><. arr `shouldThrow` (== SizeMismatchException (Sz2 1 (m + 1)) (size arr)) @@ -236,15 +240,16 @@ , Function e , CoArbitrary e , Arbitrary e - , Arbitrary (Array r Ix1 e) - , Arbitrary (Array r Ix2 e) - , Show (Array r Ix2 e) - , Eq (Array r Ix2 e) - , Show (Array r Ix1 e) + , Arbitrary (Matrix r e) + , Arbitrary (Vector r e) + , Show (Matrix r e) + , Eq (Matrix r e) + , Show (Vector r e) + , Eq (Vector r e) ) => Spec mutableNumericSpec = - describe "Numerc Operations" $ do + describe "Numeric Operations" $ do prop "Plus" $ prop_Plus @r @e prop "Minus" $ prop_Minus @r @e prop "Times" $ prop_Times @r @e diff --git a/src/Test/Massiv/Core/Index.hs b/src/Test/Massiv/Core/Index.hs --- a/src/Test/Massiv/Core/Index.hs +++ b/src/Test/Massiv/Core/Index.hs @@ -1,11 +1,9 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} diff --git a/tests/Data/Massiv/Array/Manifest/VectorSpec.hs b/tests/Data/Massiv/Array/Manifest/VectorSpec.hs deleted file mode 100644 --- a/tests/Data/Massiv/Array/Manifest/VectorSpec.hs +++ /dev/null @@ -1,77 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -module Data.Massiv.Array.Manifest.VectorSpec (spec) where - -import Data.Massiv.Array.Manifest.Vector -import Data.Massiv.Array as A -import Test.Massiv.Core -import qualified Data.Vector as VB -import qualified Data.Vector.Generic as VG -import qualified Data.Vector.Primitive as VP -import qualified Data.Vector.Storable as VS -import qualified Data.Vector.Unboxed as VU - -prop_castToFromVector - :: ( VG.Vector (VRepr r) Int - , Mutable r ix Int - , Typeable (VRepr r) - , ARepr (VRepr r) ~ r - , Eq (Array r ix Int) - , Show (Array r ix Int) - ) - => proxy ix -> r -> ArrNE r ix Int -> Property -prop_castToFromVector _ _ (ArrNE arr) = - Just arr === (castToVector arr >>= castFromVector (getComp arr) (size arr)) - - -prop_toFromVector :: - forall r ix v. - ( Mutable r ix Int - , Mutable (ARepr v) ix Int - , VRepr (ARepr v) ~ v - , Eq (Array r ix Int) - , VG.Vector v Int - , Show (Array r ix Int) - , Typeable v - ) - => Proxy v - -> Proxy ix - -> r - -> ArrNE r ix Int - -> Property -prop_toFromVector _ _ _ (ArrNE arr) = - arr === fromVector' (getComp arr) (size arr) (toVector arr :: v Int) - - -toFromVectorSpec :: Spec -toFromVectorSpec = do - it_prop "Unboxed" U - it_prop "Primitive" P - it_prop "Storable" S - it_prop "BoxedStrict" B - where - it_prop name r = - describe name $ do - describe "CastToFrom" $ do - it "Ix1" $ property $ prop_castToFromVector (Proxy :: Proxy Ix1) r - it "Ix2" $ property $ prop_castToFromVector (Proxy :: Proxy Ix2) r - it "Ix3" $ property $ prop_castToFromVector (Proxy :: Proxy Ix3) r - describe "Through Boxed Vector" $ do - it "Ix1" $ property $ prop_toFromVector (Proxy :: Proxy VB.Vector) (Proxy :: Proxy Ix1) r - it "Ix2" $ property $ prop_toFromVector (Proxy :: Proxy VB.Vector) (Proxy :: Proxy Ix2) r - describe "Through Unboxed Vector" $ do - it "Ix1" $ property $ prop_toFromVector (Proxy :: Proxy VU.Vector) (Proxy :: Proxy Ix1) r - it "Ix2" $ property $ prop_toFromVector (Proxy :: Proxy VU.Vector) (Proxy :: Proxy Ix2) r - describe "Through Primitive Vector" $ do - it "Ix1" $ property $ prop_toFromVector (Proxy :: Proxy VP.Vector) (Proxy :: Proxy Ix1) r - it "Ix2" $ property $ prop_toFromVector (Proxy :: Proxy VP.Vector) (Proxy :: Proxy Ix2) r - describe "Through Storable Vector" $ do - it "Ix1" $ property $ prop_toFromVector (Proxy :: Proxy VS.Vector) (Proxy :: Proxy Ix1) r - it "Ix2" $ property $ prop_toFromVector (Proxy :: Proxy VS.Vector) (Proxy :: Proxy Ix2) r - - -spec :: Spec -spec = describe "toFromVector" toFromVectorSpec diff --git a/tests/Data/Massiv/Array/ManifestSpec.hs b/tests/Data/Massiv/Array/ManifestSpec.hs deleted file mode 100644 --- a/tests/Data/Massiv/Array/ManifestSpec.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MonoLocalBinds #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeApplications #-} -module Data.Massiv.Array.ManifestSpec (spec) where - -import Data.ByteString as S -import Data.ByteString.Builder as S -import Data.ByteString.Lazy as SL -import Data.Massiv.Array as A -import Test.Massiv.Core -import Data.Word (Word8) - - --- ByteString -prop_toFromByteString :: Manifest r Ix1 Word8 => Array r Ix1 Word8 -> Property -prop_toFromByteString arr = toManifest arr === fromByteString (getComp arr) (toByteString arr) - -prop_castToFromByteString :: Array S Ix1 Word8 -> Property -prop_castToFromByteString arr = arr === castFromByteString (getComp arr) (castToByteString arr) - - -prop_fromToByteString :: Comp -> [Word8] -> Property -prop_fromToByteString comp ls = bs === toByteString (fromByteString comp bs) - where bs = S.pack ls - -prop_toBuilder :: Array P Ix1 Word8 -> Property -prop_toBuilder arr = bs === SL.toStrict (S.toLazyByteString (toBuilder S.word8 arr)) - where bs = toByteString arr - -conversionSpec :: Spec -conversionSpec = - describe "ByteString" $ do - it "castTo/TromByteString" $ property prop_castToFromByteString - it "to/from ByteString P" $ property (prop_toFromByteString @P) - it "to/from ByteString S" $ property (prop_toFromByteString @S) - it "from/to ByteString" $ property prop_fromToByteString - it "toBuilder" $ property prop_toBuilder - - -spec :: Spec -spec = describe "Conversion" conversionSpec diff --git a/tests/Data/Massiv/Array/Ops/ConstructSpec.hs b/tests/Data/Massiv/Array/Ops/ConstructSpec.hs deleted file mode 100644 --- a/tests/Data/Massiv/Array/Ops/ConstructSpec.hs +++ /dev/null @@ -1,130 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE ScopedTypeVariables #-} -module Data.Massiv.Array.Ops.ConstructSpec (spec) where - -import Data.List as L -import Data.Massiv.Array as A -import Test.Massiv.Core -import qualified GHC.Exts as GHC (IsList(..)) -import Prelude as P - -prop_rangeEqRangeStep1 :: Int -> Int -> Property -prop_rangeEqRangeStep1 from to = range Seq from to === rangeStep' Par from 1 to - -prop_rangeEqEnumFromN :: Int -> Int -> Property -prop_rangeEqEnumFromN from to = range Seq from to === enumFromN Par from (Sz (to - from)) - -prop_rangeStepEqEnumFromStepN :: Int -> NonZero Int -> Int -> Property -prop_rangeStepEqEnumFromStepN from (NonZero step) sz = - rangeStep' Seq from step (from + step * sz) === enumFromStepN Par from step (Sz sz) - - -prop_rangeStepExc :: Int -> Int -> Property -prop_rangeStepExc from to = - assertException - (\case - IndexZeroException _ -> True - _ -> False) - (computeAs U (rangeStep' Seq from 0 to)) - -prop_toFromListIsList :: - (Show (Array U ix Int), GHC.IsList (Array U ix Int), Index ix) - => Proxy ix - -> ArrNE U ix Int - -> Property -prop_toFromListIsList _ (ArrNE arr) = arr === GHC.fromList (GHC.toList arr) - - -prop_toFromList :: - forall ix . (Show (Array U ix Int), Nested LN ix Int, Ragged L ix Int) - => Proxy ix - -> ArrNE U ix Int - -> Property -prop_toFromList _ (ArrNE arr) = comp === comp' .&&. arr === arr' - where comp = getComp arr - arr' = fromLists' comp (toLists arr) - comp' = getComp arr' - - -prop_excFromToListIx2 :: Comp -> [[Int]] -> Property -prop_excFromToListIx2 comp ls2 = - if P.null lsL || P.all (head lsL ==) lsL - then label "Expected Success" $ resultLs === ls2 - else label "Expected Failure" $ assertSomeException resultLs - where - lsL = P.map P.length ls2 - resultLs = toLists (fromLists' comp ls2 :: Array U Ix2 Int) - - -prop_excFromToListIx3 :: Comp -> [[[Int]]] -> Property -prop_excFromToListIx3 comp ls3 - | P.null (P.concat (P.concat ls3)) = - classify True "Expected Success" $ counterexample (show arr) $ totalElem (size arr) === 0 - | P.all (head lsL ==) lsL && P.all (P.all (head (head lsLL) ==)) lsLL = - classify True "Expected Success" $ counterexample (show arr) $ resultLs === ls3 - | otherwise = classify True "Expected Failure" $ assertSomeException resultLs - where - arr = fromLists' comp ls3 :: Array U Ix3 Int - resultLs = toLists arr - lsL = P.map P.length ls3 - lsLL = P.map (P.map P.length) ls3 - - -specConstructIx1 :: Spec -specConstructIx1 = do - it "toFromList" $ property (prop_toFromList (Proxy :: Proxy Ix1)) - it "toFromListIsList" $ property (prop_toFromListIsList (Proxy :: Proxy Ix1)) - it "rangeEqRangeStep1" $ property prop_rangeEqRangeStep1 - it "rangeEqEnumFromN" $ property prop_rangeEqEnumFromN - it "rangeStepEqEnumFromStepN" $ property prop_rangeStepEqEnumFromStepN - it "rangeStepExc" $ property prop_rangeStepExc - -specConstructIx2 :: Spec -specConstructIx2 = do - it "toFromList" $ property (prop_toFromList (Proxy :: Proxy Ix2)) - it "toFromListIsList" $ property (prop_toFromListIsList (Proxy :: Proxy Ix2)) - it "excFromToListIx2" $ property prop_excFromToListIx2 - -specConstructIx3 :: Spec -specConstructIx3 = do - it "toFromList" $ property (prop_toFromList (Proxy :: Proxy Ix3)) - it "toFromListIsList" $ property (prop_toFromListIsList (Proxy :: Proxy Ix3)) - it "excFromToListIx3" $ property prop_excFromToListIx3 - -mkIntermediate :: Int -> Array U Ix1 Int -mkIntermediate t = A.fromList Seq [t + 50, t + 75] - -initArr :: Array N Ix1 (Array U Ix1 Int) -initArr = makeArray Seq (Sz1 3) mkIntermediate - -initArr2 :: Array N Ix2 (Array U Ix1 Int) -initArr2 = makeArray Seq (Sz 2) (\ (x :. y) -> mkIntermediate (x+y)) - -prop_unfoldrList :: Sz1 -> Fun Word (Int, Word) -> Word -> Property -prop_unfoldrList sz1 f i = - conjoin $ - L.zipWith - (===) - (A.toList (computeAs P $ unfoldrS_ sz1 (apply f) i)) - (L.unfoldr (Just . apply f) i) - -specExpand :: Spec -specExpand = do - it "expandOuter" $ compute (expandOuter 2 A.index' initArr :: Array D Ix2 Int) `shouldBe` - resize' (Sz2 2 3) (fromList Seq [50, 51, 52, 75, 76, 77] :: Array U Ix1 Int) - it "expandInner" $ compute (expandInner 2 A.index' initArr :: Array D Ix2 Int) `shouldBe` - resize' (Sz2 3 2) (fromList Seq [50, 75, 51, 76, 52, 77] :: Array U Ix1 Int) - it "expandwithin" $ compute (expandWithin Dim1 2 A.index' initArr2 :: Array D Ix3 Int) `shouldBe` - resize' (Sz 2) (fromList Seq [50, 75, 51, 76, 51, 76, 52, 77] :: Array U Ix1 Int) - it "expandwithin'" $ compute (expandWithin' 1 2 A.index' initArr2 :: Array D Ix3 Int) `shouldBe` - resize' (Sz 2) (fromList Seq [50, 75, 51, 76, 51, 76, 52, 77] :: Array U Ix1 Int) - -spec :: Spec -spec = do - describe "Ix1" specConstructIx1 - describe "Ix2" specConstructIx2 - describe "Ix3" specConstructIx3 - describe "Expand" specExpand - describe "Unfolding" $ it "unfoldrS_" $ property prop_unfoldrList diff --git a/tests/Data/Massiv/Array/Ops/SliceSpec.hs b/tests/Data/Massiv/Array/Ops/SliceSpec.hs deleted file mode 100644 --- a/tests/Data/Massiv/Array/Ops/SliceSpec.hs +++ /dev/null @@ -1,248 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MonoLocalBinds #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeFamilies #-} -module Data.Massiv.Array.Ops.SliceSpec (spec) where - -import Control.Applicative ((<|>)) -import Control.Exception -import Data.Massiv.Array.Unsafe -import Data.Massiv.Array as A -import Test.Massiv.Core - ------------ --- Size -- ------------ - -prop_ExtractEqualsExtractFromTo :: - ( Eq (Array (R r) ix e) - , Show (Array (R r) ix e) - , Extract r ix e - ) - => proxy (r, ix, e) - -> SzIx ix - -> Array r ix e - -> Property -prop_ExtractEqualsExtractFromTo _ (SzIx (Sz eIx) sIx) arr = - (extractFromToM sIx eIx arr <|> Nothing) === extractM sIx (Sz (liftIndex2 (-) eIx sIx)) arr - - -specSizeN :: - ( Eq (Array (R r) ix e) - , Show (Array (R r) ix e) - , Arbitrary (Array r ix e) - , Show (Array r ix e) - , Arbitrary ix - , Extract r ix e - ) - => proxy (r, ix, e) - -> Spec -specSizeN proxy = - describe "extract" $ - it "ExtractEqualsExtractFromTo" $ property $ prop_ExtractEqualsExtractFromTo proxy - - ------------ --- Slice -- ------------ - - -prop_SliceRight :: - (Slice r ix e, OuterSlice r ix e, Eq (Elt r ix e), Show (Elt r ix e)) - => proxy (r, ix, e) - -> Int - -> Array r ix e - -> Property -prop_SliceRight _ i arr = - either (Left . displayException) Right (arr !?> i) === - either (Left . displayException) Right (arr (dimensions (size arr), i)) - - -prop_SliceLeft :: - (Slice r ix e, InnerSlice r ix e, Eq (Elt r ix e), Show (Elt r ix e)) - => proxy (r, ix, e) - -> Int - -> Array r ix e - -> Property -prop_SliceLeft _ i arr = - either (Left . displayException) Right (arr (1, i)) - - -prop_SliceIndexDim2D :: ArrIx D Ix2 Int -> Property -prop_SliceIndexDim2D (ArrIx arr ix@(i :. j)) = - val === evaluate' (arr i) j - where - val = unsafeIndex arr ix - - -prop_SliceIndexDim2RankD :: ArrIx D Ix2 Int -> Property -prop_SliceIndexDim2RankD (ArrIx arr ix@(i :. j)) = - val === evaluate' (arr (2, i)) j .&&. - val === evaluate' (arr (1, j)) i - where - val = unsafeIndex arr ix - - -prop_SliceIndexDim3D :: ArrIx D Ix3 Int -> Property -prop_SliceIndexDim3D (ArrIx arr ix@(i :> j :. k)) = - val === evaluate' (arr i !> j) k .&&. - val === evaluate' (arr i) j .&&. - val === evaluate' (arr !> i Property -prop_SliceIndexDim3RankD (ArrIx arr ix@(i :> j :. k)) = - val === evaluate' (arr (3, i) (2, j)) k .&&. - val === evaluate' (arr (3, i) (1, k)) j .&&. - val === evaluate' (arr (2, j) (2, i)) k .&&. - val === evaluate' (arr (2, j) (1, k)) i .&&. - val === evaluate' (arr (1, k) (2, i)) j .&&. - val === evaluate' (arr (1, k) (1, j)) i - where - val = unsafeIndex arr ix - - -prop_SliceIndexDim2M :: ArrIx P Ix2 Int -> Property -prop_SliceIndexDim2M (ArrIx arr' ix@(i :. j)) = - val === (arr !> i ! j) .&&. - val === (arr Property -prop_SliceIndexDim2RankM (ArrIx arr' ix@(i :. j)) = - val === (arr (2, i) ! j) .&&. - val === (arr (1, j) ! i) - where - arr = toManifest arr' - val = unsafeIndex arr ix - - -prop_SliceIndexDim3M :: ArrIx P Ix3 Int -> Property -prop_SliceIndexDim3M (ArrIx arr' ix@(i :> j :. k)) = - val === (arr i !> j ! k) .&&. - val === (arr i ! j) .&&. - val === (arr !> i Property -prop_SliceIndexDim3RankM (ArrIx arr' ix@(i :> j :. k)) = - val === (arr (3, i) (2, j) ! k) .&&. - val === (arr (3, i) (1, k) ! j) .&&. - val === (arr (2, j) (2, i) ! k) .&&. - val === (arr (2, j) (1, k) ! i) .&&. - val === (arr (1, k) (2, i) ! j) .&&. - val === (arr (1, k) (1, j) ! i) - where - arr = toManifest arr' - val = unsafeIndex arr ix - - -prop_SliceIndexDim4D :: ArrIx D Ix4 Int -> Property -prop_SliceIndexDim4D (ArrIx arr ix@(i1 :> i2 :> i3 :. i4)) = - val === evaluate' (arr !> i1 !> i2 !> i3) i4 .&&. - val === evaluate' (arr !> i1 !> i2 i1 i1 i2) i3 .&&. - val === evaluate' (arr i1 !> i2) i3 .&&. - val === evaluate' (arr i1 i1) i2 - where - val = unsafeIndex arr ix - -prop_SliceIndexDim4RankD :: ArrIx D Ix4 Int -> Property -prop_SliceIndexDim4RankD (ArrIx arr ix@(i1 :> i2 :> i3 :. i4)) = - val === unsafeIndex (arr (4, i1) (3, i2) (2, i3)) i4 .&&. - val === unsafeIndex (arr (4, i1) (2, i3) (3, i2) (3, i1)) (i3 :. i4) .&&. - val === unsafeIndex (arr (2, i3) (2, i2)) (i1 :. i4) .&&. - val === unsafeIndex (arr (2, i3) (1, i4) !> i1) i2 .&&. - val === unsafeIndex (arr (1, i4) !> i1 !> i2) i3 - where - val = evaluate' arr ix - - -prop_SliceIndexDim4RankM :: ArrIx P Ix4 Int -> Property -prop_SliceIndexDim4RankM (ArrIx arr' ix@(i1 :> i2 :> i3 :. i4)) = - val === (arr (4, i1) (3, i2) (2, i3) ! i4) .&&. - val === (arr (4, i1) (2, i3) (3, i2) (3, i1) ! (i3 :. i4)) .&&. - val === (arr (2, i3) (2, i2) ! (i1 :. i4)) .&&. - val === (arr (2, i3) (1, i4) !> i1 ! i2) .&&. - val === (arr (1, i4) !> i1 !> i2 ! i3) - where - arr = toManifest arr' - val = unsafeIndex arr ix - - -prop_SliceIndexDim4M :: ArrIx P Ix4 Int -> Property -prop_SliceIndexDim4M (ArrIx arr' ix@(i1 :> i2 :> i3 :. i4)) = - val === (arr !> i1 !> i2 !> i3 ! i4) .&&. - val === (arr !> i1 !> i2 i1 i1 i2 ! i3) .&&. - val === (arr i1 !> i2 ! i3) .&&. - val === (arr i1 i1 ! i2) - where - arr = toManifest arr' - val = unsafeIndex arr ix - - - -specSliceN :: ( Arbitrary (Array r ix e) - , Show (Array r ix e) - , Slice r ix e - , OuterSlice r ix e - , InnerSlice r ix e - , Eq (Elt r ix e) - , Show (Elt r ix e) - ) - => proxy (r, ix, e) -> Spec -specSliceN proxy = - describe "Slice" $ do - it "SliceRight" $ property $ prop_SliceRight proxy - it "SliceLeft" $ property $ prop_SliceLeft proxy - - - -spec :: Spec -spec = do - describe "Ix1" $ - specSizeN (Nothing :: Maybe (D, Ix1, Int)) - describe "Ix2" $ do - specSizeN (Nothing :: Maybe (D, Ix2, Int)) - specSliceN (Nothing :: Maybe (D, Ix2, Int)) - describe "SliceIndex" $ do - it "Delayed" $ property prop_SliceIndexDim2D - it "Rank - Delayed" $ property prop_SliceIndexDim2RankD - it "Manifest" $ property prop_SliceIndexDim2M - it "Rank - Manifest" $ property prop_SliceIndexDim2RankM - describe "Ix3" $ do - specSizeN (Nothing :: Maybe (D, Ix3, Int)) - specSliceN (Nothing :: Maybe (D, Ix3, Int)) - describe "SliceIndex" $ do - it "Delayed" $ property prop_SliceIndexDim3D - it "Rank - Delayed" $ property prop_SliceIndexDim3RankD - it "Manifest" $ property prop_SliceIndexDim3M - it "Rank - Manifest" $ property prop_SliceIndexDim3RankM - describe "Ix4" $ do - specSizeN (Nothing :: Maybe (D, Ix4, Int)) - specSliceN (Nothing :: Maybe (D, Ix4, Int)) - describe "SliceIndex" $ do - it "Delayed" $ property prop_SliceIndexDim4D - it "Rank - Delayed" $ property prop_SliceIndexDim4RankD - it "Manifest" $ property prop_SliceIndexDim4M - it "Rank - Manifest" $ property prop_SliceIndexDim4RankM diff --git a/tests/Data/Massiv/ArraySpec.hs b/tests/Data/Massiv/ArraySpec.hs deleted file mode 100644 --- a/tests/Data/Massiv/ArraySpec.hs +++ /dev/null @@ -1,137 +0,0 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MonoLocalBinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} --- Here are contained tests for all instances for all main classes -module Data.Massiv.ArraySpec - ( spec - ) where - -import Data.Massiv.Array -import Test.Massiv.Core - - -prop_Construct_makeArray_Manifest :: - forall r ix. (Load D ix Int, Ragged L ix Int, Source r ix Int, Construct r ix Int) - => Comp - -> Sz ix - -> Fun Int Int - -> Property -prop_Construct_makeArray_Manifest comp sz f = - makeArrayLinearR D comp sz (apply f) === - delay (setComp Seq (makeArray comp sz (apply f . toLinearIndex sz) :: Array r ix Int)) - -prop_Construct_makeArray_Delayed :: - forall r ix. (Load D ix Int, Ragged L ix Int, Load r ix Int, Construct r ix Int) - => Comp - -> Sz ix - -> Fun Int Int - -> Property -prop_Construct_makeArray_Delayed comp sz f = - makeArrayLinearR P comp sz (apply f) === - compute (setComp Seq (makeArrayLinear comp sz (apply f)) :: Array r ix Int) - -prop_Functor :: - forall r ix. - (Load D ix Int, Ragged L ix Int, Load r ix Int, Construct r ix Int, Functor (Array r ix)) - => Comp - -> Sz ix - -> Fun Int Int - -> Fun Int Int - -> Property -prop_Functor comp sz f g = - makeArrayLinearR P comp sz (apply g . apply f) === - compute (fmap (apply g) (makeArrayLinear comp sz (apply f) :: Array r ix Int)) - -prop_Extract :: - forall r ix. - ( Load D ix Int - , Ragged L ix Int - , Load (R r) ix Int - , Construct r ix Int - , Extract r ix Int - ) - => Comp - -> Sz ix - -> Fun Int Int - -> ix - -> Sz ix - -> Property -prop_Extract comp sz f start newSize = - (computeAs P <$> toStringException (extractM start newSize arrD)) === - (compute <$> toStringException (extractM start newSize arr)) - where - arrD = makeArrayLinearR D comp sz (apply f) - arr = makeArrayLinear comp sz (apply f) :: Array r ix Int - -prop_IxUnbox :: - forall ix. - ( Load D ix ix - , Ragged L ix ix - , Construct U ix ix - , Source U ix ix - ) - => Comp - -> Sz ix - -> Fun Int ix - -> Property -prop_IxUnbox comp sz f = - makeArrayLinearR D comp sz (apply f) === - delay (makeArrayLinear comp sz (apply f) :: Array U ix ix) - -prop_computeWithStride :: - forall r ix. (Load D ix Int, Ragged L ix Int, StrideLoad r ix Int, Construct r ix Int) - => Comp - -> Sz ix - -> Fun Int Int - -> Stride ix - -> Property -prop_computeWithStride comp sz f stride = - arr === computeWithStride stride arrL .&&. - arr === compute (fromStrideLoad stride arrL) - where - arrL = makeArrayLinear comp sz (apply f) :: Array r ix Int - arr = computeWithStrideAs P stride (makeArrayLinearR D comp sz (apply f)) - - -specCommon :: - forall ix. - (Arbitrary ix, Load D ix Int, StrideLoad DW ix Int, Ragged L ix Int, Ragged L ix ix, Unbox ix) - => Spec -specCommon = - describe "Construct" $ do - it "Construct_makeArray B" $ property $ prop_Construct_makeArray_Manifest @B @ix - it "Construct_makeArray N" $ property $ prop_Construct_makeArray_Manifest @N @ix - it "Construct_makeArray S" $ property $ prop_Construct_makeArray_Manifest @S @ix - it "Construct_makeArray P" $ property $ prop_Construct_makeArray_Manifest @P @ix - it "Construct_makeArray U" $ property $ prop_Construct_makeArray_Manifest @U @ix - it "Construct_makeArray_Delayed DI" $ property $ prop_Construct_makeArray_Delayed @DI @ix - it "Construct_makeArray_Delayed DL" $ property $ prop_Construct_makeArray_Delayed @DL @ix - it "Construct_makeArray_Delayed DW" $ property $ prop_Construct_makeArray_Delayed @DW @ix - it "Functor D" $ property $ prop_Functor @D @ix - it "Functor DI" $ property $ prop_Functor @DI @ix - it "Functor DL" $ property $ prop_Functor @DL @ix - it "Functor DW" $ property $ prop_Functor @DW @ix - it "Extract DI" $ property $ prop_Extract @DI @ix - it "Extract B" $ property $ prop_Extract @B @ix - it "Extract N" $ property $ prop_Extract @N @ix - it "Extract S" $ property $ prop_Extract @S @ix - it "Extract U" $ property $ prop_Extract @U @ix - it "computeWithStride DI" $ property $ prop_computeWithStride @DI @ix - it "computeWithStride DW" $ property $ prop_computeWithStride @DW @ix - it "computeWithStride B" $ property $ prop_computeWithStride @B @ix - it "computeWithStride N" $ property $ prop_computeWithStride @N @ix - it "computeWithStride S" $ property $ prop_computeWithStride @S @ix - it "computeWithStride U" $ property $ prop_computeWithStride @U @ix - it "IxUnbox" $ property $ prop_IxUnbox @ix - - -spec :: Spec -spec = do - specCommon @Ix1 - specCommon @Ix2 - specCommon @Ix3 - -- FIXME: Uses too much RAM when compiling - -- specCommon @Ix4 - -- specCommon @Ix5 diff --git a/tests/Test/Massiv/Array/Manifest/PrimitiveSpec.hs b/tests/Test/Massiv/Array/Manifest/PrimitiveSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Test/Massiv/Array/Manifest/PrimitiveSpec.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module Test.Massiv.Array.Manifest.PrimitiveSpec (spec) where + +import Data.Massiv.Array as A +import Data.Massiv.Array.Unsafe +import Test.Massiv.Core +import Data.Word +import Data.Primitive.ByteArray + +prop_ToFromByteArray :: + forall ix. (Ragged L ix Word16) + => Array P ix Word16 + -> Property +prop_ToFromByteArray arr = + expectProp $ do + let sz = size arr + ba = unwrapByteArray arr + resizeM sz (fromByteArray Seq (toByteArray arr)) `shouldReturn` arr + fromByteArrayM Seq sz (toByteArray arr) `shouldReturn` arr + fromByteArrayOffsetM Seq sz (unwrapByteArrayOffset arr) ba `shouldReturn` arr + + marr <- unsafeThaw arr + (reallocated, mba) <- toMutableByteArray marr + -- check that no reallocation happens when there was no slicing + reallocated `shouldBe` (2 * totalElem sz == sizeofByteArray ba) + marr' <- fromMutableByteArrayM sz mba + unsafeFreeze Seq marr' `shouldReturn` arr + + let mba' = unwrapMutableByteArrayOffset marr + marr'' <- fromMutableByteArrayOffsetM sz mba' (unwrapMutableByteArray marr) + unsafeFreeze Seq marr'' `shouldReturn` arr + + +prop_ToFromPrimitiveVector :: + forall ix. (Ragged L ix Word) + => Array P ix Word + -> Property +prop_ToFromPrimitiveVector arr = + expectProp $ do + fromPrimitiveVector (toPrimitiveVector arr) `shouldBe` flatten arr + + marr <- unsafeThaw arr + arr' <- unsafeFreeze Seq $ fromPrimitiveMVector $ toPrimitiveMVector marr + arr' `shouldBe` flatten arr + +spec :: Spec +spec = + describe "Primitive" $ do + describe "ToFromByteArray" $ do + prop "ToFromByteArray" $ prop_ToFromByteArray @Ix1 + prop "ToFromByteArray" $ prop_ToFromByteArray @Ix2 + prop "ToFromByteArray" $ prop_ToFromByteArray @Ix3 + describe "ToFromPrimitiveVector" $ do + prop "ToFromPrimitiveVector" $ prop_ToFromPrimitiveVector @Ix1 + prop "ToFromPrimitiveVector" $ prop_ToFromPrimitiveVector @Ix2 + prop "ToFromPrimitiveVector" $ prop_ToFromPrimitiveVector @Ix3 diff --git a/tests/Test/Massiv/Array/Manifest/VectorSpec.hs b/tests/Test/Massiv/Array/Manifest/VectorSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Test/Massiv/Array/Manifest/VectorSpec.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +module Test.Massiv.Array.Manifest.VectorSpec (spec) where + +import Data.Massiv.Array.Manifest.Vector +import Data.Massiv.Array as A +import Test.Massiv.Core +import qualified Data.Vector as VB +import qualified Data.Vector.Generic as VG +import qualified Data.Vector.Primitive as VP +import qualified Data.Vector.Storable as VS +import qualified Data.Vector.Unboxed as VU + +prop_castToFromVector + :: ( VG.Vector (VRepr r) Int + , Mutable r ix Int + , Typeable (VRepr r) + , ARepr (VRepr r) ~ r + , Eq (Array r ix Int) + , Show (Array r ix Int) + ) + => proxy ix -> r -> ArrNE r ix Int -> Property +prop_castToFromVector _ _ (ArrNE arr) = + Just arr === (castToVector arr >>= castFromVector (getComp arr) (size arr)) + + +prop_toFromVector :: + forall r ix v. + ( Mutable r ix Int + , Mutable (ARepr v) ix Int + , VRepr (ARepr v) ~ v + , Eq (Array r ix Int) + , VG.Vector v Int + , Show (Array r ix Int) + , Typeable v + ) + => Proxy v + -> Proxy ix + -> r + -> ArrNE r ix Int + -> Property +prop_toFromVector _ _ _ (ArrNE arr) = + arr === fromVector' (getComp arr) (size arr) (toVector arr :: v Int) + + +toFromVectorSpec :: Spec +toFromVectorSpec = do + it_prop "Unboxed" U + it_prop "Primitive" P + it_prop "Storable" S + it_prop "BoxedStrict" B + where + it_prop name r = + describe name $ do + describe "CastToFrom" $ do + it "Ix1" $ property $ prop_castToFromVector (Proxy :: Proxy Ix1) r + it "Ix2" $ property $ prop_castToFromVector (Proxy :: Proxy Ix2) r + it "Ix3" $ property $ prop_castToFromVector (Proxy :: Proxy Ix3) r + describe "Through Boxed Vector" $ do + it "Ix1" $ property $ prop_toFromVector (Proxy :: Proxy VB.Vector) (Proxy :: Proxy Ix1) r + it "Ix2" $ property $ prop_toFromVector (Proxy :: Proxy VB.Vector) (Proxy :: Proxy Ix2) r + describe "Through Unboxed Vector" $ do + it "Ix1" $ property $ prop_toFromVector (Proxy :: Proxy VU.Vector) (Proxy :: Proxy Ix1) r + it "Ix2" $ property $ prop_toFromVector (Proxy :: Proxy VU.Vector) (Proxy :: Proxy Ix2) r + describe "Through Primitive Vector" $ do + it "Ix1" $ property $ prop_toFromVector (Proxy :: Proxy VP.Vector) (Proxy :: Proxy Ix1) r + it "Ix2" $ property $ prop_toFromVector (Proxy :: Proxy VP.Vector) (Proxy :: Proxy Ix2) r + describe "Through Storable Vector" $ do + it "Ix1" $ property $ prop_toFromVector (Proxy :: Proxy VS.Vector) (Proxy :: Proxy Ix1) r + it "Ix2" $ property $ prop_toFromVector (Proxy :: Proxy VS.Vector) (Proxy :: Proxy Ix2) r + + +spec :: Spec +spec = describe "toFromVector" toFromVectorSpec diff --git a/tests/Test/Massiv/Array/ManifestSpec.hs b/tests/Test/Massiv/Array/ManifestSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Test/Massiv/Array/ManifestSpec.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeApplications #-} +module Test.Massiv.Array.ManifestSpec (spec) where + +import Data.ByteString as S +import Data.ByteString.Builder as S +import Data.ByteString.Lazy as SL +import Data.Massiv.Array as A +import Test.Massiv.Core +import Data.Word (Word8) + + +-- ByteString +prop_toFromByteString :: Manifest r Ix1 Word8 => Array r Ix1 Word8 -> Property +prop_toFromByteString arr = toManifest arr === fromByteString (getComp arr) (toByteString arr) + +prop_castToFromByteString :: Array S Ix1 Word8 -> Property +prop_castToFromByteString arr = arr === castFromByteString (getComp arr) (castToByteString arr) + + +prop_fromToByteString :: Comp -> [Word8] -> Property +prop_fromToByteString comp ls = bs === toByteString (fromByteString comp bs) + where bs = S.pack ls + +prop_toBuilder :: Array P Ix1 Word8 -> Property +prop_toBuilder arr = bs === SL.toStrict (S.toLazyByteString (toBuilder S.word8 arr)) + where bs = toByteString arr + +conversionSpec :: Spec +conversionSpec = + describe "ByteString" $ do + it "castTo/TromByteString" $ property prop_castToFromByteString + it "to/from ByteString P" $ property (prop_toFromByteString @P) + it "to/from ByteString S" $ property (prop_toFromByteString @S) + it "from/to ByteString" $ property prop_fromToByteString + it "toBuilder" $ property prop_toBuilder + + +spec :: Spec +spec = describe "Conversion" conversionSpec diff --git a/tests/Test/Massiv/Array/NumericSpec.hs b/tests/Test/Massiv/Array/NumericSpec.hs --- a/tests/Test/Massiv/Array/NumericSpec.hs +++ b/tests/Test/Massiv/Array/NumericSpec.hs @@ -11,8 +11,6 @@ spec :: Spec spec = do mutableNumericSpec @P @Int - mutableNumericSpec @P @Float mutableNumericFloatSpec @P mutableNumericSpec @S @Int - mutableNumericSpec @S @Float mutableNumericFloatSpec @S diff --git a/tests/Test/Massiv/Array/Ops/ConstructSpec.hs b/tests/Test/Massiv/Array/Ops/ConstructSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Test/Massiv/Array/Ops/ConstructSpec.hs @@ -0,0 +1,130 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Test.Massiv.Array.Ops.ConstructSpec (spec) where + +import Data.List as L +import Data.Massiv.Array as A +import Test.Massiv.Core +import qualified GHC.Exts as GHC (IsList(..)) +import Prelude as P + +prop_rangeEqRangeStep1 :: Int -> Int -> Property +prop_rangeEqRangeStep1 from to = range Seq from to === rangeStep' Par from 1 to + +prop_rangeEqEnumFromN :: Int -> Int -> Property +prop_rangeEqEnumFromN from to = range Seq from to === enumFromN Par from (Sz (to - from)) + +prop_rangeStepEqEnumFromStepN :: Int -> NonZero Int -> Int -> Property +prop_rangeStepEqEnumFromStepN from (NonZero step) sz = + rangeStep' Seq from step (from + step * sz) === enumFromStepN Par from step (Sz sz) + + +prop_rangeStepExc :: Int -> Int -> Property +prop_rangeStepExc from to = + assertException + (\case + IndexZeroException _ -> True + _ -> False) + (computeAs U (rangeStep' Seq from 0 to)) + +prop_toFromListIsList :: + (Show (Array U ix Int), GHC.IsList (Array U ix Int), Index ix) + => Proxy ix + -> ArrNE U ix Int + -> Property +prop_toFromListIsList _ (ArrNE arr) = arr === GHC.fromList (GHC.toList arr) + + +prop_toFromList :: + forall ix . (Show (Array U ix Int), Nested LN ix Int, Ragged L ix Int) + => Proxy ix + -> ArrNE U ix Int + -> Property +prop_toFromList _ (ArrNE arr) = comp === comp' .&&. arr === arr' + where comp = getComp arr + arr' = fromLists' comp (toLists arr) + comp' = getComp arr' + + +prop_excFromToListIx2 :: Comp -> [[Int]] -> Property +prop_excFromToListIx2 comp ls2 = + if P.null lsL || P.all (head lsL ==) lsL + then label "Expected Success" $ resultLs === ls2 + else label "Expected Failure" $ assertSomeException resultLs + where + lsL = P.map P.length ls2 + resultLs = toLists (fromLists' comp ls2 :: Array U Ix2 Int) + + +prop_excFromToListIx3 :: Comp -> [[[Int]]] -> Property +prop_excFromToListIx3 comp ls3 + | P.null (P.concat (P.concat ls3)) = + classify True "Expected Success" $ counterexample (show arr) $ totalElem (size arr) === 0 + | P.all (head lsL ==) lsL && P.all (P.all (head (head lsLL) ==)) lsLL = + classify True "Expected Success" $ counterexample (show arr) $ resultLs === ls3 + | otherwise = classify True "Expected Failure" $ assertSomeException resultLs + where + arr = fromLists' comp ls3 :: Array U Ix3 Int + resultLs = toLists arr + lsL = P.map P.length ls3 + lsLL = P.map (P.map P.length) ls3 + + +specConstructIx1 :: Spec +specConstructIx1 = do + it "toFromList" $ property (prop_toFromList (Proxy :: Proxy Ix1)) + it "toFromListIsList" $ property (prop_toFromListIsList (Proxy :: Proxy Ix1)) + it "rangeEqRangeStep1" $ property prop_rangeEqRangeStep1 + it "rangeEqEnumFromN" $ property prop_rangeEqEnumFromN + it "rangeStepEqEnumFromStepN" $ property prop_rangeStepEqEnumFromStepN + it "rangeStepExc" $ property prop_rangeStepExc + +specConstructIx2 :: Spec +specConstructIx2 = do + it "toFromList" $ property (prop_toFromList (Proxy :: Proxy Ix2)) + it "toFromListIsList" $ property (prop_toFromListIsList (Proxy :: Proxy Ix2)) + it "excFromToListIx2" $ property prop_excFromToListIx2 + +specConstructIx3 :: Spec +specConstructIx3 = do + it "toFromList" $ property (prop_toFromList (Proxy :: Proxy Ix3)) + it "toFromListIsList" $ property (prop_toFromListIsList (Proxy :: Proxy Ix3)) + it "excFromToListIx3" $ property prop_excFromToListIx3 + +mkIntermediate :: Int -> Array U Ix1 Int +mkIntermediate t = A.fromList Seq [t + 50, t + 75] + +initArr :: Array N Ix1 (Array U Ix1 Int) +initArr = makeArray Seq (Sz1 3) mkIntermediate + +initArr2 :: Array N Ix2 (Array U Ix1 Int) +initArr2 = makeArray Seq (Sz 2) (\ (x :. y) -> mkIntermediate (x+y)) + +prop_unfoldrList :: Sz1 -> Fun Word (Int, Word) -> Word -> Property +prop_unfoldrList sz1 f i = + conjoin $ + L.zipWith + (===) + (A.toList (computeAs P $ unfoldrS_ sz1 (apply f) i)) + (L.unfoldr (Just . apply f) i) + +specExpand :: Spec +specExpand = do + it "expandOuter" $ compute (expandOuter 2 A.index' initArr :: Array D Ix2 Int) `shouldBe` + resize' (Sz2 2 3) (fromList Seq [50, 51, 52, 75, 76, 77] :: Array U Ix1 Int) + it "expandInner" $ compute (expandInner 2 A.index' initArr :: Array D Ix2 Int) `shouldBe` + resize' (Sz2 3 2) (fromList Seq [50, 75, 51, 76, 52, 77] :: Array U Ix1 Int) + it "expandwithin" $ compute (expandWithin Dim1 2 A.index' initArr2 :: Array D Ix3 Int) `shouldBe` + resize' (Sz 2) (fromList Seq [50, 75, 51, 76, 51, 76, 52, 77] :: Array U Ix1 Int) + it "expandwithin'" $ compute (expandWithin' 1 2 A.index' initArr2 :: Array D Ix3 Int) `shouldBe` + resize' (Sz 2) (fromList Seq [50, 75, 51, 76, 51, 76, 52, 77] :: Array U Ix1 Int) + +spec :: Spec +spec = do + describe "Ix1" specConstructIx1 + describe "Ix2" specConstructIx2 + describe "Ix3" specConstructIx3 + describe "Expand" specExpand + describe "Unfolding" $ it "unfoldrS_" $ property prop_unfoldrList diff --git a/tests/Test/Massiv/Array/Ops/SliceSpec.hs b/tests/Test/Massiv/Array/Ops/SliceSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Test/Massiv/Array/Ops/SliceSpec.hs @@ -0,0 +1,247 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +module Test.Massiv.Array.Ops.SliceSpec (spec) where + +import Control.Applicative ((<|>)) +import Control.Exception +import Data.Massiv.Array.Unsafe +import Data.Massiv.Array as A +import Test.Massiv.Core + +----------- +-- Size -- +----------- + +prop_ExtractEqualsExtractFromTo :: + ( Eq (Array (R r) ix e) + , Show (Array (R r) ix e) + , Extract r ix e + ) + => proxy (r, ix, e) + -> SzIx ix + -> Array r ix e + -> Property +prop_ExtractEqualsExtractFromTo _ (SzIx (Sz eIx) sIx) arr = + (extractFromToM sIx eIx arr <|> Nothing) === extractM sIx (Sz (liftIndex2 (-) eIx sIx)) arr + + +specSizeN :: + ( Eq (Array (R r) ix e) + , Show (Array (R r) ix e) + , Arbitrary (Array r ix e) + , Show (Array r ix e) + , Arbitrary ix + , Extract r ix e + ) + => proxy (r, ix, e) + -> Spec +specSizeN proxy = + describe "extract" $ + it "ExtractEqualsExtractFromTo" $ property $ prop_ExtractEqualsExtractFromTo proxy + + +----------- +-- Slice -- +----------- + + +prop_SliceRight :: + (Slice r ix e, OuterSlice r ix e, Eq (Elt r ix e), Show (Elt r ix e)) + => proxy (r, ix, e) + -> Int + -> Array r ix e + -> Property +prop_SliceRight _ i arr = + either (Left . displayException) Right (arr !?> i) === + either (Left . displayException) Right (arr (dimensions (size arr), i)) + + +prop_SliceLeft :: + (Slice r ix e, InnerSlice r ix e, Eq (Elt r ix e), Show (Elt r ix e)) + => proxy (r, ix, e) + -> Int + -> Array r ix e + -> Property +prop_SliceLeft _ i arr = + either (Left . displayException) Right (arr (1, i)) + + +prop_SliceIndexDim2D :: ArrIx D Ix2 Int -> Property +prop_SliceIndexDim2D (ArrIx arr ix@(i :. j)) = + val === evaluate' (arr i) j + where + val = unsafeIndex arr ix + + +prop_SliceIndexDim2RankD :: ArrIx D Ix2 Int -> Property +prop_SliceIndexDim2RankD (ArrIx arr ix@(i :. j)) = + val === evaluate' (arr (2, i)) j .&&. + val === evaluate' (arr (1, j)) i + where + val = unsafeIndex arr ix + + +prop_SliceIndexDim3D :: ArrIx D Ix3 Int -> Property +prop_SliceIndexDim3D (ArrIx arr ix@(i :> j :. k)) = + val === evaluate' (arr i !> j) k .&&. + val === evaluate' (arr i) j .&&. + val === evaluate' (arr !> i Property +prop_SliceIndexDim3RankD (ArrIx arr ix@(i :> j :. k)) = + val === evaluate' (arr (3, i) (2, j)) k .&&. + val === evaluate' (arr (3, i) (1, k)) j .&&. + val === evaluate' (arr (2, j) (2, i)) k .&&. + val === evaluate' (arr (2, j) (1, k)) i .&&. + val === evaluate' (arr (1, k) (2, i)) j .&&. + val === evaluate' (arr (1, k) (1, j)) i + where + val = unsafeIndex arr ix + + +prop_SliceIndexDim2M :: ArrIx P Ix2 Int -> Property +prop_SliceIndexDim2M (ArrIx arr' ix@(i :. j)) = + val === (arr !> i ! j) .&&. + val === (arr Property +prop_SliceIndexDim2RankM (ArrIx arr' ix@(i :. j)) = + val === (arr (2, i) ! j) .&&. + val === (arr (1, j) ! i) + where + arr = toManifest arr' + val = unsafeIndex arr ix + + +prop_SliceIndexDim3M :: ArrIx P Ix3 Int -> Property +prop_SliceIndexDim3M (ArrIx arr' ix@(i :> j :. k)) = + val === (arr i !> j ! k) .&&. + val === (arr i ! j) .&&. + val === (arr !> i Property +prop_SliceIndexDim3RankM (ArrIx arr' ix@(i :> j :. k)) = + val === (arr (3, i) (2, j) ! k) .&&. + val === (arr (3, i) (1, k) ! j) .&&. + val === (arr (2, j) (2, i) ! k) .&&. + val === (arr (2, j) (1, k) ! i) .&&. + val === (arr (1, k) (2, i) ! j) .&&. + val === (arr (1, k) (1, j) ! i) + where + arr = toManifest arr' + val = unsafeIndex arr ix + + +prop_SliceIndexDim4D :: ArrIx D Ix4 Int -> Property +prop_SliceIndexDim4D (ArrIx arr ix@(i1 :> i2 :> i3 :. i4)) = + val === evaluate' (arr !> i1 !> i2 !> i3) i4 .&&. + val === evaluate' (arr !> i1 !> i2 i1 i1 i2) i3 .&&. + val === evaluate' (arr i1 !> i2) i3 .&&. + val === evaluate' (arr i1 i1) i2 + where + val = unsafeIndex arr ix + +prop_SliceIndexDim4RankD :: ArrIx D Ix4 Int -> Property +prop_SliceIndexDim4RankD (ArrIx arr ix@(i1 :> i2 :> i3 :. i4)) = + val === unsafeIndex (arr (4, i1) (3, i2) (2, i3)) i4 .&&. + val === unsafeIndex (arr (4, i1) (2, i3) (3, i2) (3, i1)) (i3 :. i4) .&&. + val === unsafeIndex (arr (2, i3) (2, i2)) (i1 :. i4) .&&. + val === unsafeIndex (arr (2, i3) (1, i4) !> i1) i2 .&&. + val === unsafeIndex (arr (1, i4) !> i1 !> i2) i3 + where + val = evaluate' arr ix + + +prop_SliceIndexDim4RankM :: ArrIx P Ix4 Int -> Property +prop_SliceIndexDim4RankM (ArrIx arr' ix@(i1 :> i2 :> i3 :. i4)) = + val === (arr (4, i1) (3, i2) (2, i3) ! i4) .&&. + val === (arr (4, i1) (2, i3) (3, i2) (3, i1) ! (i3 :. i4)) .&&. + val === (arr (2, i3) (2, i2) ! (i1 :. i4)) .&&. + val === (arr (2, i3) (1, i4) !> i1 ! i2) .&&. + val === (arr (1, i4) !> i1 !> i2 ! i3) + where + arr = toManifest arr' + val = unsafeIndex arr ix + + +prop_SliceIndexDim4M :: ArrIx P Ix4 Int -> Property +prop_SliceIndexDim4M (ArrIx arr' ix@(i1 :> i2 :> i3 :. i4)) = + val === (arr !> i1 !> i2 !> i3 ! i4) .&&. + val === (arr !> i1 !> i2 i1 i1 i2 ! i3) .&&. + val === (arr i1 !> i2 ! i3) .&&. + val === (arr i1 i1 ! i2) + where + arr = toManifest arr' + val = unsafeIndex arr ix + + + +specSliceN :: ( Arbitrary (Array r ix e) + , Show (Array r ix e) + , Slice r ix e + , OuterSlice r ix e + , InnerSlice r ix e + , Eq (Elt r ix e) + , Show (Elt r ix e) + ) + => proxy (r, ix, e) -> Spec +specSliceN proxy = + describe "Slice" $ do + it "SliceRight" $ property $ prop_SliceRight proxy + it "SliceLeft" $ property $ prop_SliceLeft proxy + + + +spec :: Spec +spec = do + describe "Ix1" $ + specSizeN (Nothing :: Maybe (D, Ix1, Int)) + describe "Ix2" $ do + specSizeN (Nothing :: Maybe (D, Ix2, Int)) + specSliceN (Nothing :: Maybe (D, Ix2, Int)) + describe "SliceIndex" $ do + it "Delayed" $ property prop_SliceIndexDim2D + it "Rank - Delayed" $ property prop_SliceIndexDim2RankD + it "Manifest" $ property prop_SliceIndexDim2M + it "Rank - Manifest" $ property prop_SliceIndexDim2RankM + describe "Ix3" $ do + specSizeN (Nothing :: Maybe (D, Ix3, Int)) + specSliceN (Nothing :: Maybe (D, Ix3, Int)) + describe "SliceIndex" $ do + it "Delayed" $ property prop_SliceIndexDim3D + it "Rank - Delayed" $ property prop_SliceIndexDim3RankD + it "Manifest" $ property prop_SliceIndexDim3M + it "Rank - Manifest" $ property prop_SliceIndexDim3RankM + describe "Ix4" $ do + specSizeN (Nothing :: Maybe (D, Ix4, Int)) + specSliceN (Nothing :: Maybe (D, Ix4, Int)) + describe "SliceIndex" $ do + it "Delayed" $ property prop_SliceIndexDim4D + it "Rank - Delayed" $ property prop_SliceIndexDim4RankD + it "Manifest" $ property prop_SliceIndexDim4M + it "Rank - Manifest" $ property prop_SliceIndexDim4RankM diff --git a/tests/Test/Massiv/ArraySpec.hs b/tests/Test/Massiv/ArraySpec.hs new file mode 100644 --- /dev/null +++ b/tests/Test/Massiv/ArraySpec.hs @@ -0,0 +1,137 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +-- Here are tests for all instances for all main classes +module Test.Massiv.ArraySpec + ( spec + ) where + +import Data.Massiv.Array +import Test.Massiv.Core + + +prop_Construct_makeArray_Manifest :: + forall r ix. (Load D ix Int, Ragged L ix Int, Source r ix Int, Construct r ix Int) + => Comp + -> Sz ix + -> Fun Int Int + -> Property +prop_Construct_makeArray_Manifest comp sz f = + makeArrayLinearR D comp sz (apply f) === + delay (setComp Seq (makeArray comp sz (apply f . toLinearIndex sz) :: Array r ix Int)) + +prop_Construct_makeArray_Delayed :: + forall r ix. (Load D ix Int, Ragged L ix Int, Load r ix Int, Construct r ix Int) + => Comp + -> Sz ix + -> Fun Int Int + -> Property +prop_Construct_makeArray_Delayed comp sz f = + makeArrayLinearR P comp sz (apply f) === + compute (setComp Seq (makeArrayLinear comp sz (apply f)) :: Array r ix Int) + +prop_Functor :: + forall r ix. + (Load D ix Int, Ragged L ix Int, Load r ix Int, Construct r ix Int, Functor (Array r ix)) + => Comp + -> Sz ix + -> Fun Int Int + -> Fun Int Int + -> Property +prop_Functor comp sz f g = + makeArrayLinearR P comp sz (apply g . apply f) === + compute (fmap (apply g) (makeArrayLinear comp sz (apply f) :: Array r ix Int)) + +prop_Extract :: + forall r ix. + ( Load D ix Int + , Ragged L ix Int + , Load (R r) ix Int + , Construct r ix Int + , Extract r ix Int + ) + => Comp + -> Sz ix + -> Fun Int Int + -> ix + -> Sz ix + -> Property +prop_Extract comp sz f start newSize = + (computeAs P <$> toStringException (extractM start newSize arrD)) === + (compute <$> toStringException (extractM start newSize arr)) + where + arrD = makeArrayLinearR D comp sz (apply f) + arr = makeArrayLinear comp sz (apply f) :: Array r ix Int + +prop_IxUnbox :: + forall ix. + ( Load D ix ix + , Ragged L ix ix + , Construct U ix ix + , Source U ix ix + ) + => Comp + -> Sz ix + -> Fun Int ix + -> Property +prop_IxUnbox comp sz f = + makeArrayLinearR D comp sz (apply f) === + delay (makeArrayLinear comp sz (apply f) :: Array U ix ix) + +prop_computeWithStride :: + forall r ix. (Load D ix Int, Ragged L ix Int, StrideLoad r ix Int, Construct r ix Int) + => Comp + -> Sz ix + -> Fun Int Int + -> Stride ix + -> Property +prop_computeWithStride comp sz f stride = + arr === computeWithStride stride arrL .&&. + arr === compute (fromStrideLoad stride arrL) + where + arrL = makeArrayLinear comp sz (apply f) :: Array r ix Int + arr = computeWithStrideAs P stride (makeArrayLinearR D comp sz (apply f)) + + +specCommon :: + forall ix. + (Arbitrary ix, Load D ix Int, StrideLoad DW ix Int, Ragged L ix Int, Ragged L ix ix, Unbox ix) + => Spec +specCommon = + describe "Construct" $ do + it "Construct_makeArray B" $ property $ prop_Construct_makeArray_Manifest @B @ix + it "Construct_makeArray N" $ property $ prop_Construct_makeArray_Manifest @N @ix + it "Construct_makeArray S" $ property $ prop_Construct_makeArray_Manifest @S @ix + it "Construct_makeArray P" $ property $ prop_Construct_makeArray_Manifest @P @ix + it "Construct_makeArray U" $ property $ prop_Construct_makeArray_Manifest @U @ix + it "Construct_makeArray_Delayed DI" $ property $ prop_Construct_makeArray_Delayed @DI @ix + it "Construct_makeArray_Delayed DL" $ property $ prop_Construct_makeArray_Delayed @DL @ix + it "Construct_makeArray_Delayed DW" $ property $ prop_Construct_makeArray_Delayed @DW @ix + it "Functor D" $ property $ prop_Functor @D @ix + it "Functor DI" $ property $ prop_Functor @DI @ix + it "Functor DL" $ property $ prop_Functor @DL @ix + it "Functor DW" $ property $ prop_Functor @DW @ix + it "Extract DI" $ property $ prop_Extract @DI @ix + it "Extract B" $ property $ prop_Extract @B @ix + it "Extract N" $ property $ prop_Extract @N @ix + it "Extract S" $ property $ prop_Extract @S @ix + it "Extract U" $ property $ prop_Extract @U @ix + it "computeWithStride DI" $ property $ prop_computeWithStride @DI @ix + it "computeWithStride DW" $ property $ prop_computeWithStride @DW @ix + it "computeWithStride B" $ property $ prop_computeWithStride @B @ix + it "computeWithStride N" $ property $ prop_computeWithStride @N @ix + it "computeWithStride S" $ property $ prop_computeWithStride @S @ix + it "computeWithStride U" $ property $ prop_computeWithStride @U @ix + it "IxUnbox" $ property $ prop_IxUnbox @ix + + +spec :: Spec +spec = do + specCommon @Ix1 + specCommon @Ix2 + specCommon @Ix3 + -- FIXME: Uses too much RAM when compiling + -- specCommon @Ix4 + -- specCommon @Ix5