packages feed

massiv-test (empty) → 0.1.0

raw patch · 31 files changed

+3205/−0 lines, 31 filesdep +QuickCheckdep +basedep +bytestringsetup-changed

Dependencies added: QuickCheck, base, bytestring, containers, data-default, data-default-class, deepseq, exceptions, genvalidity-hspec, hspec, massiv, massiv-test, primitive, scheduler, unliftio, vector

Files

+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# 0.1.0++* Initial release.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Alexey Kuleshevich (c) 2017-2019++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Alexey Kuleshevich nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,45 @@+# massiv-test++This package is designed for users of `massiv`, that would like to do some testing of+their code, while reusing functionality that has already been written for testing `massiv`+itsef. This library is still a work in progress, nevertheless it is at a fairly usable+state. Below is a list of use case for this package.++## QuickCheck generators++First and foremost this package provides `Arbitrary` and `CoArbitrary` instances for the+relevant types available in `massiv`, as well as few extra handy `newtype` wrappers that+can be very useful for writing property tests for libraries and applications that depends+on `massiv`.++## Reusable spec++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+predefined collection of `hspec` specs and/or `QuickCheck` properties to validate their+implementation.++## Test suite for `massiv`++Internally `massiv-test` package contains all of the tests that are used on `massiv`. The+whole test suite has been extracted out to make the `massiv` package lighter as well as to+make the test functionality reusable, without impacting the dependency footprint of the+user that does not need the testing functionlity.++Because of this usecase, the major version of `massiv-test` is expected to increase with+almost every release of `massiv`.++## Doctests++Together with examples in haddock it is possible to describe various properties. Those+examples and properties can be tested with doctests, but such properties can not be tested+without QuickCheck generators readily available for import, for that reason `doctest` test+section of `massiv` also depends on `massiv-test`.++# More info++For more info on `massiv` and related libraries refer to+[README](https://github.com/lehins/massiv/blob/master/README.md) on github.++
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple+main :: IO ()+main = defaultMain
+ massiv-test.cabal view
@@ -0,0 +1,95 @@+name:                massiv-test+version:             0.1.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+license:             BSD3+license-file:        LICENSE+author:              Alexey Kuleshevich+maintainer:          alexey@kuleshevi.ch+copyright:           2018-2019 Alexey Kuleshevich+category:            Data, Data Structures, Parallelism+build-type:          Simple+extra-source-files:  README.md+                   , CHANGELOG.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:    Test.Massiv.Core+                    , Test.Massiv.Core.Common+                    , Test.Massiv.Core.Index+                    , Test.Massiv.Core.Mutable+                    , Test.Massiv.Array.Mutable+                    , Test.Massiv.Utils+++  build-depends:       base >= 4.9 && < 5+                     , bytestring+                     , data-default-class+                     , deepseq+                     , exceptions+                     , QuickCheck+                     , hspec+                     , massiv == 0.4.*+                     , scheduler+                     , primitive+                     , unliftio+                     , vector++  default-language:    Haskell2010+  ghc-options:        -Wall+                      -Wincomplete-record-updates+                      -Wincomplete-uni-patterns+                      -Wredundant-constraints+                      -fno-warn-orphans++test-suite tests+  type:               exitcode-stdio-1.0+  hs-source-dirs:     tests+  main-is:            Main.hs+  other-modules:      Spec+                    , Test.Massiv.Core.IndexSpec+                    , Test.Massiv.Core.SchedulerSpec+                    , Test.Massiv.Array.MutableSpec+                      -- TODO: Below should be moved to Test.Massiv.Array+                    , Data.Massiv.Array.Delayed.InterleavedSpec+                    , Data.Massiv.Array.Delayed.PushSpec+                    , Data.Massiv.Array.Delayed.WindowedSpec+                    , Data.Massiv.Array.DelayedSpec+                    , Data.Massiv.Array.Manifest.VectorSpec+                    , Data.Massiv.Array.ManifestSpec+                    , Data.Massiv.Array.Numeric.IntegralSpec+                    , Data.Massiv.Array.Ops.ConstructSpec+                    , Data.Massiv.Array.Ops.FoldSpec+                    , Data.Massiv.Array.Ops.MapSpec+                    , Data.Massiv.Array.Ops.SliceSpec+                    , Data.Massiv.Array.Ops.SortSpec+                    , Data.Massiv.Array.Ops.TransformSpec+                    , Data.Massiv.Array.StencilSpec+                    , Data.Massiv.ArraySpec+  build-depends:      base+                    , bytestring+                    , containers+                    , data-default+                    , deepseq+                    , genvalidity-hspec+                    , massiv+                    , massiv-test+                    , hspec+                    , scheduler+                    , QuickCheck+                    , vector++  default-language:   Haskell2010+  ghc-options:       -Wall+                     -Wincomplete-record-updates+                     -Wincomplete-uni-patterns+                     -Wredundant-constraints+                     -fno-warn-orphans+                     -threaded+                     -with-rtsopts=-N2++source-repository head+  type:     git+  location: https://github.com/lehins/massiv
+ src/Test/Massiv/Array/Mutable.hs view
@@ -0,0 +1,260 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+module Test.Massiv.Array.Mutable+  ( -- * Spec for safe Mutable instance+    mutableSpec+  , prop_GenerateArray+  , prop_iMapiMapM+  -- * Atomic ops spec+  , atomicIntSpec+  ) where++import UnliftIO.Async+import Data.Bits+import Data.Functor.Identity+import Data.List as L+import Data.Massiv.Array as A+import Data.Massiv.Array.Mutable.Atomic+import Data.Massiv.Array.Unsafe+import Test.Massiv.Core.Common+import Test.Massiv.Utils as T+++-- prop_MapMapM :: forall r ix(Show (Array r ix Word), Eq (Array r ix Word), Mutable r ix Word) =>+--                 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)+  => Fun (ix, e) e+  -> Array D ix e+  -> Property+prop_iMapiMapM f arr =+  (compute (A.imap (curry (apply f)) arr) :: Array r ix e) ===+  runIdentity (A.imapM (\ix e -> pure $ apply f (ix, e)) arr)++prop_GenerateArray ::+     forall r ix e.+     ( Show (Array r ix e)+     , Eq (Array r ix e)+     , Mutable r ix e+     , Show e+     , Arbitrary e+     , Arbitrary ix+     , Function ix+     , CoArbitrary ix+     )+  => Property+prop_GenerateArray =+  property $ \comp sz f' -> do+    let arr = makeArray comp sz f :: Array r ix e+        arrST = runST (generateArrayS (size arr) (return . evaluate' arr))+        f = apply f'+    arrST `shouldBe` arr+    arrIO <- generateArray (getComp arr) (size arr) (evaluateM arr)+    arrIO `shouldBe` arr++prop_Shrink ::+     forall r ix e.+     ( Show (Array r ix e)+     , Mutable r ix e+     , Resize r ix+     , Source r Ix1 e+     , Arbitrary ix+     , Arbitrary e+     , Eq e+     )+  => Property+prop_Shrink  =+  property $ \ (ArrIx arr ix) -> runST $ do+    marr :: MArray s r ix e <- thawS arr+    sarr <- unsafeFreeze (getComp arr) =<< unsafeLinearShrink marr (Sz ix)+    pure (A.foldlS (.&&.) (property True) $ A.zipWith (==) (flatten arr) (flatten sarr))++prop_GrowShrink ::+     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+     , Arbitrary ix+     , Arbitrary e+     , Show e+     )+  => Property+prop_GrowShrink =+  property $ \ (ArrNE arr) (NonNegative delta) e -> runST $ do+    let sz = size (arr :: Array r ix e)+        k = getDim' (unSz sz) (dimensions sz)+        -- increase the outer most dimension, just so the structure doesn't change+        newSz = Sz $ setDim' (unSz sz) (dimensions sz) (k + delta)+    marr <- thawS arr+    grownMarr <- unsafeLinearGrow marr newSz+    -- Make sure we can write into the newly allocated area+    when (delta > 0) $ void $ write grownMarr (liftIndex pred (unSz newSz)) e+    garr <- compute . extract' zeroIndex sz <$> unsafeFreeze (getComp arr) grownMarr+    sarr <- freezeS =<< unsafeLinearShrink grownMarr sz+    pure (garr === arr .&&. sarr === arr)++++prop_unfoldrList ::+     forall r ix e.+     ( Show (Array r Ix1 e)+     , Eq (Array r Ix1 e)+     , Arbitrary ix+     , Arbitrary e+     , Show e+     , Resize r ix+     , Mutable r ix e+     , Mutable r Ix1 e+     )+  => Property+prop_unfoldrList =+  property $ \comp sz f (i :: Word) ->+    let xs = runST (unfoldrPrimM_ comp sz (pure . apply f) i) :: Array r ix e+        ys = A.fromList comp (L.take (totalElem sz) (L.unfoldr (Just . apply f) i))+     in flatten xs === ys+++prop_unfoldrReverseUnfoldl ::+     forall r ix e.+     ( Show (Array r ix e)+     , Eq (Array r ix e)+     , Arbitrary ix+     , Arbitrary e+     , Show e+     , Source r ix e+     , Mutable r ix e+     )+  => Property+prop_unfoldrReverseUnfoldl =+  property $ \ comp sz f (i :: Word) ->+    let swapTuple (x, y) = (y, x)+        rev a =+          compute @r (backpermute' sz (liftIndex pred . liftIndex2 (-) (unSz sz)) a)+     in do a1 :: Array r ix e <- unfoldrPrimM_ @r comp sz (pure . apply f) i+           a2 <- unfoldlPrimM_ @r comp sz (pure . swapTuple . apply f) i+           rev a1 `shouldBe` a2+++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+     , Eq (Array r ix e)+     , Typeable e+     , Show e+     , Eq e+     , Mutable r ix e+     , Mutable r Ix1 e+     , Extract r ix e+     , Resize r ix+     , 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+  describe "Unfolding" $ do+    it "unfoldrList" $ prop_unfoldrList @r @ix @e+    it "unfoldrReverseUnfoldl" $ prop_unfoldrReverseUnfoldl @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.+prop_atomicModifyIntArrayMany ::+     forall ix. (Show (Array P ix Int), Arbitrary ix, Index ix)+  => Property+prop_atomicModifyIntArrayMany =+  property $ \(ArrIx arr ix) (ys :: Array B Ix1 Int)  -> do+    marr <- thaw arr+    atomicModifyIntArray marr (liftIndex (subtract 1 . negate) ix) succ `shouldReturn` Nothing+    mys <- mapConcurrently (atomicModifyIntArray marr ix . const) ys+    x <- A.readM marr (ix :: ix)+    let xs = x : fromMaybe (error "atomicModifyIntArray") (Prelude.sequenceA (toList mys))+    y <- indexM arr ix+    L.sort (y : toList ys) `shouldBe` L.sort xs++prop_atomicReadIntArray ::+     forall ix. (Show (Array P ix Int), Arbitrary ix, Index ix)+  => Property+prop_atomicReadIntArray =+  property $ \arr (ix :: ix) -> do+    marr <- unsafeThaw arr+    mx <- A.read marr ix+    atomicReadIntArray marr ix `shouldReturn` mx++prop_atomicWriteIntArray ::+     forall ix. (Show (Array P ix Int), Arbitrary ix, Index ix)+  => Property+prop_atomicWriteIntArray =+  property $ \arr (ix :: ix) (e :: Int) -> do+    marr <- unsafeThaw arr+    mx <- A.read marr ix+    atomicWriteIntArray marr ix e `shouldReturn` isJust mx+    T.forM_ mx $ \ _ ->+      A.read marr ix `shouldReturn` Just e++prop_atomicOpIntArray ::+     forall ix. (Show (Array P ix Int), Arbitrary ix, Index ix)+  => (Int -> Int -> Int)+  -> (forall m. PrimMonad m =>+                  MArray (PrimState m) P ix Int -> ix -> Int -> m (Maybe Int))+  -> Property+prop_atomicOpIntArray f atomicAction =+  property $ \arr (ix :: ix) (e :: Int) -> do+    marr <- unsafeThaw arr+    mx <- A.read marr ix+    atomicAction marr ix e `shouldReturn` mx+    T.forM_ mx $ \x -> A.readM marr ix `shouldReturn` f x e++prop_casIntArray ::+     forall ix. (Show (Array P ix Int), Arbitrary ix, Index ix)+  => Property+prop_casIntArray =+  property $ \arr (ix :: ix) (e :: Int) -> do+    marr <- unsafeThaw arr+    mx <- A.read marr ix+    case mx of+      Nothing -> casIntArray marr ix e e `shouldReturn` Nothing+      Just x -> do+        casIntArray marr ix x e `shouldReturn` mx+        A.readM marr ix `shouldReturn` e+++atomicIntSpec ::+     forall ix. (Show (Array P ix Int), Arbitrary ix, Index ix)+  => Spec+atomicIntSpec =+  describe "Atomic Int Operations" $ do+    it "atomicModifyIntArrayMany" $ prop_atomicModifyIntArrayMany @ix+    it "atomicReadIntArray" $ prop_atomicReadIntArray @ix+    it "atomicWriteIntArray" $ prop_atomicWriteIntArray @ix+    it "atomicAddIntArray" $ prop_atomicOpIntArray @ix (+) atomicAddIntArray+    it "atomicSubIntArray" $ prop_atomicOpIntArray @ix (-) atomicSubIntArray+    it "atomicAndIntArray" $ prop_atomicOpIntArray @ix (.&.) atomicAndIntArray+    it "atomicNandIntArray" $+      prop_atomicOpIntArray @ix (\x y -> complement (x .&. y)) atomicNandIntArray+    it "atomicOrIntArray" $ prop_atomicOpIntArray @ix (.|.) atomicOrIntArray+    it "atomicXorIntArray" $ prop_atomicOpIntArray @ix xor atomicXorIntArray+    it "casIntArray" $ prop_casIntArray @ix
+ src/Test/Massiv/Core.hs view
@@ -0,0 +1,9 @@+module Test.Massiv.Core+  ( module Index+  , module Commmon+  , module Utils+  ) where++import Test.Massiv.Core.Index as Index (DimIx(..), SzIx(..), SzNE(..))+import Test.Massiv.Core.Common as Commmon+import Test.Massiv.Utils as Utils
+ src/Test/Massiv/Core/Common.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE UndecidableInstances #-}+module Test.Massiv.Core.Common+  ( ArrNE(..)+  , ArrTiny(..)+  , ArrTinyNE(..)+  , ArrIx(..)+  , module X+  ) where++import Data.Massiv.Array+import Test.Massiv.Core.Index as X+import Test.Massiv.Utils+++++-- | Arbitrary non-empty array. Computation strategy can be either `Seq` or `Par`.+--+-- @since 0.1.0+newtype ArrNE r ix e = ArrNE+  { unArr :: Array r ix e+  }++-- | Arbitrary small and possibly empty array. Computation strategy can be either `Seq` or `Par`.+--+-- @since 0.1.0+newtype ArrTiny r ix e = ArrTiny+  { unArrTiny :: Array r ix e+  }++-- | Tiny but non-empty+--+-- @since 0.1.0+newtype ArrTinyNE r ix e = ArrTinyNE+  { unArrTinyNE :: Array r ix e+  }++-- | Arbitrary non-empty array with a valid index. Can be either `Seq` or `Par`+--+-- @since 0.1.0+data ArrIx r ix e = ArrIx (Array r ix e) ix++deriving instance (Show (Array r ix e)) => Show (ArrNE r ix e)+deriving instance (Show (Array r ix e)) => Show (ArrTiny r ix e)+deriving instance (Show (Array r ix e)) => Show (ArrTinyNE r ix e)+deriving instance (Show (Array r ix e), Show ix) => Show (ArrIx r ix e)++++instance Arbitrary Comp where+  arbitrary =+    frequency+      [ (20, pure Seq)+      , (10, pure Par)+      , (15, ParOn <$> arbitrary)+      , (15, ParN . getSmall <$> arbitrary)+      ]+++arbitraryArray :: (Construct 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) =>+         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+  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) =>+         Arbitrary (ArrTinyNE r ix e) where+  arbitrary = ArrTinyNE <$> arbitraryArray (liftSz (succ . (`mod` 10)) <$> arbitrary)++instance (Arbitrary ix, Construct 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) =>+         Arbitrary (ArrIx r ix e) where+  arbitrary = do+    SzIx sz ix <- arbitrary+    func <- arbitrary+    comp <- arbitrary+    return $ ArrIx (makeArrayLinear comp sz func) ix
+ src/Test/Massiv/Core/Index.hs view
@@ -0,0 +1,536 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+module Test.Massiv.Core.Index+  ( DimIx(..)+  , SzNE(..)+  , SzIx(..)+  , ixToList+  , arbitraryIx1+  , toIx+  -- * Specs+  -- ** Index+  , specIx1+  , ixSpec+  , ix2UpSpec+  , ixNumSpec+  -- ** Size+  , szNumSpec+  , szSpec+  -- * Re-exports+  , module Data.Massiv.Core.Index+  ) where++import Control.DeepSeq+import Control.Exception (throw)+import Control.Monad+import Data.Foldable as F+import Data.Functor.Identity+import Data.IORef+import Data.Massiv.Array.Unsafe (Sz(SafeSz))+import Data.Massiv.Core.Index+import Data.Proxy+import Data.Typeable+import Test.Massiv.Utils+++-- | Dimension that is always within bounds of an index+newtype DimIx ix = DimIx Dim deriving Show++deriving instance Arbitrary Dim++-- | Size that will result in a non-empty array.+--+-- prop > \ (neSz :: Sz1) -> totalElem (unSzNE neSz) > 0+-- prop > \ (neSz :: Sz2) -> totalElem (unSzNE neSz) > 0+-- prop > \ (neSz :: Sz3) -> totalElem (unSzNE neSz) > 0+-- prop > \ (neSz :: Sz4) -> totalElem (unSzNE neSz) > 0+-- prop > \ (neSz :: Sz5) -> totalElem (unSzNE neSz) > 0+newtype SzNE ix = SzNE+  { unSzNE :: Sz ix+  } deriving (Show)+++-- | Non-empty size together with an index that is within bounds of that index.+data SzIx ix = SzIx (Sz ix) ix deriving Show++instance (Index ix, Arbitrary ix) => Arbitrary (Sz ix) where+  arbitrary = do+    sz <- Sz . liftIndex abs <$> arbitrary+    if totalElem sz > 50000+      then arbitrary+      else return sz++instance (Index ix, Arbitrary ix) => Arbitrary (SzNE ix) where+  arbitrary = SzNE . Sz . liftIndex (+1) . unSz <$> arbitrary++instance (Index ix, Arbitrary ix) => Arbitrary (Stride ix) where+  arbitrary = do+    Positive (Small x) <- arbitrary+    Stride . liftIndex ((+1) . (`mod` min 6 x)) <$> arbitrary++instance (Index ix, Arbitrary ix) => Arbitrary (SzIx ix) where+  arbitrary = do+    SzNE sz <- arbitrary+    -- Make sure index is within bounds:+    SzIx sz . flip (liftIndex2 mod) (unSz sz) <$> arbitrary+++instance Arbitrary e => Arbitrary (Border e) where+  arbitrary =+    oneof+      [ Fill <$> arbitrary+      , return Wrap+      , return Edge+      , return Reflect+      , return Continue+      ]+++instance Index ix => Arbitrary (DimIx ix) where+  arbitrary = do+    n <- arbitrary+    return $ DimIx (1 + (Dim n `mod` dimensions (Proxy :: Proxy ix)))++-- | Generators are quadratic in QuickCheck. Unlike built-in Arbitrary instance for `Int`,+-- this one generates smaller integers+--+-- @since 0.1.0+arbitraryIx1 :: Gen Int+arbitraryIx1 = sized (\s -> resize (floor $ (sqrt :: Double -> Double) $ fromIntegral s) arbitrary)++-- | Convert an index to a list+--+-- @since 0.1.0+ixToList :: Index ix => ix -> [Int]+ixToList = reverse . foldlIndex (flip (:)) []++-- | A fairly slow way to convert from one arbitrary index to another of the same dimension+--+-- @since 0.1.0+toIx ::+     forall ix' ix. (Dimensions ix' ~ Dimensions ix, Index ix', Index ix)+  => ix+  -> ix'+toIx ix = F.foldl' setEachIndex zeroIndex [1 .. dimensions (Sz ix)]+  where+    setEachIndex ix' d = setDim' ix' d (getDim' ix d)++instance Arbitrary Ix0 where+  arbitrary = pure Ix0++instance Arbitrary Ix2 where+  arbitrary = (:.) <$> arbitraryIx1 <*> arbitraryIx1++instance Arbitrary Ix3 where+  arbitrary = (:>) <$> arbitraryIx1 <*> ((:.) <$> arbitraryIx1 <*> arbitraryIx1)++instance Arbitrary Ix4 where+  arbitrary = (:>) <$> arbitraryIx1 <*> arbitrary++instance Arbitrary Ix5 where+  arbitrary = (:>) <$> arbitraryIx1 <*> arbitrary++instance CoArbitrary Ix2 where+  coarbitrary (i :. j) = coarbitrary i . coarbitrary j++instance CoArbitrary Ix3 where+  coarbitrary (i :> ix) = coarbitrary i . coarbitrary ix++instance CoArbitrary Ix4 where+  coarbitrary (i :> ix) = coarbitrary i . coarbitrary ix++instance CoArbitrary Ix5 where+  coarbitrary (i :> ix) = coarbitrary i . coarbitrary ix++instance Function Ix2 where+  function = functionMap fromIx2 toIx2++instance Function Ix3 where+  function = functionMap fromIx3 toIx3++instance Function Ix4 where+  function = functionMap fromIx4 toIx4++instance Function Ix5 where+  function = functionMap fromIx5 toIx5+++prop_IsSafeIndex :: Index ix => SzIx ix -> Bool+prop_IsSafeIndex (SzIx sz ix) = isSafeIndex sz ix++prop_RepairSafeIx :: Index ix => SzIx ix -> Property+prop_RepairSafeIx (SzIx sz ix) =+  ix === repairIndex sz ix (errorImpossible "below zero") (errorImpossible "above zero")+  where+    errorImpossible msg sz1 ix1 =+      error $ "Impossible <" ++ msg ++ ">: " ++ show sz1 ++ " and " ++ show ix1++prop_UnconsCons :: Index ix => ix -> Property+prop_UnconsCons ix = ix === uncurry consDim (unconsDim ix)++prop_UnsnocSnoc :: Index ix => ix -> Property+prop_UnsnocSnoc ix = ix === uncurry snocDim (unsnocDim ix)++prop_ToFromLinearIndex :: Index ix => SzIx ix -> Property+prop_ToFromLinearIndex (SzIx sz ix) =+  isSafeIndex sz ix ==> ix == fromLinearIndex sz (toLinearIndex sz ix)++prop_FromToLinearIndex :: Index ix => SzNE ix -> NonNegative Int -> Property+prop_FromToLinearIndex (SzNE sz) (NonNegative i) =+  totalElem sz >= i ==> i == toLinearIndex sz (fromLinearIndex sz i)++prop_CountElements :: Index ix => Int -> Sz ix -> Property+prop_CountElements thresh sz =+  totalElem sz < thresh ==> totalElem sz ==+  iter zeroIndex (unSz sz) (pureIndex 1) (<) 0 (const (+ 1))++prop_IterMonotonic :: Index ix => Int -> Sz ix -> Property+prop_IterMonotonic thresh sz =+  totalElem sz < thresh ==> fst $+  iter (liftIndex succ zeroIndex) (unSz sz) (pureIndex 1) (<) (True, zeroIndex) mono+  where+    mono curIx (prevMono, prevIx) =+      let isMono = prevMono && prevIx < curIx+       in isMono `seq` (isMono, curIx)++prop_IterMonotonicM :: Index ix => Int -> Sz ix -> Property+prop_IterMonotonicM thresh sz =+  totalElem sz < thresh ==> fst $+  runIdentity $ iterM (liftIndex succ zeroIndex) (unSz sz) (pureIndex 1) (<) (True, zeroIndex) mono+  where+    mono curIx (prevMono, prevIx) =+      let isMono = prevMono && prevIx < curIx+       in return $ isMono `seq` (isMono, curIx)+++prop_IterMonotonicBackwards :: Index ix => Int -> Sz ix -> Property+prop_IterMonotonicBackwards thresh sz@(Sz szix) =+  totalElem sz < thresh ==> fst $+  iter (liftIndex pred szix) zeroIndex (pureIndex (-1)) (>=) (True, szix) mono+  where+    mono curIx (prevMono, prevIx) =+      let isMono = prevMono && prevIx > curIx+       in isMono `seq` (isMono, curIx)++prop_IterMonotonicBackwardsM :: Index ix => Int -> Sz ix -> Property+prop_IterMonotonicBackwardsM thresh sz@(Sz szix) =+  totalElem sz < thresh ==> fst $+  runIdentity $ iterM (liftIndex pred szix) zeroIndex (pureIndex (-1)) (>=) (True, szix) mono+  where+    mono curIx (prevMono, prevIx) =+      let isMono = prevMono && prevIx > curIx+       in return $ isMono `seq` (isMono, curIx)++prop_LiftLift2 :: Index ix => ix -> Int -> Bool+prop_LiftLift2 ix delta = liftIndex2 (+) ix (liftIndex (+delta) zeroIndex) ==+                            liftIndex (+delta) ix+++prop_BorderRepairSafe :: Index ix => Border ix -> SzNE ix -> ix -> Property+prop_BorderRepairSafe border@(Fill defIx) (SzNE sz) ix =+  not (isSafeIndex sz ix) ==> handleBorderIndex border sz id ix == defIx+prop_BorderRepairSafe border (SzNE sz) ix =+  not (isSafeIndex sz ix) ==> isSafeIndex sz (handleBorderIndex border sz id ix)+++prop_GetDropInsert :: Index ix => DimIx ix -> ix -> Property+prop_GetDropInsert (DimIx dim) ix =+  property $+  flip shouldReturn ix $ do+    i <- getDimM ix dim+    ixL <- dropDimM ix dim+    insertDimM ixL dim i++prop_PullOutInsert :: Index ix => DimIx ix -> ix -> Property+prop_PullOutInsert (DimIx dim) ix =+  property $+  flip shouldReturn ix $ do+    (i, ixL) <- pullOutDimM ix dim+    insertDimM ixL dim i++prop_getDimException :: (Typeable ix, Index ix) => Dim -> ix -> Property+prop_getDimException d ix =+  (d <= 0 || d > dimensions (Just ix)) ==>+  assertExceptionIO (== IndexDimensionException ix d) (getDimM ix d)++prop_setDimException :: (Typeable ix, Index ix) => Dim -> ix -> Int -> Property+prop_setDimException d ix i =+  (d <= 0 || d > dimensions (Just ix)) ==>+  assertExceptionIO (== IndexDimensionException ix d) (setDimM ix d i)++prop_PullOutDimException :: (Typeable ix, Index ix) => Dim -> ix -> Property+prop_PullOutDimException d ix =+  (d <= 0 || d > dimensions (Just ix)) ==>+  assertExceptionIO (== IndexDimensionException ix d) (pullOutDimM ix d)++prop_InsertDimException ::+     forall ix. (Typeable (Lower ix), Index ix)+  => Dim+  -> Lower ix+  -> Int+  -> Property+prop_InsertDimException d ix i =+  (d <= 0 || d > dimensions resIO) ==> assertExceptionIO (== IndexDimensionException ix d) resIO+  where+    resIO = insertDimM ix d i :: IO ix+++prop_UnconsGetDrop :: (Index (Lower ix), Index ix) => ix -> Property+prop_UnconsGetDrop ix =+  property $+  flip shouldReturn (unconsDim ix) $ do+    i <- getDimM ix (dimensions (Just ix))+    ixL <- dropDimM ix (dimensions (Just ix))+    return (i, ixL)++prop_UnsnocGetDrop :: (Index (Lower ix), Index ix) => ix -> Property+prop_UnsnocGetDrop ix =+  property $+  flip shouldReturn (unsnocDim ix) $ do+    i <- getDimM ix 1+    ixL <- dropDimM ix 1+    return (ixL, i)++prop_SetAll :: Index ix => ix -> Property+prop_SetAll ix = property $ do+  replaceDims dims `shouldReturn` ix+  replaceDims (reverse dims) `shouldReturn` ix+  where+    replaceDims = foldM (\cix d -> getDimM ix d >>= setDimM cix d) zeroIndex+    dims = [1 .. dimensions (Just ix)] :: [Dim]+++prop_SetGet :: Index ix => ix -> DimIx ix -> Int -> Property+prop_SetGet ix (DimIx dim) n = n === getDim' (setDim' ix dim n) dim++++prop_BorderIx1 :: Positive Int -> Border Char -> Fun Ix1 Char -> SzNE Ix1 -> Ix1 -> Property+prop_BorderIx1 (Positive period) border getVal (SzNE sz) ix =+  if isSafeIndex sz ix+    then val === apply getVal ix+    else case border of+           Fill defVal -> val === defVal+           Wrap ->+             val ===+             handleBorderIndex+               border+               sz+               (apply getVal)+               (liftIndex2 (+) (liftIndex (* period) (unSz sz)) ix)+           Edge ->+             if ix < 0+               then val === apply getVal (liftIndex (max 0) ix)+               else val === apply getVal (liftIndex2 min (liftIndex (subtract 1) (unSz sz)) ix)+           Reflect ->+             val ===+             handleBorderIndex+               border+               sz+               (apply getVal)+               (liftIndex2 (+) (liftIndex (* (2 * signum ix * period)) (unSz sz)) ix)+           Continue ->+             val ===+             handleBorderIndex+               Reflect+               sz+               (apply getVal)+               (if ix < 0+                  then ix - 1+                  else ix + 1)+  where+    val = handleBorderIndex border sz (apply getVal) ix+++prop_BinaryNumIx ::+  (Num ix, Index ix) => (forall n . Num n => n -> n -> n) -> ix -> ix -> Property+prop_BinaryNumIx f ix1 ix2 = zipWith f (ixToList ix1) (ixToList ix2) === ixToList (f ix1 ix2)++prop_UnaryNumIx ::+  (Num ix, Index ix) => (forall n . Num n => n -> n) -> ix -> Property+prop_UnaryNumIx f ix = map f (ixToList ix) === ixToList (f ix)++prop_BinaryNumSz ::+  (Num ix, Index ix) => (forall n . Num n => n -> n -> n) -> Sz ix -> Sz ix -> Property+prop_BinaryNumSz f sz1 sz2 =+  zipWith f' (ixToList (unSz sz1)) (ixToList (unSz sz2)) === ixToList (unSz (f sz1 sz2))+  where+    f' x y = max 0 (f x y)++prop_UnaryNumSz ::+  (Num ix, Index ix) => (forall n . Num n => n -> n) -> Sz ix -> Property+prop_UnaryNumSz f sz = map f' (ixToList (unSz sz)) === ixToList (unSz (f sz))+  where+    f' = max 0 . f++++prop_IterLinearM :: Index ix => Sz ix -> NonNegative Int -> Positive Int -> Property+prop_IterLinearM sz (NonNegative start) (Positive increment) = property $ do+  xs <- iterLinearM sz start (totalElem sz) increment (<) [] $ \i ix acc -> do+    toLinearIndex sz ix `shouldBe` i+    pure (i:acc)+  reverse xs `shouldBe` [start, start + increment .. totalElem sz - 1]++prop_IterLinearM_ :: Index ix => Sz ix -> NonNegative Int -> Positive Int -> Property+prop_IterLinearM_ sz (NonNegative start) (Positive increment) = property $ do+  ref <- newIORef []+  iterLinearM_ sz start (totalElem sz) increment (<) $ \i ix -> do+    toLinearIndex sz ix `shouldBe` i+    modifyIORef' ref (i:)+  xs <- readIORef ref+  reverse xs `shouldBe` [start, start + increment .. totalElem sz - 1]++-----------+-- Specs --+-----------++specIx1 :: Spec+specIx1 = describe "Ix1" $ do+  ixSpec @Ix1+  ixNumSpec @Ix1+  it "Border" $ property prop_BorderIx1+++ixSpec ::+     forall ix. (Typeable (Lower ix), Arbitrary (Lower ix), Typeable ix, Index ix, Arbitrary ix)+  => Spec+ixSpec = do+  let threshold = 50000+  describe "Safety" $ do+    it "IsSafeIndex" $ property $ prop_IsSafeIndex @ix+    it "RepairSafeIx" $ property $ prop_RepairSafeIx @ix+  describe "Lifting" $+    it "Lift/Lift2" $ property $ prop_LiftLift2 @ix+  describe "Linear" $ do+    it "ToFromLinearIndex" $ property $ prop_ToFromLinearIndex @ix+    it "FromToLinearIndex" $ property $ 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+  describe "Border" $+    it "BorderRepairSafe" $ property $ 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+  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+  describe "Dimension" $ do+    it "GetInnerDimension" $ property $ \(ix :: ix) -> lastDim ix === getDimension ix Dim1+    it "GetOuterDimension" $ property $+      \(ix :: ix) -> headDim ix === getDimension ix (DimN :: Dimension (Dimensions ix))+    it "SetInnerDimension" $ property $+      \(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 $+      \(ix :: ix) -> tailDim ix === dropDimension ix (DimN :: Dimension (Dimensions ix))+    it "InsertInnerDimension" $ property $+      \(ixl :: Lower ix) i -> (snocDim ixl i :: ix) === insertDimension ixl Dim1 i+    it "InsertOuterDimension" $ property $+      \(ixl :: Lower ix) i -> (consDim i ixl :: ix) ===+                               insertDimension ixl (DimN :: Dimension (Dimensions ix)) i+    it "PullOutInnerDimension" $ property $+      \(ix :: ix) -> unsnocDim ix === uncurry (flip (,)) (pullOutDimension ix Dim1)+    it "PullInnerOuterDimension" $ property $+      \(ix :: ix) -> unconsDim ix ===+                               pullOutDimension ix (DimN :: Dimension (Dimensions ix))++  describe "NFData" $ do+    it "rnf" $ property $ \ (ix :: ix) -> rnf ix `shouldBe` ()+    it "throws exception" $ property $ \ (DimIx d :: DimIx ix) (ix :: ix) ->+      assertException (== ExpectedException) (setDim' ix d (throw ExpectedException))+++ix2UpSpec ::+     forall ix. (Index ix, Index (Lower ix), Arbitrary ix, Arbitrary (Lower ix), Typeable (Lower ix))+  => Spec+ix2UpSpec =+  describe "Higher/Lower" $ do+    it "UnconsGetDrop" $ property $ prop_UnconsGetDrop @ix+    it "UnsnocGetDrop" $ property $ 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) ->+      (fromIntegral i :: ix) === liftIndex (const i) zeroIndex+  describe "Constants" $ do+    it "zeroIndex" $ (zeroIndex :: ix) `shouldBe` 0+    it "oneIndex" $ (oneIndex :: ix) `shouldBe` 1++-- | Spec that validates the Num instance for any `Index ix => Sz ix`+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) ->+      (fromIntegral i :: Sz ix) === SafeSz (pureIndex (max 0 i))+    it "fromIx" $ property $ \ (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+++prop_PullOutInsertSize :: Index ix => DimIx ix -> Sz ix -> Property+prop_PullOutInsertSize (DimIx dim) sz =+  either throw (sz ===) $ do+    (i, szL) <- pullOutSzM sz dim+    insertSzM szL dim i+++szSpec ::+     forall ix. (Index ix, Arbitrary ix)+  => 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 $+      \ (sz :: Sz ix) i -> setSzM sz 1 i `shouldReturn` snocSz (fst $ unsnocSz sz) i+  describe "Number of Elements" $ do+    it "TotalElem" $ property $+      \(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)+  describe "Iterators" $ do+    it "IterLinearM" $ property $ prop_IterLinearM @ix+    it "IterLinearM_" $ property $ prop_IterLinearM_ @ix
+ src/Test/Massiv/Core/Mutable.hs view
@@ -0,0 +1,289 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+module Test.Massiv.Core.Mutable+  ( -- * Spec for Mutable instance+    unsafeMutableSpec+  , prop_UnsafeNewMsize+  , prop_UnsafeThawFreeze+  , prop_UnsafeInitializeNew+  , prop_UnsafeArrayLinearCopy+  -- ** Properties that aren't valid for boxed+  , unsafeMutableUnboxedSpec+  , prop_UnsafeInitialize+  ) where++import Data.Massiv.Array as A+import Data.Massiv.Array.Unsafe+import Test.Massiv.Core.Common+import Test.Massiv.Utils++++prop_UnsafeNewMsize ::+     forall r ix e.+     (Arbitrary ix, Mutable r ix e)+  => Property+prop_UnsafeNewMsize = property $ \ sz -> do+  marr :: MArray RealWorld r ix e <- unsafeNew sz+  sz `shouldBe` msize marr++prop_UnsafeNewLinearWriteRead ::+     forall r ix e.+     (Eq e, Show e, Mutable r ix e, Arbitrary ix, Arbitrary e)+  => Property+prop_UnsafeNewLinearWriteRead = property $ \ (SzIx sz ix) e1 e2 -> do+  marr :: MArray RealWorld r ix e <- unsafeNew sz+  let i = toLinearIndex sz ix+  unsafeLinearWrite marr i e1+  unsafeLinearRead marr i `shouldReturn` e1+  unsafeLinearModify marr (\ !_ -> pure e2) i `shouldReturn` e1+  unsafeLinearRead marr i `shouldReturn` e2+++prop_UnsafeThawFreeze ::+     forall r ix e.+     (Eq (Array r ix e), Show (Array r ix e), Mutable r ix e)+  => Array r ix e -> Property+prop_UnsafeThawFreeze arr = arr === runST (unsafeFreeze (getComp arr) =<< unsafeThaw arr)+++prop_UnsafeInitializeNew ::+     forall r ix e.+     ( Eq (Array r ix e)+     , Show (Array r ix e)+     , Show e+     , Arbitrary e+     , Arbitrary ix+     , Mutable r ix e+     )+  => Property+prop_UnsafeInitializeNew =+  property $ \comp sz e ->+    (A.replicate comp sz e :: Array r ix e) ===+    runST (unsafeFreeze comp =<< initializeNew (Just e) sz)++prop_UnsafeInitialize ::+     forall r ix e.+     ( Eq (Array r ix e)+     , Show (Array r ix e)+     , Arbitrary ix+     , Mutable r ix e+     )+  => Property+prop_UnsafeInitialize =+  property $ \comp sz ->+    runST $ do+      marr1 :: MArray s r ix e <- unsafeNew sz+      initialize marr1+      marr2 :: MArray s r ix e <- initializeNew Nothing sz+      (===) <$> unsafeFreeze comp marr1 <*> unsafeFreeze comp marr2+++prop_UnsafeLinearCopy ::+     forall r ix e. (Eq (Array r ix e), Show (Array r ix e), Mutable r ix e)+  => Array r ix e+  -> Property+prop_UnsafeLinearCopy arr =+  (arr, arr) ===+  runST+    (do let sz = size arr+        marrs <- thawS arr+        marrd <- unsafeNew sz+        unsafeLinearCopy marrs 0 marrd 0 (Sz (totalElem sz))+        arrd <- unsafeFreeze (getComp arr) marrd+        arrs <- unsafeFreeze (getComp arr) marrs+        pure (arrs, arrd))++prop_UnsafeLinearCopyPart ::+     forall r ix e.+     ( Eq (Array r ix e)+     , Show (Array r ix e)+     , Eq (Array (R r) Ix1 e)+     , Show (Array (R r) Ix1 e)+     , Mutable r ix e+     , Mutable r Ix1 e+     , Extract r Ix1 e+     , Resize r ix+     )+  => ArrIx r ix e+  -> NonNegative Ix1+  -> Ix1+  -> Property+prop_UnsafeLinearCopyPart (ArrIx arr ix) (NonNegative delta) toOffset =+  arr === arrs .&&. extract' i k (flatten arr) === extract' j k arrd+  where+    sz = size arr+    i = toLinearIndex sz ix+    j = max 0 (i + toOffset)+    k = Sz (totalElem sz - i - delta)+    sz' = Sz (j + unSz k)+    (arrs, arrd) =+      runST $ do+        marrs <- thawS arr -- make sure that the source does not get modified+        marrd <- unsafeNew sz'+        unsafeLinearCopy marrs i marrd j k+        (,) <$> unsafeFreeze (getComp arr) marrs <*> unsafeFreeze (getComp arr) marrd+++prop_UnsafeArrayLinearCopy ::+     forall r ix e. (Eq (Array r ix e), Show (Array r ix e), Mutable r ix e)+  => Array r ix e+  -> Property+prop_UnsafeArrayLinearCopy arr =+  arr ===+  runST+    (do let sz = size arr+        marr <- unsafeNew sz+        unsafeArrayLinearCopy arr 0 marr 0 (Sz (totalElem sz))+        unsafeFreeze (getComp arr) marr)+++prop_UnsafeArrayLinearCopyPart ::+     forall r ix e.+     ( Eq (Array (R r) Ix1 e)+     , Show (Array (R r) Ix1 e)+     , Mutable r ix e+     , Mutable r Ix1 e+     , Extract r Ix1 e+     , Resize r ix+     )+  => ArrIx r ix e+  -> NonNegative Ix1+  -> Ix1+  -> Property+prop_UnsafeArrayLinearCopyPart (ArrIx arr ix) (NonNegative delta) toOffset =+  extract' i k (flatten arr) === extract' j k arr'+  where+    sz = size arr+    i = toLinearIndex sz ix+    j = max 0 (i + toOffset)+    k = Sz (totalElem sz - i - delta)+    sz' = Sz (j + unSz k)+    arr' =+      runST $ do+        marr <- unsafeNew sz'+        unsafeArrayLinearCopy arr i marr j k+        unsafeFreeze (getComp arr) marr++prop_UnsafeLinearSet ::+     forall r ix e.+     ( Eq (Array (R r) Ix1 e)+     , Show (Array (R r) Ix1 e)+     , Mutable r ix e+     , Extract r Ix1 e+     , Resize r ix+     )+  => Comp+  -> SzIx ix+  -> NonNegative Ix1+  -> e+  -> Property+prop_UnsafeLinearSet comp (SzIx sz ix) (NonNegative delta) e =+  extract' i k (flatten (A.replicate Seq sz e :: Array r ix e)) ===+  extract' i k (flatten (arrd :: Array r ix e))+  where+    i = toLinearIndex sz ix+    k = Sz (totalElem sz - i - delta)+    arrd =+      runST $ do+        marrd <- unsafeNew sz+        unsafeLinearSet marrd i k e+        unsafeFreeze comp marrd++prop_UnsafeLinearShrink ::+     forall r ix e.+     ( Eq (Array (R r) Ix1 e)+     , Show (Array (R r) Ix1 e)+     , Mutable r ix e+     , Extract r Ix1 e+     , Resize r ix+     )+  => ArrIx r ix e+  -> Property+prop_UnsafeLinearShrink (ArrIx arr ix) =+  extract' 0 k (flatten arr) === extract' 0 k (flatten arr')+  where+    sz = size arr+    sz' = Sz (liftIndex2 (-) (unSz sz) ix)+    k = Sz (totalElem sz')+    arr' =+      runST $ do+        marr <- thawS arr+        marr' <- unsafeLinearShrink marr sz'+        unsafeFreeze (getComp arr) marr'++prop_UnsafeLinearGrow ::+     forall r ix e.+     ( Eq (Array r ix e)+     , Show (Array r ix e)+     , Eq (Array (R r) Ix1 e)+     , Show (Array (R r) Ix1 e)+     , Mutable r ix e+     , Extract r Ix1 e+     , Resize r ix+     )+  => ArrIx r ix e+  -> e+  -> Property+prop_UnsafeLinearGrow (ArrIx arr ix) e =+  extract' 0 k (flatten arr) === extract' 0 k (flatten arrGrown) .&&.+  arrCopied === arrGrown+  where+    sz = size arr+    sz' = Sz (liftIndex2 (+) (unSz sz) ix)+    k = Sz (totalElem sz)+    (arrCopied, arrGrown) =+      runST $ do+        marrCopied <- unsafeNew sz'+        unsafeArrayLinearCopy arr 0 marrCopied 0 k+        marr <- thawS arr+        marrGrown <- unsafeLinearGrow marr sz'+        when (sz' /= sz) $ do+          unsafeLinearSet marrGrown (totalElem sz) (Sz (totalElem sz' - totalElem sz)) e+          unsafeLinearSet marrCopied (totalElem sz) (Sz (totalElem sz' - totalElem sz)) e+        (,) <$> unsafeFreeze (getComp arr) marrCopied <*> unsafeFreeze (getComp arr) marrGrown+++unsafeMutableSpec ::+     forall r ix e.+     ( Eq (Array (R r) Ix1 e)+     , Show (Array (R r) Ix1 e)+     , Eq (Array r ix e)+     , Show (Array r ix e)+     , Mutable r ix e+     , Mutable r Ix1 e+     , Show e+     , Eq e+     , Arbitrary e+     , Arbitrary ix+     , Typeable e+     , Typeable ix+     , Extract r Ix1 e+     , Resize r 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++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)+  => Spec+unsafeMutableUnboxedSpec =+  describe ("Mutable Unboxed (" ++ showsArrayType @r @ix @e ") (Unsafe)") $+    it "UnsafeInitialize" $ prop_UnsafeInitialize @r @ix @e
+ src/Test/Massiv/Utils.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+module Test.Massiv.Utils+  ( showsType+  , showsArrayType+  , assertException+  , assertExceptionIO+  , assertSomeException+  , assertSomeExceptionIO+  , toStringException+  , ExpectedException(..)+  , applyFun2Compat+  , module X+  ) where++import Control.Monad as X+import Control.Monad.ST as X+import Data.Maybe as X (fromMaybe, isJust, isNothing)+import Data.Typeable as X+import Test.QuickCheck as X hiding ((.&.))+import Test.QuickCheck.Monadic as X+import Test.Hspec as X+import Test.QuickCheck.Function as X+import Control.DeepSeq (NFData, deepseq)+import UnliftIO.Exception (Exception(..), SomeException, catch, catchAny)+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup as X ((<>))+#endif+++-- | Use Typeable to show the type.+showsType :: forall t . Typeable t => ShowS+showsType = showsTypeRep (typeRep (Proxy :: Proxy t))++-- | Use Typeable to show the array type+showsArrayType :: forall r ix e . (Typeable r, Typeable ix, Typeable e) => ShowS+showsArrayType =+  ("Array " ++) . showsType @r . (" (" ++) . showsType @ix . (") " ++) . showsType @e+++assertException ::+     (Testable b, NFData a, Exception exc)+  => (exc -> b) -- ^ Return True if that is the exception that was expected+  -> a -- ^ Value that should throw an exception, when fully evaluated+  -> Property+assertException isExc = assertExceptionIO isExc . pure+++assertSomeException :: NFData a => a -> Property+assertSomeException = assertSomeExceptionIO . pure+++assertExceptionIO ::+     (Testable b, NFData a, Exception exc)+  => (exc -> b) -- ^ Return True if that is the exception that was expected+  -> IO a -- ^ IO Action that should throw an exception+  -> Property+assertExceptionIO isExc action =+  monadicIO $+  run $+  catch+    (do res <- action+        res `deepseq` return (counterexample "Did not receive an exception" False))+    (\exc -> displayException exc `deepseq` return (property (isExc exc)))++assertSomeExceptionIO :: NFData a => IO a -> Property+assertSomeExceptionIO action =+  monadicIO $+  run $+  catchAny+    (do res <- action+        res `deepseq` return (counterexample "Did not receive an exception" False))+    (\exc -> displayException exc `deepseq` return (property True))+++toStringException :: Either SomeException a -> Either String a+toStringException = either (Left . displayException) Right+++data ExpectedException = ExpectedException deriving (Show, Eq)++instance Exception ExpectedException+++applyFun2Compat :: Fun (a, b) c -> (a -> b -> c)+#if MIN_VERSION_QuickCheck(2,10,0)+applyFun2Compat = applyFun2+#else+applyFun2Compat (Fun _ f) a b = f (a, b)+instance Function Word where+  function = functionMap fromIntegral fromInteger+#endif
+ tests/Data/Massiv/Array/Delayed/InterleavedSpec.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-}+module Data.Massiv.Array.Delayed.InterleavedSpec+  ( spec+  ) where++import Data.Massiv.Array+import Test.Massiv.Core+++prop_EqDelayed ::+     (Ragged L ix Int, Load D ix Int, Load DI ix Int)+  => Array D ix Int+  -> Property+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 arr =+  computeAs P (resize' k arr) === computeAs P (resize' k arrD)+  where+    arrD = fromInterleaved arr+    k = Sz (totalElem (size arr))++spec :: Spec+spec =+  describe "Interleaved same as Delayed" $ do+    it "EqDelayed Ix1" $ property $ prop_EqDelayed @Ix1+    it "EqDelayed Ix2" $ property $ prop_EqDelayed @Ix2+    it "EqDelayed Ix3" $ property $ prop_EqDelayed @Ix3+    it "EqDelayed Ix4" $ property $ prop_EqDelayed @Ix4+    it "EqDelayed Ix5" $ property $ prop_EqDelayed @Ix5+    it "Resize Ix1" $ property $ prop_Resize @Ix1+    it "Resize Ix2" $ property $ prop_Resize @Ix2+    it "Resize Ix3" $ property $ prop_Resize @Ix3+    it "Resize Ix4" $ property $ prop_Resize @Ix4+    it "Resize Ix5" $ property $ prop_Resize @Ix5
+ tests/Data/Massiv/Array/Delayed/PushSpec.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+module Data.Massiv.Array.Delayed.PushSpec (spec) where++-- import Data.Massiv.Array.Delayed+-- import Data.Massiv.Array.Unsafe+-- import Data.Massiv.Array as A+import Test.Massiv.Core+++-- prop_upsampleDifferentDefault ::+--      Proxy ix -> Comp -> SzIx ix -> Int -> Maybe Int -> Property+-- prop_upsampleDifferentDefault _ comp (SzIx sz ix) v mDef =+--   computeAs P (unsafeMakeLoadArray comp sz mDef $ \ put -> put ix v)+++spec :: Spec+spec = pure ()+  -- describe "upsampleDifferentDefault" $ do+  --   it "Ix1" $ property $ prop_upsampleDifferentDefault (Proxy :: Proxy Ix1)+  --   it "Ix2" $ property $ prop_upsampleDifferentDefault (Proxy :: Proxy Ix2)+  --   it "Ix3" $ property $ prop_upsampleDifferentDefault (Proxy :: Proxy Ix3)+  --   it "Ix4" $ property $ prop_upsampleDifferentDefault (Proxy :: Proxy Ix4)+  --   it "Ix5" $ property $ prop_upsampleDifferentDefault (Proxy :: Proxy Ix5)+++-- identityDL :: Int -> Array DL Ix2 Int+-- identityDL n = makeLoadArrayS (Sz2 n n) 0 $ \ writeCell -> do+--   let f i = writeCell (i :. i) 1+--   A.mapM_ f (0 ... n - 1)
+ tests/Data/Massiv/Array/Delayed/WindowedSpec.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+module Data.Massiv.Array.Delayed.WindowedSpec (spec) where++import Data.Massiv.Array.Delayed+import Data.Massiv.Array.Unsafe+import Data.Massiv.Array as A+import Test.Massiv.Core+++data ArrDW ix e = ArrDW (Array D ix e) (Array DW ix e)++instance (Show ix, Index ix, Show (Array D ix e), Show (Array DW ix e)) => Show (ArrDW ix e) where+  show (ArrDW d dw) =+    "Delayed:\n" +++    show d +++    "\nCorresponding Windowed:\n" +++    --show dw +++    windowInfo+    where+      windowInfo =+        maybe+          "\n No Window"+          (\Window {windowStart, windowSize} ->+             "\n With Window starting index (" +++             show windowStart ++ ") and size (" ++ show windowSize ++ ")") $+        getWindow dw++instance (Arbitrary ix, CoArbitrary ix, Index ix, Arbitrary e, Typeable e) =>+         Arbitrary (ArrDW ix e) where+  arbitrary = do+    ArrTiny (arr :: Array D ix e) <- arbitrary+    let sz = size arr+    ArrDW arr <$>+      if totalElem sz == 0+        then return (makeArray (getComp arr) sz (unsafeIndex arr))+        else do+          wix <- flip (liftIndex2 mod) (unSz sz) <$> arbitrary+          wsz <- liftIndex (+1) . flip (liftIndex2 mod) (liftIndex2 (-) (unSz sz) wix) <$> arbitrary+          return $ makeWindowedArray arr wix (Sz wsz) (unsafeIndex arr)+++prop_EqDelayed ::+     (Ragged L ix Int, Load DW ix Int) => Proxy ix -> ArrDW ix Int -> Property+prop_EqDelayed _ (ArrDW arrD arrDW) =+  computeAs P arrD === computeAs P arrDW++prop_EqDelayedStride ::+     (Ragged L ix Int, StrideLoad DW ix Int) => Proxy ix -> Stride ix -> ArrDW ix Int -> Property+prop_EqDelayedStride _ stride (ArrDW arrD arrDW) =+  computeWithStrideAs P stride arrD === computeWithStrideAs P stride arrDW+++spec :: Spec+spec = do+  describe "Equivalency with Delayed" $ do+    it "Ix1" $ property $ prop_EqDelayed (Proxy :: Proxy Ix1)+    it "Ix2" $ property $ prop_EqDelayed (Proxy :: Proxy Ix2)+    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/Data/Massiv/Array/DelayedSpec.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Data.Massiv.Array.DelayedSpec (spec) where++import Data.Massiv.Array.Unsafe+import Data.Massiv.Array as A+import Test.Massiv.Core+++downsampleArr :: Source r ix e => Stride ix -> Array r ix e -> Array D ix e+downsampleArr stride arr =+  unsafeBackpermute (strideSize stride (size arr)) (liftIndex2 (*) (unStride stride)) arr++prop_computeWithStrideEqDownsample ::+     Ragged L ix Int+  => proxy ix+  -> Stride ix+  -> Array D ix Int+  -> Property+prop_computeWithStrideEqDownsample _ stride arr =+  computeWithStride stride arr === computeAs U (downsampleArr stride arr)+++prop_computeWithStrideInterleavedEqDownsample ::+     Ragged L ix Int+  => proxy ix+  -> Stride ix+  -> Array D ix Int+  -> Property+prop_computeWithStrideInterleavedEqDownsample _ stride arr =+  computeWithStride stride (toInterleaved arr) === computeAs U (downsampleArr stride arr)++prop_computeWithStrideWindowedEqDownsample ::+     (Ragged L ix Int, StrideLoad DW ix Int)+  => proxy ix+  -> Stride ix+  -> ArrIx D ix Int+  -> Property+prop_computeWithStrideWindowedEqDownsample _ stride (ArrIx arr _) =+  computeWithStride stride (insertWindow arr (Window zeroIndex (size arr) (unsafeIndex arr) Nothing)) ===+  -- Below triggers a bug in ghc-8.0 which results in a deadlock.+  -- computeWithStride stride (makeWindowedArray arr zeroIndex (size arr) (unsafeIndex arr)) ===+  computeAs U (downsampleArr stride arr)+++delayedSpec ::+     (Arbitrary ix, StrideLoad DW ix Int, Ragged L ix Int)+  => String+  -> proxy ix+  -> Spec+delayedSpec dimName proxy =+  describe dimName $ do+    it "computeWithStrideEqDownsample" $ property $ prop_computeWithStrideEqDownsample proxy+    it "computeWithStrideInterleavedEqDownsample" $+      property $ prop_computeWithStrideInterleavedEqDownsample proxy+    it "computeWithStrideWindowedEqDownsample" $+      property $ prop_computeWithStrideWindowedEqDownsample proxy++spec :: Spec+spec = do+  delayedSpec "Ix1" (Proxy :: Proxy Ix1)+  delayedSpec "Ix2" (Proxy :: Proxy Ix2)+  delayedSpec "Ix3" (Proxy :: Proxy Ix3)+  delayedSpec "Ix4" (Proxy :: Proxy Ix4)
+ tests/Data/Massiv/Array/Manifest/VectorSpec.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+module Data.Massiv.Array.Manifest.VectorSpec (spec) where++import Data.Massiv.Array.Manifest.Vector+import Data.Massiv.Array as A+import Test.Massiv.Core+import qualified Data.Vector as VB+import qualified Data.Vector.Generic as VG+import qualified Data.Vector.Primitive as VP+import qualified Data.Vector.Storable as VS+import qualified Data.Vector.Unboxed as VU++prop_castToFromVector+  :: ( VG.Vector (VRepr r) Int+     , Mutable r ix Int+     , Typeable (VRepr r)+     , ARepr (VRepr r) ~ r+     , Eq (Array r ix Int)+     , Show (Array r ix Int)+     )+  => proxy ix -> r -> ArrNE r ix Int -> Property+prop_castToFromVector _ _ (ArrNE arr) =+  Just arr === (castToVector arr >>= castFromVector (getComp arr) (size arr))+++prop_toFromVector ::+     forall r ix v.+     ( Mutable r ix Int+     , Mutable (ARepr v) ix Int+     , VRepr (ARepr v) ~ v+     , Eq (Array r ix Int)+     , VG.Vector v Int+     , Show (Array r ix Int)+     , Typeable v+     )+  => Proxy v+  -> Proxy ix+  -> r+  -> ArrNE r ix Int+  -> Property+prop_toFromVector _ _ _ (ArrNE arr) =+  arr === fromVector' (getComp arr) (size arr) (toVector arr :: v Int)+++toFromVectorSpec :: Spec+toFromVectorSpec = do+  it_prop "Unboxed" U+  it_prop "Primitive" P+  it_prop "Storable" S+  it_prop "BoxedStrict" B+  where+    it_prop name r =+      describe name $ do+        describe "CastToFrom" $ do+          it "Ix1" $ property $ prop_castToFromVector (Proxy :: Proxy Ix1) r+          it "Ix2" $ property $ prop_castToFromVector (Proxy :: Proxy Ix2) r+          it "Ix3" $ property $ prop_castToFromVector (Proxy :: Proxy Ix3) r+        describe "Through Boxed Vector" $ do+          it "Ix1" $ property $ prop_toFromVector (Proxy :: Proxy VB.Vector) (Proxy :: Proxy Ix1) r+          it "Ix2" $ property $ prop_toFromVector (Proxy :: Proxy VB.Vector) (Proxy :: Proxy Ix2) r+        describe "Through Unboxed Vector" $ do+          it "Ix1" $ property $ prop_toFromVector (Proxy :: Proxy VU.Vector) (Proxy :: Proxy Ix1) r+          it "Ix2" $ property $ prop_toFromVector (Proxy :: Proxy VU.Vector) (Proxy :: Proxy Ix2) r+        describe "Through Primitive Vector" $ do+          it "Ix1" $ property $ prop_toFromVector (Proxy :: Proxy VP.Vector) (Proxy :: Proxy Ix1) r+          it "Ix2" $ property $ prop_toFromVector (Proxy :: Proxy VP.Vector) (Proxy :: Proxy Ix2) r+        describe "Through Storable Vector" $ do+          it "Ix1" $ property $ prop_toFromVector (Proxy :: Proxy VS.Vector) (Proxy :: Proxy Ix1) r+          it "Ix2" $ property $ prop_toFromVector (Proxy :: Proxy VS.Vector) (Proxy :: Proxy Ix2) r+++spec :: Spec+spec = describe "toFromVector" toFromVectorSpec
+ tests/Data/Massiv/Array/ManifestSpec.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeApplications #-}+module Data.Massiv.Array.ManifestSpec (spec) where++import Data.ByteString as S+import Data.ByteString.Builder as S+import Data.ByteString.Lazy as SL+import Data.Massiv.Array as A+import Test.Massiv.Core+import Data.Word (Word8)+++-- ByteString+prop_toFromByteString :: Manifest r Ix1 Word8 => Array r Ix1 Word8 -> Property+prop_toFromByteString arr = toManifest arr === fromByteString (getComp arr) (toByteString arr)++prop_castToFromByteString :: Array S Ix1 Word8 -> Property+prop_castToFromByteString arr = arr === castFromByteString (getComp arr) (castToByteString arr)+++prop_fromToByteString :: Comp -> [Word8] -> Property+prop_fromToByteString comp ls = bs === toByteString (fromByteString comp bs)+  where bs = S.pack ls++prop_toBuilder :: Array P Ix1 Word8 -> Property+prop_toBuilder arr = bs === SL.toStrict (S.toLazyByteString (toBuilder S.word8 arr))+  where bs = toByteString arr++conversionSpec :: Spec+conversionSpec =+  describe "ByteString" $ do+    it "castTo/TromByteString" $ property prop_castToFromByteString+    it "to/from ByteString P" $ property (prop_toFromByteString @P)+    it "to/from ByteString S" $ property (prop_toFromByteString @S)+    it "from/to ByteString" $ property prop_fromToByteString+    it "toBuilder" $ property prop_toBuilder+++spec :: Spec+spec = describe "Conversion" conversionSpec
+ tests/Data/Massiv/Array/Numeric/IntegralSpec.hs view
@@ -0,0 +1,37 @@+module Data.Massiv.Array.Numeric.IntegralSpec+  ( spec+  ) where++import Data.Massiv.Array as A+import Data.Massiv.Array.Numeric.Integral+import Test.Hspec++gaussian :: Float -> Float+gaussian x = exp (x ^ (2 :: Int))++spec :: Spec+spec = do+  let (a, b) = (0, 2)+      integrator rule = rule Seq N (\ scale -> gaussian . scale) 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+    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+    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
+ tests/Data/Massiv/Array/Ops/ConstructSpec.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Data.Massiv.Array.Ops.ConstructSpec (spec) where++import Data.List as L+import Data.Massiv.Array as A+import Test.Massiv.Core+import qualified GHC.Exts as GHC (IsList(..))+import Prelude as P++prop_rangeEqRangeStep1 :: Int -> Int -> Property+prop_rangeEqRangeStep1 from to = range Seq from to === rangeStep' Par from 1 to++prop_rangeEqEnumFromN :: Int -> Int -> Property+prop_rangeEqEnumFromN from to = range Seq from to === enumFromN Par from (Sz (to - from))++prop_rangeStepEqEnumFromStepN :: Int -> NonZero Int -> Int -> Property+prop_rangeStepEqEnumFromStepN from (NonZero step) sz =+  rangeStep' Seq from step (from + step * sz) === enumFromStepN Par from step (Sz sz)+++prop_rangeStepExc :: Int -> Int -> Property+prop_rangeStepExc from to =+  assertException+    (\case+       IndexZeroException _ -> True+       _ -> False)+    (computeAs U (rangeStep' Seq from 0 to))++prop_toFromListIsList ::+     (Show (Array U ix Int), GHC.IsList (Array U ix Int), Index ix)+  => Proxy ix+  -> ArrNE U ix Int+  -> Property+prop_toFromListIsList _ (ArrNE arr) = arr === GHC.fromList (GHC.toList arr)+++prop_toFromList ::+  forall ix . (Show (Array U ix Int), Nested LN ix Int, Ragged L ix Int)+  => Proxy ix+  -> ArrNE U ix Int+  -> Property+prop_toFromList _ (ArrNE arr) = comp === comp' .&&. arr === arr'+  where comp = getComp arr+        arr' = fromLists' comp (toLists arr)+        comp' = getComp arr'+++prop_excFromToListIx2 :: Comp -> [[Int]] -> Property+prop_excFromToListIx2 comp ls2 =+  if P.null lsL || P.all (head lsL ==) lsL+     then label "Expected Success" $ resultLs === ls2+     else label "Expected Failure" $ assertSomeException resultLs+  where+    lsL = P.map P.length ls2+    resultLs = toLists (fromLists' comp ls2 :: Array U Ix2 Int)+++prop_excFromToListIx3 :: Comp -> [[[Int]]] -> Property+prop_excFromToListIx3 comp ls3+  | P.null (P.concat (P.concat ls3)) =+    classify True "Expected Success" $ counterexample (show arr) $ totalElem (size arr) === 0+  | P.all (head lsL ==) lsL && P.all (P.all (head (head lsLL) ==)) lsLL =+    classify True "Expected Success" $ counterexample (show arr) $ resultLs === ls3+  | otherwise = classify True "Expected Failure" $ assertSomeException resultLs+  where+    arr = fromLists' comp ls3 :: Array U Ix3 Int+    resultLs = toLists arr+    lsL = P.map P.length ls3+    lsLL = P.map (P.map P.length) ls3+++specConstructIx1 :: Spec+specConstructIx1 = do+  it "toFromList" $ property (prop_toFromList (Proxy :: Proxy Ix1))+  it "toFromListIsList" $ property (prop_toFromListIsList (Proxy :: Proxy Ix1))+  it "rangeEqRangeStep1" $ property prop_rangeEqRangeStep1+  it "rangeEqEnumFromN" $ property prop_rangeEqEnumFromN+  it "rangeStepEqEnumFromStepN" $ property prop_rangeStepEqEnumFromStepN+  it "rangeStepExc" $ property prop_rangeStepExc++specConstructIx2 :: Spec+specConstructIx2 = do+  it "toFromList" $ property (prop_toFromList (Proxy :: Proxy Ix2))+  it "toFromListIsList" $ property (prop_toFromListIsList (Proxy :: Proxy Ix2))+  it "excFromToListIx2" $ property prop_excFromToListIx2++specConstructIx3 :: Spec+specConstructIx3 = do+  it "toFromList" $ property (prop_toFromList (Proxy :: Proxy Ix3))+  it "toFromListIsList" $ property (prop_toFromListIsList (Proxy :: Proxy Ix3))+  it "excFromToListIx3" $ property prop_excFromToListIx3++mkIntermediate :: Int -> Array U Ix1 Int+mkIntermediate t = A.fromList Seq [t + 50, t + 75]++initArr :: Array N Ix1 (Array U Ix1 Int)+initArr = makeArray Seq (Sz1 3) mkIntermediate++initArr2 :: Array N Ix2 (Array U Ix1 Int)+initArr2 = makeArray Seq (Sz 2) (\ (x :. y) -> mkIntermediate (x+y))++prop_unfoldrList :: Sz1 -> Fun Word (Int, Word) -> Word -> Property+prop_unfoldrList sz1 f i =+  conjoin $+  L.zipWith+    (===)+    (A.toList (computeAs P $ unfoldrS_ sz1 (apply f) i))+    (L.unfoldr (Just . apply f) i)++specExpand :: Spec+specExpand = do+  it "expandOuter" $ compute (expandOuter 2 A.index' initArr :: Array D Ix2 Int) `shouldBe`+    resize' (Sz2 2 3) (fromList Seq [50, 51, 52, 75, 76, 77] :: Array U Ix1 Int)+  it "expandInner" $ compute (expandInner 2 A.index' initArr :: Array D Ix2 Int) `shouldBe`+    resize' (Sz2 3 2) (fromList Seq [50, 75, 51, 76, 52, 77] :: Array U Ix1 Int)+  it "expandwithin" $ compute (expandWithin Dim1 2 A.index' initArr2 :: Array D Ix3 Int) `shouldBe`+    resize' (Sz 2) (fromList Seq [50, 75, 51, 76, 51, 76, 52, 77] :: Array U Ix1 Int)+  it "expandwithin'" $ compute (expandWithin' 1 2 A.index' initArr2 :: Array D Ix3 Int) `shouldBe`+    resize' (Sz 2) (fromList Seq [50, 75, 51, 76, 51, 76, 52, 77] :: Array U Ix1 Int)++spec :: Spec+spec = do+  describe "Ix1" specConstructIx1+  describe "Ix2" specConstructIx2+  describe "Ix3" specConstructIx3+  describe "Expand" specExpand+  describe "Unfolding" $ it "unfoldrS_" $ property prop_unfoldrList
+ tests/Data/Massiv/Array/Ops/FoldSpec.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Data.Massiv.Array.Ops.FoldSpec (spec) where++import qualified Data.Foldable as F+import Data.Massiv.Array as A+import Test.Massiv.Core+import Data.Semigroup+import Prelude hiding (map, product, sum)++++prop_SumSEqSumP :: Index ix => proxy ix -> Array D ix Int -> Bool+prop_SumSEqSumP _ arr = sum arr == sum (setComp Par arr)+++prop_ProdSEqProdP :: Index ix => proxy ix -> Array D ix Int -> Bool+prop_ProdSEqProdP _ arr = product arr == product (setComp Par arr)++prop_NestedFoldP :: Array D Ix1 (Array D Ix1 Int) -> Bool+prop_NestedFoldP arr = sum (setComp Par (map sum $ setComp Par arr)) == sum (map sum arr)+++specFold ::+     (Arbitrary ix, Index ix, Show (Array D ix Int))+  => proxy ix+  -> String+  -> Spec+specFold proxy dimStr =+  describe dimStr $ do+    it "sumS Eq sumP" $ property $ prop_SumSEqSumP proxy+    it "prodS Eq prodP" $ property $ prop_ProdSEqProdP proxy++foldOpsProp :: (Source P ix Int) => proxy ix -> Fun Int Bool -> ArrTinyNE P ix Int -> Property+foldOpsProp _ f (ArrTinyNE arr) =+  (A.maximum' arr === getMax (foldMono Max arr)) .&&.+  (A.minimum' arr === getMin (foldSemi Min maxBound arr)) .&&.+  (A.sum arr === F.sum ls) .&&.+  (A.product (A.map ((+ 0.1) . (fromIntegral :: Int -> Double)) arr) ===+   getProduct (foldMono (Product . (+ 0.1) . fromIntegral) arr)) .&&.+  (A.all (apply f) arr === F.all (apply f) ls) .&&.+  (A.any (apply f) arr === F.any (apply f) ls) .&&.+  (A.or (A.map (apply f) arr) === F.or (fmap (apply f) ls)) .&&.+  (A.and (A.map (apply f) arr) === F.and (fmap (apply f) ls))+  where+    ls = toList arr++spec :: Spec+spec = do+  specFold (Nothing :: Maybe Ix1) "Ix1"+  specFold (Nothing :: Maybe Ix2) "Ix2"+  it "Nested Parallel Fold" $ property prop_NestedFoldP+  describe "Foldable Props" $ do+    it "Ix1" $ property $ foldOpsProp (Nothing :: Maybe Ix1)+    it "Ix2" $ property $ foldOpsProp (Nothing :: Maybe Ix2)+    it "Ix3" $ property $ foldOpsProp (Nothing :: Maybe Ix3)
+ tests/Data/Massiv/Array/Ops/MapSpec.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+module Data.Massiv.Array.Ops.MapSpec (spec) where++import Data.IORef+import Control.Monad.ST+import Data.Foldable as F+import Data.Massiv.Array.Unsafe+import Data.Massiv.Array as A+import Test.Massiv.Core+import Prelude as P+import Control.Scheduler.Internal++prop_zipUnzip ::+     (Index ix, Show (Array D ix Int))+  => Array D ix Int+  -> Array D ix Int+  -> Property+prop_zipUnzip arr1 arr2 =+  (extract' zeroIndex sz arr1, extract' zeroIndex sz arr2) === A.unzip (A.zip arr1 arr2)+  where sz = Sz (liftIndex2 min (unSz (size arr1)) (unSz (size arr2)))++prop_zipFlip ::+     (Index ix, Show (Array D ix (Int, Int)))+  => Array D ix Int+  -> Array D ix Int+  -> Property+prop_zipFlip arr1 arr2 =+  A.zip arr1 arr2 ===+  A.map (\(e2, e1) -> (e1, e2)) (A.zip arr2 arr1)++prop_zipUnzip3 ::+     (Index ix, Show (Array D ix Int))+  => Array D ix Int+  -> Array D ix Int+  -> Array D ix Int+  -> Property+prop_zipUnzip3 arr1 arr2 arr3 =+  (extract' zeroIndex sz arr1, extract' zeroIndex sz arr2, extract' zeroIndex sz arr3) ===+  A.unzip3 (A.zip3 arr1 arr2 arr3)+  where+    sz =+      Sz (liftIndex2 min (liftIndex2 min (unSz (size arr1)) (unSz (size arr2))) (unSz (size arr3)))++prop_zipFlip3 ::+     (Index ix, Show (Array D ix (Int, Int, Int)))+  => Array D ix Int+  -> Array D ix Int+  -> Array D ix Int+  -> Property+prop_zipFlip3 arr1 arr2 arr3 =+  A.zip3 arr1 arr2 arr3 === A.map (\(e3, e2, e1) -> (e1, e2, e3)) (A.zip3 arr3 arr2 arr1)++++prop_itraverseA ::+     (Index ix, Show (Array U ix Int)) => Array D ix Int -> Fun (ix, Int) Int -> Property+prop_itraverseA arr fun =+  alt_imapM (\ix -> Just . applyFun2Compat fun ix) arr ===+  itraverseAR U (\ix -> Just . applyFun2Compat fun ix) arr+++mapSpec ::+     forall ix.+     ( Arbitrary ix+     , CoArbitrary ix+     , Index ix+     , Function ix+     , Show (Array U ix Int)+     , Show (Array D ix Int)+     , Show (Array D ix (Int, Int))+     , Show (Array D ix (Int, Int, Int))+     )+  => Spec+mapSpec = do+  describe "Zipping" $ do+    it "zipUnzip" $ property $ prop_zipUnzip @ix+    it "zipFlip" $ property $ prop_zipFlip @ix+    it "zipUnzip3" $ property $ prop_zipUnzip3 @ix+    it "zipFlip3" $ property $ prop_zipFlip3 @ix+  describe "Traversing" $ do+    it "itraverseA" $ property $ prop_itraverseA @ix+  describe "StatefulMapping" $ do+    it "mapWS" $ property $ prop_MapWS @ix++spec :: Spec+spec = do+  describe "Ix1" $ mapSpec @Ix1+  describe "Ix2" $ mapSpec @Ix2+  describe "Ix3" $ mapSpec @Ix3+  describe "Ix4" $ mapSpec @Ix4++++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)+  where+    loadList xs =+      runST $ do+        marr <- unsafeNew (size arr)+        _ <- F.foldlM (\i e -> unsafeLinearWrite marr i e >> return (i + 1)) 0 xs+        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+    states <- initWorkerStates (getComp arr) (\_ -> newIORef 0)+    arr' <-+      forWS states arr $ \e ref -> do+        acc <- readIORef ref+        writeIORef ref (acc + e)+        pure e+    accsArr <- A.mapM @P readIORef (evalArray Seq (_workerStatesArray states))+    pure (A.sum arr' === A.sum accsArr .&&. arr === arr')
+ tests/Data/Massiv/Array/Ops/SliceSpec.hs view
@@ -0,0 +1,248 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+module Data.Massiv.Array.Ops.SliceSpec (spec) where++import Control.Applicative ((<|>))+import Control.Exception+import Data.Massiv.Array.Unsafe+import Data.Massiv.Array as A+import Test.Massiv.Core++-----------+-- Size --+-----------++prop_ExtractEqualsExtractFromTo ::+     ( Eq (Array (R r) ix e)+     , Show (Array (R r) ix e)+     , Extract r ix e+     )+  => proxy (r, ix, e)+  -> SzIx ix+  -> Array r ix e+  -> Property+prop_ExtractEqualsExtractFromTo _ (SzIx (Sz eIx) sIx) arr =+  (extractFromToM sIx eIx arr <|> Nothing) === extractM sIx (Sz (liftIndex2 (-) eIx sIx)) arr+++specSizeN ::+     ( Eq (Array (R r) ix e)+     , Show (Array (R r) ix e)+     , Arbitrary (Array r ix e)+     , Show (Array r ix e)+     , Arbitrary ix+     , Extract r ix e+     )+  => proxy (r, ix, e)+  -> Spec+specSizeN proxy =+  describe "extract" $+    it "ExtractEqualsExtractFromTo" $ property $ prop_ExtractEqualsExtractFromTo proxy+++-----------+-- Slice --+-----------+++prop_SliceRight ::+     (Slice r ix e, OuterSlice r ix e, Eq (Elt r ix e), Show (Elt r ix e))+  => proxy (r, ix, e)+  -> Int+  -> Array r ix e+  -> Property+prop_SliceRight _ i arr =+  either (Left . displayException) Right (arr !?> i) ===+  either (Left . displayException) Right (arr <!?> (dimensions (size arr), i))+++prop_SliceLeft ::+     (Slice r ix e, InnerSlice r ix e, Eq (Elt r ix e), Show (Elt r ix e))+  => proxy (r, ix, e)+  -> Int+  -> Array r ix e+  -> Property+prop_SliceLeft _ i arr =+  either (Left . displayException) Right (arr <!? i) ===+  either (Left . displayException) Right (arr <!?> (1, i))+++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_SliceIndexDim2RankD :: ArrIx D Ix2 Int -> Property+prop_SliceIndexDim2RankD (ArrIx arr ix@(i :. j)) =+  val === evaluate' (arr <!> (2, i)) j .&&.+  val === evaluate' (arr <!> (1, j)) i+  where+    val = unsafeIndex arr ix+++prop_SliceIndexDim3D :: ArrIx D Ix3 Int -> Property+prop_SliceIndexDim3D (ArrIx arr ix@(i :> j :. k)) =+  val === evaluate' (arr <! 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_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+++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 proxy =+  describe "Slice" $ do+    it "SliceRight" $ property $ prop_SliceRight proxy+    it "SliceLeft" $ property $ prop_SliceLeft proxy++++spec :: Spec+spec = do+  describe "Ix1" $+    specSizeN (Nothing :: Maybe (D, Ix1, Int))+  describe "Ix2" $ do+    specSizeN (Nothing :: Maybe (D, Ix2, Int))+    specSliceN (Nothing :: Maybe (D, Ix2, Int))+    describe "SliceIndex" $ do+      it "Delayed" $ property prop_SliceIndexDim2D+      it "Rank - Delayed" $ property prop_SliceIndexDim2RankD+      it "Manifest" $ property prop_SliceIndexDim2M+      it "Rank - Manifest" $ property prop_SliceIndexDim2RankM+  describe "Ix3" $ do+    specSizeN (Nothing :: Maybe (D, Ix3, Int))+    specSliceN (Nothing :: Maybe (D, Ix3, Int))+    describe "SliceIndex" $ do+      it "Delayed" $ property prop_SliceIndexDim3D+      it "Rank - Delayed" $ property prop_SliceIndexDim3RankD+      it "Manifest" $ property prop_SliceIndexDim3M+      it "Rank - Manifest" $ property prop_SliceIndexDim3RankM+  describe "Ix4" $ do+    specSizeN (Nothing :: Maybe (D, Ix4, Int))+    specSliceN (Nothing :: Maybe (D, Ix4, Int))+    describe "SliceIndex" $ do+      it "Delayed" $ property prop_SliceIndexDim4D+      it "Rank - Delayed" $ property prop_SliceIndexDim4RankD+      it "Manifest" $ property prop_SliceIndexDim4M+      it "Rank - Manifest" $ property prop_SliceIndexDim4RankM
+ tests/Data/Massiv/Array/Ops/SortSpec.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-}+module Data.Massiv.Array.Ops.SortSpec (spec) where++import Data.List as L+import Data.Massiv.Array as A+import Test.Massiv.Core+++prop_IsSorted :: (b -> b) -> ([Int] -> b) -> (b -> [Int]) -> [Int] -> Property+prop_IsSorted sortWith from to xs =+  to (sortWith (from xs)) === sort xs++spec :: Spec+spec =+  describe "QuickSort" $ do+    it "Seq" $ property $ prop_IsSorted (quicksort @P) (A.fromList Seq) A.toList+    it "Par" $ property $ prop_IsSorted (quicksort @P) (A.fromList (ParN 4)) A.toList
+ tests/Data/Massiv/Array/Ops/TransformSpec.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeApplications #-}+module Data.Massiv.Array.Ops.TransformSpec (spec) where++import Data.Massiv.Array as A+import Test.Massiv.Core+import Data.Sequence as S+import Prelude as P+import Data.Foldable as F (foldl', toList)+import Data.Maybe++prop_transposeOuterInner :: Array D Ix2 Int -> Property+prop_transposeOuterInner arr = transposeOuter arr === transpose arr++prop_upsampleDownsample ::+     (Show (Array P ix Int), Index ix) => ArrTiny P ix Int -> Stride ix -> Int -> Property+prop_upsampleDownsample (ArrTiny arr) stride fill =+  arr === compute (downsample stride (computeAs P (upsample fill stride arr)))++prop_ExtractAppend+  :: (Show (Array P ix Int), Index ix)+  => DimIx ix -> ArrIx P ix Int -> Property+prop_ExtractAppend (DimIx dim) (ArrIx arr ix) =+  arr === compute (uncurry (append' dim) $ A.splitAt' dim (getDim' ix dim) arr)++prop_SplitExtract+  :: (Show (Array P ix Int), Show (Array M ix Int), Index ix)+  => DimIx ix -> ArrIx P ix Int -> Positive Int -> Property+prop_SplitExtract (DimIx dim) (ArrIx arr ix) (Positive n) =+  (computeAs P <$> splitAt' dim i arr) === (left, computeAs P (append' dim center right)) .&&.+  (computeAs P splitLeft, splitRight) === (computeAs P (append' dim left center), right)+  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)+        (splitLeft, splitRight) = splitAt' dim (i + n') arr++prop_ConcatAppend+  :: (Show (Array P ix Int), Index ix)+  => DimIx ix -> Comp -> Sz ix -> NonEmptyList (Fun ix Int) -> Property+prop_ConcatAppend (DimIx dim) comp sz (NonEmpty fns) =+  foldl1 (\arr -> computeAs P . append' dim arr) arrs ===+  computeAs P (concat' dim arrs)+  where+    arrs = P.map (makeArrayR P comp sz . apply) fns++prop_AppendMappend+  :: Array D Ix1 Int -> Array D Ix1 Int -> Property+prop_AppendMappend arr1 arr2 =+  computeAs P (append' 1 arr1 arr2) === computeAs P (toLoadArray arr1 <> toLoadArray arr2)++prop_ConcatMconcat+  :: [Array D Ix1 Int] -> Property+prop_ConcatMconcat arrs =+  computeAs P (concat' 1 (A.empty : arrs)) === computeAs P (mconcat (fmap toLoadArray arrs))++prop_ExtractSizeMismatch ::+     Index ix => ArrTiny P ix Int -> Positive Int -> Property+prop_ExtractSizeMismatch (ArrTiny arr) (Positive n) =+  assertExceptionIO (SizeElementsMismatchException sz sz' ==) $ resizeM sz' arr+  where+    sz = size arr+    sz' = Sz (totalElem sz + n)++spec :: Spec+spec = do+  it "transposeOuterInner" $ property prop_transposeOuterInner+  describe "upsampleDownsample" $ do+    it "Ix1" $ property (prop_upsampleDownsample @Ix1)+    it "Ix2" $ property (prop_upsampleDownsample @Ix2)+    it "Ix3" $ property (prop_upsampleDownsample @Ix3)+    it "Ix4" $ property (prop_upsampleDownsample @Ix4)+  describe "extractSizeMismatch" $ do+    it "Ix1" $ property (prop_ExtractSizeMismatch @Ix1)+    it "Ix2" $ property (prop_ExtractSizeMismatch @Ix2)+    it "Ix3" $ property (prop_ExtractSizeMismatch @Ix3)+    it "Ix4" $ property (prop_ExtractSizeMismatch @Ix4)+  describe "ExtractAppend" $ do+    it "Ix1" $ property (prop_ExtractAppend @Ix1)+    it "Ix2" $ property (prop_ExtractAppend @Ix2)+    it "Ix3" $ property (prop_ExtractAppend @Ix3)+    it "Ix4" $ property (prop_ExtractAppend @Ix4)+  describe "ExtractAppend" $ do+    it "Ix1" $ property (prop_SplitExtract @Ix1)+    it "Ix2" $ property (prop_SplitExtract @Ix2)+    it "Ix3" $ property (prop_SplitExtract @Ix3)+    it "Ix4" $ property (prop_SplitExtract @Ix4)+  describe "ConcatAppend" $ do+    it "Ix1" $ property (prop_ConcatAppend @Ix1)+    it "Ix2" $ property (prop_ConcatAppend @Ix2)+    it "Ix3" $ property (prop_ConcatAppend @Ix3)+    it "Ix4" $ property (prop_ConcatAppend @Ix4)+  describe "Monoid" $ do+    it "Ix1" $ property prop_AppendMappend+    it "Ix1" $ property prop_ConcatMconcat+  describe "Sequence" $ do+    it "ConsSnoc" $ property prop_ConsSnoc+    it "UnconsUnsnoc" $ property prop_UnconsUnsnoc+  describe "zoomWithGrid" $ do+    it "Ix1" $ property (prop_zoomWithGridStrideCompute @Ix1)+    it "Ix2" $ property (prop_zoomWithGridStrideCompute @Ix2)+    it "Ix3" $ property (prop_zoomWithGridStrideCompute @Ix3)+    it "Ix4" $ property (prop_zoomWithGridStrideCompute @Ix4)++prop_zoomWithGridStrideCompute :: (Show (Array P ix Int), Index ix) => Array D ix Int -> Stride ix -> Int -> Property+prop_zoomWithGridStrideCompute arr stride defVal =+  (computeWithStrideAs P stride' arr' ===+   A.replicate Seq (Sz (liftIndex (+ 1) $ unSz (size arr))) defVal) .&&.+  (computeWithStrideAs P stride' (extract' (pureIndex 1) sz' arr') === compute arr)+  where+    arr' = computeAs P (zoomWithGrid defVal stride arr)+    sz' = Sz (liftIndex (subtract 1) $ unSz (size arr'))+    stride' = Stride (liftIndex (+ 1) $ unStride stride)+++prop_UnconsUnsnoc :: Array D Ix1 Int -> Bool -> Property+prop_UnconsUnsnoc arr unconsFirst =+  preJust $ do+    (arr', u, s) <-+      if unconsFirst+        then do+          (u, au) <- unconsM arr+          (as, s) <- unsnocM au+          pure (as, u, s)+        else do+          (as, s) <- unsnocM arr+          (u, au) <- unconsM as+          pure (au, u, s)+    pure (computeAs U (A.snoc (A.cons u (toLoadArray (computeAs U arr'))) s) === compute arr)++preJust :: Testable prop => Maybe prop -> Property+preJust m = isJust m ==> fromJust m++prop_ConsSnoc :: Array D Ix1 Int -> [SeqOp Int] -> Property+prop_ConsSnoc arr ops =+  A.toList (computeAs U (foldl' applyArraySeqOp (toLoadArray arr) ops)) ===+  F.toList (foldl' applySequenceSeqOp (S.fromList (A.toList arr)) ops)++data SeqOp e = Cons e | Snoc e deriving (Eq, Show)++instance Arbitrary e => Arbitrary (SeqOp e) where+  arbitrary = do+    e <- arbitrary+    elements [Cons e, Snoc e]++applyArraySeqOp :: Array DL Ix1 e -> SeqOp e -> Array DL Ix1 e+applyArraySeqOp arr = \case+  Cons x -> A.cons x arr+  Snoc x -> A.snoc arr x+++applySequenceSeqOp :: Seq a -> SeqOp a -> Seq a+applySequenceSeqOp arr = \case+  Cons x -> x <| arr+  Snoc x -> arr |> x
+ tests/Data/Massiv/Array/StencilSpec.hs view
@@ -0,0 +1,196 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Data.Massiv.Array.StencilSpec (spec) where++import Control.DeepSeq (deepseq)+import Data.Default (Default(def))+import Data.Massiv.Array as A+import Test.Massiv.Core++-- sum3x3Stencil :: Fractional a => Stencil Ix2 a a+-- sum3x3Stencil = makeConvolutionStencil (3 :. 3) (1 :. 1) $ \ get ->+--   get (-1 :. -1) 1 . get (-1 :. 0) 1 . get (-1 :. 1) 1 .+--   get ( 0 :. -1) 1 . get ( 0 :. 0) 1 . get ( 0 :. 1) 1 .+--   get ( 1 :. -1) 1 . get ( 1 :. 0) 1 . get ( 1 :. 1) 1+-- {-# INLINE sum3x3Stencil #-}+++singletonStencil :: (Index ix) => (Int -> Int) -> Stencil ix Int Int+singletonStencil f =+  makeStencil oneSz zeroIndex $ \ get -> fmap f (get zeroIndex)+{-# INLINE singletonStencil #-}+++prop_MapSingletonStencil :: (Load DW ix Int, Manifest U ix Int) =>+                            Proxy ix -> Fun Int Int -> Border Int -> ArrNE U ix Int -> Bool+prop_MapSingletonStencil _ f b (ArrNE arr) =+  computeAs U (mapStencil b (singletonStencil (apply f)) arr) == computeAs U (A.map (apply f) arr)++prop_MapSingletonStencilWithStride :: (StrideLoad DW ix Int, Manifest U ix Int) =>+                                      Proxy ix -> Fun Int Int -> Border Int -> ArrNE U ix Int -> Bool+prop_MapSingletonStencilWithStride _ f b (ArrNE arr) =+  computeWithStride oneStride (mapStencil b (singletonStencil (apply f)) arr) ==+  computeAs U (A.map (apply f) arr)++-- Tests out of bounds stencil indexing+prop_DangerousStencil ::+     Index ix => Proxy ix -> NonZero Int -> DimIx ix -> SzIx ix -> Property+prop_DangerousStencil _ (NonZero s) (DimIx r) (SzIx sz ix) =+  ix' `deepseq` assertSomeException $ makeStencil sz ix $ \get -> get ix' :: Value Int+  where+    ix' = liftIndex (* signum s) (setDim' zeroIndex r (getDim' (unSz sz) r))+++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)+  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)+  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)+++stencilDirection :: (Default a, Unbox a, Manifest r Ix2 a) => Ix2 -> Array r Ix2 a -> Array U Ix2 a+stencilDirection ix =+  computeAs U . mapStencil (Fill def) (makeStencil (Sz 3) (1 :. 1) $ \f -> f ix)+++stencilCorners ::+     (Default a, Unbox a, Manifest r Ix2 a) => Ix2 -> Ix2 -> Array r Ix2 a -> Array U Ix2 a+stencilCorners ixC ix = computeAs U . mapStencil (Fill def) (makeStencil (Sz 3) ixC $ \f -> f ix)+++stencilConvolution :: Spec+stencilConvolution = do+  let xs3 :: Array U Ix1 Int+      xs3 = [1, 2, 3]+      xs3f f = f (-1) 1 . f 0 2 . f 1 3+      xs4 :: Array U 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 = [1, 2, 3, 4, 5]+      ysConvXs3 = [4, 10, 16, 22, 22]+      ysConvXs4 = [10, 20, 30, 34, 31]+      ysCorrXs3 = [8, 14, 20, 26, 14]+      ysCorrXs4 = [11, 20, 30, 40, 26]+      ysConvXs4' = [4, 10, 20, 30, 34]+      ysCorrXs4' = [20, 30, 40, 26, 14]+      xs4f' f = f (-1) 1 . f 0 2 . f 1 3 . f 2 4+      applyStencil s = computeAs U . mapStencil (Fill 0) s+  describe "makeConvolutionStencilFromKernel" $ do+    it "1x3" $ applyStencil (makeConvolutionStencilFromKernel xs3) ys `shouldBe` ysConvXs3+    it "1x4" $ applyStencil (makeConvolutionStencilFromKernel xs4) ys `shouldBe` ysConvXs4+  describe "makeCorrelationStencilFromKernel" $ do+    it "1x3" $ applyStencil (makeCorrelationStencilFromKernel xs3) ys `shouldBe` ysCorrXs3+    it "1x4" $ applyStencil (makeCorrelationStencilFromKernel xs4) ys `shouldBe` ysCorrXs4+  describe "makeConvolutionStencil" $ do+    it "1x3" $ applyStencil (makeConvolutionStencil (Sz1 3) 1 xs3f) ys `shouldBe` ysConvXs3+    it "1x4" $ applyStencil (makeConvolutionStencil (Sz1 4) 2 xs4f) ys `shouldBe` ysConvXs4+    it "1x4" $ applyStencil (makeConvolutionStencil (Sz1 4) 1 xs4f') ys `shouldBe` ysConvXs4'+  describe "makeCorrelationStencil" $ do+    it "1x3" $ applyStencil (makeCorrelationStencil (Sz1 3) 1 xs3f) ys `shouldBe` ysCorrXs3+    it "1x4" $ applyStencil (makeCorrelationStencil (Sz1 4) 2 xs4f) ys `shouldBe` ysCorrXs4+    it "1x4" $ applyStencil (makeCorrelationStencil (Sz1 4) 1 xs4f') ys `shouldBe` ysCorrXs4'+  describe "makeConvolutionStencil == makeConvolutionStencilFromKernel" $ do+    it "Sobel Horizontal" $+      property $ \(arr :: Array U Ix2 Int) ->+        applyStencil (makeConvolutionStencil (Sz 3) 1 sobelX) arr ===+        applyStencil (makeConvolutionStencilFromKernel sobelKernelX) arr+    it "1x3" $+      property $ \(arr :: Array U Ix1 Int) ->+        applyStencil (makeConvolutionStencil (Sz1 3) 1 xs3f) arr ===+        applyStencil (makeConvolutionStencilFromKernel xs3) arr+    it "1x4" $+      property $ \(arr :: Array U Ix1 Int) ->+        applyStencil (makeConvolutionStencil (Sz1 4) 2 xs4f) arr ===+        applyStencil (makeConvolutionStencilFromKernel xs4) arr+  describe "makeCorrelationStencil == makeCorrelationStencilFromKernel" $ do+    it "Sobel Horizontal" $+      property $ \(arr :: Array U Ix2 Int) ->+        applyStencil (makeCorrelationStencil (Sz 3) 1 sobelX) arr ===+        applyStencil (makeCorrelationStencilFromKernel sobelKernelX) arr+    it "1x3" $+      property $ \(arr :: Array U Ix1 Int) ->+        applyStencil (makeCorrelationStencil (Sz1 3) 1 xs3f) arr ===+        applyStencil (makeCorrelationStencilFromKernel xs3) arr+    it "1x4" $+      property $ \(arr :: Array U Ix1 Int) ->+        applyStencil (makeCorrelationStencil (Sz1 4) 2 xs4f) arr ===+        applyStencil (makeCorrelationStencilFromKernel xs4) arr+  describe "makeConvolutionStencil == makeCorrelationStencil . rotate180" $ do+    it "Sobel Horizontal" $+      property $ \(arr :: Array U Ix2 Int) ->+        applyStencil (makeConvolutionStencilFromKernel sobelKernelX) arr ===+        applyStencil (makeCorrelationStencilFromKernel (rotate180 sobelKernelX)) arr+    it "1x3" $+      property $ \(arr :: Array U Ix1 Int) ->+        applyStencil (makeConvolutionStencilFromKernel xs3) arr ===+        applyStencil (makeCorrelationStencilFromKernel (rotate180 xs3)) arr+    -- it "1x4" $+    --   property $ \(arr :: Array U Ix1 Int) ->+    --     applyStencil (makeConvolutionStencilFromKernel xs4) arr ===+    --     applyStencil (makeCorrelationStencilFromKernel (rotate180 xs4)) arr++spec :: Spec+spec = do+  describe "Stencil" $ do+    stencilSpec+    let arr = [[1, 2, 3], [4, 5, 6], [7, 8, 9]] :: Array U Ix2 Int+    describe "Unit tests Ix2" $ do+      it "Direction Left" $+        stencilDirection (0 :. 1) arr `shouldBe` [[2, 3, 0], [5, 6, 0], [8, 9, 0]]+      it "Direction Right" $+        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" $+        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]]+      it "Direction Right/Top Corner" $+        stencilCorners (0 :. 2) (2 :. -2) arr `shouldBe` [[0, 0, 7], [0, 0, 0], [0, 0, 0]]+      it "Direction Right/Bottom Corner" $+        stencilCorners (2 :. 2) (-2 :. -2) arr `shouldBe` [[0, 0, 0], [0, 0, 0], [0, 0, 1]]+      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+          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]]+      it "map stencil with stride on larger array" $+        let largeArr = makeArrayR U Seq (Sz 5) (succ . toLinearIndex (Sz 5))+            strideArr = mapStencil (Fill 0) stencil largeArr+         in computeWithStrideAs U stride strideArr `shouldBe`+            [[-6, 1, 14], [-13, 9, 43], [4, 21, 44]]+  stencilConvolution++sobelX :: Num e => (Ix2 -> e -> e -> e) -> e -> e+sobelX f = f (-1 :. -1) (-1) . f (-1 :. 1) 1 .+           f ( 0 :. -1) (-2) . f ( 0 :. 1) 2 .+           f ( 1 :. -1) (-1) . f ( 1 :. 1) 1++sobelKernelX :: Array U 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))
+ tests/Data/Massiv/ArraySpec.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+-- Here are contained tests for all instances for all main classes+module Data.Massiv.ArraySpec+  ( spec+  ) where++import Data.Massiv.Array+import Test.Massiv.Core+++prop_Construct_makeArray_Manifest ::+     forall r ix. (Load D ix Int, Ragged L ix Int, Source r ix Int, Construct r ix Int)+  => Comp+  -> Sz ix+  -> Fun Int Int+  -> Property+prop_Construct_makeArray_Manifest comp sz f =+  makeArrayLinearR D comp sz (apply f) ===+  delay (setComp Seq (makeArray comp sz (apply f . toLinearIndex sz) :: Array r ix Int))++prop_Construct_makeArray_Delayed ::+     forall r ix. (Load D ix Int, Ragged L ix Int, Load r ix Int, Construct r ix Int)+  => Comp+  -> Sz ix+  -> Fun Int Int+  -> Property+prop_Construct_makeArray_Delayed comp sz f =+  makeArrayLinearR P comp sz (apply f) ===+  compute (setComp Seq (makeArrayLinear comp sz (apply f)) :: Array r ix Int)++prop_Functor ::+     forall r ix.+     (Load D ix Int, Ragged L ix Int, Load r ix Int, Construct r ix Int, Functor (Array r ix))+  => Comp+  -> Sz ix+  -> Fun Int Int+  -> Fun Int Int+  -> Property+prop_Functor comp sz f g =+  makeArrayLinearR P comp sz (apply g . apply f) ===+  compute (fmap (apply g) (makeArrayLinear comp sz (apply f) :: Array r ix Int))++prop_Extract ::+     forall r ix.+     ( Load D ix Int+     , Ragged L ix Int+     , Load (R r) ix Int+     , Construct r ix Int+     , Extract r ix Int+     )+  => Comp+  -> Sz ix+  -> Fun Int Int+  -> ix+  -> Sz ix+  -> Property+prop_Extract comp sz f start newSize =+  (computeAs P <$> toStringException (extractM start newSize arrD))  ===+  (compute <$> toStringException (extractM start newSize arr))+  where+    arrD = makeArrayLinearR D comp sz (apply f)+    arr = makeArrayLinear comp sz (apply f) :: Array r ix Int++prop_IxUnbox ::+     forall ix.+     ( Load D ix ix+     , Ragged L ix ix+     , Construct U ix ix+     , Source U ix ix+     )+  => Comp+  -> Sz ix+  -> Fun Int ix+  -> Property+prop_IxUnbox comp sz f =+  makeArrayLinearR D comp sz (apply f) ===+  delay (makeArrayLinear comp sz (apply f) :: Array U ix ix)++prop_computeWithStride ::+     forall r ix. (Load D ix Int, Ragged L ix Int, StrideLoad r ix Int, Construct r ix Int)+  => Comp+  -> Sz ix+  -> Fun Int Int+  -> Stride ix+  -> Property+prop_computeWithStride comp sz f stride =+  arr === computeWithStride stride arrL .&&.+  arr === compute (fromStrideLoad stride arrL)+  where+    arrL = makeArrayLinear comp sz (apply f) :: Array r ix Int+    arr = computeWithStrideAs P stride (makeArrayLinearR D comp sz (apply f))+++specCommon ::+     forall ix.+     (Arbitrary ix, Load D ix Int, StrideLoad DW ix Int, Ragged L ix Int, Ragged L ix ix, Unbox ix)+  => Spec+specCommon =+  describe "Construct" $ do+    it "Construct_makeArray B" $ property $ prop_Construct_makeArray_Manifest @B @ix+    it "Construct_makeArray N" $ property $ prop_Construct_makeArray_Manifest @N @ix+    it "Construct_makeArray S" $ property $ prop_Construct_makeArray_Manifest @S @ix+    it "Construct_makeArray P" $ property $ prop_Construct_makeArray_Manifest @P @ix+    it "Construct_makeArray U" $ property $ prop_Construct_makeArray_Manifest @U @ix+    it "Construct_makeArray_Delayed DI" $ property $ prop_Construct_makeArray_Delayed @DI @ix+    it "Construct_makeArray_Delayed DL" $ property $ prop_Construct_makeArray_Delayed @DL @ix+    it "Construct_makeArray_Delayed DW" $ property $ prop_Construct_makeArray_Delayed @DW @ix+    it "Functor D" $ property $ prop_Functor @D @ix+    it "Functor DI" $ property $ prop_Functor @DI @ix+    it "Functor DL" $ property $ prop_Functor @DL @ix+    it "Functor DW" $ property $ prop_Functor @DW @ix+    it "Extract DI" $ property $ prop_Extract @DI @ix+    it "Extract B" $ property $ prop_Extract @B @ix+    it "Extract N" $ property $ prop_Extract @N @ix+    it "Extract S" $ property $ prop_Extract @S @ix+    it "Extract U" $ property $ prop_Extract @U @ix+    it "computeWithStride DI" $ property $ prop_computeWithStride @DI @ix+    it "computeWithStride DW" $ property $ prop_computeWithStride @DW @ix+    it "computeWithStride B" $ property $ prop_computeWithStride @B @ix+    it "computeWithStride N" $ property $ prop_computeWithStride @N @ix+    it "computeWithStride S" $ property $ prop_computeWithStride @S @ix+    it "computeWithStride U" $ property $ prop_computeWithStride @U @ix+    it "IxUnbox" $ property $ prop_IxUnbox @ix+++spec :: Spec+spec = do+  specCommon @Ix1+  specCommon @Ix2+  specCommon @Ix3+  -- FIXME: Uses too much RAM when compiling+  -- specCommon @Ix4+  -- specCommon @Ix5
+ tests/Main.hs view
@@ -0,0 +1,10 @@+module Main where++import System.IO (BufferMode(LineBuffering), hSetBuffering, stdout)+import Test.Hspec+import Spec++main :: IO ()+main = do+  hSetBuffering stdout LineBuffering+  hspec spec
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --no-main #-}
+ tests/Test/Massiv/Array/MutableSpec.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+module Test.Massiv.Array.MutableSpec (spec) where++import Data.Massiv.Array+import Test.Massiv.Core+import Test.Massiv.Core.Mutable+import Test.Massiv.Array.Mutable++type MutableArraySpec r ix e+   = ( Eq (Array r ix e)+     , Show (Array r ix e)+     , Eq (Array (R r) Ix1 e)+     , Show (Array (R r) Ix1 e)+     , Load (R r) ix e+     , Extract r ix e+     , Resize r ix+     , Arbitrary (Array r ix e)+     , Mutable r ix e+     , Construct r ix e)++type MutableSpec r e+   = ( Show e+     , Eq e+     , Typeable e+     , Arbitrary e+     , CoArbitrary e+     , Function e+     , MutableArraySpec r Ix1 e+     , MutableArraySpec r Ix2 e+     , MutableArraySpec r Ix3 e+     , MutableArraySpec r Ix4 e+     , MutableArraySpec r Ix5 e)++specMutableR :: forall r e. MutableSpec r e => Spec+specMutableR = do+  unsafeMutableSpec @r @Ix1 @e+  unsafeMutableSpec @r @Ix2 @e+  unsafeMutableSpec @r @Ix3 @e+  unsafeMutableSpec @r @Ix4 @e+  unsafeMutableSpec @r @Ix5 @e+  mutableSpec @r @Ix1 @e+  mutableSpec @r @Ix2 @e+  mutableSpec @r @Ix3 @e+  mutableSpec @r @Ix4 @e+  --mutableSpec @r @Ix5 @e -- slows down the test suite+++specUnboxedMutableR :: forall r e. MutableSpec r e => Spec+specUnboxedMutableR = do+  specMutableR @r @e+  unsafeMutableUnboxedSpec @r @Ix1 @e+  unsafeMutableUnboxedSpec @r @Ix2 @e+  unsafeMutableUnboxedSpec @r @Ix3 @e+  unsafeMutableUnboxedSpec @r @Ix4 @e+  unsafeMutableUnboxedSpec @r @Ix5 @e++++spec :: Spec+spec = do+  specMutableR @B @Int+  specMutableR @N @Int+  specUnboxedMutableR @S @Int+  specUnboxedMutableR @P @Int+  specUnboxedMutableR @U @Int+  atomicIntSpec @Ix1+  atomicIntSpec @Ix2+  atomicIntSpec @Ix3+  atomicIntSpec @Ix4+  atomicIntSpec @Ix5
+ tests/Test/Massiv/Core/IndexSpec.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+module Test.Massiv.Core.IndexSpec (spec) where++import Control.DeepSeq+import Data.Massiv.Array+import Data.Massiv.Array.Unsafe (Sz(SafeSz))+import Test.Massiv.Core.Index+import Test.Massiv.Utils+import Test.Validity.Eq (eqSpecOnArbitrary)+import Test.Validity.Ord (ordSpecOnArbitrary)++++specIxN ::+     forall ix.+     ( Num ix+     -- , Unbox ix -- TODO: add spec for unboxed vectors+     , Index ix+     , Bounded ix+     , Index (Lower ix)+     , Typeable ix+     , Typeable (Lower ix)+     , Arbitrary ix+     , Arbitrary (Lower ix)+     )+  => Spec+specIxN = do+  describe (showsTypeRep (typeRep (Proxy :: Proxy ix)) "") $ do+    ixSpec @ix+    ix2UpSpec @ix+    ixNumSpec @ix+    it "Show" $ property $ \ix -> ("Just (" ++ show (ix :: ix) ++ ")") === show (Just ix)+  describe "Bounded" $ do+    it "minBound" $ fromIntegral (minBound :: Int) `shouldBe` (minBound :: ix)+    it "maxBound" $ fromIntegral (maxBound :: Int) `shouldBe` (maxBound :: ix)+  eqSpecOnArbitrary @ix+  ordSpecOnArbitrary @ix+  describe "Stride" $ do+    it "Positive" $+      property $ \(ix :: ix) ->+        case Stride ix of+          str@(Stride ix') -> foldlIndex (\a x -> a && x > 0) True ix' .&&.+                              unStride str === liftIndex (max 1) ix+    it "Show" $ property $ \str -> ("Just (" ++ show (str :: Stride ix) ++ ")") === show (Just str)+    eqSpecOnArbitrary @(Stride ix)+    ordSpecOnArbitrary @(Stride ix)+    it "DeebpSeq" $ property $ \ (str :: Stride ix) -> rnf str `shouldBe` ()+    it "oneStride" $ unStride oneStride `shouldBe` (1 :: ix)+    it "toLinearIndexStride" $ property $ \ str (SzIx sz ix :: SzIx ix) ->+      let k = toLinearIndexStride str sz ix+          ix' = fromLinearIndex sz k+      in ix' * unStride str + liftIndex2 mod ix (unStride str) === ix+    it "strideSize" $ property $ \ (str :: Stride ix) sz ->+      let sz' = Sz (unSz sz * unStride str) in strideSize str sz' === sz+    it "strideStart" $ property $ \ (str :: Stride ix) ix ->+      let start = strideStart str ix+      in liftIndex2 mod start (unStride str) === zeroIndex .&&.+         ix <= start+++specIxT ::+     forall ix ix'.+     ( Typeable ix+     , Typeable (Lower ix)+     , Index ix+     , Index (Lower ix)+     , Arbitrary ix+     , Arbitrary (Lower ix)+     )+  => (ix -> ix')+  -> (ix' -> ix)+  -> Spec+specIxT fromIxT toIxT = describe (showsTypeRep (typeRep (Proxy :: Proxy ix)) "") $ do+  ixSpec @ix+  ix2UpSpec @ix+  it "toFromIx" $ property $ \ ix -> ix === toIxT (fromIxT ix)++specPatterns :: Spec+specPatterns =+  describe "Patterns" $ do+    it "Ix1" $+      property $ \i ->+        case i of+          Ix1 i' -> i' === Ix1 i+    it "Ix2" $+      property $ \i2 i1 ->+        case i2 :. i1 of+          Ix2 i2' i1' -> i2' :. i1' === Ix2 i2 i1+    it "Ix3" $+      property $ \i3 i2 i1 ->+        case i3 :> i2 :. i1 of+          Ix3 i3' i2' i1' -> i3' :> i2' :. i1' === Ix3 i3 i2 i1+    it "Ix4" $+      property $ \i4 i3 i2 i1 ->+        case i4 :> i3 :> i2 :. i1 of+          Ix4 i4' i3' i2' i1' -> i4' :> i3' :> i2' :. i1' === Ix4 i4 i3 i2 i1+    it "Ix5" $+      property $ \i5 i4 i3 i2 i1 ->+        case i5 :> i4 :> i3 :> i2 :. i1 of+          Ix5 i5' i4' i3' i2' i1' -> i5' :> i4' :> i3' :> i2' :. i1' === Ix5 i5 i4 i3 i2 i1+    it "Sz1" $+      property $ \i ->+        case Sz i of+          Sz1 i' -> SafeSz i' === Sz1 i+    it "Sz2" $+      property $ \i2 i1 ->+        case Sz (i2 :. i1) of+          Sz2 i2' i1' -> SafeSz (i2' :. i1') === Sz2 i2 i1+    it "Sz3" $+      property $ \i3 i2 i1 ->+        case Sz (i3 :> i2 :. i1) of+          Sz3 i3' i2' i1' -> SafeSz (i3' :> i2' :. i1') === Sz3 i3 i2 i1+    it "Sz4" $+      property $ \i4 i3 i2 i1 ->+        case Sz (i4 :> i3 :> i2 :. i1) of+          Sz4 i4' i3' i2' i1' -> SafeSz (i4' :> i3' :> i2' :. i1') === Sz4 i4 i3 i2 i1+    it "Sz5" $+      property $ \i5 i4 i3 i2 i1 ->+        case Sz (i5 :> i4 :> i3 :> i2 :. i1) of+          Sz5 i5' i4' i3' i2' i1' -> SafeSz (i5' :> i4' :> i3' :> i2' :. i1') === Sz5 i5 i4 i3 i2 i1+++specSz ::+     forall ix.+     ( Num ix+     -- , Unbox ix -- TODO: add Unbox instance and a spec for unboxed vectors+     , Index ix+     , Typeable ix+     , Arbitrary ix+     )+  => Spec+specSz = do+  describe ("Sz (" ++ showsTypeRep (typeRep (Proxy :: Proxy ix)) ")") $ do+    szSpec @ix+    szNumSpec @ix+    it "Show" $ property $ \sz -> ("Just (" ++ show (sz :: Sz ix) ++ ")") === show (Just sz)+  eqSpecOnArbitrary @(Sz ix)+  ordSpecOnArbitrary @(Sz ix)++specIx :: Spec+specIx = do+  specIx1+  specIxN @Ix2+  specIxN @Ix3+  specIxN @Ix4+  specIxN @Ix5+  describe "Dimension" $+    it "fromDimension" $ do+      fromDimension Dim1 `shouldBe` 1+      fromDimension Dim2 `shouldBe` 2+      fromDimension Dim3 `shouldBe` 3+      fromDimension Dim4 `shouldBe` 4+      fromDimension Dim5 `shouldBe` 5++spec :: Spec+spec = do+  specIx+  specIxT @Ix2T toIx2 fromIx2+  specIxT @Ix3T toIx3 fromIx3+  specIxT @Ix4T toIx4 fromIx4+  specIxT @Ix5T toIx5 fromIx5+  specPatterns+  specSz @Ix1+  specSz @Ix2+  specSz @Ix3+  specSz @Ix4+  specSz @Ix5+  describe "NFData Border" $ do+    it "Fill exception" $+      assertException (ExpectedException==) (Fill (throw ExpectedException :: Int))+    it "rnf" $ property $ \ (b :: Border Int) -> rnf b `shouldBe` ()+  eqSpecOnArbitrary @(Border Int)
+ tests/Test/Massiv/Core/SchedulerSpec.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+module Test.Massiv.Core.SchedulerSpec (spec) where++import Control.Exception.Base (ArithException(DivideByZero))+import Data.Massiv.Array as A+import Test.Massiv.Core+import Prelude as P+++-- | Ensure proper exception handling.+prop_CatchDivideByZero :: ArrIx D Ix2 Int -> [Int] -> Property+prop_CatchDivideByZero (ArrIx arr ix) caps =+  assertException+    (== DivideByZero)+    (A.sum $+     A.imap+       (\ix' x ->+          if ix == ix'+            then x `div` 0+            else x)+       (setComp (ParOn caps) arr))++-- | Ensure proper exception handling in nested parallel computation+prop_CatchNested :: ArrIx D Ix1 (ArrIx D Ix1 Int) -> [Int] -> Property+prop_CatchNested (ArrIx arr ix) caps =+  assertException+    (== DivideByZero)+    (computeAs U $+     A.map A.sum $+     A.imap+       (\ix' (ArrIx iarr ixi) ->+          if ix == ix'+            then A.imap+                   (\ixi' e ->+                      if ixi == ixi'+                        then e `div` 0+                        else e)+                   iarr+            else iarr)+       (setComp (ParOn caps) arr))+++spec :: Spec+spec =+  describe "Scheduler - Exceptions" $ do+    it "CatchDivideByZero" $ property prop_CatchDivideByZero+    it "CatchNested" $ property prop_CatchNested