massiv-test 0.1.6.1 → 1.0.0.0
raw patch · 32 files changed
+765/−676 lines, 32 filesdep ~massiv
Dependency ranges changed: massiv
Files
- CHANGELOG.md +8/−0
- README.md +1/−1
- massiv-test.cabal +5/−2
- src/Test/Massiv/Array/Delayed.hs +3/−4
- src/Test/Massiv/Array/Load.hs +66/−0
- src/Test/Massiv/Array/Mutable.hs +55/−35
- src/Test/Massiv/Array/Numeric.hs +37/−46
- src/Test/Massiv/Core/Common.hs +7/−7
- src/Test/Massiv/Core/Index.hs +65/−59
- src/Test/Massiv/Core/Mutable.hs +59/−39
- src/Test/Massiv/Utils.hs +14/−0
- tests/Main.hs +3/−2
- tests/Spec.hs +1/−1
- tests/Test/Massiv/Array/Delayed/InterleavedSpec.hs +1/−4
- tests/Test/Massiv/Array/Delayed/StreamSpec.hs +8/−2
- tests/Test/Massiv/Array/Delayed/WindowedSpec.hs +0/−3
- tests/Test/Massiv/Array/DelayedSpec.hs +1/−1
- tests/Test/Massiv/Array/Manifest/VectorSpec.hs +6/−3
- tests/Test/Massiv/Array/ManifestSpec.hs +5/−4
- tests/Test/Massiv/Array/MutableSpec.hs +83/−19
- tests/Test/Massiv/Array/Numeric/IntegralSpec.hs +19/−19
- tests/Test/Massiv/Array/Ops/ConstructSpec.hs +25/−26
- tests/Test/Massiv/Array/Ops/FoldSpec.hs +4/−8
- tests/Test/Massiv/Array/Ops/MapSpec.hs +4/−8
- tests/Test/Massiv/Array/Ops/SliceSpec.hs +101/−166
- tests/Test/Massiv/Array/Ops/SortSpec.hs +1/−1
- tests/Test/Massiv/Array/Ops/TransformSpec.hs +32/−40
- tests/Test/Massiv/Array/StencilSpec.hs +90/−81
- tests/Test/Massiv/ArraySpec.hs +37/−38
- tests/Test/Massiv/Core/IndexSpec.hs +3/−7
- tests/Test/Massiv/Core/ListSpec.hs +0/−4
- tests/Test/Massiv/VectorSpec.hs +21/−46
CHANGELOG.md view
@@ -1,3 +1,11 @@+# 1.0.0++* Support for massiv-1.0.0.0++# 0.1.7++* Add `propIO`+ # 0.1.6 * Fix expectations for matrix multiplications. Empty arrays now always produce empty arrays.
README.md view
@@ -16,7 +16,7 @@ Another important use case is for advanced users that came up with their own index types or array representations and would like to run a standard set of specs on their instance-implementations. For example a custom `Index ix`, or `Mutable r ix e` instances can use a+implementations. For example a custom `Index ix`, or `Maniest r e` instances can use a predefined collection of `hspec` specs and/or `QuickCheck` properties to validate their implementation.
massiv-test.cabal view
@@ -1,5 +1,5 @@ name: massiv-test-version: 0.1.6.1+version: 1.0.0.0 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@@ -21,6 +21,7 @@ , Test.Massiv.Core.Index , Test.Massiv.Core.Mutable , Test.Massiv.Array.Delayed+ , Test.Massiv.Array.Load , Test.Massiv.Array.Mutable , Test.Massiv.Array.Numeric , Test.Massiv.Utils@@ -33,7 +34,7 @@ , exceptions , QuickCheck , hspec- , massiv >= 0.5.9+ , massiv >= 1.0 && < 2 , scheduler , primitive , unliftio@@ -74,6 +75,7 @@ , Test.Massiv.Core.IndexSpec , Test.Massiv.Core.ListSpec , Test.Massiv.Core.SchedulerSpec+ build-tool-depends: hspec-discover:hspec-discover build-depends: base , bytestring , containers@@ -127,6 +129,7 @@ , Test.Massiv.Core.IndexSpec , Test.Massiv.Core.ListSpec , Test.Massiv.Core.SchedulerSpec+ build-tool-depends: hspec-discover:hspec-discover build-depends: base , bytestring , containers
src/Test/Massiv/Array/Delayed.hs view
@@ -32,7 +32,7 @@ -- | Alternative implementation of `stackSlicesM` with `concat'`. Useful for testing and benchmarks stackSlices' ::- (Functor f, Foldable f, Resize r (Lower ix), Source r ix e, Load r (Lower ix) e)+ (Functor f, Foldable f, Source r e, Index ix, Load r (Lower ix) e) => Dim -> f (Array r (Lower ix) e) -> Array DL ix e@@ -40,7 +40,6 @@ let fixupSize arr = resize' (Sz (insertDim' (unSz (size arr)) dim 1)) arr in concat' dim $ fmap fixupSize arrsF - compareAsListAndLoaded :: (Eq e, Show e, Foldable (Array r' Ix1), Load r' Ix1 e) => Array r' Ix1 e -> [e] -> Property compareAsListAndLoaded str ls =@@ -48,7 +47,7 @@ -- | Compare `toStream` and `A.toList` prop_toStream ::- forall r ix e. (Source r ix e, Stream r ix e, Show e, Eq e)+ forall r ix e. (Source r e, Stream r ix e, Show e, Eq e) => Array r ix e -> Property prop_toStream arr =@@ -132,7 +131,7 @@ forall r e. ( Eq e , Show e- , Source r Ix1 e+ , Source r e , Foldable (Array r Ix1) ) => Vector r e
+ src/Test/Massiv/Array/Load.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+module Test.Massiv.Array.Load+ ( -- * Spec for loadable representations+ loadSpec+ ) where+++import Data.Massiv.Array as A+import Test.Massiv.Core.Common ()+import Test.Massiv.Utils as T++prop_replicate ::+ forall r ix e.+ ( Eq e+ , Show e+ , Load r ix e+ , Ragged L ix e+ )+ => Comp+ -> Sz ix+ -> e+ -> Property+prop_replicate comp sz e = propIO $ do+ computeAs B (A.replicate @r comp sz e) `shouldBe`+ computeAs B (makeArrayLinear @r comp sz (const e))++prop_makeArray ::+ forall r ix e.+ ( Eq e+ , Show e+ , Load r ix e+ , Ragged L ix e+ )+ => Comp+ -> Sz ix+ -> Fun ix e+ -> Property+prop_makeArray comp sz f = propIO $ do+ let barr = makeArray @B comp sz (applyFun f)+ computeAs B (makeArray @r comp sz (applyFun f)) `shouldBe` barr+ computeAs B (makeArrayLinear @r comp sz (applyFun f . fromLinearIndex sz)) `shouldBe` barr+++loadSpec ::+ forall r ix e.+ ( Eq e+ , Show e+ , Typeable e+ , Arbitrary e+ , Function ix+ , Arbitrary ix+ , CoArbitrary ix+ , Ragged L ix e+ , Load r ix e+ )+ => Spec+loadSpec = do+ describe (("LoadSpec " ++) . showsArrayType @r @ix @e $ "") $ do+ prop "replicate" $ prop_replicate @r @ix @e+ prop "makeArray" $ prop_makeArray @r @ix @e
src/Test/Massiv/Array/Mutable.hs view
@@ -13,30 +13,31 @@ , prop_GrowShrink , prop_unfoldrList , prop_unfoldrReverseUnfoldl- , prop_toStreamArrayMutable+ , prop_toStreamArrayManifest -- * Atomic ops spec , atomicIntSpec ) where +import Control.Scheduler import Data.Bits import Data.Functor.Identity import Data.List as L import Data.Massiv.Array as A-import qualified Data.Massiv.Vector.Stream as S import Data.Massiv.Array.Mutable.Atomic import Data.Massiv.Array.Unsafe+import qualified Data.Massiv.Vector.Stream as S 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) =>+-- prop_MapMapM :: forall r ix(Show (Array r ix Word), Eq (Array r ix Word), Manifest r ix) => -- Fun Word Word -> ArrTiny D ix Word -> Property -- prop_MapMapM r _ f (ArrTiny arr) = -- computeAs r (A.map (apply f) arr) === runIdentity (A.mapMR r (return . apply f) arr) prop_iMapiMapM ::- forall r ix e. (Show (Array r ix e), Eq (Array r ix e), Mutable r ix e)+ forall r ix e. (Show (Array r ix e), Eq (Array r ix e), Manifest r e, Index ix) => Fun (ix, e) e -> Array D ix e -> Property@@ -48,7 +49,8 @@ forall r ix e. ( Show (Array r ix e) , Eq (Array r ix e)- , Mutable r ix e+ , Manifest r e+ , Load r ix e , Show e , Arbitrary e , Arbitrary ix@@ -67,13 +69,7 @@ prop_Shrink :: forall r ix e.- ( Show (Array r ix e)- , Mutable r ix e- , Source r Ix1 e- , Arbitrary ix- , Arbitrary e- , Eq e- )+ (Show (Array r ix e), Manifest r e, Load r ix e, Arbitrary ix, Arbitrary e, Eq e) => Property prop_Shrink = property $ \ (ArrIx arr ix) -> runST $ do@@ -86,9 +82,8 @@ forall r ix e. ( Eq (Array r ix e) , Show (Array r ix e)- , Load (R r) ix e- , Mutable r ix e- , Extract r ix e+ , Load r ix e+ , Manifest r e , Arbitrary ix , Arbitrary e , Show e@@ -114,12 +109,11 @@ forall r ix e. ( Show (Array r Ix1 e) , Eq (Array r Ix1 e)+ , Index ix , Arbitrary ix , Arbitrary e , Show e- , Resize r ix- , Mutable r ix e- , Mutable r Ix1 e+ , Manifest r e ) => Property prop_unfoldrList =@@ -133,11 +127,11 @@ forall r ix e. ( Show (Array r ix e) , Eq (Array r ix e)+ , Index ix , Arbitrary ix , Arbitrary e , Show e- , Source r ix e- , Mutable r ix e+ , Manifest r e ) => Property prop_unfoldrReverseUnfoldl =@@ -149,46 +143,72 @@ a2 <- unfoldlPrimM_ @r 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 =+prop_toStreamArrayManifest ::+ forall r ix e. (Manifest r e, Index ix, Show (Array r ix e), Eq (Array r ix e))+ => Array r ix e+ -> Property+prop_toStreamArrayManifest arr = arr === S.unstreamExact (size arr) (S.stepsStream (toSteps (toStreamArray arr))) +prop_WithMArray ::+ forall r ix e. (HasCallStack, Index ix, Manifest r e, Eq (Array r ix e), Show (Array r ix e))+ => Array r ix e+ -> Fun e e+ -> Fun e e+ -> Property+prop_WithMArray arr f g =+ expectProp $ do+ let g' :: Monad m => e -> m e+ g' = pure . applyFun g+ let arr' = compute $ A.map (applyFun g . applyFun f) arr+ arr1 <-+ withMArray_ arr $ \scheduler marr -> scheduleWork_ scheduler $ forPrimM marr (g' . applyFun f)+ arr1 `shouldBe` arr'+ arr2 <-+ withLoadMArray_ (A.map (applyFun f) arr) $ \scheduler marr ->+ scheduleWork_ scheduler $ forPrimM marr g'+ arr2 `shouldBe` arr'+ arr3 <- withMArrayS_ arr $ \marr -> forPrimM marr (g' . applyFun f)+ arr3 `shouldBe` arr'+ arr4 <- withLoadMArrayS_ (A.map (applyFun f) arr) $ \marr -> forPrimM marr g'+ arr4 `shouldBe` arr'+ let arr5 = withMArrayST_ arr $ \marr -> forPrimM marr (g' . applyFun f)+ arr5 `shouldBe` arr'+ let arr6 = withLoadMArrayST_ (A.map (applyFun f) arr) $ \marr -> forPrimM marr g'+ arr6 `shouldBe` arr' mutableSpec :: forall r ix e. ( Show (Array D ix e) , Show (Array r ix e)- , Show (Array r Ix1 e)- , Eq (Array r Ix1 e)- , Load (R r) ix e+ , Show (Vector r e)+ , Eq (Vector r e)+ , Load r ix e , Eq (Array r ix e) , Typeable e , Show e , Eq e- , Mutable r ix e- , Mutable r Ix1 e- , Extract r ix e+ , Manifest r e , CoArbitrary ix , Arbitrary e , CoArbitrary e , Arbitrary ix- , Typeable ix , Function ix , Function e ) => Spec mutableSpec = do describe ("Mutable (" ++ showsArrayType @r @ix @e ") (Safe)") $ do- it "GenerateArray" $ property $ prop_GenerateArray @r @ix @e- it "Shrink" $ property $ prop_Shrink @r @ix @e- it "GrowShrink" $ property $ prop_GrowShrink @r @ix @e- it "map == mapM" $ property $ prop_iMapiMapM @r @ix @e+ prop "GenerateArray" $ prop_GenerateArray @r @ix @e+ prop "Shrink" $ prop_Shrink @r @ix @e+ prop "GrowShrink" $ prop_GrowShrink @r @ix @e+ prop "map == mapM" $ prop_iMapiMapM @r @ix @e+ prop "withMArray" $ prop_WithMArray @r @ix @e 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)+ prop "toStreamArrayMutable" $ prop_toStreamArrayManifest @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.
src/Test/Massiv/Array/Numeric.hs view
@@ -6,7 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Test.Massiv.Array.Numeric- ( -- * Spec for safe Mutable instance+ ( -- * Spec for safe Manifest instance prop_MatrixMatrixMultiply , mutableNumericSpec , mutableNumericFloatSpec@@ -18,7 +18,7 @@ naiveMatrixMatrixMultiply ::- (Num e, Source (R r1) Ix1 e, Source (R r2) Ix1 e, OuterSlice r1 Ix2 e, InnerSlice r2 Ix2 e)+ (Num e, Source r1 e, Source r2 e) => Array r1 Ix2 e -> Array r2 Ix2 e -> Array D Ix2 e@@ -38,7 +38,7 @@ prop_MatrixMatrixMultiply ::- forall r e. (Numeric r e, Mutable r Ix2 e, Eq (Matrix r e), Show (Matrix r e))+ forall r e. (Numeric r e, Manifest r e, Eq (Matrix r e), Show (Matrix r e)) => Fun e e -> Matrix r e -> Property@@ -54,11 +54,8 @@ prop_MatrixVectorMultiply :: forall r e. ( Numeric r e- , InnerSlice r Ix2 e- , Mutable r Ix2 e- , Source (R r) Ix1 e- , Source r Ix1 e- , Construct r Ix1 e+ , Manifest r e+ , Load r Ix1 e , Eq e , Show e )@@ -76,10 +73,8 @@ prop_VectorMatrixMultiply :: forall r e. ( Numeric r e- , OuterSlice r Ix2 e- , Mutable r Ix2 e- , Source (R r) Ix1 e- , Mutable r Ix1 e+ , Load r Ix1 e+ , Manifest r e , Show (Vector r e) , Eq (Vector r e) )@@ -97,7 +92,7 @@ (== SizeMismatchException (Sz2 1 (m + 1)) (size arr)) prop_DotProduct ::- forall r e. (Numeric r e, Mutable r Ix1 e, Eq e, Show e)+ forall r e. (Numeric r e, Manifest r e, Eq e, Show e, Load r Ix1 e) => Fun e e -> Vector r e -> Property@@ -109,7 +104,7 @@ (== SizeMismatchException (size v) (size v + 1)) prop_Norm ::- forall r e. (NumericFloat r e, Mutable r Ix1 e, RealFloat e, Show e)+ forall r e. (NumericFloat r e, Manifest r e, RealFloat e, Show e) => e -> Vector r e -> Property@@ -119,7 +114,7 @@ prop_Plus :: forall r e.- (Numeric r e, Mutable r Ix2 e, Show (Array r Ix2 e), Eq (Array r Ix2 e))+ (Numeric r e, Manifest r e, Show (Matrix r e), Eq (Matrix r e)) => Fun e e -> Matrix r e -> e@@ -130,12 +125,12 @@ let arr' = compute (A.map (applyFun f) arr) arr !+! arr' `shouldBe` compute (A.zipWith (+) arr arr') let Sz2 m n = size arr- when (m /= n) $+ when (m /= n && m * n /= 0) $ arr .+. compute (transpose arr) `shouldThrow` (== SizeMismatchException (size arr) (Sz2 n m)) prop_Minus :: forall r e.- (Numeric r e, Mutable r Ix2 e, Show (Array r Ix2 e), Eq (Array r Ix2 e))+ (Numeric r e, Manifest r e, Show (Array r Ix2 e), Eq (Array r Ix2 e)) => Fun e e -> Matrix r e -> e@@ -146,12 +141,12 @@ let arr' = compute (A.map (applyFun f) arr) arr !-! arr' `shouldBe` compute (A.zipWith (-) arr arr') let Sz2 m n = size arr- when (m /= n) $+ when (m /= n && m * n /= 0) $ arr .-. compute (transpose arr) `shouldThrow` (== SizeMismatchException (size arr) (Sz2 n m)) prop_Times :: forall r e.- (Numeric r e, Mutable r Ix2 e, Show (Array r Ix2 e), Eq (Array r Ix2 e))+ (Numeric r e, Manifest r e, Show (Matrix r e), Eq (Matrix r e)) => Fun e e -> Matrix r e -> e@@ -162,17 +157,17 @@ let arr' = compute (A.map (applyFun f) arr) arr !*! arr' `shouldBe` compute (A.zipWith (*) arr arr') let Sz2 m n = size arr- when (m /= n) $+ when (m /= n && m * n /= 0) $ arr .*. compute (transpose arr) `shouldThrow` (== SizeMismatchException (size arr) (Sz2 n m)) prop_Divide :: forall r e. ( NumericFloat r e- , Mutable r Ix2 e+ , Manifest r e , Show e , RealFloat e- , Show (Array r Ix2 e)- , Eq (Array r Ix2 e)+ , Show (Matrix r e)+ , Eq (Matrix r e) ) => e -- ^ Epsilon -> Fun e e@@ -186,11 +181,11 @@ unless (A.or (A.zipWith (\x y -> x == 0 && y == 0) arr arr')) $ arr !/! arr' `shouldBe` compute (A.zipWith (/) arr arr') let Sz2 m n = size arr- when (m /= n) $+ when (m /= n && m * n /= 0) $ arr ./. compute (transpose arr) `shouldThrow` (== SizeMismatchException (size arr) (Sz2 n m)) prop_Floating ::- forall r e. (RealFloat e, Source r Ix2 e, NumericFloat r e, Show e)+ forall r e. (RealFloat e, Source r e, NumericFloat r e, Show e) => e -> Matrix r e -> Property@@ -215,7 +210,7 @@ epsilonFoldableExpect eps (delay (atanhA arr)) (A.map atanh arr) prop_Floating2 ::- forall r e. (RealFloat e, Mutable r Ix2 e, NumericFloat r e, Show e)+ forall r e. (RealFloat e, Manifest r e, NumericFloat r e, Show e) => e -> Matrix r e -> Fun e e@@ -231,11 +226,9 @@ mutableNumericSpec :: forall r e. ( Numeric r e- , Mutable r Ix2 e- , InnerSlice r Ix2 e- , OuterSlice r Ix2 e- , Source (R r) Ix1 e- , Mutable r Ix1 e+ , Manifest r e+ , Load r Ix1 e+ , Load r Ix2 e , Eq e , Show e , Function e@@ -273,21 +266,19 @@ mutableNumericFloatSpec :: forall r. ( NumericFloat r Float- , Mutable r Ix1 Float- , Mutable r Ix2 Float- , Arbitrary (Array r Ix1 Float)- , Arbitrary (Array r Ix2 Float)- , Show (Array r Ix1 Float)- , Show (Array r Ix2 Float)- , Eq (Array r Ix2 Float)+ , Manifest r Float+ , Arbitrary (Vector r Float)+ , Arbitrary (Matrix r Float)+ , Show (Vector r Float)+ , Show (Matrix r Float)+ , Eq (Matrix r Float) , NumericFloat r Double- , Mutable r Ix1 Double- , Mutable r Ix2 Double- , Arbitrary (Array r Ix1 Double)- , Arbitrary (Array r Ix2 Double)- , Show (Array r Ix1 Double)- , Show (Array r Ix2 Double)- , Eq (Array r Ix2 Double)+ , Manifest r Double+ , Arbitrary (Vector r Double)+ , Arbitrary (Matrix r Double)+ , Show (Vector r Double)+ , Show (Matrix r Double)+ , Eq (Matrix r Double) ) => Spec mutableNumericFloatSpec = do@@ -308,6 +299,6 @@ prop "Power" $ prop_Power @r ed prop_Power ::- (Numeric r e, Source r Ix2 e, RealFloat e, Show e) => e -> Matrix r e -> Int -> Property+ (Numeric r e, Source r e, RealFloat e, Show e) => e -> Matrix r e -> Int -> Property prop_Power eps arr p = expectProp $ epsilonFoldableExpect eps (delay (arr .^^ p)) (A.map (^^ p) arr)
src/Test/Massiv/Core/Common.hs view
@@ -62,29 +62,29 @@ ] -arbitraryArray :: (Construct r ix e, Arbitrary e) => Gen (Sz ix) -> Gen (Array r ix e)+arbitraryArray :: (Load r ix e, Arbitrary e) => Gen (Sz ix) -> Gen (Array r ix e) arbitraryArray szGen = makeArrayLinear <$> arbitrary <*> szGen <*> arbitrary -- | Arbitrary array-instance (Arbitrary ix, Construct r ix e, Arbitrary e) =>+instance (Arbitrary ix, Load r ix e, Arbitrary e) => Arbitrary (Array r ix e) where arbitrary = makeArrayLinear <$> arbitrary <*> arbitrary <*> arbitrary -instance (Arbitrary ix, Construct r ix e, Arbitrary e) => Arbitrary (ArrTiny r ix e) where+instance (Arbitrary ix, Load r ix e, Arbitrary e) => Arbitrary (ArrTiny r ix e) where arbitrary = ArrTiny <$> arbitraryArray (liftSz (`mod` 10) <$> arbitrary) -- | Arbitrary small and possibly empty array. Computation strategy can be either `Seq` or `Par`.-instance (Arbitrary ix, Construct r ix e, Arbitrary e) =>+instance (Arbitrary ix, Load r ix e, Arbitrary e) => Arbitrary (ArrTinyNE r ix e) where arbitrary = ArrTinyNE <$> arbitraryArray (liftSz (succ . (`mod` 10)) <$> arbitrary) -instance (Arbitrary ix, Construct r ix e, Arbitrary e) =>+instance (Arbitrary ix, Load r ix e, Arbitrary e) => Arbitrary (ArrNE r ix e) where arbitrary = ArrNE <$> arbitraryArray (unSzNE <$> arbitrary) -instance (Arbitrary ix, Construct r ix e, Arbitrary e) =>+instance (Arbitrary ix, Load r ix e, Arbitrary e) => Arbitrary (ArrIx r ix e) where arbitrary = do SzIx sz ix <- arbitrary@@ -112,7 +112,7 @@ show windowStart ++ ") and size (" ++ show windowSize ++ ")") $ getWindow dw -instance (Arbitrary ix, CoArbitrary ix, Index ix, Arbitrary e, Typeable e) =>+instance (Arbitrary ix, CoArbitrary ix, Load DW ix e, Arbitrary e, Typeable e) => Arbitrary (ArrDW ix e) where arbitrary = do ArrTiny (arr :: Array D ix e) <- arbitrary
src/Test/Massiv/Core/Index.hs view
@@ -41,6 +41,7 @@ import Data.Massiv.Core.Index import Data.Proxy import Data.Typeable+import GHC.Exception (ErrorCall(ErrorCallWithLocation)) import Test.Massiv.Utils @@ -419,52 +420,53 @@ ixSpec = do let threshold = 50000 describe "Safety" $ do- it "IsSafeIndex" $ property $ prop_IsSafeIndex @ix- it "RepairSafeIx" $ property $ prop_RepairSafeIx @ix+ prop "IsSafeIndex" $ prop_IsSafeIndex @ix+ prop "RepairSafeIx" $ prop_RepairSafeIx @ix describe "Lifting" $- it "Lift/Lift2" $ property $ prop_LiftLift2 @ix+ prop "Lift/Lift2" $ prop_LiftLift2 @ix describe "Linear" $ do- it "ToFromLinearIndex" $ property $ prop_ToFromLinearIndex @ix- it "FromToLinearIndex" $ property $ prop_FromToLinearIndex @ix+ prop "ToFromLinearIndex" $ prop_ToFromLinearIndex @ix+ prop "FromToLinearIndex" $ prop_FromToLinearIndex @ix describe "Iterator" $ do- it "CountElements" $ property $ prop_CountElements @ix threshold- it "Monotonic" $ property $ prop_IterMonotonic @ix threshold- it "MonotonicBackwards" $ property $ prop_IterMonotonicBackwards @ix threshold- it "MonotonicM" $ property $ prop_IterMonotonicM @ix threshold- it "MonotonicBackwardsM" $ property $ prop_IterMonotonicBackwardsM @ix threshold+ prop "CountElements" $ prop_CountElements @ix threshold+ prop "Monotonic" $ prop_IterMonotonic @ix threshold+ prop "MonotonicBackwards" $ prop_IterMonotonicBackwards @ix threshold+ prop "MonotonicM" $ prop_IterMonotonicM @ix threshold+ prop "MonotonicBackwardsM" $ prop_IterMonotonicBackwardsM @ix threshold describe "Border" $- it "BorderRepairSafe" $ property $ prop_BorderRepairSafe @ix+ prop "BorderRepairSafe" $ prop_BorderRepairSafe @ix describe "SetGetDrop" $ do- it "SetAll" $ property $ prop_SetAll @ix- it "SetGet" $ property $ prop_SetGet @ix- it "GetDropInsert" $ property $ prop_GetDropInsert @ix- it "PullOutInsert" $ property $ prop_PullOutInsert @ix- it "UnconsCons" $ property $ prop_UnconsCons @ix- it "UnsnocSnoc" $ property $ prop_UnsnocSnoc @ix+ prop "SetAll" $ prop_SetAll @ix+ prop "SetGet" $ prop_SetGet @ix+ prop "GetDropInsert" $ prop_GetDropInsert @ix+ prop "PullOutInsert" $ prop_PullOutInsert @ix+ prop "UnconsCons" $ prop_UnconsCons @ix+ prop "UnsnocSnoc" $ prop_UnsnocSnoc @ix describe "IndexDimensionException" $ do- it "getDimException" $ property $ prop_getDimException @ix- it "setDimException" $ property $ prop_setDimException @ix- it "PullOutDimException" $ property $ prop_PullOutDimException @ix- it "InsertDimException" $ property $ prop_InsertDimException @ix+ prop "getDimException" $ prop_getDimException @ix+ prop "setDimException" $ prop_setDimException @ix+ prop "PullOutDimException" $ prop_PullOutDimException @ix+ prop "InsertDimException" $ prop_InsertDimException @ix describe "Dimension" $ do- it "GetInnerDimension" $ property $ \(ix :: ix) -> lastDim ix === getDimension ix Dim1- it "GetOuterDimension" $ property $+ prop "GetInnerDimension" $ \(ix :: ix) -> lastDim ix === getDimension ix Dim1+ prop "GetOuterDimension" $ \(ix :: ix) -> headDim ix === getDimension ix (DimN :: Dimension (Dimensions ix))- it "SetInnerDimension" $ property $+ prop "SetInnerDimension" $ \(ix :: ix) i -> snocDim (initDim ix) i === setDimension ix Dim1 i- it "SetOuterDimension" $ property $- \(ix :: ix) i -> consDim i (tailDim ix) === setDimension ix (DimN :: Dimension (Dimensions ix)) i- it "DropInnerDimension" $ property $ \(ix :: ix) -> initDim ix === dropDimension ix Dim1- it "DropOuterDimension" $ property $+ prop "SetOuterDimension" $+ \(ix :: ix) i -> consDim i (tailDim ix) ===+ setDimension ix (DimN :: Dimension (Dimensions ix)) i+ prop "DropInnerDimension" $ \(ix :: ix) -> initDim ix === dropDimension ix Dim1+ prop "DropOuterDimension" $ \(ix :: ix) -> tailDim ix === dropDimension ix (DimN :: Dimension (Dimensions ix))- it "InsertInnerDimension" $ property $+ prop "InsertInnerDimension" $ \(ixl :: Lower ix) i -> (snocDim ixl i :: ix) === insertDimension ixl Dim1 i- it "InsertOuterDimension" $ property $+ prop "InsertOuterDimension" $ \(ixl :: Lower ix) i -> (consDim i ixl :: ix) === insertDimension ixl (DimN :: Dimension (Dimensions ix)) i- it "PullOutInnerDimension" $ property $+ prop "PullOutInnerDimension" $ \(ix :: ix) -> unsnocDim ix === uncurry (flip (,)) (pullOutDimension ix Dim1)- it "PullInnerOuterDimension" $ property $+ prop "PullInnerOuterDimension" $ \(ix :: ix) -> unconsDim ix === pullOutDimension ix (DimN :: Dimension (Dimensions ix)) @@ -479,21 +481,21 @@ => Spec ix2UpSpec = describe "Higher/Lower" $ do- it "UnconsGetDrop" $ property $ prop_UnconsGetDrop @ix- it "UnsnocGetDrop" $ property $ prop_UnsnocGetDrop @ix+ prop "UnconsGetDrop" $ prop_UnconsGetDrop @ix+ prop "UnsnocGetDrop" $ prop_UnsnocGetDrop @ix -- | Spec that validates the Num instance for any `Index ix => ix` ixNumSpec :: forall ix . (Typeable ix, Num ix, Index ix, Arbitrary ix) => Spec ixNumSpec = do describe ("Num (" ++ showsType @ix ")") $ do- it "(+)" $ property $ prop_BinaryNumIx @ix (+)- it "(-)" $ property $ prop_BinaryNumIx @ix (-)- it "(*)" $ property $ prop_BinaryNumIx @ix (*)- it "negate" $ property $ prop_UnaryNumIx @ix negate- it "abs" $ property $ prop_UnaryNumIx @ix abs- it "signum" $ property $ prop_UnaryNumIx @ix signum- it "fromInteger" $ property $ \ (i :: Int) ->+ prop "(+)" $ prop_BinaryNumIx @ix (+)+ prop "(-)" $ prop_BinaryNumIx @ix (-)+ prop "(*)" $ prop_BinaryNumIx @ix (*)+ prop "negate" $ prop_UnaryNumIx @ix negate+ prop "abs" $ prop_UnaryNumIx @ix abs+ prop "signum" $ prop_UnaryNumIx @ix signum+ prop "fromInteger" $ \ (i :: Int) -> (fromIntegral i :: ix) === liftIndex (const i) zeroIndex describe "Constants" $ do it "zeroIndex" $ (zeroIndex :: ix) `shouldBe` 0@@ -503,15 +505,19 @@ szNumSpec :: forall ix . (Typeable ix, Num ix, Index ix, Arbitrary ix) => Spec szNumSpec = do describe ("Num (" ++ showsType @(Sz ix) ")") $ do- it "(+)" $ property $ prop_BinaryNumSz @ix (+)- it "(-)" $ property $ prop_BinaryNumSz @ix (-)- it "(*)" $ property $ prop_BinaryNumSz @ix (*)- it "negate" $ property $ prop_UnaryNumSz @ix negate- it "abs" $ property $ prop_UnaryNumSz @ix abs- it "signum" $ property $ prop_UnaryNumSz @ix signum- it "fromInteger" $ property $ \ (i :: Int) ->+ prop "(+)" $ prop_BinaryNumSz @ix (+)+ prop "(-)" $ prop_BinaryNumSz @ix (-)+ prop "(*)" $ prop_BinaryNumSz @ix (*)+ prop "negate (throws error on non-zero)" $ \sz ->+ sz /= zeroSz ==> assertException+ (\(ErrorCallWithLocation err loc) -> err `deepseq` loc `deepseq` True)+ (negate sz :: Sz ix)++ prop "abs" $ prop_UnaryNumSz @ix abs+ prop "signum" $ prop_UnaryNumSz @ix signum+ prop "fromInteger" $ \ (i :: Int) -> (fromIntegral i :: Sz ix) === SafeSz (pureIndex (max 0 i))- it "fromIx" $ property $ \ (ix :: ix) -> unSz (Sz ix) === liftIndex (max 0) ix+ prop "fromIx" $ \ (ix :: ix) -> unSz (Sz ix) === liftIndex (max 0) ix describe "Constants" $ do it "zeroSz" $ (zeroSz :: Sz ix) `shouldBe` 0 it "oneSz" $ (oneSz :: Sz ix) `shouldBe` 1@@ -529,17 +535,17 @@ => Spec szSpec = do describe "Higher/Lower" $ do- it "LiftSzNegate" $ property $ \ (sz :: Sz ix) -> liftSz negate sz === zeroSz- it "UnconsCons" $ property $ \ (sz :: Sz ix) -> sz === uncurry consSz (unconsSz sz)- it "UnsnocSnoc" $ property $ \ (sz :: Sz ix) -> sz === uncurry snocSz (unsnocSz sz)- it "PullOutInsert" $ property $ prop_PullOutInsertSize @ix- it "SetSzInnerSnoc" $ property $+ prop "LiftSzNegate" $ \ (sz :: Sz ix) -> liftSz negate sz === zeroSz+ prop "UnconsCons" $ \ (sz :: Sz ix) -> sz === uncurry consSz (unconsSz sz)+ prop "UnsnocSnoc" $ \ (sz :: Sz ix) -> sz === uncurry snocSz (unsnocSz sz)+ prop "PullOutInsert" $ prop_PullOutInsertSize @ix+ prop "SetSzInnerSnoc" $ \ (sz :: Sz ix) i -> setSzM sz 1 i `shouldReturn` snocSz (fst $ unsnocSz sz) i describe "Number of Elements" $ do- it "TotalElem" $ property $+ prop "TotalElem" $ \(sz :: Sz ix) -> totalElem sz === foldlIndex (*) 1 (unSz sz)- it "IsNonEmpty" $ property $- \(sz :: Sz ix) -> isNonEmpty sz === foldlIndex (\a x -> a && x > 0) True (unSz sz)+ prop "IsNonZeroSz" $+ \(sz :: Sz ix) -> isNotZeroSz sz === foldlIndex (\a x -> a && x > 0) True (unSz sz) describe "Iterators" $ do- it "IterLinearM" $ property $ prop_IterLinearM @ix- it "IterLinearM_" $ property $ prop_IterLinearM_ @ix+ prop "IterLinearM" $ prop_IterLinearM @ix+ prop "IterLinearM_" $ prop_IterLinearM_ @ix
src/Test/Massiv/Core/Mutable.hs view
@@ -25,15 +25,15 @@ prop_UnsafeNewMsize :: forall r ix e.- (Arbitrary ix, Mutable r ix e)+ (Arbitrary ix, Index ix, Manifest r e) => Property prop_UnsafeNewMsize = property $ \ sz -> do marr :: MArray RealWorld r ix e <- unsafeNew sz- sz `shouldBe` msize marr+ sz `shouldBe` sizeOfMArray marr prop_UnsafeNewLinearWriteRead :: forall r ix e.- (Eq e, Show e, Mutable r ix e, Arbitrary ix, Arbitrary e)+ (Eq e, Show e, Manifest r e, Index ix, Arbitrary ix, Arbitrary e) => Property prop_UnsafeNewLinearWriteRead = property $ \ (SzIx sz ix) e1 e2 -> do marr :: MArray RealWorld r ix e <- unsafeNew sz@@ -46,7 +46,7 @@ prop_UnsafeThawFreeze :: forall r ix e.- (Eq (Array r ix e), Show (Array r ix e), Mutable r ix e)+ (Eq (Array r ix e), Show (Array r ix e), Index ix, Manifest r e) => Array r ix e -> Property prop_UnsafeThawFreeze arr = arr === runST (unsafeFreeze (getComp arr) =<< unsafeThaw arr) @@ -58,7 +58,8 @@ , Show e , Arbitrary e , Arbitrary ix- , Mutable r ix e+ , Index ix+ , Manifest r e ) => Property prop_UnsafeInitializeNew =@@ -71,7 +72,8 @@ ( Eq (Array r ix e) , Show (Array r ix e) , Arbitrary ix- , Mutable r ix e+ , Index ix+ , Manifest r e ) => Property prop_UnsafeInitialize =@@ -84,7 +86,7 @@ prop_UnsafeLinearCopy ::- forall r ix e. (Eq (Array r ix e), Show (Array r ix e), Mutable r ix e)+ forall r ix e. (Eq (Array r ix e), Show (Array r ix e), Index ix, Manifest r e) => Array r ix e -> Property prop_UnsafeLinearCopy arr =@@ -104,8 +106,8 @@ , Show (Vector r e) , Eq (Array r ix e) , Show (Array r ix e)- , Mutable r ix e- , Mutable r Ix1 e+ , Manifest r e+ , Index ix ) => ArrIx r ix e -> NonNegative Ix1@@ -128,7 +130,7 @@ prop_UnsafeArrayLinearCopy ::- forall r ix e. (Eq (Array r ix e), Show (Array r ix e), Mutable r ix e)+ forall r ix e. (Eq (Array r ix e), Show (Array r ix e), Index ix, Manifest r e) => Array r ix e -> Property prop_UnsafeArrayLinearCopy arr =@@ -141,12 +143,7 @@ prop_UnsafeArrayLinearCopyPart ::- forall r ix e.- ( Eq (Vector r e)- , Show (Vector r e)- , Mutable r ix e- , Mutable r Ix1 e- )+ forall r ix e. (Eq (Vector r e), Show (Vector r e), Index ix, Manifest r e) => ArrIx r ix e -> NonNegative Ix1 -> Ix1@@ -169,8 +166,8 @@ forall r ix e. ( Eq (Vector r e) , Show (Vector r e)- , Mutable r ix e- , Mutable r Ix1 e+ , Index ix+ , Manifest r e ) => Comp -> SzIx ix@@ -193,8 +190,8 @@ forall r ix e. ( Eq (Vector r e) , Show (Vector r e)- , Mutable r ix e- , Source r Ix1 e+ , Manifest r e+ , Index ix ) => ArrIx r ix e -> Property@@ -216,8 +213,8 @@ , Show (Array r ix e) , Eq (Vector r e) , Show (Vector r e)- , Mutable r ix e- , Source r Ix1 e+ , Manifest r e+ , Index ix ) => ArrIx r ix e -> e@@ -241,40 +238,63 @@ (,) <$> unsafeFreeze (getComp arr) marrCopied <*> unsafeFreeze (getComp arr) marrGrown +prop_UnsafeLinearSliceMArray ::+ forall r ix e. (HasCallStack, Index ix, Manifest r e, Eq (Vector r e), Show (Vector r e))+ => Array r ix e+ -> Property+prop_UnsafeLinearSliceMArray arr =+ forAll genLinearRegion $ \(i, k) ->+ propIO $ do+ marr <- thawS arr+ unsafeFreeze Seq (unsafeLinearSliceMArray i k marr) `shouldReturn` unsafeLinearSlice i k arr+ where+ n = totalElem (size arr)+ genLinearRegion = do+ k <- chooseInt (0, n)+ i <- chooseInt (0, n - k)+ pure (i, Sz k)++ unsafeMutableSpec :: forall r ix e. ( Eq (Vector r e) , Show (Vector r e) , Eq (Array r ix e) , Show (Array r ix e)- , Mutable r ix e- , Mutable r Ix1 e+ , Manifest r e , Show e , Eq e+ , Load r ix e , Arbitrary e , Arbitrary ix , Typeable e- , Typeable ix ) => Spec unsafeMutableSpec =- describe ("Mutable (" ++ showsArrayType @r @ix @e ") (Unsafe)") $ do- it "UnsafeNewMsize" $ prop_UnsafeNewMsize @r @ix @e- it "UnsafeNewLinearWriteRead" $ prop_UnsafeNewLinearWriteRead @r @ix @e- it "UnsafeThawFreeze" $ property $ prop_UnsafeThawFreeze @r @ix @e- it "UnsafeInitializeNew" $ prop_UnsafeInitializeNew @r @ix @e- it "UnsafeLinearSet" $ property $ prop_UnsafeLinearSet @r @ix @e- it "UnsafeLinearCopy" $ property $ prop_UnsafeLinearCopy @r @ix @e- it "UnsafeLinearCopyPart" $ property $ prop_UnsafeLinearCopyPart @r @ix @e- it "UnsafeArrayLinearCopy" $ property $ prop_UnsafeArrayLinearCopy @r @ix @e- it "UnsafeArrayLinearCopyPart" $ property $ prop_UnsafeArrayLinearCopyPart @r @ix @e- it "UnsafeLinearShrink" $ property $ prop_UnsafeLinearShrink @r @ix @e- it "UnsafeLinearGrow" $ property $ prop_UnsafeLinearGrow @r @ix @e+ describe ("Manifest (" ++ showsArrayType @r @ix @e ") (Unsafe)") $ do+ prop "UnsafeNewMsize" $ prop_UnsafeNewMsize @r @ix @e+ prop "UnsafeNewLinearWriteRead" $ prop_UnsafeNewLinearWriteRead @r @ix @e+ prop "UnsafeThawFreeze" $ prop_UnsafeThawFreeze @r @ix @e+ prop "UnsafeInitializeNew" $ prop_UnsafeInitializeNew @r @ix @e+ prop "UnsafeLinearSet" $ prop_UnsafeLinearSet @r @ix @e+ prop "UnsafeLinearCopy" $ prop_UnsafeLinearCopy @r @ix @e+ prop "UnsafeLinearCopyPart" $ prop_UnsafeLinearCopyPart @r @ix @e+ prop "UnsafeArrayLinearCopy" $ prop_UnsafeArrayLinearCopy @r @ix @e+ prop "UnsafeArrayLinearCopyPart" $ prop_UnsafeArrayLinearCopyPart @r @ix @e+ prop "UnsafeLinearShrink" $ prop_UnsafeLinearShrink @r @ix @e+ prop "UnsafeLinearGrow" $ prop_UnsafeLinearGrow @r @ix @e+ prop "UnsafeLinearSliceMArray" $ prop_UnsafeLinearSliceMArray @r @ix @e unsafeMutableUnboxedSpec :: forall r ix e.- (Typeable e, Typeable ix, Eq (Array r ix e), Show (Array r ix e), Arbitrary ix, Mutable r ix e)+ ( Typeable e+ , Eq (Array r ix e)+ , Show (Array r ix e)+ , Index ix+ , Arbitrary ix+ , Manifest r e+ ) => Spec unsafeMutableUnboxedSpec =- describe ("Mutable Unboxed (" ++ showsArrayType @r @ix @e ") (Unsafe)") $+ describe ("Manifest Unboxed (" ++ showsArrayType @r @ix @e ") (Unsafe)") $ it "UnsafeInitialize" $ prop_UnsafeInitialize @r @ix @e
src/Test/Massiv/Utils.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeApplications #-} module Test.Massiv.Utils ( showsType@@ -10,9 +11,11 @@ , assertSomeException , assertSomeExceptionIO , toStringException+ , selectErrorCall , ExpectedException(..) , applyFun2Compat , expectProp+ , propIO -- * Epsilon comparison , epsilonExpect , epsilonFoldableExpect@@ -34,6 +37,7 @@ import Test.Hspec.QuickCheck as X import Test.QuickCheck.Function as X import Control.DeepSeq as X (NFData, deepseq)+import Control.Exception (ErrorCall (..)) import UnliftIO.Exception (Exception(..), SomeException, catch, catchAny) #if !MIN_VERSION_base(4,11,0) import Data.Semigroup as X ((<>))@@ -89,6 +93,10 @@ toStringException = either (Left . displayException) Right +selectErrorCall :: ErrorCall -> Bool+selectErrorCall = \case+ ErrorCallWithLocation err loc -> err `deepseq` loc `deepseq` True+ data ExpectedException = ExpectedException deriving (Show, Eq) instance Exception ExpectedException@@ -108,6 +116,12 @@ -- @since 1.5.0 expectProp :: Expectation -> Property expectProp = monadicIO . run++-- | Convert a Testable to a quickcheck Property. Works well with hspec expectations as well+--+-- @since 1.7.0+propIO :: (Testable a) => IO a -> Property+propIO action = monadicIO $ run action epsilonExpect ::
tests/Main.hs view
@@ -1,10 +1,11 @@ module Main where -import System.IO (BufferMode(LineBuffering), hSetBuffering, stdout)+import Spec (spec)+import System.IO (BufferMode (LineBuffering), hSetBuffering, hSetEncoding, stdout, utf8) import Test.Hspec-import Spec main :: IO () main = do hSetBuffering stdout LineBuffering+ hSetEncoding stdout utf8 hspec spec
tests/Spec.hs view
@@ -1,1 +1,1 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --no-main #-}+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}
tests/Test/Massiv/Array/Delayed/InterleavedSpec.hs view
@@ -16,10 +16,7 @@ prop_EqDelayed arr = computeAs P arr === computeAs P (toInterleaved arr) -prop_Resize ::- (Ragged L ix Int, Load D ix Int, Load DI ix Int)- => Array DI ix Int- -> Property+prop_Resize :: (Ragged L ix Int) => Array DI ix Int -> Property prop_Resize arr = computeAs P (resize' k arr) === computeAs P (resize' k arrD) where
tests/Test/Massiv/Array/Delayed/StreamSpec.hs view
@@ -1,8 +1,14 @@+{-# LANGUAGE TypeApplications #-}+ module Test.Massiv.Array.Delayed.StreamSpec (spec) where +import Data.Massiv.Array import Test.Massiv.Core import Test.Massiv.Array.Delayed-+import Test.Massiv.Array.Load+import Data.Int spec :: Spec-spec = delayedStreamSpec+spec = do+ delayedStreamSpec+ loadSpec @DS @Ix1 @Int16
tests/Test/Massiv/Array/Delayed/WindowedSpec.hs view
@@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} module Test.Massiv.Array.Delayed.WindowedSpec (spec) where@@ -33,11 +32,9 @@ it "Ix3" $ property $ prop_EqDelayed (Proxy :: Proxy Ix3) it "Ix4" $ property $ prop_EqDelayed (Proxy :: Proxy Ix4) it "Ix5" $ property $ prop_EqDelayed (Proxy :: Proxy Ix5)- it "Ix2T" $ property $ prop_EqDelayed (Proxy :: Proxy Ix2T) describe "Equivalency with Stride With Delayed" $ do it "Ix1" $ property $ prop_EqDelayedStride (Proxy :: Proxy Ix1) it "Ix2" $ property $ prop_EqDelayedStride (Proxy :: Proxy Ix2) it "Ix3" $ property $ prop_EqDelayedStride (Proxy :: Proxy Ix3) it "Ix4" $ property $ prop_EqDelayedStride (Proxy :: Proxy Ix4) it "Ix5" $ property $ prop_EqDelayedStride (Proxy :: Proxy Ix5)- it "Ix2T" $ property $ prop_EqDelayedStride (Proxy :: Proxy Ix2T)
tests/Test/Massiv/Array/DelayedSpec.hs view
@@ -8,7 +8,7 @@ import Test.Massiv.Core -downsampleArr :: Source r ix e => Stride ix -> Array r ix e -> Array D ix e+downsampleArr :: (Index ix, Source r e) => Stride ix -> Array r ix e -> Array D ix e downsampleArr stride arr = unsafeBackpermute (strideSize stride (size arr)) (liftIndex2 (*) (unStride stride)) arr
tests/Test/Massiv/Array/Manifest/VectorSpec.hs view
@@ -16,11 +16,12 @@ prop_castToFromVector :: ( VG.Vector (VRepr r) Int- , Mutable r ix Int+ , Manifest r Int , Typeable (VRepr r) , ARepr (VRepr r) ~ r , Eq (Array r ix Int) , Show (Array r ix Int)+ , Index ix ) => proxy ix -> r -> ArrNE r ix Int -> Property prop_castToFromVector _ _ (ArrNE arr) =@@ -29,13 +30,15 @@ prop_toFromVector :: forall r ix v.- ( Mutable r ix Int- , Mutable (ARepr v) ix Int+ ( Manifest r Int+ , Manifest (ARepr v) Int , VRepr (ARepr v) ~ v , Eq (Array r ix Int) , VG.Vector v Int , Show (Array r ix Int) , Typeable v+ , Load (ARepr v) ix Int+ , Load r ix Int ) => Proxy v -> Proxy ix
tests/Test/Massiv/Array/ManifestSpec.hs view
@@ -14,15 +14,16 @@ -- ByteString-prop_toFromByteString :: Manifest r Ix1 Word8 => Array r Ix1 Word8 -> Property-prop_toFromByteString arr = toManifest arr === fromByteString (getComp arr) (toByteString arr)+prop_toFromByteString ::+ (Show (Vector r Word8), Eq (Vector r Word8), Load r Ix1 Word8) => Vector r Word8 -> Property+prop_toFromByteString arr = arr === fromByteString (getComp arr) (toByteString arr) -prop_castToFromByteString :: Array S Ix1 Word8 -> Property+prop_castToFromByteString :: Vector S 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)+prop_fromToByteString comp ls = bs === toByteString (fromByteString comp bs :: Vector P Word8) where bs = S.pack ls prop_toBuilder :: Array P Ix1 Word8 -> Property
tests/Test/Massiv/Array/MutableSpec.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}@@ -14,7 +13,9 @@ import Test.Massiv.Core.Mutable import Test.Massiv.Array.Delayed import Test.Massiv.Array.Mutable+import Test.Massiv.Array.Load import GHC.Exts+import Data.Int type MutableArraySpec r ix e = ( Show e@@ -25,15 +26,13 @@ , Function e , Eq (Array r ix e) , Show (Array r ix e)- , Eq (Array (R r) Ix1 e)- , Show (Array (R r) Ix1 e)- , Load (R r) ix e- , Extract r ix e- , Resize r ix+ , Eq (Vector r e)+ , Show (Vector r e)+ , Load r ix e , Arbitrary (Array r ix e)- , Mutable r ix e+ , Manifest r e , Stream r ix e- , Construct r ix e)+ ) type MutableSpec r e = ( Typeable e@@ -49,7 +48,7 @@ localMutableSpec = do describe "toStream/toList" $ it "toStream" $ property (prop_toStream @r @ix @e)- describe "Mutable operations" $ do+ describe "Manifest operations" $ do it "write" $ property (prop_Write @r @ix @e) it "modify" $ property (prop_Modify @r @ix @e) it "swap" $ property (prop_Swap @r @ix @e)@@ -65,16 +64,42 @@ mutableSpec @r @Ix2 @e mutableSpec @r @Ix3 @e mutableSpec @r @Ix4 @e+ loadSpec @r @Ix1 @e+ loadSpec @r @Ix2 @e+ loadSpec @r @Ix3 @e+ loadSpec @r @Ix4 @e+ --mutableSpec @r @Ix5 @e -- slows down the test suite localMutableSpec @r @Ix1 @e localMutableSpec @r @Ix2 @e localMutableSpec @r @Ix3 @e localMutableSpec @r @Ix4 @e localMutableSpec @r @Ix5 @e+ describe "NonFlat" $ do+ specMutableNonFlatR @r @Ix2 @e+ specMutableNonFlatR @r @Ix3 @e+ specMutableNonFlatR @r @Ix4 @e+ specMutableNonFlatR @r @Ix5 @e describe "toStream/toList" $ it "toStreamIsList" $ property (prop_toStreamIsList @r @e)- --mutableSpec @r @Ix5 @e -- slows down the test suite +specMutableNonFlatR ::+ forall r ix e.+ ( Arbitrary ix+ , Typeable e+ , Arbitrary e+ , Index (Lower ix)+ , Load r ix e+ , Manifest r e+ , Eq (Array r (Lower ix) e)+ , Show (Array r (Lower ix) e)+ , Show (Array r ix e)+ )+ => Spec+specMutableNonFlatR = do+ describe (showsArrayType @r @ix @e "") $+ prop "outerSliceMArrayM" $ prop_outerSliceMArrayM @r @ix @e + specUnboxedMutableR :: forall r e. MutableSpec r e => Spec specUnboxedMutableR = do specMutableR @r @e@@ -84,7 +109,12 @@ unsafeMutableUnboxedSpec @r @Ix4 @e unsafeMutableUnboxedSpec @r @Ix5 @e -prop_Write :: (Mutable r ix e, Eq e, Show e) => Array r ix e -> ix -> e -> Property+prop_Write ::+ forall r ix e. (Index ix, Manifest r e, Eq e, Show e)+ => Array r ix e+ -> ix+ -> e+ -> Property prop_Write arr ix e = monadicIO $ run $ do@@ -112,7 +142,12 @@ index' arr'' ix `shouldBe` e -prop_Modify :: (Mutable r ix e, Eq e, Show e) => Array r ix e -> Fun e e -> ix -> Property+prop_Modify ::+ forall r ix e. (Index ix, Manifest r e, Eq e, Show e)+ => Array r ix e+ -> Fun e e+ -> ix+ -> Property prop_Modify arr f ix = monadicIO $ run $ do@@ -143,7 +178,12 @@ 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+prop_Swap ::+ forall r ix e. (Index ix, Manifest r e, Eq e, Show e)+ => Array r ix e+ -> ix+ -> ix+ -> Property prop_Swap arr ix1 ix2 = monadicIO $ run $ do@@ -183,15 +223,39 @@ index' arr'' ix2 `shouldBe` e1 +prop_outerSliceMArrayM ::+ forall r ix e.+ ( Index ix+ , Index (Lower ix)+ , Manifest r e+ , Eq (Array r (Lower ix) e)+ , Show (Array r (Lower ix) e)+ )+ => ArrNE r ix e+ -> Property+prop_outerSliceMArrayM (ArrNE arr) =+ forAll genIxInAndOut $ \(iIn, iOut) ->+ propIO $ do+ marr <- thawS arr+ (outerSliceMArrayM marr iIn >>= freezeS) `shouldReturn` arr !> iIn+ outerSliceMArrayM marr iOut `shouldThrow` (== IndexOutOfBoundsException (Sz nOuter) iOut)+ where+ (Sz nOuter, _) = unconsSz $ size arr+ genIxInAndOut = do+ let n = max 0 (nOuter - 1)+ iIn <- chooseInt (0, n)+ iOut <- oneof [chooseInt (minBound, -1), chooseInt (n, maxBound)]+ pure (iIn, iOut) + spec :: Spec spec = do- specMutableR @B @Int- specMutableR @N @Int- specMutableR @BL @Int- specUnboxedMutableR @S @Int- specUnboxedMutableR @P @Int- specUnboxedMutableR @U @Int+ specMutableR @B @Int16+ specMutableR @BN @Int16+ specMutableR @BL @Int16+ specUnboxedMutableR @S @Int16+ specUnboxedMutableR @P @Int16+ specUnboxedMutableR @U @Int16 atomicIntSpec @Ix1 atomicIntSpec @Ix2 atomicIntSpec @Ix3
tests/Test/Massiv/Array/Numeric/IntegralSpec.hs view
@@ -12,26 +12,26 @@ spec :: Spec spec = do let (a, b) = (0, 2)- integrator rule = rule Seq N (\ s -> gaussian . s) a b (Sz1 1)+ integrator rule = rule Seq BN (gaussian .) a b (Sz1 1) describe "Integral Approximation" $ do it "Midpoint Rule" $ do- integrator midpointRule 4 ! 0 `shouldBe` 14.485613- integrator midpointRule 8 ! 0 `shouldBe` 15.905677- integrator midpointRule 16 ! 0 `shouldBe` 16.311854- integrator midpointRule 32 ! 0 `shouldBe` 16.417171- integrator midpointRule 64 ! 0 `shouldBe` 16.443748- integrator midpointRule 128 ! 0 `shouldBe` 16.450407+ integrator midpointRule 4 `evaluate'` 0 `shouldBe` 14.485613+ integrator midpointRule 8 `evaluate'` 0 `shouldBe` 15.905677+ integrator midpointRule 16 `evaluate'` 0 `shouldBe` 16.311854+ integrator midpointRule 32 `evaluate'` 0 `shouldBe` 16.417171+ integrator midpointRule 64 `evaluate'` 0 `shouldBe` 16.443748+ integrator midpointRule 128 `evaluate'` 0 `shouldBe` 16.450407 it "Trapezoid Rule" $ do- integrator trapezoidRule 4 ! 0 `shouldBe` 20.644558- integrator trapezoidRule 8 ! 0 `shouldBe` 17.565086- integrator trapezoidRule 16 ! 0 `shouldBe` 16.735381- integrator trapezoidRule 32 ! 0 `shouldBe` 16.523618- integrator trapezoidRule 64 ! 0 `shouldBe` 16.470394- integrator trapezoidRule 128 ! 0 `shouldBe` 16.457073+ integrator trapezoidRule 4 `evaluate'` 0 `shouldBe` 20.644558+ integrator trapezoidRule 8 `evaluate'` 0 `shouldBe` 17.565086+ integrator trapezoidRule 16 `evaluate'` 0 `shouldBe` 16.735381+ integrator trapezoidRule 32 `evaluate'` 0 `shouldBe` 16.523618+ integrator trapezoidRule 64 `evaluate'` 0 `shouldBe` 16.470394+ integrator trapezoidRule 128 `evaluate'` 0 `shouldBe` 16.457073 it "Simspon's Rule" $ do- integrator simpsonsRule 4 ! 0 `shouldBe` 17.353626- integrator simpsonsRule 8 ! 0 `shouldBe` 16.538595- integrator simpsonsRule 16 ! 0 `shouldBe` 16.458815- integrator simpsonsRule 32 ! 0 `shouldBe` 16.453030- integrator simpsonsRule 64 ! 0 `shouldBe` 16.452653- integrator simpsonsRule 128 ! 0 `shouldBe` 16.452629+ integrator simpsonsRule 4 `evaluate'` 0 `shouldBe` 17.353626+ integrator simpsonsRule 8 `evaluate'` 0 `shouldBe` 16.538595+ integrator simpsonsRule 16 `evaluate'` 0 `shouldBe` 16.458815+ integrator simpsonsRule 32 `evaluate'` 0 `shouldBe` 16.453030+ integrator simpsonsRule 64 `evaluate'` 0 `shouldBe` 16.452653+ integrator simpsonsRule 128 `evaluate'` 0 `shouldBe` 16.452629
tests/Test/Massiv/Array/Ops/ConstructSpec.hs view
@@ -24,28 +24,27 @@ prop_rangeStepExc :: Int -> Int -> Property prop_rangeStepExc from to = assertException- (\case- IndexZeroException _ -> True- _ -> False)+ selectErrorCall (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+ -> Array U ix Int -> Property-prop_toFromListIsList _ (ArrNE arr) = arr === GHC.fromList (GHC.toList arr)+prop_toFromListIsList _ arr = arr === GHC.fromList (GHC.toList arr) prop_toFromList ::- forall ix . (Show (Array U ix Int), Nested LN ix Int, Ragged L ix Int)+ forall ix . (Show (Array B ix Int), Ragged L ix Int) => Proxy ix- -> ArrNE U ix Int+ -> Array B ix Int -> Property-prop_toFromList _ (ArrNE arr) = comp === comp' .&&. arr === arr'- where comp = getComp arr- arr' = fromLists' comp (toLists arr)- comp' = getComp arr'+prop_toFromList _ arr = comp === comp' .&&. arr === arr'+ where+ comp = getComp arr+ arr' = fromLists' comp $ toLists arr+ comp' = getComp arr' prop_excFromToListIx2 :: Comp -> [[Int]] -> Property@@ -74,32 +73,32 @@ 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+ prop "toFromList" $ prop_toFromList (Proxy :: Proxy Ix1)+ prop "toFromListIsList" $ prop_toFromListIsList (Proxy :: Proxy Ix1)+ prop "rangeEqRangeStep1" prop_rangeEqRangeStep1+ prop "rangeEqEnumFromN" prop_rangeEqEnumFromN+ prop "rangeStepEqEnumFromStepN" prop_rangeStepEqEnumFromStepN+ prop "rangeStepExc" 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+ prop "toFromList" $ (prop_toFromList (Proxy :: Proxy Ix2))+ prop "toFromListIsList" $ (prop_toFromListIsList (Proxy :: Proxy Ix2))+ prop "excFromToListIx2" $ 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+ prop "toFromList" $ (prop_toFromList (Proxy :: Proxy Ix3))+ prop "toFromListIsList" $ (prop_toFromListIsList (Proxy :: Proxy Ix3))+ prop "excFromToListIx3" $ 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 :: Array BN Ix1 (Array U Ix1 Int) initArr = makeArray Seq (Sz1 3) mkIntermediate -initArr2 :: Array N Ix2 (Array U Ix1 Int)+initArr2 :: Array BN Ix2 (Array U Ix1 Int) initArr2 = makeArray Seq (Sz 2) (\ (x :. y) -> mkIntermediate (x+y)) prop_unfoldrList :: Sz1 -> Fun Word (Int, Word) -> Word -> Property@@ -127,4 +126,4 @@ describe "Ix2" specConstructIx2 describe "Ix3" specConstructIx3 describe "Expand" specExpand- describe "Unfolding" $ it "unfoldrS_" $ property prop_unfoldrList+ describe "Unfolding" $ prop "unfoldrS_" prop_unfoldrList
tests/Test/Massiv/Array/Ops/FoldSpec.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}@@ -24,7 +23,7 @@ prop_ProdSEqProdP arr = product arr == product (setComp Par arr) -foldOpsProp :: Source P ix Int => Fun Int Bool -> ArrTinyNE P ix Int -> Expectation+foldOpsProp :: Index ix => Fun Int Bool -> ArrTinyNE P ix Int -> Expectation foldOpsProp f (ArrTinyNE arr) = do A.maximum' arr `shouldBe` getMax (foldMono Max arr) A.minimum' arr `shouldBe` getMin (foldSemi Min maxBound arr)@@ -54,10 +53,7 @@ prop "foldOps" $ foldOpsProp @ix -prop_foldOuterSliceToList ::- (Elt P ix Int ~ Array M (Lower ix) Int, OuterSlice P ix Int, Index (Lower ix))- => ArrTiny P ix Int- -> Property+prop_foldOuterSliceToList :: (Index ix, Index (Lower ix)) => ArrTiny P ix Int -> Property prop_foldOuterSliceToList (ArrTiny arr) = foldOuterSlice A.toList arr === A.fold (A.map pure arr) @@ -77,5 +73,5 @@ emptySelector = (== SizeEmptyException (Sz (zeroIndex :: ix))) it "maximumM" $ maximumM (A.empty :: Array D Ix1 Int) `shouldThrow` emptySelector @Ix1 it "minimumM" $ minimumM (A.empty :: Array D Ix2 Int) `shouldThrow` emptySelector @Ix2- it "maximum'" $ (pure $! maximum' (A.empty :: Array D Ix3 Int)) `shouldThrow` emptySelector @Ix3- it "minimum'" $ (pure $! minimum' (A.empty :: Array D Ix4 Int)) `shouldThrow` emptySelector @Ix4+ it "maximum'" $ (pure $! maximum' (A.empty :: Array D Ix3 Int)) `shouldThrow` selectErrorCall+ it "minimum'" $ (pure $! minimum' (A.empty :: Array D Ix4 Int)) `shouldThrow` selectErrorCall
tests/Test/Massiv/Array/Ops/MapSpec.hs view
@@ -139,9 +139,9 @@ alt_imapM- :: (Applicative f, Mutable r2 t1 b, Source r1 t1 t2) =>- (t1 -> t2 -> f b) -> Array r1 t1 t2 -> f (Array r2 t1 b)-alt_imapM f arr = fmap loadList $ P.traverse (uncurry f) $ foldrS (:) [] (zipWithIndex arr)+ :: (Applicative f, Index ix, Manifest r2 b, Source r1 a) =>+ (ix -> a -> f b) -> Array r1 ix a -> f (Array r2 ix b)+alt_imapM f arr = fmap loadList $ P.traverse (uncurry f) $ foldrS (:) [] (imap (,) arr) where loadList xs = runST $ do@@ -150,18 +150,14 @@ unsafeFreeze (getComp arr) marr {-# INLINE loadList #-} -zipWithIndex :: forall r ix e . Source r ix e => Array r ix e -> Array D ix (ix, e)-zipWithIndex arr = A.zip (range Seq zeroIndex (unSz (size arr))) arr-{-# INLINE zipWithIndex #-} - prop_MapWS :: (Show (Array U ix Int), Index ix) => Array U ix Int -> Property prop_MapWS arr = monadicIO $ run $ do let comp = getComp arr count <- getCompWorkers comp- arrStates <- new @P (Sz count)+ arrStates <- newMArray' @P (Sz count) states <- initWorkerStates comp (\(WorkerId i) -> pure $ \f -> modifyM_ arrStates f i) arr' <- forWS states arr $ \e smod -> do
tests/Test/Massiv/Array/Ops/SliceSpec.hs view
@@ -1,12 +1,11 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeApplications #-} {-# 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 @@ -15,10 +14,7 @@ ----------- prop_ExtractEqualsExtractFromTo ::- ( Eq (Array (R r) ix e)- , Show (Array (R r) ix e)- , Extract r ix e- )+ (Source r e, Eq e, Show e, Ragged L ix e) => proxy (r, ix, e) -> SzIx ix -> Array r ix e@@ -28,12 +24,14 @@ specSizeN ::- ( Eq (Array (R r) ix e)- , Show (Array (R r) ix e)+ ( HasCallStack+ , Eq e+ , Show e+ , Ragged L ix e , Arbitrary (Array r ix e) , Show (Array r ix e)+ , Source r e , Arbitrary ix- , Extract r ix e ) => proxy (r, ix, e) -> Spec@@ -47,173 +45,116 @@ ----------- -prop_SliceRight ::- (Slice r ix e, OuterSlice r ix e, Eq (Elt r ix e), Show (Elt r ix e))+prop_SliceOuter ::+ ( HasCallStack+ , Source r e+ , Index ix+ , Ragged L (Lower ix) e+ , Show e+ , Eq e+ , Show (Array r (Lower ix) e)+ ) => proxy (r, ix, e)- -> Int+ -> Ix1 -> 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_SliceOuter _ i arr =+ expectProp $+ if isSafeIndex (fst (unconsSz (size arr))) i+ then do+ e1 <- arr !?> i+ e2 <- arr <!?> (dimensions (size arr), i)+ delay e1 `shouldBe` e2+ else do+ arr !?> i `shouldSatisfy` isNothing+ arr <!?> (dimensions (size arr), i) `shouldSatisfy` isNothing -prop_SliceLeft ::- (Slice r ix e, InnerSlice r ix e, Eq (Elt r ix e), Show (Elt r ix e))+prop_SliceInner ::+ (HasCallStack, Source r e, Index ix, Ragged L (Lower ix) e, Show e, Eq e) => proxy (r, ix, e) -> Int -> Array r ix e -> Property-prop_SliceLeft _ i arr =- either (Left . displayException) Right (arr <!? i) ===- either (Left . displayException) Right (arr <!?> (1, i))+prop_SliceInner _ i arr =+ expectProp $ do+ if isSafeIndex (snd (unsnocSz (size arr))) i+ then do+ e1 <- arr <!? i+ e2 <- arr <!?> (1, i)+ e1 `shouldBe` e2+ else do+ arr <!? i `shouldSatisfy` isNothing+ arr <!?> (1, i) `shouldSatisfy` isNothing -prop_SliceIndexDim2D :: ArrIx D Ix2 Int -> Property-prop_SliceIndexDim2D (ArrIx arr ix@(i :. j)) =- val === evaluate' (arr <! j) i .&&.- val === evaluate' (arr !> i) j- where- val = unsafeIndex arr ix+prop_SliceIndexDim2 :: (HasCallStack, Source r Int) => ArrIx r Ix2 Int -> Property+prop_SliceIndexDim2 (ArrIx arr ix@(i :. j)) =+ expectProp $ do+ val <- evaluateM arr ix+ evaluateM (arr !> i) j `shouldReturn` val+ evaluateM (arr <! j) i `shouldReturn` val+ evaluateM (arr <!> (2, i)) j `shouldReturn` val+ evaluateM (arr <!> (1, j)) i `shouldReturn` val -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_SliceIndexDim3 :: (HasCallStack, Source r Int) => ArrIx r Ix3 Int -> Property+prop_SliceIndexDim3 (ArrIx arr ix@(i :> j :. k)) =+ expectProp $ do+ val <- evaluateM arr ix+ evaluateM (arr <! k <! j) i `shouldReturn` val+ evaluateM (arr !> i !> j) k `shouldReturn` val+ evaluateM (arr <! k !> i) j `shouldReturn` val+ evaluateM (arr !> i <! k) j `shouldReturn` val+ evaluateM (arr <!> (3, i) <!> (2, j)) k `shouldReturn` val+ evaluateM (arr <!> (3, i) <!> (1, k)) j `shouldReturn` val+ evaluateM (arr <!> (2, j) <!> (2, i)) k `shouldReturn` val+ evaluateM (arr <!> (2, j) <!> (1, k)) i `shouldReturn` val+ evaluateM (arr <!> (1, k) <!> (2, i)) j `shouldReturn` val+ evaluateM (arr <!> (1, k) <!> (1, j)) i `shouldReturn` val -prop_SliceIndexDim3D :: ArrIx D Ix3 Int -> Property-prop_SliceIndexDim3D (ArrIx arr ix@(i :> j :. k)) =- val === evaluate' (arr <! k <! j) i .&&.- val === evaluate' (arr !> i !> j) k .&&.- val === evaluate' (arr <! k !> i) j .&&.- val === evaluate' (arr !> i <! k) j- where- val = unsafeIndex arr ix+prop_SliceIndexDim4 :: (HasCallStack, Source r Int) => ArrIx r Ix4 Int -> Property+prop_SliceIndexDim4 (ArrIx arr ix@(i1 :> i2 :> i3 :. i4)) =+ expectProp $ do+ val <- evaluateM arr ix+ evaluateM (arr <!> (4, i1) <!> (3, i2) <!> (2, i3)) i4 `shouldReturn` val+ evaluateM (arr <!> (4, i1) <!> (2, i3) <! i4) i2 `shouldReturn` val+ evaluateM (arr <!> (3, i2) <!> (3, i1)) (i3 :. i4) `shouldReturn` val+ evaluateM (arr <!> (2, i3) <!> (2, i2)) (i1 :. i4) `shouldReturn` val+ evaluateM (arr <!> (2, i3) <!> (1, i4) !> i1) i2 `shouldReturn` val+ evaluateM (arr <!> (1, i4) !> i1 !> i2) i3 `shouldReturn` val -prop_SliceIndexDim3RankD :: ArrIx D Ix3 Int -> 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+ evaluateM (arr !> i1 !> i2 !> i3) i4 `shouldReturn` val+ evaluateM (arr !> i1 !> i2 <! i4) i3 `shouldReturn` val+ evaluateM (arr !> i1 <! i4 <! i3) i2 `shouldReturn` val+ evaluateM (arr !> i1 <! i4 !> i2) i3 `shouldReturn` val+ evaluateM (arr <! i4 !> i1 !> i2) i3 `shouldReturn` val+ evaluateM (arr <! i4 !> i1 <! i3) i2 `shouldReturn` val+ evaluateM (arr <! i4 <! i3 <! i2) i1 `shouldReturn` val+ evaluateM (arr <! i4 <! i3 !> i1) i2 `shouldReturn` val -prop_SliceIndexDim2M :: ArrIx P Ix2 Int -> Property-prop_SliceIndexDim2M (ArrIx arr' ix@(i :. j)) =- val === (arr !> i ! j) .&&.- val === (arr <! j ! i)- where- arr = toManifest arr'- val = unsafeIndex arr ix -prop_SliceIndexDim2RankM :: ArrIx P Ix2 Int -> 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 <! k <! j ! i) .&&.- val === (arr !> i !> j ! k) .&&.- val === (arr <! k !> i ! j) .&&.- val === (arr !> i <! k ! j)- where- arr = toManifest arr'- val = unsafeIndex arr ix---prop_SliceIndexDim3RankM :: ArrIx P Ix3 Int -> 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 <! i4) i3 .&&.- val === evaluate' (arr !> i1 <! i4 <! i3) i2 .&&.- val === evaluate' (arr !> i1 <! i4 !> i2) i3 .&&.- val === evaluate' (arr <! i4 !> i1 !> i2) i3 .&&.- val === evaluate' (arr <! i4 !> i1 <! i3) i2 .&&.- val === evaluate' (arr <! i4 <! i3 <! i2) i1 .&&.- val === evaluate' (arr <! i4 <! i3 !> 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) <! i4) i2 .&&.- val === unsafeIndex (arr <!> (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) <! i4 ! i2) .&&.- val === (arr <!> (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 <! i4 ! i3) .&&.- val === (arr !> i1 <! i4 <! i3 ! i2) .&&.- val === (arr !> i1 <! i4 !> i2 ! i3) .&&.- val === (arr <! i4 !> i1 !> i2 ! i3) .&&.- val === (arr <! i4 !> i1 <! i3 ! i2) .&&.- val === (arr <! i4 <! i3 <! i2 ! i1) .&&.- val === (arr <! i4 <! i3 !> 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 ::+ ( HasCallStack+ , Source r e+ , Load r ix e+ , Arbitrary ix+ , Arbitrary e+ , Show (Array r ix e)+ , Ragged L (Lower ix) e+ , Show e+ , Eq e+ , Show (Array r (Lower ix) e)+ )+ => proxy (r, ix, e)+ -> Spec specSliceN proxy = describe "Slice" $ do- it "SliceRight" $ property $ prop_SliceRight proxy- it "SliceLeft" $ property $ prop_SliceLeft proxy+ prop "SliceOuter" $ prop_SliceOuter proxy+ prop "SliceInner" $ prop_SliceInner proxy @@ -225,23 +166,17 @@ 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+ prop "Delayed" $ prop_SliceIndexDim2 @D+ prop "Manifest" $ prop_SliceIndexDim2 @P 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+ prop "Delayed" $ prop_SliceIndexDim3 @D+ prop "Manifest" $ prop_SliceIndexDim3 @P 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+ prop "Delayed" $ prop_SliceIndexDim4 @D+ prop "Manifest" $ prop_SliceIndexDim4 @P
tests/Test/Massiv/Array/Ops/SortSpec.hs view
@@ -14,7 +14,7 @@ to (sortWith (from xs)) === sort xs tallyMap :: Array P Ix1 Word -> Map Word Int-tallyMap arr = F.foldr' addCount M.empty $ toManifest arr+tallyMap = foldrS addCount M.empty where addCount :: Word -> Map Word Int -> Map Word Int addCount !el !counter = M.insertWith (+) el 1 counter
tests/Test/Massiv/Array/Ops/TransformSpec.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}@@ -17,11 +16,11 @@ import Test.Massiv.Core import Test.Massiv.Array.Delayed (stackSlices') -prop_TransposeOuterInner :: Array D Ix2 Int -> Property+prop_TransposeOuterInner :: Matrix D Int -> Property prop_TransposeOuterInner arr = transposeOuter arr === transpose arr prop_UpsampleDownsample ::- forall r ix e . (Eq (Array r ix e), Show (Array r ix e), Mutable r ix e)+ forall r ix e . (Eq (Array r ix e), Show (Array r ix e), Load r ix e, Manifest r e) => ArrTiny r ix e -> Stride ix -> e@@ -30,13 +29,7 @@ arr === compute (downsample stride (compute @r (upsample fill stride arr))) prop_ExtractAppend ::- forall r ix e.- ( Eq (Array r ix e)- , Show (Array r ix e)- , Source (R r) ix e- , Extract r ix e- , Mutable r ix e- )+ forall r ix e. (Eq (Array r ix e), Show (Array r ix e), Manifest r e, Index ix) => DimIx ix -> ArrIx r ix e -> Property@@ -45,13 +38,14 @@ prop_SplitExtract :: forall r ix e.- ( Eq (Array r ix e)- , Eq (Array (R r) ix e)+ ( Eq e+ , Show e+ , Eq (Array r ix e) , Show (Array r ix e)- , Show (Array (R r) ix e)- , Source (R r) ix e- , Mutable r ix e- , Extract r ix e+ , Source r e+ , Load r ix e+ , Manifest r e+ , Ragged L ix e ) => DimIx ix -> ArrIx r ix e@@ -63,11 +57,11 @@ where i = getDim' ix dim k = getDim' (unSz (size arr)) dim n' = n `mod` (k - i)- (left, center, right) = either throw id (splitExtractM dim i (Sz n') arr)+ (left, center, right) = throwEither (splitExtractM dim i (Sz n') arr) (splitLeft, splitRight) = splitAt' dim (i + n') arr prop_ConcatAppend ::- forall r ix. (Eq (Array r ix Int), Show (Array r ix Int), Mutable r ix Int)+ forall r ix. (Eq (Array r ix Int), Show (Array r ix Int), Load r ix Int, Manifest r Int) => DimIx ix -> Comp -> Sz ix@@ -80,7 +74,8 @@ arrs = P.zipWith (\ f i -> makeArray @r comp sz ((+i) . apply f)) fns [0 .. ] prop_ConcatMConcatOuterM ::- forall r ix. (Eq (Array r ix Int), Show (Array r ix Int), Mutable r ix Int)+ forall r ix.+ (Eq (Array r ix Int), Show (Array r ix Int), Load r ix Int, Manifest r Int) => Comp -> Sz ix -> NonEmptyList (Fun ix Int)@@ -93,6 +88,7 @@ where arrs = P.zipWith (\ f i -> makeArray @r comp sz ((+i) . apply f)) fns [0 .. ] + prop_AppendMappend :: Array D Ix1 Int -> Array D Ix1 Int -> Property prop_AppendMappend arr1 arr2 =@@ -104,7 +100,7 @@ computeAs P (concat' 1 (A.empty : arrs)) === computeAs P (mconcat (fmap toLoadArray arrs)) prop_ExtractSizeMismatch ::- (Resize r ix, Load r ix e, NFData (Array r Int e)) => ArrTiny r ix e -> Positive Int -> Property+ (Size r, Load r ix e, NFData (Array r Int e)) => ArrTiny r ix e -> Positive Int -> Property prop_ExtractSizeMismatch (ArrTiny arr) (Positive n) = assertExceptionIO (SizeElementsMismatchException sz sz' ==) $ resizeM sz' arr where@@ -123,19 +119,19 @@ -- => ArrNE P ix Int -- -> Property -- prop_stackInnerSlices (ArrNE arr) =--- arr === either throw compute (stackInnerSlicesM (innerSlices arr)) .&&.+-- arr === compute (throwEither (stackInnerSlicesM (innerSlices arr))) .&&. -- arr === compute (stackSlices' 1 (innerSlices arr)) prop_stackInnerSlicesIx2 :: ArrNE P Ix2 Int -> Property prop_stackInnerSlicesIx2 (ArrNE arr) =- arr === either throw compute (stackInnerSlicesM (innerSlices arr)) .&&.+ arr === compute (throwEither (stackInnerSlicesM (innerSlices arr))) .&&. arr === compute (stackSlices' 1 (innerSlices arr)) prop_stackInnerSlicesIx3 :: ArrNE P Ix3 Int -> Property prop_stackInnerSlicesIx3 (ArrNE arr) =- arr === either throw compute (stackInnerSlicesM (innerSlices arr)) .&&.+ arr === compute (throwEither (stackInnerSlicesM (innerSlices arr))) .&&. arr === compute (stackSlices' 1 (innerSlices arr)) prop_stackInnerSlicesIx4 :: ArrNE P Ix4 Int -> Property prop_stackInnerSlicesIx4 (ArrNE arr) =- arr === either throw compute (stackInnerSlicesM (innerSlices arr)) .&&.+ arr === compute (throwEither (stackInnerSlicesM (innerSlices arr))) .&&. arr === compute (stackSlices' 1 (innerSlices arr)) -- prop_stackOuterSlices ::@@ -149,19 +145,19 @@ -- => ArrNE P ix Int -- -> Property -- prop_stackOuterSlices (ArrNE arr) =--- arr === either throw compute (stackOuterSlicesM (outerSlices arr)) .&&.+-- arr === compute (throwEither (stackOuterSlicesM (outerSlices arr))) .&&. -- arr === compute (stackSlices' (dimensions (Proxy :: Proxy ix)) (outerSlices arr)) prop_stackOuterSlicesIx2 :: ArrNE P Ix2 Int -> Property prop_stackOuterSlicesIx2 (ArrNE arr) =- arr === either throw compute (stackOuterSlicesM (outerSlices arr)) .&&.+ arr === compute (throwEither (stackOuterSlicesM (outerSlices arr))) .&&. arr === compute (stackSlices' (dimensions (Proxy :: Proxy Ix2)) (outerSlices arr)) prop_stackOuterSlicesIx3 :: ArrNE P Ix3 Int -> Property prop_stackOuterSlicesIx3 (ArrNE arr) =- arr === either throw compute (stackOuterSlicesM (outerSlices arr)) .&&.+ arr === compute (throwEither (stackOuterSlicesM (outerSlices arr))) .&&. arr === compute (stackSlices' (dimensions (Proxy :: Proxy Ix3)) (outerSlices arr)) prop_stackOuterSlicesIx4 :: ArrNE P Ix4 Int -> Property prop_stackOuterSlicesIx4 (ArrNE arr) =- arr === either throw compute (stackOuterSlicesM (outerSlices arr)) .&&.+ arr === compute (throwEither (stackOuterSlicesM (outerSlices arr))) .&&. arr === compute (stackSlices' (dimensions (Proxy :: Proxy Ix4)) (outerSlices arr)) @@ -172,10 +168,8 @@ forall r ix e. ( Eq (Array r ix e) , Show (Array r ix e)- , StrideLoad (R r) ix e , StrideLoad r ix e- , Mutable r ix e- , Extract r ix e+ , Manifest r e ) => Array r ix e -> Stride ix@@ -191,7 +185,7 @@ stride' = Stride (liftIndex (+ 1) $ unStride stride) prop_ZoomStrideCompute ::- forall r ix e. (Eq (Array r ix e), Show (Array r ix e), StrideLoad r ix e, Mutable r ix e)+ forall r ix e. (Eq (Array r ix e), Show (Array r ix e), StrideLoad r ix e, Manifest r e) => Array r ix e -> Stride ix -> Property@@ -212,20 +206,18 @@ , Function e , Function ix , Eq (Array r ix e)- , Eq (Array (R r) ix e) , Eq (Array r ix Int) , Show (Array r ix e)- , Show (Array (R r) ix e) , Show (Array r ix Int) , NFData (Array r ix e) , NFData (Array r Int e)- , Resize r ix- , Extract r ix e- , Source (R r) ix e+ , Load r ix e+ , Load r ix Int+ , Ragged L ix e+ , Source r e , StrideLoad r ix e- , StrideLoad (R r) ix e- , Mutable r ix Int- , Mutable r ix e)+ , Manifest r Int+ , Manifest r e) specTransformR :: forall r ix e. Transform r ix e
tests/Test/Massiv/Array/StencilSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-}@@ -25,38 +26,29 @@ makeStencil oneSz zeroIndex $ \ get -> f (get zeroIndex) -prop_MapSingletonStencil ::- (Load DW ix Int, Manifest U ix Int, Show (Array U ix Int))- => Proxy ix- -> Fun Int Int- -> Border Int- -> ArrNE U ix Int- -> Property+prop_MapSingletonStencil :: (Load DW ix Int, Show (Array P ix Int)) =>+ Proxy ix -> Fun Int Int -> Border Int -> ArrNE P ix Int -> Property prop_MapSingletonStencil _ f b (ArrNE arr) =- computeAs U (mapStencil b (singletonStencil (apply f)) arr) === computeAs U (A.map (apply f) arr)+ computeAs P (mapStencil b (singletonStencil (apply f)) arr) === computeAs P (A.map (apply f) arr) prop_ApplyZeroStencil ::- (Load DW ix Int, Show (Array U ix Int), Manifest U ix Int)- => Proxy ix- -> Int- -> Array U ix Int- -> Property+ (Load DW ix Int, Show (Array P ix Int)) => Proxy ix -> Int -> Array P ix Int -> Property prop_ApplyZeroStencil _ e arr =- computeAs U (applyStencil noPadding zeroStencil arr) === makeArray Seq (size arr) (const e)+ computeAs P (applyStencil noPadding zeroStencil arr) === makeArray Seq (size arr) (const e) where zeroStencil = makeStencil zeroSz zeroIndex $ const e prop_MapSingletonStencilWithStride ::- (StrideLoad DW ix Int, Manifest U ix Int, Show (Array U ix Int))+ (StrideLoad DW ix Int, Show (Array P ix Int)) => Proxy ix -> Fun Int Int -> Border Int- -> ArrNE U ix Int+ -> ArrNE P ix Int -> Property prop_MapSingletonStencilWithStride _ f b (ArrNE arr) = computeWithStride oneStride (mapStencil b (singletonStencil (apply f)) arr) ===- computeAs U (A.map (apply f) arr)+ computeAs P (A.map (apply f) arr) -- Tests out of bounds stencil indexing prop_DangerousStencil ::@@ -66,23 +58,42 @@ -> SzIx ix -> Property prop_DangerousStencil _ (DimIx r) (SzIx sz center) =- assertException validateException arr+ assertException selectErrorCall arr where stencil = makeStencil sz center $ \get -> get ix' :: Int arr = computeAs P (mapStencil Edge stencil (makeArray Seq sz (const 0) :: Array P ix Int)) ix' = liftIndex2 (-) (setDim' zeroIndex r (getDim' (unSz sz) r)) (setDim' zeroIndex r (getDim' center r))- validateException = \case- IndexOutOfBoundsException _ _ -> pure ()- exc -> expectationFailure $ "Unexpected exception: " <> show exc instance Index ix => Show (Stencil ix a b) where show stencil = "Stencil " ++ show (getStencilSize stencil) ++ " " ++ show (getStencilCenter stencil) +unsafeMapStencil ::+ (Index ix, Manifest r e)+ => Border e+ -> Sz ix+ -> ix+ -> (ix -> (ix -> e) -> a)+ -> Array r ix e+ -> Array DW ix a+unsafeMapStencil b sSz sCenter stencilF !arr = insertWindow warr window+ where+ !warr = makeArray (getComp arr) sz (stencil (borderIndex b arr))+ !window =+ Window+ { windowStart = sCenter+ , windowSize = windowSz+ , windowIndex = stencil (unsafeIndex arr)+ , windowUnrollIx2 = unSz . fst <$> pullOutSzM sSz 2+ }+ !sz = size arr+ !windowSz = Sz (liftIndex2 (-) (unSz sz) (liftIndex (subtract 1) (unSz sSz)))+ stencil getVal !ix = stencilF ix $ \ !ixD -> getVal (liftIndex2 (+) ix ixD) + prop_MapEqApplyStencil :: (Show (Array P ix Int), StrideLoad DW ix Int) => Stride ix@@ -127,61 +138,59 @@ stencilSpec :: Spec stencilSpec = do describe "MapSingletonStencil" $ do- it "Ix1" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix1)- it "Ix2" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix2)- it "Ix3" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix3)- it "Ix4" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix4)- it "Ix2T" $ property $ prop_MapSingletonStencil (Proxy :: Proxy Ix2T)+ prop "Ix1" $ prop_MapSingletonStencil (Proxy :: Proxy Ix1)+ prop "Ix2" $ prop_MapSingletonStencil (Proxy :: Proxy Ix2)+ prop "Ix3" $ prop_MapSingletonStencil (Proxy :: Proxy Ix3)+ prop "Ix4" $ prop_MapSingletonStencil (Proxy :: Proxy Ix4) describe "MapSingletonStencilWithStride" $ do- it "Ix1" $ property $ prop_MapSingletonStencilWithStride (Proxy :: Proxy Ix1)- it "Ix2" $ property $ prop_MapSingletonStencilWithStride (Proxy :: Proxy Ix2)- it "Ix3" $ property $ prop_MapSingletonStencilWithStride (Proxy :: Proxy Ix3)+ prop "Ix1" $ prop_MapSingletonStencilWithStride (Proxy :: Proxy Ix1)+ prop "Ix2" $ prop_MapSingletonStencilWithStride (Proxy :: Proxy Ix2)+ prop "Ix3" $ prop_MapSingletonStencilWithStride (Proxy :: Proxy Ix3) describe "ApplyZeroStencil" $ do- it "Ix1" $ property $ prop_ApplyZeroStencil (Proxy :: Proxy Ix1)- it "Ix2" $ property $ prop_ApplyZeroStencil (Proxy :: Proxy Ix2)- it "Ix3" $ property $ prop_ApplyZeroStencil (Proxy :: Proxy Ix3)- it "Ix4" $ property $ prop_ApplyZeroStencil (Proxy :: Proxy Ix4)- it "Ix2T" $ property $ prop_ApplyZeroStencil (Proxy :: Proxy Ix2T)+ prop "Ix1" $ prop_ApplyZeroStencil (Proxy :: Proxy Ix1)+ prop "Ix2" $ prop_ApplyZeroStencil (Proxy :: Proxy Ix2)+ prop "Ix3" $ prop_ApplyZeroStencil (Proxy :: Proxy Ix3)+ prop "Ix4" $ prop_ApplyZeroStencil (Proxy :: Proxy Ix4) describe "DangerousStencil" $ do- it "Ix1" $ property $ prop_DangerousStencil (Proxy :: Proxy Ix1)- it "Ix2" $ property $ prop_DangerousStencil (Proxy :: Proxy Ix2)- it "Ix3" $ property $ prop_DangerousStencil (Proxy :: Proxy Ix3)- it "Ix4" $ property $ prop_DangerousStencil (Proxy :: Proxy Ix4)+ prop "Ix1" $ prop_DangerousStencil (Proxy :: Proxy Ix1)+ prop "Ix2" $ prop_DangerousStencil (Proxy :: Proxy Ix2)+ prop "Ix3" $ prop_DangerousStencil (Proxy :: Proxy Ix3)+ prop "Ix4" $ prop_DangerousStencil (Proxy :: Proxy Ix4) describe "MapEqApplyStencil" $ do- it "Ix1" $ property $ prop_MapEqApplyStencil @Ix1- it "Ix2" $ property $ prop_MapEqApplyStencil @Ix2- it "Ix3" $ property $ prop_MapEqApplyStencil @Ix3- it "Ix4" $ property $ prop_MapEqApplyStencil @Ix4+ prop "Ix1" $ prop_MapEqApplyStencil @Ix1+ prop "Ix2" $ prop_MapEqApplyStencil @Ix2+ prop "Ix3" $ prop_MapEqApplyStencil @Ix3+ prop "Ix4" $ prop_MapEqApplyStencil @Ix4 describe "FoldrStencil" $ do- it "Ix1" $ property $ prop_FoldrStencil @Ix1- it "Ix2" $ property $ prop_FoldrStencil @Ix2- it "Ix3" $ property $ prop_FoldrStencil @Ix3- it "Ix4" $ property $ prop_FoldrStencil @Ix4+ prop "Ix1" $ prop_FoldrStencil @Ix1+ prop "Ix2" $ prop_FoldrStencil @Ix2+ prop "Ix3" $ prop_FoldrStencil @Ix3+ prop "Ix4" $ prop_FoldrStencil @Ix4 describe "Simple" $ do- it "sumStencil" $ property $ \ (arr :: Array B Ix2 Rational) border ->- computeAs N (mapStencil border avg3x3Stencil arr) ===- computeAs N (applyStencil (Padding 1 1 border) (avgStencil (Sz 3)) arr)- it "sameSizeAndCenter" $ property $ \ (SzIx sz ix) ->+ prop "sumStencil" $ \ (arr :: Array B Ix2 Rational) border ->+ computeAs BN (mapStencil border avg3x3Stencil arr) ===+ computeAs BN (applyStencil (Padding 1 1 border) (avgStencil (Sz 3)) arr)+ prop "sameSizeAndCenter" $ \ (SzIx sz ix) -> let stencil = makeStencil sz ix ($ Ix1 0) :: Stencil Ix1 Int Int in getStencilSize stencil === sz .&&. getStencilCenter stencil === ix -stencilDirection :: Ix2 -> Array U Ix2 Int -> Array U Ix2 Int-stencilDirection ix = computeAs U . mapStencil (Fill 0) (makeStencil (Sz 3) (1 :. 1) $ \f -> f ix)+stencilDirection :: Ix2 -> Matrix P Int -> Matrix P Int+stencilDirection ix = computeAs P . mapStencil (Fill 0) (makeStencil (Sz 3) (1 :. 1) $ \f -> f ix) -stencilCorners :: Ix2 -> Ix2 -> Array U Ix2 Int -> Array U Ix2 Int-stencilCorners ixC ix = computeAs U . mapStencil (Fill 0) (makeStencil (Sz 3) ixC $ \f -> f ix)+stencilCorners :: Ix2 -> Ix2 -> Matrix P Int -> Matrix P Int+stencilCorners ixC ix = computeAs P . mapStencil (Fill 0) (makeStencil (Sz 3) ixC $ \f -> f ix) stencilConvolution :: Spec stencilConvolution = do- let xs3 :: Array U Ix1 Int+ let xs3 :: Array P Ix1 Int xs3 = [1, 2, 3] xs3f f = f (-1) 1 . f 0 2 . f 1 3- xs4 :: Array U Ix1 Int+ xs4 :: Array P Ix1 Int xs4 = [1, 2, 3, 4] xs4f f = f (-2) 1 . f (-1) 2 . f 0 3 . f 1 4- ys :: Array U Ix1 Int+ ys :: Array P Ix1 Int ys = [1, 2, 3, 4, 5] ysConvXs3 = [4, 10, 16, 22, 22] ysConvXs4 = [10, 20, 30, 34, 31]@@ -190,12 +199,12 @@ 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- mapStencil1 :: Stencil Ix1 Int Int -> Array U Ix1 Int -> Array U Ix1 Int- mapStencil1 s = computeAs U . mapStencil (Fill 0) s- mapStencil2 :: Stencil Ix2 Int Int -> Array U Ix2 Int -> Array U Ix2 Int- mapStencil2 s = computeAs U . mapStencil (Fill 0) s- applyStencil1 :: Stencil Ix1 Int Int -> Array U Ix1 Int -> Array U Ix1 Int- applyStencil1 s = computeAs U . applyStencil noPadding s+ mapStencil1 :: Stencil Ix1 Int Int -> Array P Ix1 Int -> Array P Ix1 Int+ mapStencil1 s = computeAs P . mapStencil (Fill 0) s+ mapStencil2 :: Stencil Ix2 Int Int -> Array P Ix2 Int -> Array P Ix2 Int+ mapStencil2 s = computeAs P . mapStencil (Fill 0) s+ applyStencil1 :: Stencil Ix1 Int Int -> Array P Ix1 Int -> Array P Ix1 Int+ applyStencil1 s = computeAs P . applyStencil noPadding s describe "makeConvolutionStencilFromKernel" $ do it "1x3 map" $ mapStencil1 (makeConvolutionStencilFromKernel xs3) ys `shouldBe` ysConvXs3 it "1x4 map" $ mapStencil1 (makeConvolutionStencilFromKernel xs4) ys `shouldBe` ysConvXs4@@ -218,41 +227,41 @@ it "1x4" $ mapStencil1 (makeCorrelationStencil (Sz1 4) 1 xs4f') ys `shouldBe` ysCorrXs4' describe "makeConvolutionStencil == makeConvolutionStencilFromKernel" $ do it "Sobel Horizontal" $- property $ \(arr :: Array U Ix2 Int) ->+ property $ \(arr :: Array P Ix2 Int) -> mapStencil2 (makeConvolutionStencil (Sz 3) 1 sobelX) arr === mapStencil2 (makeConvolutionStencilFromKernel sobelKernelX) arr it "1x3" $- property $ \(arr :: Array U Ix1 Int) ->+ property $ \(arr :: Array P Ix1 Int) -> mapStencil1 (makeConvolutionStencil (Sz1 3) 1 xs3f) arr === mapStencil1 (makeConvolutionStencilFromKernel xs3) arr it "1x4" $- property $ \(arr :: Array U Ix1 Int) ->+ property $ \(arr :: Array P Ix1 Int) -> mapStencil1 (makeConvolutionStencil (Sz1 4) 2 xs4f) arr === mapStencil1 (makeConvolutionStencilFromKernel xs4) arr describe "makeCorrelationStencil == makeCorrelationStencilFromKernel" $ do it "Sobel Horizontal" $- property $ \(arr :: Array U Ix2 Int) ->+ property $ \(arr :: Array P Ix2 Int) -> mapStencil2 (makeCorrelationStencil (Sz 3) 1 sobelX) arr === mapStencil2 (makeCorrelationStencilFromKernel sobelKernelX) arr it "1x3" $- property $ \(arr :: Array U Ix1 Int) ->+ property $ \(arr :: Array P Ix1 Int) -> mapStencil1 (makeCorrelationStencil (Sz1 3) 1 xs3f) arr === mapStencil1 (makeCorrelationStencilFromKernel xs3) arr it "1x4" $- property $ \(arr :: Array U Ix1 Int) ->+ property $ \(arr :: Array P Ix1 Int) -> mapStencil1 (makeCorrelationStencil (Sz1 4) 2 xs4f) arr === mapStencil1 (makeCorrelationStencilFromKernel xs4) arr describe "makeConvolutionStencil == makeCorrelationStencil . rotate180" $ do it "Sobel Horizontal" $- property $ \(arr :: Array U Ix2 Int) ->+ property $ \(arr :: Array P Ix2 Int) -> mapStencil2 (makeConvolutionStencilFromKernel sobelKernelX) arr === mapStencil2 (makeCorrelationStencilFromKernel (rotate180 sobelKernelX)) arr it "1x3" $- property $ \(arr :: Array U Ix1 Int) ->+ property $ \(arr :: Array P Ix1 Int) -> mapStencil1 (makeConvolutionStencilFromKernel xs3) arr === mapStencil1 (makeCorrelationStencilFromKernel (rotate180 xs3)) arr it "1x5" $- property $ \(arr :: Array U Ix1 Int) ->+ property $ \(arr :: Array P Ix1 Int) -> mapStencil1 (makeConvolutionStencilFromKernel ys) arr === mapStencil1 (makeCorrelationStencilFromKernel (rotate180 ys)) arr @@ -260,7 +269,7 @@ spec = do describe "Stencil" $ do stencilSpec- let arr = [[1, 2, 3], [4, 5, 6], [7, 8, 9]] :: Array U Ix2 Int+ let arr = [[1, 2, 3], [4, 5, 6], [7, 8, 9]] :: Array P Ix2 Int describe "Unit tests Ix2" $ do it "Direction Left" $ stencilDirection (0 :. 1) arr `shouldBe` [[2, 3, 0], [5, 6, 0], [8, 9, 0]]@@ -268,7 +277,7 @@ stencilDirection (0 :. -1) arr `shouldBe` [[0, 1, 2], [0, 4, 5], [0, 7, 8]] it "Direction Down" $ stencilDirection (1 :. 0) arr `shouldBe` [[4, 5, 6], [7, 8, 9], [0, 0, 0]]- it "Direction Up" $+ it "Direction Pp" $ stencilDirection (-1 :. 0) arr `shouldBe` [[0, 0, 0], [1, 2, 3], [4, 5, 6]] it "Direction Left/Top Corner" $ stencilCorners (0 :. 0) (2 :. 2) arr `shouldBe` [[9, 0, 0], [0, 0, 0], [0, 0, 0]]@@ -279,16 +288,16 @@ it "Direction Left/Bottom Corner" $ stencilCorners (2 :. 0) (-2 :. 2) arr `shouldBe` [[0, 0, 0], [0, 0, 0], [3, 0, 0]] describe "mapStencil with stride" $ do- let kernel = [[-1, 0, 1], [0, 1, 0], [-1, 0, 1]] :: Array U Ix2 Int+ let kernel = [[-1, 0, 1], [0, 1, 0], [-1, 0, 1]] :: Array P Ix2 Int stencil = makeConvolutionStencilFromKernel kernel stride = Stride 2 it "map stencil with stride on small array" $ let strideArr = mapStencil (Fill 0) stencil arr- in computeWithStrideAs U stride strideArr `shouldBe` [[-4, 8], [2, 14]]+ in computeWithStrideAs P stride strideArr `shouldBe` [[-4, 8], [2, 14]] it "map stencil with stride on larger array" $- let largeArr = makeArrayR U Seq (Sz 5) (succ . toLinearIndex (Sz 5))+ let largeArr = makeArrayR P Seq (Sz 5) (succ . toLinearIndex (Sz 5)) strideArr = mapStencil (Fill 0) stencil largeArr- in computeWithStrideAs U stride strideArr `shouldBe`+ in computeWithStrideAs P stride strideArr `shouldBe` [[-6, 1, 14], [-13, 9, 43], [4, 21, 44]] stencilConvolution @@ -297,10 +306,10 @@ f ( 0 :. -1) (-2) . f ( 0 :. 1) 2 . f ( 1 :. -1) (-1) . f ( 1 :. 1) 1 -sobelKernelX :: Array U Ix2 Int+sobelKernelX :: Array P Ix2 Int sobelKernelX = [ [-1, 0, 1] , [-2, 0, 2] , [-1, 0, 1] ] -rotate180 :: (Num ix, Index ix) => Array U ix Int -> Array U ix Int-rotate180 = computeAs U . transform' (\sz -> (sz, sz)) (\(Sz sz) f ix -> f (sz - 1 - ix))+rotate180 :: (Num ix, Index ix) => Array P ix Int -> Array P ix Int+rotate180 = computeAs P . transform' (\sz -> (sz, sz)) (\(Sz sz) f ix -> f (sz - 1 - ix))
tests/Test/Massiv/ArraySpec.hs view
@@ -13,7 +13,7 @@ prop_Construct_makeArray_Manifest ::- forall r ix. (Load D ix Int, Ragged L ix Int, Source r ix Int, Construct r ix Int)+ forall r ix. (Ragged L ix Int, Source r Int, Load r ix Int) => Comp -> Sz ix -> Fun Int Int@@ -23,7 +23,7 @@ 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)+ forall r ix. (Ragged L ix Int, Load r ix Int) => Comp -> Sz ix -> Fun Int Int@@ -34,7 +34,7 @@ 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))+ (Ragged L ix Int, Load r ix Int, Functor (Array r ix)) => Comp -> Sz ix -> Fun Int Int@@ -46,11 +46,9 @@ 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+ ( Ragged L ix Int+ , Load r ix Int+ , Source r Int ) => Comp -> Sz ix@@ -67,10 +65,9 @@ prop_IxUnbox :: forall ix.- ( Load D ix ix- , Ragged L ix ix- , Construct U ix ix- , Source U ix ix+ ( Ragged L ix ix+ , Source U ix+ , Unbox ix ) => Comp -> Sz ix@@ -81,7 +78,7 @@ 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)+ forall r ix. (Ragged L ix Int, StrideLoad r ix Int) => Comp -> Sz ix -> Fun Int Int@@ -97,34 +94,36 @@ specCommon :: forall ix.- (Arbitrary ix, Load D ix Int, StrideLoad DW ix Int, Ragged L ix Int, Ragged L ix ix, Unbox ix)+ (Arbitrary ix, 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+ prop "Construct_makeArray B" $ prop_Construct_makeArray_Manifest @B @ix+ prop "Construct_makeArray BN" $ prop_Construct_makeArray_Manifest @BN @ix+ prop "Construct_makeArray BL" $ prop_Construct_makeArray_Manifest @BL @ix+ prop "Construct_makeArray S" $ prop_Construct_makeArray_Manifest @S @ix+ prop "Construct_makeArray P" $ prop_Construct_makeArray_Manifest @P @ix+ prop "Construct_makeArray U" $ prop_Construct_makeArray_Manifest @U @ix+ prop "Construct_makeArray_Delayed DI" $ prop_Construct_makeArray_Delayed @DI @ix+ prop "Construct_makeArray_Delayed DL" $ prop_Construct_makeArray_Delayed @DL @ix+ prop "Construct_makeArray_Delayed DW" $ prop_Construct_makeArray_Delayed @DW @ix+ prop "Functor D" $ prop_Functor @D @ix+ prop "Functor DI" $ prop_Functor @DI @ix+ prop "Functor DL" $ prop_Functor @DL @ix+ prop "Functor DW" $ prop_Functor @DW @ix+ prop "Extract B" $ prop_Extract @B @ix+ prop "Extract BN" $ prop_Extract @BN @ix+ prop "Extract BL" $ prop_Extract @BL @ix+ prop "Extract S" $ prop_Extract @S @ix+ prop "Extract U" $ prop_Extract @U @ix+ prop "computeWithStride DI" $ prop_computeWithStride @DI @ix+ prop "computeWithStride DW" $ prop_computeWithStride @DW @ix+ prop "computeWithStride B" $ prop_computeWithStride @B @ix+ prop "computeWithStride BN" $ prop_computeWithStride @BN @ix+ prop "computeWithStride BL" $ prop_computeWithStride @BL @ix+ prop "computeWithStride S" $ prop_computeWithStride @S @ix+ prop "computeWithStride U" $ prop_computeWithStride @U @ix+ prop "IxUnbox" $ prop_IxUnbox @ix spec :: Spec
tests/Test/Massiv/Core/IndexSpec.hs view
@@ -7,6 +7,7 @@ {-# LANGUAGE TypeOperators #-} module Test.Massiv.Core.IndexSpec (spec) where +import Control.Exception import Control.DeepSeq import Data.Massiv.Array import Data.Massiv.Array.Unsafe (Sz(SafeSz))@@ -23,8 +24,6 @@ , Index ix , Bounded ix , Index (Lower ix)- , Typeable ix- , Typeable (Lower ix) , Arbitrary ix , Arbitrary (Lower ix) , IsIndexDimension ix (Dimensions ix)@@ -66,9 +65,7 @@ specIxT :: forall ix ix'.- ( Typeable ix- , Typeable (Lower ix)- , Index ix+ ( Index ix , Index (Lower ix) , Arbitrary ix , Arbitrary (Lower ix)@@ -132,7 +129,6 @@ ( Num ix -- , Unbox ix -- TODO: add Unbox instance and a spec for unboxed vectors , Index ix- , Typeable ix , Arbitrary ix ) => Spec@@ -140,7 +136,7 @@ describe ("Sz (" ++ showsTypeRep (typeRep (Proxy :: Proxy ix)) ")") $ do szSpec @ix szNumSpec @ix- it "Show" $ property $ \sz -> ("Just (" ++ show (sz :: Sz ix) ++ ")") === show (Just sz)+ prop "Show" $ \sz -> ("Just (" ++ show (sz :: Sz ix) ++ ")") === show (Just sz) eqSpecOnArbitrary @(Sz ix) ordSpecOnArbitrary @(Sz ix)
tests/Test/Massiv/Core/ListSpec.hs view
@@ -1,11 +1,9 @@ {-# 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@@ -17,5 +15,3 @@ spec = do describe "L" $ it "toStream" $ property (prop_toStreamIsList @L @Int)- describe "LN" $- it "toStream" $ property (prop_toStreamIsList @LN @Int)
tests/Test/Massiv/VectorSpec.hs view
@@ -9,7 +9,6 @@ import Control.Arrow (first) import Control.Applicative-import Control.DeepSeq import Control.Exception import Data.Bits import Data.Int@@ -31,11 +30,8 @@ infix 4 !==!, !!==!! -sizeException :: SizeException -> Bool-sizeException exc = exc `deepseq` True- toUnboxV2 ::- (Unbox e, Unbox e1, Unbox e2, Index ix1, Index ix2)+ Unbox e => (VU.Vector e1 -> VU.Vector e2 -> VU.Vector e) -> Array U ix1 e1 -> Array U ix2 e2@@ -44,7 +40,7 @@ fromUnboxedVector (getComp v1 <> getComp v2) (f (toUnboxedVector v1) (toUnboxedVector v2)) toUnboxV3 ::- (Unbox e, Unbox e1, Unbox e2, Unbox e3, Index ix1, Index ix2, Index ix3)+ Unbox e => (VU.Vector e1 -> VU.Vector e2 -> VU.Vector e3 -> VU.Vector e) -> Array U ix1 e1 -> Array U ix2 e2@@ -53,7 +49,7 @@ toUnboxV3 f v1 v2 v3 = appComp (getComp v1) (toUnboxV2 (f (toUnboxedVector v1)) v2 v3) toUnboxV4 ::- (Unbox e, Unbox e1, Unbox e2, Unbox e3, Unbox e4, Index ix1, Index ix2, Index ix3, Index ix4)+ Unbox e => (VU.Vector e1 -> VU.Vector e2 -> VU.Vector e3 -> VU.Vector e4 -> VU.Vector e) -> Array U ix1 e1 -> Array U ix2 e2@@ -63,18 +59,7 @@ toUnboxV4 f v1 v2 v3 v4 = appComp (getComp v1) (toUnboxV3 (f (toUnboxedVector v1)) v2 v3 v4) toUnboxV5 ::- ( Unbox e- , Unbox e1- , Unbox e2- , Unbox e3- , Unbox e4- , Unbox e5- , Index ix1- , Index ix2- , Index ix3- , Index ix4- , Index ix5- )+ Unbox e => (VU.Vector e1 -> VU.Vector e2 -> VU.Vector e3 -> VU.Vector e4 -> VU.Vector e5 -> VU.Vector e) -> Array U ix1 e1 -> Array U ix2 e2@@ -85,20 +70,7 @@ toUnboxV5 f v1 v2 v3 v4 v5 = appComp (getComp v1) (toUnboxV4 (f (toUnboxedVector v1)) v2 v3 v4 v5) toUnboxV6 ::- ( Unbox e- , Unbox e1- , Unbox e2- , Unbox e3- , Unbox e4- , Unbox e5- , Unbox e6- , Index ix1- , Index ix2- , Index ix3- , Index ix4- , Index ix5- , Index ix6- )+ Unbox e => (VU.Vector e1 -> VU.Vector e2 -> VU.Vector e3 -> VU.Vector e4 -> VU.Vector e5 -> VU.Vector e6 -> VU.Vector e) -> Array U ix1 e1 -> Array U ix2 e2@@ -159,13 +131,14 @@ (!==!) :: (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+(!!==!!) ::+ (Eq e, Show e, Prim e, Load 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'+ Right vec' -> toPrimitiveVector (compute arr) `shouldBe` vec' Left (_exc :: ErrorCall) ->- shouldThrow (pure $! computeAs P arr) sizeException+ shouldThrow (pure $! computeAs P arr) selectErrorCall newtype SeedVector = SeedVector (VP.Vector Word32) deriving (Eq, Show) @@ -445,7 +418,7 @@ prop_szipWith6 :: Vector DS Word64 -> Vector B Word32- -> Vector N Word16+ -> Vector BN Word16 -> Vector S Word8 -> Vector U Int8 -> Vector P Int16@@ -493,7 +466,7 @@ -> Vector S Word32 -> Vector P Word16 -> Vector U Word8- -> Vector N Int8+ -> Vector BN Int8 -> Fun (Ix1, (Word64, Word32, Word16, Word8, Int8)) Int -> Property prop_sizipWith5 v1 v2 v3 v4 v5 f =@@ -503,8 +476,8 @@ prop_sizipWith6 :: Vector DS Word64 -> Vector D Word32- -> Vector B Word16- -> Vector N Word8+ -> Vector BL Word16+ -> Vector BN Word8 -> Vector P Int8 -> Vector P Int16 -> Fun (Ix1, Word64, (Word32, Word16, Word8, Int8, Int16)) Int@@ -807,11 +780,11 @@ slength (sfromList []) `shouldBe` Nothing slength (sfromListN 1 []) `shouldBe` Nothing slength (sgenerate 1 id) `shouldBe` Just 1- it "snull" $ do- snull sempty `shouldBe` True- snull (fromLists' Seq [[]] :: Array P Ix2 Int) `shouldBe` True- snull (siterateN 3 id ()) `shouldBe` False- snull (0 ..: 1 :> 2 :> 3 :. 0) `shouldBe` True+ it "isNull" $ do+ isNull sempty `shouldBe` True+ isNull (fromLists' Seq [[]] :: Array P Ix2 Int) `shouldBe` True+ isNull (siterateN 3 id ()) `shouldBe` False+ isNull (0 ..: 1 :> 2 :> 3 :. 0) `shouldBe` True describe "Indexing" $ do prop "head' (non-empty)" $ \(ArrNE arr :: ArrNE D Ix1 Int) -> head' arr === evaluate' arr 0 .&&. head' arr === shead' arr@@ -884,6 +857,8 @@ prop "ssingleton" $ \(e :: Word) -> V.ssingleton e !==! VP.singleton e prop "replicate" $ \comp k (e :: Word) -> V.replicate @DL comp (Sz k) e !==! VP.replicate k e+ prop "replicate" $ \k (e :: Word) ->+ V.replicate @DS Seq (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)@@ -955,7 +930,7 @@ prop "fmap" $ \(v :: Vector DS Word) (f :: Fun Word Int) -> fmap (apply f) v !==! VP.map (apply f) (toPrimitiveVector (compute v)) prop "<$" $ \(v :: Vector DS Word) (a :: Char) ->- (a <$ v) !==! VP.replicate (totalElem (size v)) a+ (a <$ v) !==! VP.replicate (length v) a prop "smap" $ \(v :: Vector P Word) (f :: Fun Word Int) -> V.smap (apply f) v !==! VP.map (apply f) (toPrimitiveVector v) prop "simap" $ \(v :: Vector P Word) (f :: Fun (Int, Word) Int) ->