diff --git a/.circleci/config.yml b/.circleci/config.yml index fad20a3ddb..dd27dc40ec 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -154,6 +154,7 @@ jobs: GHCVER: "9.14.1" CABAL_PROJECT: "cabal.project.doctest" DISABLE_SDIST_BUILD: "y" + DISABLE_DIST_CHECKS: "y" DISABLE_TEST: "y" DISABLE_BENCH: "y" DISABLE_DOCS: "y" diff --git a/.github/workflows/regression-check.yml b/.github/workflows/regression-check.yml index bffa55032e..051acac986 100644 --- a/.github/workflows/regression-check.yml +++ b/.github/workflows/regression-check.yml @@ -30,6 +30,9 @@ jobs: Data.Array.Stream Data.Fold Data.MutArray + Data.MutByteArray.DeriveSerialize + Data.MutByteArray.DeriveUnboxGeneric + Data.MutByteArray.DeriveUnboxTH Data.Parser Data.ParserK Data.ParserK.Chunked @@ -37,7 +40,6 @@ jobs: Data.RingArray Data.Scanl Data.Scanl.Concurrent - Data.Serialize Data.Stream Data.Stream.Concurrent Data.Stream.ConcurrentEager @@ -45,8 +47,6 @@ jobs: Data.Stream.ConcurrentOrdered Data.Stream.Prelude Data.StreamK:6 - Data.Unbox - Data.Unbox.Derive.TH Data.Unfold Data.Unfold.Prelude FileSystem.DirIO diff --git a/benchmark/Streamly/Benchmark/Data/Serialize/RecCompatible.hs b/benchmark/Streamly/Benchmark/Data/MutByteArray/RecCompatible.hs similarity index 85% rename from benchmark/Streamly/Benchmark/Data/Serialize/RecCompatible.hs rename to benchmark/Streamly/Benchmark/Data/MutByteArray/RecCompatible.hs index 146fcce12d..3910443d59 100644 --- a/benchmark/Streamly/Benchmark/Data/Serialize/RecCompatible.hs +++ b/benchmark/Streamly/Benchmark/Data/MutByteArray/RecCompatible.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} -module Streamly.Benchmark.Data.Serialize.RecCompatible +module Streamly.Benchmark.Data.MutByteArray.RecCompatible ( RecCompatible(..) , valRecCompatible ) where @@ -10,7 +10,7 @@ module Streamly.Benchmark.Data.Serialize.RecCompatible -------------------------------------------------------------------------------- import Streamly.Internal.Data.MutByteArray (Serialize) -import Streamly.Benchmark.Data.Serialize.TH (genLargeRecord) +import Streamly.Benchmark.Data.MutByteArray.TH (genLargeRecord) import qualified Streamly.Internal.Data.MutByteArray as Serialize diff --git a/benchmark/Streamly/Benchmark/Data/Serialize/RecNonCompatible.hs b/benchmark/Streamly/Benchmark/Data/MutByteArray/RecNonCompatible.hs similarity index 83% rename from benchmark/Streamly/Benchmark/Data/Serialize/RecNonCompatible.hs rename to benchmark/Streamly/Benchmark/Data/MutByteArray/RecNonCompatible.hs index 7bbbfb91e9..ded3285200 100644 --- a/benchmark/Streamly/Benchmark/Data/Serialize/RecNonCompatible.hs +++ b/benchmark/Streamly/Benchmark/Data/MutByteArray/RecNonCompatible.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} -module Streamly.Benchmark.Data.Serialize.RecNonCompatible +module Streamly.Benchmark.Data.MutByteArray.RecNonCompatible ( RecNonCompatible(..) , valRecNonCompatible ) where @@ -9,7 +9,7 @@ module Streamly.Benchmark.Data.Serialize.RecNonCompatible -- Imports -------------------------------------------------------------------------------- -import Streamly.Benchmark.Data.Serialize.TH (genLargeRecord) +import Streamly.Benchmark.Data.MutByteArray.TH (genLargeRecord) import qualified Streamly.Internal.Data.MutByteArray as Serialize diff --git a/benchmark/Streamly/Benchmark/Data/Serialize.hs b/benchmark/Streamly/Benchmark/Data/MutByteArray/Serialize.hs similarity index 98% rename from benchmark/Streamly/Benchmark/Data/Serialize.hs rename to benchmark/Streamly/Benchmark/Data/MutByteArray/Serialize.hs index f07f856c9a..05136aafe1 100644 --- a/benchmark/Streamly/Benchmark/Data/Serialize.hs +++ b/benchmark/Streamly/Benchmark/Data/MutByteArray/Serialize.hs @@ -7,7 +7,7 @@ #endif -- | --- Module : Streamly.Benchmark.Data.Serialize +-- Module : Streamly.Benchmark.Data.MutByteArray.Serialize -- Copyright : (c) 2023 Composewell -- License : BSD-3-Clause -- Maintainer : streamly@composewell.com @@ -39,8 +39,8 @@ import Test.Tasty.Bench import Streamly.Benchmark.Common #ifndef USE_UNBOX -import Streamly.Benchmark.Data.Serialize.RecCompatible -import Streamly.Benchmark.Data.Serialize.RecNonCompatible +import Streamly.Benchmark.Data.MutByteArray.RecCompatible +import Streamly.Benchmark.Data.MutByteArray.RecNonCompatible #endif #ifdef USE_UNBOX diff --git a/benchmark/Streamly/Benchmark/Data/Serialize/TH.hs b/benchmark/Streamly/Benchmark/Data/MutByteArray/TH.hs similarity index 97% rename from benchmark/Streamly/Benchmark/Data/Serialize/TH.hs rename to benchmark/Streamly/Benchmark/Data/MutByteArray/TH.hs index 035a9c5ce0..2dfeefa9e9 100644 --- a/benchmark/Streamly/Benchmark/Data/Serialize/TH.hs +++ b/benchmark/Streamly/Benchmark/Data/MutByteArray/TH.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} -module Streamly.Benchmark.Data.Serialize.TH (genLargeRecord) where +module Streamly.Benchmark.Data.MutByteArray.TH (genLargeRecord) where -------------------------------------------------------------------------------- -- Imports diff --git a/benchmark/streamly-benchmarks.cabal b/benchmark/streamly-benchmarks.cabal index deaa6ae41e..7d2219c56c 100644 --- a/benchmark/streamly-benchmarks.cabal +++ b/benchmark/streamly-benchmarks.cabal @@ -313,6 +313,33 @@ benchmark Data.MutArray else buildable: True +benchmark Data.MutByteArray.DeriveSerialize + import: bench-options + type: exitcode-stdio-1.0 + hs-source-dirs: . + cpp-options: -DUSE_TH + main-is: Streamly/Benchmark/Data/MutByteArray/Serialize.hs + build-depends: QuickCheck, template-haskell + other-modules: + Streamly.Benchmark.Data.MutByteArray.TH + Streamly.Benchmark.Data.MutByteArray.RecCompatible + Streamly.Benchmark.Data.MutByteArray.RecNonCompatible + +benchmark Data.MutByteArray.DeriveUnboxGeneric + import: bench-options + type: exitcode-stdio-1.0 + hs-source-dirs: . + cpp-options: -DUSE_UNBOX + main-is: Streamly/Benchmark/Data/MutByteArray/Serialize.hs + +benchmark Data.MutByteArray.DeriveUnboxTH + import: bench-options + type: exitcode-stdio-1.0 + hs-source-dirs: . + cpp-options: -DUSE_UNBOX + cpp-options: -DUSE_TH + main-is: Streamly/Benchmark/Data/MutByteArray/Serialize.hs + benchmark Data.Parser import: bench-options type: exitcode-stdio-1.0 @@ -407,19 +434,6 @@ benchmark Data.Scanl.Concurrent else buildable: True --- XXX Should be renamed to MutByteArray -benchmark Data.Serialize - import: bench-options - type: exitcode-stdio-1.0 - hs-source-dirs: . - cpp-options: -DUSE_TH - main-is: Streamly/Benchmark/Data/Serialize.hs - build-depends: QuickCheck, template-haskell - other-modules: - Streamly.Benchmark.Data.Serialize.TH - Streamly.Benchmark.Data.Serialize.RecCompatible - Streamly.Benchmark.Data.Serialize.RecNonCompatible - benchmark Data.SmallArray import: bench-options type: exitcode-stdio-1.0 @@ -585,21 +599,6 @@ benchmark Data.StreamK.StreamKAlt if !flag(dev) || impl(ghcjs) buildable: False -benchmark Data.Unbox - import: bench-options - type: exitcode-stdio-1.0 - hs-source-dirs: . - cpp-options: -DUSE_UNBOX - main-is: Streamly/Benchmark/Data/Serialize.hs - -benchmark Data.Unbox.Derive.TH - import: bench-options - type: exitcode-stdio-1.0 - hs-source-dirs: . - cpp-options: -DUSE_UNBOX - cpp-options: -DUSE_TH - main-is: Streamly/Benchmark/Data/Serialize.hs - benchmark Data.Unfold import: bench-options type: exitcode-stdio-1.0 diff --git a/core/src/Streamly/Internal/Data/MutArray/Generic.hs b/core/src/Streamly/Internal/Data/MutArray/Generic.hs index 46d10be398..3d382b8d08 100644 --- a/core/src/Streamly/Internal/Data/MutArray/Generic.hs +++ b/core/src/Streamly/Internal/Data/MutArray/Generic.hs @@ -860,8 +860,9 @@ clone :: MonadIO m => MutArray a -> m (MutArray a) clone src = do let len = length src dst <- emptyOf len - unsafePutSlice src 0 dst 0 len - return dst + let dst1 = dst { arrEnd = arrStart dst + len } + unsafePutSlice src 0 dst1 0 len + return dst1 ------------------------------------------------------------------------------- -- Size diff --git a/core/src/Streamly/Internal/Data/MutArray/Type.hs b/core/src/Streamly/Internal/Data/MutArray/Type.hs index 9e01b7621a..2885c695de 100644 --- a/core/src/Streamly/Internal/Data/MutArray/Type.hs +++ b/core/src/Streamly/Internal/Data/MutArray/Type.hs @@ -1632,7 +1632,9 @@ indexReaderWith liftio (D.Stream stepi sti) = Unfold step inject r <- stepi defState st case r of D.Yield i s -> do - x <- liftio $ getIndex i (MutArray contents start end undefined) + -- We do not need arrBound but we cannot leave it undefined + -- because it is a strict field. + x <- liftio $ getIndex i (MutArray contents start end end) case x of Just v -> return $ D.Yield v (GetIndicesState contents start end s) Nothing -> error "Invalid Index" diff --git a/src/Streamly/Internal/Data/SmallArray.hs b/src/Streamly/Internal/Data/SmallArray.hs index 549c984578..dde0dd339b 100644 --- a/src/Streamly/Internal/Data/SmallArray.hs +++ b/src/Streamly/Internal/Data/SmallArray.hs @@ -24,6 +24,8 @@ module Streamly.Internal.Data.SmallArray , length , createOf + , create + , createOfLast , toStreamD , toStreamDRev @@ -33,8 +35,14 @@ module Streamly.Internal.Data.SmallArray , reader , fromListN + , fromList , fromStreamDN , fromStreamN + , fromStream + + , toList + , unsafeGetIndex + , unsafeSliceOffLen , streamFold , fold @@ -53,6 +61,9 @@ import Streamly.Data.Stream (Stream) import Streamly.Internal.Data.Tuple.Strict (Tuple'(..)) import Streamly.Internal.Data.Unfold (Unfold(..)) +import qualified Data.List as List +import qualified Streamly.Data.Fold as Fold + import qualified Streamly.Internal.Data.Stream as D import qualified Streamly.Internal.Data.Fold as FL (Fold (..), Step (Done, Partial)) @@ -157,6 +168,10 @@ fromStreamDN limit str = do fromListN :: Int -> [a] -> SmallArray a fromListN n xs = unsafePerformIO $ fromStreamDN n $ D.fromList xs +{-# INLINABLE fromList #-} +fromList :: [a] -> SmallArray a +fromList = smallArrayFromList + instance NFData a => NFData (SmallArray a) where {-# INLINE rnf #-} rnf = foldl' (\_ x -> rnf x) () @@ -191,6 +206,31 @@ fold f arr = D.fold f (toStreamD arr) streamFold :: Monad m => (Stream m a -> m b) -> SmallArray a -> m b streamFold f arr = f (read arr) +{-# INLINE toList #-} +toList :: SmallArray a -> [a] +toList = foldr (:) [] + +{-# INLINE create #-} +create :: MonadIO m => Fold m a (SmallArray a) +create = fmap fromList Fold.toList + +{-# INLINE fromStream #-} +fromStream :: MonadIO m => Stream m a -> m (SmallArray a) +fromStream m = fmap fromList (D.fold Fold.toList m) + +{-# INLINE unsafeGetIndex #-} +unsafeGetIndex :: Int -> SmallArray a -> a +unsafeGetIndex i arr = indexSmallArray arr i + +{-# INLINE unsafeSliceOffLen #-} +unsafeSliceOffLen :: Int -> Int -> SmallArray a -> SmallArray a +unsafeSliceOffLen i n arr = cloneSmallArray arr i n + +{-# INLINE createOfLast #-} +createOfLast :: MonadIO m => Int -> Fold m a (SmallArray a) +createOfLast n = fmap (fromList . takeLast) Fold.toList + where takeLast xs = drop (List.length xs - n) xs + {-# INLINE_NORMAL reader #-} reader :: Monad m => Unfold m (SmallArray a) a reader = Unfold step inject diff --git a/streamly.cabal b/streamly.cabal index bcd8d0a4ee..b8c59480a7 100644 --- a/streamly.cabal +++ b/streamly.cabal @@ -76,10 +76,10 @@ extra-source-files: benchmark/Streamly/Benchmark/Data/Array/Stream.hs benchmark/Streamly/Benchmark/Data/Fold/*.hs benchmark/Streamly/Benchmark/Data/MutArray.hs + benchmark/Streamly/Benchmark/Data/MutByteArray/*.hs benchmark/Streamly/Benchmark/Data/Parser/*.hs benchmark/Streamly/Benchmark/Data/RingArray.hs benchmark/Streamly/Benchmark/Data/Scanl/*.hs - benchmark/Streamly/Benchmark/Data/Serialize/*.hs benchmark/Streamly/Benchmark/Data/Stream/*.hs benchmark/Streamly/Benchmark/Data/Stream/Nesting/*.hs benchmark/Streamly/Benchmark/Data/Stream/Parse/*.hs @@ -123,16 +123,9 @@ extra-source-files: src/inline.hs test/Streamly/Test/Control/Exception.hs test/Streamly/Test/Data/*.hs - test/Streamly/Test/Data/Array/CommonImports.hs - test/Streamly/Test/Data/Array/Common.hs - test/Streamly/Test/Data/Array/Generic.hs - test/Streamly/Test/Data/Array.hs - test/Streamly/Test/Data/MutArray.hs - test/Streamly/Test/Data/RingArray.hs - test/Streamly/Test/Data/Array/Stream.hs - test/Streamly/Test/Data/Parser.hs - test/Streamly/Test/Data/Parser/*.hs - test/Streamly/Test/Data/ParserK.hs + test/Streamly/Test/Data/Array/*.hs + test/Streamly/Test/Data/MutArray/*.hs + test/Streamly/Test/Data/ParserK/*.hs test/Streamly/Test/Data/Stream/*.hs test/Streamly/Test/Data/Stream/MkType/*.hs test/Streamly/Test/Data/Stream/Prelude/*.hs @@ -153,14 +146,12 @@ extra-source-files: test/Streamly/Test/Data/Fold/*.hs test/Streamly/Test/Unicode/ucd/NormalizationTest.txt test/Streamly/Test/Unicode/extra/NormalizationTest.txt - test/Streamly/Test/Data/Unbox.hs - test/Streamly/Test/Data/Unbox/*.hs - test/Streamly/Test/Data/Serialize.hs - test/Streamly/Test/Data/Serialize/*.hs + test/Streamly/Test/Data/MutByteArray/*.hs test/lib/Streamly/Test/Common.hs test/lib/Streamly/Test/Control/Exception/Common.hs test/lib/Streamly/Test/Prelude/Common.hs - test/lib/Streamly/Test/Parser/Common.hs + test/lib/Streamly/Test/Data/Parser/CommonTests.hs + test/lib/Streamly/Test/Data/Parser/CommonUtilities.hs test/streamly-tests.cabal test/version-bounds.hs diff --git a/targets/Targets.hs b/targets/Targets.hs index d4ce001430..13741f42de 100644 --- a/targets/Targets.hs +++ b/targets/Targets.hs @@ -109,17 +109,17 @@ targets = ] ) - , ("Data.Serialize", + , ("Data.MutByteArray.Serialize", [ "mut_bytearray_grp" , "streamly_core_grp" + , "noBench" ] ) - , ("Data.Serialize.Derive.TH", + , ("Data.MutByteArray.DeriveSerialize", [ "mut_bytearray_grp" - , "noBench" ] ) - , ("Data.Serialize.ENABLE_constructorTagAsString", + , ("Data.MutByteArray.SerializeConstrTags", [ "mut_bytearray_grp" , "noBench" ] @@ -201,20 +201,15 @@ targets = ] ) -} - , ("Data.Unbox", - [ "noTest" - , "streamly_core_grp" - ] - ) - , ("Data.Unbox.Derive.Generic", - [ "noBench" + , ("Data.MutByteArray.DeriveUnboxGeneric", + [ "streamly_core_grp" ] ) - , ("Data.Unbox.Derive.TH", + , ("Data.MutByteArray.DeriveUnboxTH", [ "streamly_core_grp" ] ) - , ("Data.Unbox.TH", + , ("Data.MutByteArray.DeriveUnboxTHCustom", [ "noBench" ] ) diff --git a/test/Streamly/Test/Data/Array.hs b/test/Streamly/Test/Data/Array.hs index b16cb8555d..269a029fd5 100644 --- a/test/Streamly/Test/Data/Array.hs +++ b/test/Streamly/Test/Data/Array.hs @@ -8,336 +8,133 @@ module Streamly.Test.Data.Array (main) where -import Data.Char (isLower) -import Data.List (sort) -import Data.Proxy (Proxy(..)) -import Data.Word(Word8, Word16) -import Foreign.Storable (peek) -import Foreign.ForeignPtr (newForeignPtr_, withForeignPtr) -import GHC.Ptr (plusPtr, Ptr(..)) -import Streamly.Internal.Data.MutByteArray (Unbox, sizeOf) -import Streamly.Internal.Data.MutArray (MutArray) -import Test.QuickCheck (chooseInt, listOf) -import System.Mem (performMajorGC) -import Streamly.Test.Common (performGCSweep) +import Data.Word (Word8) +import Test.Hspec as H +import Test.Hspec.QuickCheck +import Test.QuickCheck (Property, forAll, Gen, vectorOf, chooseInt) +import Test.QuickCheck.Monadic (monadicIO, assert, run) +import Streamly.Internal.Data.MutByteArray (Serialize) +import Streamly.Test.Common (listEquals) +import Streamly.Test.Data.Array.Type (typeMain) + +import qualified Streamly.Data.Fold as Fold import qualified Streamly.Internal.Data.Array as A -import qualified Streamly.Internal.Data.MutArray as MA +import qualified Streamly.Internal.Data.MutArray as MutArray +import qualified Streamly.Internal.Data.MutByteArray as Serialize +import qualified Streamly.Internal.Data.Parser as Parser +import qualified Streamly.Internal.Data.Stream as S -#include "Streamly/Test/Data/Array/CommonImports.hs" +#if MIN_VERSION_QuickCheck(2,14,0) +import Test.QuickCheck (chooseAny) +#else +import System.Random (Random(random)) +import Test.QuickCheck.Gen (Gen(MkGen)) -type Array = A.Array +chooseAny :: Random a => Gen a +chooseAny = MkGen (\r _ -> let (x, _) = random r in x) +#endif moduleName :: String moduleName = "Data.Array" -#include "Streamly/Test/Data/Array/Common.hs" - -testFromStreamToStream :: Property -testFromStreamToStream = genericTestFromTo (const A.fromStream) A.read (==) - -testFoldUnfold :: Property -testFoldUnfold = - genericTestFromTo (const (S.fold A.create)) (S.unfold A.reader) (==) - -testFromList :: Property -testFromList = - forAll (choose (0, maxArrLen)) $ \len -> - forAll (vectorOf len (arbitrary :: Gen Int)) $ \list -> - monadicIO $ do - let arr = A.fromList list - xs <- run $ S.fold Fold.toList $ S.unfold A.reader arr - assert (xs == list) - -testLengthFromStream :: Property -testLengthFromStream = genericTestFrom (const A.fromStream) - -unsafeWriteIndex :: [Int] -> Int -> Int -> IO Bool -unsafeWriteIndex xs i x = do - arr <- MA.fromList xs - MA.unsafePutIndex i arr x - x1 <- MA.unsafeGetIndex i arr - return $ x1 == x - -lastN :: Int -> [a] -> [a] -lastN n l = drop (length l - n) l - -testLastN :: Property -testLastN = - forAll (choose (0, maxArrLen)) $ \len -> - forAll (choose (0, len)) $ \n -> - forAll (vectorOf len (arbitrary :: Gen Int)) $ \list -> - monadicIO $ do - xs <- run - $ fmap A.toList - $ S.fold (A.createOfLast n) - $ S.fromList list - assert (xs == lastN n list) - -testLastN_LN :: Int -> Int -> IO Bool -testLastN_LN len n = do - let list = [1..len] - l1 <- fmap A.toList $ S.fold (A.createOfLast n) $ S.fromList list - let l2 = lastN n list - return $ l1 == l2 - -testStrip :: IO Bool -testStrip = do - dt <- MA.fromList "abcDEFgeh" - dt' <- MA.dropAround isLower dt - x <- MA.toList dt' - return $ x == "DEF" - -testStripLeft :: IO Bool -testStripLeft = do - dt <- MA.fromList "abcDEF" - dt' <- MA.dropAround isLower dt - x <- MA.toList dt' - return $ x == "DEF" - -testStripRight :: IO Bool -testStripRight = do - dt <- MA.fromList "DEFgeh" - dt' <- MA.dropAround isLower dt - x <- MA.toList dt' - return $ x == "DEF" - -testStripZero :: IO Bool -testStripZero = do - dt <- MA.fromList "DEF" - dt' <- MA.dropAround isLower dt - x <- MA.toList dt' - return $ x == "DEF" - -testStripEmpty :: IO Bool -testStripEmpty = do - dt <- MA.fromList "abc" - dt' <- MA.dropAround isLower dt - x <- MA.toList dt' - return $ x == "" - -testStripNull :: IO Bool -testStripNull = do - dt <- MA.fromList "" - dt' <- MA.dropAround isLower dt - x <- MA.toList dt' - return $ x == "" - -unsafeSlice :: Int -> Int -> [Int] -> Bool -unsafeSlice i n list = - let lst = take n $ drop i list - arr = A.toList $ A.unsafeSliceOffLen i n $ A.fromList list - in arr == lst - -testBubbleWith :: Bool -> Property -testBubbleWith asc = - forAll (listOf (chooseInt (-50, 100))) $ \ls0 -> - monadicIO $ action ls0 - - where - - action ls = do - x <- S.fold (fldm ls) $ S.fromList ls - lst <- MA.toList x - if asc - then assert (sort ls == lst) - else assert (sort ls == reverse lst) - - fldm ls = - Fold.foldlM' - (\b a -> do - arr <- MA.snoc b a - if asc - then MA.bubble compare arr - else MA.bubble (flip compare) arr - return arr - ) - (MA.emptyOf' $ length ls) - -testBubbleAsc :: Property -testBubbleAsc = testBubbleWith True - -testBubbleDesc :: Property -testBubbleDesc = testBubbleWith False - -testByteLengthWithMA :: forall a. Unbox a => a -> IO () -testByteLengthWithMA _ = do - arrA <- MA.emptyOf' 100 :: IO (MutArray a) - let arrW8 = MA.unsafeCast arrA :: MutArray Word8 - MA.byteLength arrA `shouldBe` MA.length arrW8 - -testBreakOn :: [Word8] -> Word8 -> [Word8] -> Maybe [Word8] -> IO () -testBreakOn inp sep bef aft = do - (bef_, aft_) <- A.breakEndByWord8_ sep (A.fromList inp) - bef_ `shouldBe` A.fromList bef - aft_ `shouldBe` fmap A.fromList aft - -testWrite :: [Char] -> IO () -testWrite inp = do - arr <- S.fold A.create (S.fromList inp) - A.toList arr `shouldBe` inp - -testFromToList :: [Char] -> IO () -testFromToList inp = A.toList (A.fromList inp) `shouldBe` inp - -testUnsafeIndxedFromList :: [Char] -> IO () -testUnsafeIndxedFromList inp = - let arr = A.fromList inp - in fmap (`A.unsafeGetIndex` arr) [0 .. (length inp - 1)] `shouldBe` inp - -getIntList :: Ptr Int -> Int -> IO [Int] -getIntList ptr byteLen = do - performMajorGC - getList ptr (ptr `plusPtr` byteLen) - - where - - sizeOfInt = sizeOf (Proxy :: Proxy Int) - - -- We need to be careful here. We assume Unboxed and Storable are compatible - -- with each other. For Int, they are compatible. - getList p limitP - | p >= limitP = return [] - getList p limitP = do - val <- peek p - rest <- getList (p `plusPtr` sizeOfInt) limitP - return $ val : rest - -testAsPtrUnsafeMA :: IO () -testAsPtrUnsafeMA = do - arr <- MA.fromList ([0 .. 99] :: [Int]) - arr1 <- MA.pin arr - MA.unsafeAsPtr arr1 getIntList `shouldReturn` [0 .. 99] - -testUnsafePinnedAsPtr :: IO () -testUnsafePinnedAsPtr = do - arr <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Int]) - let arr1 = A.unsafeFreeze arr - A.unsafePinnedAsPtr arr1 getIntList `shouldReturn` [10 .. 59] - -testUnsafeAsForeignPtr :: IO () -testUnsafeAsForeignPtr = do - arr <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Int]) - let arr1 = A.unsafeFreeze arr - A.unsafeAsForeignPtr arr1 getIntList1 `shouldReturn` [10 .. 59] - where - getIntList1 fp blen = withForeignPtr fp $ \p -> getIntList p blen - -testForeignPtrConversionId :: IO () -testForeignPtrConversionId = do - arr0 <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Word8]) - let arr = A.unsafeFreeze arr0 - A.unsafeAsForeignPtr arr $ \a b -> do - res <- A.unsafeFromForeignPtr a b - performGCSweep 4 100000 - res `shouldBe` arr - - -testUnsafeFromForeignPtr :: IO () -testUnsafeFromForeignPtr = do - arr0 <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Word8]) - let arr = A.unsafeFreeze arr0 - A.unsafePinnedAsPtr arr $ \ptr len -> do - fptr <- newForeignPtr_ ptr - performMajorGC - A.unsafeFromForeignPtr fptr len `shouldReturn` arr - -testFromCString# :: IO () -testFromCString# = do - arr0 <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Word8]) - let arr = A.unsafeFreeze arr0 - A.unsafePinnedAsPtr (arr <> A.fromList [0]) $ \(Ptr addr#) _ -> do - arr1 <- A.fromCString# addr# - performGCSweep 4 100000 - arr1 `shouldBe` arr - -testFromW16CString# :: IO () -testFromW16CString# = do - arr0 <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Word16]) - let arr = A.unsafeFreeze arr0 - A.unsafePinnedAsPtr (arr <> A.fromList [0]) $ \(Ptr addr#) _ -> do - arr1 <- A.fromW16CString# addr# - performGCSweep 4 100000 - arr1 `shouldBe` arr - -reallocMA :: Property -reallocMA = - let len = 10000 - bSize = len * sizeOf (Proxy :: Proxy Char) - in forAll (vectorOf len (arbitrary :: Gen Char)) $ \vec -> - forAll (chooseInt (bSize - 2000, bSize + 2000)) $ \newBLen -> do - arr <- MA.fromList vec - arr1 <- MA.reallocBytes newBLen arr - lst <- MA.toList arr - lst1 <- MA.toList arr1 - lst `shouldBe` lst1 +maxTestCount :: Int +#ifdef DEVBUILD +maxTestCount = 100 +#else +maxTestCount = 10 +#endif + +------------------------------------------------------------------------------- +-- Array.Stream tests +------------------------------------------------------------------------------- + +chunksOf :: Monad m => Int -> Fold.Fold m a b -> S.Stream m a -> S.Stream m b +chunksOf n f = S.foldMany (Fold.take n f) + +testParseBreak :: Property +testParseBreak = do + let len = 200 + forAll + ((,,) + <$> vectorOf len (chooseAny :: Gen Int) + <*> chooseInt (1, len) + <*> chooseInt (0, len)) + $ \(ls, clen, tlen) -> + monadicIO $ do + (ls1, str) <- + let input = + S.toStreamK + $ chunksOf clen (A.createOf clen) (S.fromList ls) + parser = Parser.fromFold (Fold.take tlen Fold.toList) + in run $ A.parseBreak (A.toParserK parser) input + ls2 <- run $ S.fold Fold.toList (A.concat $ S.fromStreamK str) + case ls1 of + Right x -> listEquals (==) (x ++ ls2) ls + Left _ -> assert False + +------------------------------------------------------------------------------- +-- Array serialize/deserialize tests +------------------------------------------------------------------------------- + +-- | Roundtrip a value through the Array serialization API. Apart from the +-- plain serialize'/deserialize roundtrip, this also exercises deserialization +-- from a slice with a non-zero start offset (to catch hardcoded 0 offsets) and +-- from a cloned slice. +serializeRoundtrip :: + forall a. (Eq a, Show a, Serialize a) => a -> IO () +serializeRoundtrip val = do + val `shouldBe` fst (A.deserialize (A.serialize' val)) + + -- Serialize into a buffer at a non-zero offset and build an Array slice + -- over the serialized region. + let sz = Serialize.addSizeTo 0 val + off = 10 + arr <- Serialize.new (sz + off) + end <- Serialize.serializeAt off arr val + let slice = A.Array arr off end :: A.Array Word8 + val `shouldBe` fst (A.deserialize slice) + + clonedSlice <- A.unsafeFreeze <$> MutArray.clone (A.unsafeThaw slice) + val `shouldBe` fst (A.deserialize clonedSlice) + +testSplitOnSuffix :: Word8 -> [Word8] -> [[Word8]] -> IO () +testSplitOnSuffix sep inp out = do + res <- + S.fold Fold.toList + $ A.compactEndByByte_ sep + $ chunksOf 2 (A.createOf 2) $ S.fromList inp + fmap A.toList res `shouldBe` out + +arrayMain :: SpecWith () +arrayMain = do + -- Stream of Arrays (Streamly.Internal.Data.Array) + describe "compactEndByByte_" $ do + it "0 [1,2,0,4,0,5,6]" + $ testSplitOnSuffix 0 [1, 2, 0, 4, 0, 5, 6] + [[1, 2], [4], [5, 6]] + it "0 [1,2,0,4,0,5,6,0]" + $ testSplitOnSuffix 0 [1, 2, 0, 4, 0, 5, 6, 0] + [[1, 2], [4], [5, 6]] + it "0 [0,1,2,0,4,0,5,6]" + $ testSplitOnSuffix 0 [0, 1, 2, 0, 4, 0, 5, 6] + [[], [1, 2], [4], [5, 6]] + -- Parsing Stream of Arrays (Streamly.Internal.Data.Array) + prop "parseBreak" testParseBreak + describe "serialize/deserialize" $ do + prop "Int" $ \(x :: Int) -> serializeRoundtrip x + prop "[Int]" $ \(x :: [Int]) -> serializeRoundtrip x + prop "Array Int" $ \(x :: [Int]) -> serializeRoundtrip (A.fromList x) main :: IO () main = hspec $ H.parallel $ - modifyMaxSuccess (const maxTestCount) $ do - describe moduleName $ do - commonMain - describe "Construction" $ do - -- XXX There is an issue https://github.com/composewell/streamly/issues/1577 - --prop "testAppend" testAppend - prop "testBubbleAsc" testBubbleAsc - prop "testBubbleDesc" testBubbleDesc - prop "length . fromStream === n" testLengthFromStream - prop "toStream . fromStream === id" testFromStreamToStream - prop "read . write === id" testFoldUnfold - prop "fromList" testFromList - prop "foldMany with writeNUnsafe concats to original" - (foldManyWith (\n -> Fold.take n (A.unsafeCreateOf n))) - describe "AsPtr" $ do - it "testUnsafePinnedAsPtr" testUnsafePinnedAsPtr - it "testUnsafeAsForeignPtr" testUnsafeAsForeignPtr - it "testForeignPtrConversionId" testForeignPtrConversionId - it "testUnsafeFromForeignPtr" testUnsafeFromForeignPtr - it "testFromCString#" testFromCString# - it "testFromW16CString#" testFromW16CString# - describe "unsafeSlice" $ do - it "partial" $ unsafeSlice 2 4 [1..10] - it "none" $ unsafeSlice 10 0 [1..10] - it "full" $ unsafeSlice 0 10 [1..10] - describe "Mut.unsafeWriteIndex" $ do - it "first" (unsafeWriteIndex [1..10] 0 0 `shouldReturn` True) - it "middle" (unsafeWriteIndex [1..10] 5 0 `shouldReturn` True) - it "last" (unsafeWriteIndex [1..10] 9 0 `shouldReturn` True) - describe "Fold" $ do - prop "createOfLast : 0 <= n <= len" testLastN - describe "createOfLast boundary conditions" $ do - it "createOfLast -1" (testLastN_LN 10 (-1) `shouldReturn` True) - it "createOfLast 0" (testLastN_LN 10 0 `shouldReturn` True) - it "createOfLast length" (testLastN_LN 10 10 `shouldReturn` True) - it "createOfLast (length + 1)" (testLastN_LN 10 11 `shouldReturn` True) - describe "Strip" $ do - it "strip" (testStrip `shouldReturn` True) - it "stripLeft" (testStripLeft `shouldReturn` True) - it "stripRight" (testStripRight `shouldReturn` True) - it "stripZero" (testStripZero `shouldReturn` True) - it "stripEmpty" (testStripEmpty `shouldReturn` True) - it "stripNull" (testStripNull `shouldReturn` True) - describe "Mut" $ do - it "testByteLengthWithMA Int" - (testByteLengthWithMA (undefined :: Int)) - it "testByteLengthWithMA Char" - (testByteLengthWithMA (undefined :: Char)) - it "testAsPtrUnsafeMA" testAsPtrUnsafeMA - it "reallocMA" reallocMA - describe "breakOn" $ do - it "testBreakOn [1, 0, 2] 0" - (testBreakOn [1, 0, 2] 0 [1] (Just [2])) - it "testBreakOn [1, 0] 0" (testBreakOn [1, 0] 0 [1] (Just [])) - it "testBreakOn [1] 0" (testBreakOn [1] 0 [1] Nothing) - describe "toList . fromList" $ do - it "testFromToList abc" (testFromToList "abc") - it "testFromToList \\22407" (testFromToList "\22407") - describe "unsafeGetIndex . fromList" $ do - it "testUnsafeIndxedFromList abc" (testUnsafeIndxedFromList "abc") - it "testUnsafeIndxedFromList \\22407" - (testUnsafeIndxedFromList "\22407") - describe "write" $ do - it "testWrite abc" (testWrite "abc") - it "testWrite \\22407" (testWrite "\22407") + modifyMaxSuccess (const maxTestCount) $ + describe moduleName $ do + typeMain + -- IMPORTANT NOTE: Before adding any test here first consider if it can + -- be added to the Array/Common test module. Only those tests which are + -- specific to the Unboxed Array module and do not apply to the Generic + -- Array module should be added here. + arrayMain diff --git a/test/Streamly/Test/Data/Array/Common.hs b/test/Streamly/Test/Data/Array/Common.hs deleted file mode 100644 index 5c1866a639..0000000000 --- a/test/Streamly/Test/Data/Array/Common.hs +++ /dev/null @@ -1,101 +0,0 @@ - -#include "MachDeps.h" - --- Coverage build takes too long with default number of tests -maxTestCount :: Int -#ifdef DEVBUILD -maxTestCount = 100 -#else -maxTestCount = 10 -#endif - -maxArrLen :: Int -maxArrLen = defaultChunkSize * 8 - -genericTestFrom :: - (Int -> Stream IO Int -> IO (Array Int)) - -> Property -genericTestFrom arrFold = - forAll (choose (0, maxArrLen)) $ \len -> - forAll (vectorOf len (arbitrary :: Gen Int)) $ \list -> - monadicIO $ do - arr <- run $ arrFold len $ S.fromList list - assert (A.length arr == len) - -testLength :: Property -testLength = genericTestFrom (S.fold . A.createOf) - -testLengthFromStreamN :: Property -testLengthFromStreamN = genericTestFrom A.fromStreamN - -genericTestFromTo :: - (Int -> Stream IO Int -> IO (Array Int)) - -> (Array Int -> Stream IO Int) - -> ([Int] -> [Int] -> Bool) - -> Property -genericTestFromTo arrFold arrUnfold listEq = - forAll (choose (0, maxArrLen)) $ \len -> - forAll (vectorOf len (arbitrary :: Gen Int)) $ \list -> - monadicIO $ do - arr <- run $ arrFold len $ S.fromList list - xs <- run $ S.fold Fold.toList $ arrUnfold arr - assert (listEq xs list) - - -testFoldNUnfold :: Property -testFoldNUnfold = - genericTestFromTo (S.fold . A.createOf) (S.unfold A.reader) (==) - -testFoldNToStream :: Property -testFoldNToStream = - genericTestFromTo (S.fold . A.createOf) A.read (==) - -testFoldNToStreamRev :: Property -testFoldNToStreamRev = - genericTestFromTo - (S.fold . A.createOf) - A.readRev - (\xs list -> xs == reverse list) - -testFromStreamNUnfold :: Property -testFromStreamNUnfold = - genericTestFromTo A.fromStreamN (S.unfold A.reader) (==) - -testFromStreamNToStream :: Property -testFromStreamNToStream = genericTestFromTo A.fromStreamN A.read (==) - -testFromListN :: Property -testFromListN = - forAll (choose (0, maxArrLen)) $ \len -> - forAll (choose (0, len)) $ \n -> - forAll (vectorOf len (arbitrary :: Gen Int)) $ \list -> - monadicIO $ do - let arr = A.fromListN n list - xs <- run $ S.fold Fold.toList $ S.unfold A.reader arr - listEquals (==) xs (take n list) - -foldManyWith :: (Int -> Fold IO Int (Array Int)) -> Property -foldManyWith f = - forAll (choose (0, maxArrLen)) $ \len -> - forAll (vectorOf len (arbitrary :: Gen Int)) $ \list -> - monadicIO $ do - xs <- run - $ S.fold Fold.toList - $ S.unfoldEach A.reader - $ S.foldMany (f 240) - $ S.fromList list - assert (xs == list) - -commonMain :: SpecWith () -commonMain = do - describe "Construction" $ do - prop "length . writeN n === n" testLength - prop "length . fromStreamN n === n" testLengthFromStreamN - prop "read . writeN === id " testFoldNUnfold - prop "toStream . writeN === id" testFoldNToStream - prop "toStreamRev . writeN === reverse" testFoldNToStreamRev - prop "read . fromStreamN === id" testFromStreamNUnfold - prop "toStream . fromStreamN === id" testFromStreamNToStream - prop "fromListN" testFromListN - prop "foldMany with writeN concats to original" - (foldManyWith A.createOf) diff --git a/test/Streamly/Test/Data/Array/CommonImports.hs b/test/Streamly/Test/Data/Array/CommonImports.hs deleted file mode 100644 index b5ed8116ba..0000000000 --- a/test/Streamly/Test/Data/Array/CommonImports.hs +++ /dev/null @@ -1,13 +0,0 @@ - -import Test.Hspec.QuickCheck -import Test.QuickCheck (Property, forAll, Gen, vectorOf, arbitrary, choose) -import Test.QuickCheck.Monadic (monadicIO, assert, run) -import Test.Hspec as H - -import Streamly.Data.Fold (Fold) -import Streamly.Internal.Data.Stream (Stream) -import Streamly.Internal.System.IO (defaultChunkSize) -import Streamly.Test.Common (listEquals) - -import qualified Streamly.Data.Fold as Fold -import qualified Streamly.Internal.Data.Stream as S diff --git a/test/Streamly/Test/Data/Array/Generic.hs b/test/Streamly/Test/Data/Array/Generic.hs index 2a47d99010..5031abb95f 100644 --- a/test/Streamly/Test/Data/Array/Generic.hs +++ b/test/Streamly/Test/Data/Array/Generic.hs @@ -9,45 +9,29 @@ module Streamly.Test.Data.Array.Generic (main) where -#include "Streamly/Test/Data/Array/CommonImports.hs" +import Test.Hspec as H +import Test.Hspec.QuickCheck +import Test.QuickCheck (Property, forAll, Gen, vectorOf, arbitrary, choose) +import Test.QuickCheck.Monadic (monadicIO, assert, run) +import Streamly.Data.Fold (Fold) +import Streamly.Internal.Data.Stream (Stream) +import Streamly.Internal.System.IO (defaultChunkSize) +import Streamly.Test.Common (listEquals) + +import qualified Streamly.Data.Fold as Fold import qualified Streamly.Internal.Data.Array.Generic as A +import qualified Streamly.Internal.Data.Array.Generic as Arr +import qualified Streamly.Internal.Data.Stream as S +import qualified Streamly.Internal.Data.Stream as Stream type Array = A.Array moduleName :: String moduleName = "Data.Array" -#include "Streamly/Test/Data/Array/Common.hs" - -testFromStreamToStream :: Property -testFromStreamToStream = - genericTestFromTo (const A.fromStream) A.read (==) - -testFoldUnfold :: Property -testFoldUnfold = - genericTestFromTo (const (S.fold A.create)) (S.unfold A.reader) (==) - -testFromList :: Property -testFromList = - forAll (choose (0, maxArrLen)) $ \len -> - forAll (vectorOf len (arbitrary :: Gen Int)) $ \list -> - monadicIO $ do - let arr = A.fromList list - xs <- run $ S.fold Fold.toList $ S.unfold A.reader arr - assert (xs == list) - -testLengthFromStream :: Property -testLengthFromStream = genericTestFrom (const A.fromStream) - -testReadShowInstance :: Property -testReadShowInstance = - forAll (choose (0, maxArrLen)) $ \len -> - forAll (vectorOf len (arbitrary :: Gen Int)) $ \list -> - monadicIO $ do - let arr = A.fromList list - assert (A.toList (read (show arr)) == list) - +#include "Streamly/Test/Data/MutArray/Common.hs" +#include "Streamly/Test/Data/Array/TypeCommon.hs" main :: IO () main = @@ -55,10 +39,9 @@ main = H.parallel $ modifyMaxSuccess (const maxTestCount) $ do describe moduleName $ do - commonMain - describe "Construction" $ do - prop "length . fromStream === n" testLengthFromStream - prop "toStream . fromStream === id" testFromStreamToStream - prop "read . write === id" testFoldUnfold - prop "fromList" testFromList - prop "testReadShowInstance" testReadShowInstance + arrayCommon + typeCommon + -- IMPORTANT NOTE: Before adding any test here first consider if it can + -- be added to the Array/Common test module. Only those tests which are + -- specific to the Generic Array module and do not apply to the Unboxed + -- Array module should be added here. diff --git a/test/Streamly/Test/Data/Array/Stream.hs b/test/Streamly/Test/Data/Array/Stream.hs deleted file mode 100644 index a784d05f29..0000000000 --- a/test/Streamly/Test/Data/Array/Stream.hs +++ /dev/null @@ -1,111 +0,0 @@ - -module Main (main) where - -import Data.Word (Word8) -import Streamly.Test.Common (listEquals, chooseInt) -import Test.Hspec (hspec, describe, shouldBe) -import Test.Hspec.QuickCheck -import Test.QuickCheck (forAll, Property, vectorOf, Gen, Arbitrary (arbitrary)) -import Test.QuickCheck.Monadic (assert, monadicIO, run) - -import qualified Streamly.Internal.Data.Array as Array -import qualified Streamly.Internal.Data.Fold as Fold -import qualified Streamly.Internal.Data.Parser as Parser -import qualified Streamly.Internal.Data.Stream as Stream -import qualified Test.Hspec as Hspec - -import Prelude hiding (sequence) - -#if MIN_VERSION_QuickCheck(2,14,0) - -import Test.QuickCheck (chooseAny) - -#else - -import System.Random (Random(random)) -import Test.QuickCheck.Gen (Gen(MkGen)) - --- | Generates a random element over the natural range of `a`. -chooseAny :: Random a => Gen a -chooseAny = MkGen (\r _ -> let (x,_) = random r in x) - -#endif - -maxTestCount :: Int -maxTestCount = 100 - -chunksOf :: Monad m - => Int -> Fold.Fold m a b -> Stream.Stream m a -> Stream.Stream m b -chunksOf n f = Stream.foldMany (Fold.take n f) - -parseBreak :: Property -parseBreak = do - let len = 200 - -- ls = input list (stream) - -- clen = chunk size - -- tlen = parser take size - forAll - ((,,) - <$> vectorOf len (chooseAny :: Gen Int) - <*> chooseInt (1, len) - <*> chooseInt (0, len)) - $ \(ls, clen, tlen) -> - monadicIO $ do - (ls1, str) <- - let input = - Stream.toStreamK - $ chunksOf - clen (Array.createOf clen) (Stream.fromList ls) - parser = Parser.fromFold (Fold.take tlen Fold.toList) - in run $ Array.parseBreak (Array.toParserK parser) input - ls2 <- run $ Stream.fold Fold.toList (Array.concat $ Stream.fromStreamK str) - case ls1 of - Right x -> listEquals (==) (x ++ ls2) ls - Left _ -> assert False - -splitOnSuffix :: Word8 -> [Word8] -> [[Word8]] -> IO () -splitOnSuffix sep inp out = do - res <- - Stream.fold Fold.toList - $ Array.compactEndByByte_ sep - $ chunksOf 2 (Array.createOf 2) $ Stream.fromList inp - fmap Array.toList res `shouldBe` out - -------------------------------------------------------------------------------- --- Main -------------------------------------------------------------------------------- - -moduleName :: String -moduleName = "Data.Array.Stream" - --- Instead of hard coding 10000 here we can have maxStreamLength for operations --- that use stream of arrays. - -concatArrayW8 :: Property -concatArrayW8 = - forAll (vectorOf 10000 (arbitrary :: Gen Word8)) - $ \w8List -> do - let w8ArrList = Array.fromList . (: []) <$> w8List - f2 <- Stream.fold Fold.toList $ Array.concat $ Stream.fromList w8ArrList - w8List `shouldBe` f2 - - -main :: IO () -main = - hspec $ - Hspec.parallel $ - modifyMaxSuccess (const maxTestCount) $ do - describe moduleName $ do - describe "Stream parsing" $ do - prop "parseBreak" parseBreak - prop "concatArrayW8" concatArrayW8 - describe "splifOnSuffix" $ do - Hspec.it "splitOnSuffix 0 [1, 2, 0, 4, 0, 5, 6]" - $ splitOnSuffix 0 [1, 2, 0, 4, 0, 5, 6] - [[1, 2], [4], [5, 6]] - Hspec.it "splitOnSuffix 0 [1, 2, 0, 4, 0, 5, 6, 0]" - $ splitOnSuffix 0 [1, 2, 0, 4, 0, 5, 6, 0] - [[1, 2], [4], [5, 6]] - Hspec.it "splitOnSuffix 0 [0, 1, 2, 0, 4, 0, 5, 6]" - $ splitOnSuffix 0 [0, 1, 2, 0, 4, 0, 5, 6] - [[], [1, 2], [4], [5, 6]] diff --git a/test/Streamly/Test/Data/Array/Type.hs b/test/Streamly/Test/Data/Array/Type.hs new file mode 100644 index 0000000000..b9dede7ef0 --- /dev/null +++ b/test/Streamly/Test/Data/Array/Type.hs @@ -0,0 +1,157 @@ +-- | +-- Module : Streamly.Test.Data.Array.Type +-- Copyright : (c) 2019 Composewell Technologies +-- License : BSD-3-Clause +-- Maintainer : streamly@composewell.com +-- Stability : experimental +-- Portability : GHC + +module Streamly.Test.Data.Array.Type (typeMain, main) where + +import Data.Proxy (Proxy(..)) +import Data.Word (Word8, Word16) +import Foreign.ForeignPtr (newForeignPtr_, withForeignPtr) +import Foreign.Storable (peek) +import GHC.Ptr (plusPtr, Ptr(..)) +import Streamly.Internal.Data.MutByteArray (sizeOf) +import System.Mem (performMajorGC) +import Test.Hspec (hspec, describe, it, shouldBe, shouldReturn, SpecWith) +import Test.Hspec.QuickCheck +import Test.QuickCheck (Property, forAll, Gen, vectorOf, arbitrary, choose) +import Test.QuickCheck.Monadic (monadicIO, assert, run) + +import Streamly.Data.Fold (Fold) +import Streamly.Internal.Data.Stream (Stream) +import Streamly.Internal.System.IO (defaultChunkSize) +import Streamly.Test.Common (listEquals, performGCSweep) + +import qualified Streamly.Data.Fold as Fold +import qualified Streamly.Internal.Data.Array as A +import qualified Streamly.Internal.Data.Array as Arr +import qualified Streamly.Internal.Data.MutArray as MA +import qualified Streamly.Internal.Data.Stream as S +import qualified Streamly.Internal.Data.Stream as Stream +import qualified Test.Hspec as Hspec + +type Array = A.Array + +moduleName :: String +moduleName = "Data.Array" + +#include "Streamly/Test/Data/MutArray/Common.hs" +#include "Streamly/Test/Data/Array/TypeCommon.hs" + +testBreakOn :: [Word8] -> Word8 -> [Word8] -> Maybe [Word8] -> IO () +testBreakOn inp sep bef aft = do + (bef_, aft_) <- A.breakEndByWord8_ sep (A.fromList inp) + bef_ `shouldBe` A.fromList bef + aft_ `shouldBe` fmap A.fromList aft + +getIntList :: Ptr Int -> Int -> IO [Int] +getIntList ptr byteLen = do + performMajorGC + getList ptr (ptr `plusPtr` byteLen) + + where + + sizeOfInt = sizeOf (Proxy :: Proxy Int) + + getList p limitP + | p >= limitP = return [] + getList p limitP = do + val <- peek p + rest <- getList (p `plusPtr` sizeOfInt) limitP + return $ val : rest + +testUnsafePinnedAsPtr :: IO () +testUnsafePinnedAsPtr = do + arr <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Int]) + let arr1 = A.unsafeFreeze arr + A.unsafePinnedAsPtr arr1 getIntList `shouldReturn` [10 .. 59] + +testUnsafeAsForeignPtr :: IO () +testUnsafeAsForeignPtr = do + arr <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Int]) + let arr1 = A.unsafeFreeze arr + A.unsafeAsForeignPtr arr1 getIntList1 `shouldReturn` [10 .. 59] + where + getIntList1 fp blen = withForeignPtr fp $ \p -> getIntList p blen + +testForeignPtrConversionId :: IO () +testForeignPtrConversionId = do + arr0 <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Word8]) + let arr = A.unsafeFreeze arr0 + A.unsafeAsForeignPtr arr $ \a b -> do + res <- A.unsafeFromForeignPtr a b + performGCSweep 4 100000 + res `shouldBe` arr + +testUnsafeFromForeignPtr :: IO () +testUnsafeFromForeignPtr = do + arr0 <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Word8]) + let arr = A.unsafeFreeze arr0 + A.unsafePinnedAsPtr arr $ \ptr len -> do + fptr <- newForeignPtr_ ptr + performMajorGC + A.unsafeFromForeignPtr fptr len `shouldReturn` arr + +testFromCString# :: IO () +testFromCString# = do + arr0 <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Word8]) + let arr = A.unsafeFreeze arr0 + A.unsafePinnedAsPtr (arr <> A.fromList [0]) $ \(Ptr addr#) _ -> do + arr1 <- A.fromCString# addr# + performGCSweep 4 100000 + arr1 `shouldBe` arr + +testFromW16CString# :: IO () +testFromW16CString# = do + arr0 <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Word16]) + let arr = A.unsafeFreeze arr0 + A.unsafePinnedAsPtr (arr <> A.fromList [0]) $ \(Ptr addr#) _ -> do + arr1 <- A.fromW16CString# addr# + performGCSweep 4 100000 + arr1 `shouldBe` arr + +testConcatArrayW8 :: Property +testConcatArrayW8 = + forAll (vectorOf 10000 (arbitrary :: Gen Word8)) + $ \w8List -> do + let w8ArrList = A.fromList . (: []) <$> w8List + f2 <- S.fold Fold.toList $ A.concat $ S.fromList w8ArrList + w8List `shouldBe` f2 + +-- Tests for exports of the Streamly.Internal.Data.Array.Type source module. +typeMain :: SpecWith () +typeMain = do + -- IMPORTANT NOTE: Before adding any test here first consider if it can + -- be added to the Array/TypeCommon test module. Only those tests which are + -- specific to the Unboxed Array module and do not apply to the Generic + -- Array module should be added here. + + it "unsafePinnedAsPtr" testUnsafePinnedAsPtr + describe "unsafeAsForeignPtr" $ do + it "read via Ptr" testUnsafeAsForeignPtr + it "roundtrip with unsafeFromForeignPtr" testForeignPtrConversionId + -- Random Access / Slicing (Array.Type) + describe "breakEndByWord8_" $ do + it "[1,0,2] sep=0" (testBreakOn [1, 0, 2] 0 [1] (Just [2])) + it "[1,0] sep=0" (testBreakOn [1, 0] 0 [1] (Just [])) + it "[1] sep=0" (testBreakOn [1] 0 [1] Nothing) + prop "unsafeCreateOf" (foldManyWith (\n -> Fold.take n (A.unsafeCreateOf n))) + it "fromCString#" testFromCString# + it "fromW16CString#" testFromW16CString# + it "unsafeFromForeignPtr" testUnsafeFromForeignPtr + + -- Stream of Arrays + prop "concat" testConcatArrayW8 + +main :: IO () +main = + hspec $ + Hspec.parallel $ + modifyMaxSuccess (const maxTestCount) $ + describe moduleName $ do + arrayCommon + typeCommon + typeMain diff --git a/test/Streamly/Test/Data/Array/TypeCommon.hs b/test/Streamly/Test/Data/Array/TypeCommon.hs new file mode 100644 index 0000000000..49806ac3cc --- /dev/null +++ b/test/Streamly/Test/Data/Array/TypeCommon.hs @@ -0,0 +1,187 @@ + +#include "MachDeps.h" + +maxArrLen :: Int +maxArrLen = defaultChunkSize * 8 + +genericTestFrom :: + (Int -> Stream IO Int -> IO (Array Int)) + -> Property +genericTestFrom arrFold = + forAll (choose (0, maxArrLen)) $ \len -> + forAll (vectorOf len (arbitrary :: Gen Int)) $ \list -> + monadicIO $ do + arr <- run $ arrFold len $ S.fromList list + assert (A.length arr == len) + +testLength :: Property +testLength = genericTestFrom (S.fold . A.createOf) + +testLengthFromStreamN :: Property +testLengthFromStreamN = genericTestFrom A.fromStreamN + +genericTestFromTo :: + (Int -> Stream IO Int -> IO (Array Int)) + -> (Array Int -> Stream IO Int) + -> ([Int] -> [Int] -> Bool) + -> Property +genericTestFromTo arrFold arrUnfold listEq = + forAll (choose (0, maxArrLen)) $ \len -> + forAll (vectorOf len (arbitrary :: Gen Int)) $ \list -> + monadicIO $ do + arr <- run $ arrFold len $ S.fromList list + xs <- run $ S.fold Fold.toList $ arrUnfold arr + assert (listEq xs list) + + +testFoldNUnfold :: Property +testFoldNUnfold = + genericTestFromTo (S.fold . A.createOf) (S.unfold A.reader) (==) + +testFoldNToStream :: Property +testFoldNToStream = + genericTestFromTo (S.fold . A.createOf) A.read (==) + +testFoldNToStreamRev :: Property +testFoldNToStreamRev = + genericTestFromTo + (S.fold . A.createOf) + A.readRev + (\xs list -> xs == reverse list) + +testFromStreamNUnfold :: Property +testFromStreamNUnfold = + genericTestFromTo A.fromStreamN (S.unfold A.reader) (==) + +testFromStreamNToStream :: Property +testFromStreamNToStream = genericTestFromTo A.fromStreamN A.read (==) + +testFromListN :: Property +testFromListN = + forAll (choose (0, maxArrLen)) $ \len -> + forAll (choose (0, len)) $ \n -> + forAll (vectorOf len (arbitrary :: Gen Int)) $ \list -> + monadicIO $ do + let arr = A.fromListN n list + xs <- run $ S.fold Fold.toList $ S.unfold A.reader arr + listEquals (==) xs (take n list) + +foldManyWith :: (Int -> Fold IO Int (Array Int)) -> Property +foldManyWith f = + forAll (choose (0, maxArrLen)) $ \len -> + forAll (vectorOf len (arbitrary :: Gen Int)) $ \list -> + monadicIO $ do + xs <- run + $ S.fold Fold.toList + $ S.unfoldEach A.reader + $ S.foldMany (f 240) + $ S.fromList list + assert (xs == list) + +testWrite :: [Char] -> IO () +testWrite inp = do + arr <- S.fold A.create (S.fromList inp) + A.toList arr `shouldBe` inp + +testFromToList :: [Char] -> IO () +testFromToList inp = A.toList (A.fromList inp) `shouldBe` inp + +testFoldUnfold :: Property +testFoldUnfold = + genericTestFromTo (const (S.fold A.create)) (S.unfold A.reader) (==) + +testFromList :: Property +testFromList = + forAll (choose (0, maxArrLen)) $ \len -> + forAll (vectorOf len (arbitrary :: Gen Int)) $ \list -> + monadicIO $ do + let arr = A.fromList list + xs <- run $ S.fold Fold.toList $ S.unfold A.reader arr + assert (xs == list) + +testLengthFromStream :: Property +testLengthFromStream = genericTestFrom (const A.fromStream) + +testFromStreamToStream :: Property +testFromStreamToStream = genericTestFromTo (const A.fromStream) A.read (==) + +unsafeSlice :: Int -> Int -> [Int] -> Bool +unsafeSlice i n list = + let lst = take n $ drop i list + arr = A.toList $ A.unsafeSliceOffLen i n $ A.fromList list + in arr == lst + +lastN :: Int -> [a] -> [a] +lastN n l = drop (length l - n) l + +testLastN :: Property +testLastN = + forAll (choose (0, maxArrLen)) $ \len -> + forAll (choose (0, len)) $ \n -> + forAll (vectorOf len (arbitrary :: Gen Int)) $ \list -> + monadicIO $ do + xs <- run + $ fmap A.toList + $ S.fold (A.createOfLast n) + $ S.fromList list + assert (xs == lastN n list) + +testLastN_LN :: Int -> Int -> IO Bool +testLastN_LN len n = do + let list = [1..len] + l1 <- fmap A.toList $ S.fold (A.createOfLast n) $ S.fromList list + let l2 = lastN n list + return $ l1 == l2 + +testUnsafeGetIndex :: [Char] -> IO () +testUnsafeGetIndex inp = + let arr = A.fromList inp + in fmap (`A.unsafeGetIndex` arr) [0 .. (length inp - 1)] `shouldBe` inp + +testReadShowInstance :: Property +testReadShowInstance = + forAll (choose (0, maxArrLen)) $ \len -> + forAll (vectorOf len (arbitrary :: Gen Int)) $ \list -> + monadicIO $ do + let arr = A.fromList list + assert (A.toList (read (show arr)) == list) + +typeCommon :: SpecWith () +typeCommon = do + describe "createOf" $ do + prop "length . createOf n === n" testLength + prop "reader . createOf === id" testFoldNUnfold + prop "read . createOf === id" testFoldNToStream + prop "readRev . createOf === reverse" testFoldNToStreamRev + prop "foldMany concats to original" (foldManyWith A.createOf) + describe "create" $ do + prop "reader . create === id" testFoldUnfold + it "abc" (testWrite "abc") + it "\\22407" (testWrite "\22407") + describe "createOfLast" $ do + prop "0 <= n <= len" testLastN + it "-1" (testLastN_LN 10 (-1) `shouldReturn` True) + it "0" (testLastN_LN 10 0 `shouldReturn` True) + it "length" (testLastN_LN 10 10 `shouldReturn` True) + it "length + 1" (testLastN_LN 10 11 `shouldReturn` True) + describe "fromStreamN" $ do + prop "length . fromStreamN n === n" testLengthFromStreamN + prop "reader . fromStreamN === id" testFromStreamNUnfold + prop "read . fromStreamN === id" testFromStreamNToStream + describe "fromStream" $ do + prop "length . fromStream === n" testLengthFromStream + prop "read . fromStream === id" testFromStreamToStream + prop "fromListN" testFromListN + describe "fromList" $ do + prop "reader . fromList === id" testFromList + it "abc" (testFromToList "abc") + it "\\22407" (testFromToList "\22407") + prop "show/read roundtrip" testReadShowInstance + -- Random Access + describe "unsafeGetIndex" $ do + it "abc" (testUnsafeGetIndex "abc") + it "\\22407" (testUnsafeGetIndex "\22407") + describe "unsafeSliceOffLen" $ do + it "partial" $ unsafeSlice 2 4 [1..10] + it "none" $ unsafeSlice 10 0 [1..10] + it "full" $ unsafeSlice 0 10 [1..10] diff --git a/test/Streamly/Test/Data/MutArray.hs b/test/Streamly/Test/Data/MutArray.hs index 6c23b60e4e..f56ba9c809 100644 --- a/test/Streamly/Test/Data/MutArray.hs +++ b/test/Streamly/Test/Data/MutArray.hs @@ -1,153 +1,164 @@ +-- | +-- Module : Streamly.Test.Data.MutArray +-- Copyright : (c) 2019 Composewell Technologies +-- License : BSD-3-Clause +-- Maintainer : streamly@composewell.com +-- Stability : experimental +-- Portability : GHC + module Streamly.Test.Data.MutArray (main) where -import Test.QuickCheck (listOf) - -import Control.Monad (void) -import Data.Complex (Complex) -import Data.Functor.Const (Const) -import Data.Functor.Identity (Identity) -import Foreign.Ptr (IntPtr, WordPtr) -import GHC.Exts -import GHC.Fingerprint.Type (Fingerprint(..)) -import GHC.Int (Int16(..), Int32(..), Int64(..), Int8(..)) -import GHC.Real (Ratio(..)) -import GHC.Stable (StablePtr(..)) -import GHC.Word (Word16(..), Word32(..), Word64(..), Word8(..)) -import Streamly.Internal.Data.MutByteArray (Unbox) -import Streamly.Test.Common (chooseInt) -import Test.Hspec (hspec, describe, it) +import GHC.Word (Word8(..)) +import Streamly.Internal.Data.MutArray (MutArray) +import Test.Hspec (hspec, describe, it, shouldBe, SpecWith) import Test.Hspec.QuickCheck -import Test.QuickCheck (forAll, Property) -import Test.QuickCheck.Monadic (monadicIO, assert) -#if MIN_VERSION_base(4,15,0) -import GHC.IO.SubSystem (IoSubSystem (..)) -#endif +import Test.QuickCheck (forAll, listOf, Property, Gen, arbitrary) +import qualified Streamly.Data.Fold as Fold import qualified Streamly.Internal.Data.MutArray as MArray import qualified Streamly.Internal.Data.Stream as Stream import qualified Test.Hspec as Hspec -maxTestCount :: Int -maxTestCount = 100 +import Streamly.Test.Common (chooseInt) +import Streamly.Test.Data.MutArray.Type (typeMain) moduleName :: String moduleName = "Data.MutArray" -testAppend :: Property -testAppend = - forAll (listOf (chooseInt (-50, 100))) $ \ls0 -> - monadicIO $ action ls0 - - where - - action ls = do - arr0 <- MArray.emptyOf' 0 - x <- Stream.fold - (MArray.append2 arr0) - (Stream.fromList (ls::[Int])) - lst <- MArray.toList x - assert (ls == lst) - -#define TEST_IE(_type) it "_type" $ testIE ([] :: [_type]) - --- XXX This should be in test/Data.Unbox --- C-ish foreign types are platfor specific. The platform needs to be taken into --- consideration when making instances. -testUnboxInstanceExistance :: Hspec.SpecWith () -testUnboxInstanceExistance = do - describe "Unbox instances" $ do - -- TEST_IE(CBool) - -- TEST_IE(CChar) - -- TEST_IE(CClock) - -- TEST_IE(CDouble) - -- TEST_IE(CFloat) - -- TEST_IE(CInt) - -- TEST_IE(CIntMax) - -- TEST_IE(CIntPtr) - -- TEST_IE(CLLong) - -- TEST_IE(CLong) - -- TEST_IE(CPtrdiff) - -- TEST_IE(CSChar) - -- TEST_IE(CSUSeconds) - -- TEST_IE(CShort) - -- TEST_IE(CSigAtomic) - -- TEST_IE(CSize) - -- TEST_IE(CTime) - -- TEST_IE(CUChar) - -- TEST_IE(CUInt) - -- TEST_IE(CUIntMax) - -- TEST_IE(CUIntPtr) - -- TEST_IE(CULLong) - -- TEST_IE(CULong) - -- TEST_IE(CUSeconds) - -- TEST_IE(CUShort) - -- TEST_IE(CWchar) - TEST_IE(IntPtr) - TEST_IE(WordPtr) - TEST_IE(Fingerprint) - TEST_IE(Int16) - TEST_IE(Int32) - TEST_IE(Int64) - TEST_IE(Int8) -#if MIN_VERSION_base(4,15,0) - TEST_IE(IoSubSystem) -#endif - TEST_IE(Word16) - TEST_IE(Word32) - TEST_IE(Word64) - TEST_IE(Word8) - -- TEST_IE(CBlkCnt) - -- TEST_IE(CBlkSize) - -- TEST_IE(CCc) - -- TEST_IE(CClockId) - -- TEST_IE(CDev) - -- TEST_IE(CFsBlkCnt) - -- TEST_IE(CFsFilCnt) - -- TEST_IE(CGid) - -- TEST_IE(CId) - -- TEST_IE(CIno) - -- TEST_IE(CKey) - -- TEST_IE(CMode) - -- TEST_IE(CNfds) - -- TEST_IE(CNlink) - -- TEST_IE(COff) - -- TEST_IE(CPid) - -- TEST_IE(CRLim) - -- TEST_IE(CSocklen) - -- TEST_IE(CSpeed) - -- TEST_IE(CSsize) - -- TEST_IE(CTcflag) - -- TEST_IE(CTimer) - -- TEST_IE(CUid) - -- TEST_IE(Fd) - TEST_IE(()) - TEST_IE(Bool) - TEST_IE(Char) - TEST_IE(Double) - TEST_IE(Float) - TEST_IE(Int) - TEST_IE(Word) - TEST_IE(Complex Int) - TEST_IE(Identity Int) -#if MIN_VERSION_base(4,14,0) - TEST_IE(Down Int) +maxTestCount :: Int +#ifdef DEVBUILD +maxTestCount = 100 +#else +maxTestCount = 10 #endif - TEST_IE(FunPtr Int) - TEST_IE(Ptr Int) - TEST_IE(Ratio Int) - TEST_IE(StablePtr Int) - TEST_IE(Const Int Int) - where - testIE :: Unbox a => [a] -> IO () - testIE lst = void $ MArray.fromList lst +------------------------------------------------------------------------------- +-- MutArray module +------------------------------------------------------------------------------- + +testIndexerFromLen :: IO () +testIndexerFromLen = do + arr <- MArray.fromList ([1..10] :: [Int]) + pairs <- Stream.fold Fold.toList + $ Stream.unfold (MArray.indexerFromLen 0 3) arr + pairs `shouldBe` [(0,3),(3,3),(6,3),(9,1)] + +testSplitterFromLen :: IO () +testSplitterFromLen = do + arr <- MArray.fromList ([1..10] :: [Int]) + slices <- Stream.fold Fold.toList + $ Stream.unfold (MArray.splitterFromLen 0 3) arr + lsts <- mapM MArray.toList slices + lsts `shouldBe` [[1,2,3],[4,5,6],[7,8,9],[10]] + +testCompactMax :: IO () +testCompactMax = do + arrs <- mapM MArray.fromList ([[1,2],[3,4],[5,6],[7,8]] :: [[Int]]) + result <- Stream.fold Fold.toList + $ MArray.compactMax 4 + $ Stream.fromList arrs + lsts <- mapM MArray.toList result + lsts `shouldBe` [[1,2,3,4],[5,6,7,8]] + +testCompactMax' :: IO () +testCompactMax' = do + arrs <- mapM MArray.fromList ([[1,2],[3,4]] :: [[Int]]) + result <- Stream.fold Fold.toList + $ MArray.compactMax' 4 + $ Stream.fromList arrs + lsts <- mapM MArray.toList result + lsts `shouldBe` [[1,2,3,4]] + +testCompactSepByByte_ :: IO () +testCompactSepByByte_ = do + arr1 <- MArray.fromList ([1,2,0,3] :: [Word8]) + arr2 <- MArray.fromList ([4,0,5] :: [Word8]) + result <- Stream.fold Fold.toList + $ MArray.compactSepByByte_ 0 + $ Stream.fromList [arr1, arr2] + lsts <- mapM MArray.toList result + lsts `shouldBe` [[1,2],[3,4],[5]] + +testCompactEndByByte_ :: IO () +testCompactEndByByte_ = do + arr1 <- MArray.fromList ([1,2,0,3] :: [Word8]) + arr2 <- MArray.fromList ([4,0,5] :: [Word8]) + result <- Stream.fold Fold.toList + $ MArray.compactEndByByte_ 0 + $ Stream.fromList [arr1, arr2] + lsts <- mapM MArray.toList result + lsts `shouldBe` [[1,2],[3,4],[5]] + +testCompactEndByLn_ :: IO () +testCompactEndByLn_ = do + arr1 <- MArray.fromList ([1,2,10,3] :: [Word8]) + arr2 <- MArray.fromList ([4,10,5,6] :: [Word8]) + result <- Stream.fold Fold.toList + $ MArray.compactEndByLn_ + $ Stream.fromList [arr1, arr2] + lsts <- mapM MArray.toList result + lsts `shouldBe` [[1,2],[3,4],[5,6]] + +lastN :: Int -> [a] -> [a] +lastN n xs = drop (max 0 (length xs - n)) xs + +testCreateOfLast :: Property +testCreateOfLast = + forAll (chooseInt (0, 20)) $ \n -> + forAll (listOf (arbitrary :: Gen Int)) $ \ls -> do + arr <- Stream.fold (MArray.createOfLast n) (Stream.fromList ls) + lst <- MArray.toList arr + lst `shouldBe` lastN n ls + +testSerializeDeserialize :: IO () +testSerializeDeserialize = do + let val = 42 :: Int + arr <- MArray.serialize MArray.empty val + (result, _) <- MArray.deserialize arr :: IO (Int, MutArray Word8) + result `shouldBe` val + +testSerializeDeserializeMultiple :: IO () +testSerializeDeserializeMultiple = do + let x = 1 :: Int + y = 2 :: Int + arr <- MArray.serialize MArray.empty x + arr1 <- MArray.serialize arr y + (v1, arr2) <- MArray.deserialize arr1 :: IO (Int, MutArray Word8) + (v2, _) <- MArray.deserialize arr2 :: IO (Int, MutArray Word8) + v1 `shouldBe` x + v2 `shouldBe` y + +mutArrayMain :: SpecWith () +mutArrayMain = do + -- IMPORTANT NOTE: Before adding any test here first consider if it can be + -- added to the MutArray/TypeCommon test module. Only those tests which are + -- specific to the Unboxed MutArray module and do not apply to the Generic + -- MutArray module should be added here. + describe "indexerFromLen" $ do + it "basic" testIndexerFromLen + describe "splitterFromLen" $ do + it "basic" testSplitterFromLen + describe "compactMax" $ do + it "coalesces small arrays" testCompactMax + describe "compactMax'" $ do + it "coalesces to pinned" testCompactMax' + describe "compactSepByByte_" $ do + it "splits on separator" testCompactSepByByte_ + describe "compactEndByByte_" $ do + it "splits on suffix" testCompactEndByByte_ + describe "compactEndByLn_" $ do + it "splits on newline" testCompactEndByLn_ + describe "createOfLast" $ do + prop "last n elements" testCreateOfLast + describe "serialize/deserialize" $ do + it "roundtrip" testSerializeDeserialize + it "multiple values" testSerializeDeserializeMultiple main :: IO () main = hspec $ Hspec.parallel $ - modifyMaxSuccess (const maxTestCount) $ do - describe moduleName $ do - describe "Stream Append" $ do - prop "testAppend" testAppend - testUnboxInstanceExistance + modifyMaxSuccess (const maxTestCount) $ + describe moduleName $ do + typeMain + mutArrayMain diff --git a/test/Streamly/Test/Data/MutArray/Common.hs b/test/Streamly/Test/Data/MutArray/Common.hs new file mode 100644 index 0000000000..e48823cab1 --- /dev/null +++ b/test/Streamly/Test/Data/MutArray/Common.hs @@ -0,0 +1,104 @@ + +-- Coverage build takes too long with default number of tests +maxTestCount :: Int +#ifdef DEVBUILD +maxTestCount = 100 +#else +maxTestCount = 10 +#endif + +------------------------------------------------------------------------------- +-- Construction +------------------------------------------------------------------------------- + +testFromStream :: IO () +testFromStream = do + arr <- Arr.fromStream $ Stream.fromList ([1..5] :: [Int]) + lst <- Stream.fold Fold.toList $ Arr.read arr + lst `shouldBe` [1..5] + +testFromStreamN :: IO () +testFromStreamN = do + arr <- Arr.fromStreamN 5 $ Stream.fromList ([1..10] :: [Int]) + lst <- Stream.fold Fold.toList $ Arr.read arr + lst `shouldBe` [1..5] + +testCreateOf :: IO () +testCreateOf = do + arr <- Stream.fold (Arr.createOf 5) $ Stream.fromList ([1..10] :: [Int]) + lst <- Stream.fold Fold.toList $ Arr.read arr + lst `shouldBe` [1..5] + Arr.length arr `shouldBe` 5 + +testCreate :: IO () +testCreate = do + arr <- Stream.fold Arr.create $ Stream.fromList ([1..5] :: [Int]) + lst <- Stream.fold Fold.toList $ Arr.read arr + lst `shouldBe` [1..5] + +------------------------------------------------------------------------------- +-- Size +------------------------------------------------------------------------------- + +testLengthCommon :: IO () +testLengthCommon = do + arr <- Arr.fromStream $ Stream.fromList ([1..10] :: [Int]) + Arr.length arr `shouldBe` 10 + +------------------------------------------------------------------------------- +-- Reading / Streaming +------------------------------------------------------------------------------- + +testRead :: IO () +testRead = do + arr <- Arr.fromStream $ Stream.fromList ([1..5] :: [Int]) + lst <- Stream.fold Fold.toList $ Arr.read arr + lst `shouldBe` [1..5] + +testReadRev :: IO () +testReadRev = do + arr <- Arr.fromStream $ Stream.fromList ([1..5] :: [Int]) + lst <- Stream.fold Fold.toList $ Arr.readRev arr + lst `shouldBe` [5, 4, 3, 2, 1] + +testReader :: IO () +testReader = do + arr <- Arr.fromStream $ Stream.fromList ([1..5] :: [Int]) + lst <- Stream.fold Fold.toList $ Stream.unfold Arr.reader arr + lst `shouldBe` [1..5] + +------------------------------------------------------------------------------- +-- Stream of arrays +------------------------------------------------------------------------------- + +testChunksOf :: IO () +testChunksOf = do + chunks <- + Stream.fold Fold.toList + $ Arr.chunksOf 3 + $ Stream.fromList ([1..10] :: [Int]) + lsts <- mapM (Stream.fold Fold.toList . Arr.read) chunks + lsts `shouldBe` [[1, 2, 3], [4, 5, 6], [7, 8, 9], [10]] + +-- Tests common to all array variants: unboxed/boxed and mutable/immutable. Only +-- tests whose functions are present and have the same (monadic) shape in every +-- variant should be added here. Arrays are constructed and read back via the +-- stream API so the same code works for both the pure immutable Array and the +-- monadic MutArray. See MutArray/TypeCommon.hs for tests specific to the mutable +-- variants. +arrayCommon :: SpecWith () +arrayCommon = do + -- Construction + it "fromStream" testFromStream + it "fromStreamN" testFromStreamN + describe "createOf" $ do + it "takes n elements" testCreateOf + it "create" testCreate + -- Size + it "length" testLengthCommon + -- Reading + it "read" testRead + it "readRev" testReadRev + it "reader" testReader + -- Stream of arrays + it "chunksOf" testChunksOf diff --git a/test/Streamly/Test/Data/MutArray/Generic.hs b/test/Streamly/Test/Data/MutArray/Generic.hs new file mode 100644 index 0000000000..ddb30fa837 --- /dev/null +++ b/test/Streamly/Test/Data/MutArray/Generic.hs @@ -0,0 +1,39 @@ +-- | +-- Module : Streamly.Test.Data.MutArray.Generic +-- Copyright : (c) 2019 Composewell Technologies +-- License : BSD-3-Clause +-- Maintainer : streamly@composewell.com +-- Stability : experimental +-- Portability : GHC + +module Streamly.Test.Data.MutArray.Generic (main) where + +import Control.Monad.IO.Class (liftIO) +import Data.Char (isLower) +import Test.Hspec as H +import Test.Hspec.QuickCheck + +import qualified Streamly.Data.Fold as Fold +import qualified Streamly.Internal.Data.MutArray.Generic as MArray +import qualified Streamly.Internal.Data.MutArray.Generic as Arr +import qualified Streamly.Internal.Data.Stream as Stream + +moduleName :: String +moduleName = "Data.MutArray.Generic" + +#include "Streamly/Test/Data/MutArray/Common.hs" +#include "Streamly/Test/Data/MutArray/TypeCommon.hs" + +main :: IO () +main = + hspec $ + H.parallel $ + modifyMaxSuccess (const maxTestCount) $ do + describe moduleName $ do + arrayCommon + typeCommon + -- IMPORTANT NOTE: Before adding any test here first consider if it + -- can be added to the MutArray/Common (all variants) or + -- MutArray/TypeCommon (mutable variants) test module. Only those + -- tests which are specific to the Generic MutArray module and do not + -- apply to the Unboxed MutArray module should be added here. diff --git a/test/Streamly/Test/Data/MutArray/Type.hs b/test/Streamly/Test/Data/MutArray/Type.hs new file mode 100644 index 0000000000..940c858631 --- /dev/null +++ b/test/Streamly/Test/Data/MutArray/Type.hs @@ -0,0 +1,1002 @@ +-- | +-- Module : Streamly.Test.Data.MutArray.Type +-- Copyright : (c) 2019 Composewell Technologies +-- License : BSD-3-Clause +-- Maintainer : streamly@composewell.com +-- Stability : experimental +-- Portability : GHC + +module Streamly.Test.Data.MutArray.Type (typeMain, main) where + +import Control.Monad.IO.Class (liftIO) +import Data.Char (isLower, ord) +import Data.List (sort) +import Data.Proxy (Proxy(..)) +import Foreign.Storable (peek) +import GHC.Exts +import GHC.Ptr (plusPtr) +import GHC.Word (Word16(..), Word8(..)) +import Streamly.Internal.Data.MutArray (MutArray) +import Streamly.Internal.Data.MutByteArray (Unbox, sizeOf) +import Streamly.Test.Common (chooseInt) +import System.Mem (performMajorGC) +import Test.Hspec (hspec, describe, it, shouldBe, shouldReturn, SpecWith) +import Test.Hspec.QuickCheck +import Test.QuickCheck (forAll, listOf, Property, vectorOf, Gen, arbitrary) +import Test.QuickCheck.Monadic (monadicIO, assert) +import qualified Streamly.Data.Fold as Fold +import qualified Streamly.Internal.Data.MutArray as MArray +import qualified Streamly.Internal.Data.MutArray as Arr +import qualified Streamly.Internal.Data.Stream as Stream +import qualified Test.Hspec as Hspec + +moduleName :: String +moduleName = "Data.MutArray" + +#include "Streamly/Test/Data/MutArray/Common.hs" +#include "Streamly/Test/Data/MutArray/TypeCommon.hs" + +testAppend :: Property +testAppend = + forAll (listOf (chooseInt (-50, 100))) $ \ls0 -> + monadicIO $ action ls0 + + where + + action ls = do + arr0 <- MArray.emptyOf' 0 + x <- Stream.fold + (MArray.append2 arr0) + (Stream.fromList (ls::[Int])) + lst <- MArray.toList x + assert (ls == lst) + +getIntList :: Ptr Int -> Int -> IO [Int] +getIntList ptr byteLen = do + performMajorGC + getList ptr (ptr `plusPtr` byteLen) + + where + + sizeOfInt = sizeOf (Proxy :: Proxy Int) + + -- We need to be careful here. We assume Unboxed and Storable are compatible + -- with each other. For Int, they are compatible. + getList p limitP + | p >= limitP = return [] + getList p limitP = do + val <- peek p + rest <- getList (p `plusPtr` sizeOfInt) limitP + return $ val : rest + +testUnsafeAsPtr :: IO () +testUnsafeAsPtr = do + arr <- MArray.fromList ([0 .. 99] :: [Int]) + arr1 <- MArray.pin arr + MArray.unsafeAsPtr arr1 getIntList `shouldReturn` [0 .. 99] + +testByteLength :: forall a. Unbox a => a -> IO () +testByteLength _ = do + arrA <- MArray.emptyOf' 100 :: IO (MutArray a) + let arrW8 = MArray.unsafeCast arrA :: MutArray Word8 + MArray.byteLength arrA `shouldBe` MArray.length arrW8 + +testBubbleWith :: Bool -> Property +testBubbleWith asc = + forAll (listOf (chooseInt (-50, 100))) $ \ls0 -> + monadicIO $ action ls0 + + where + + action ls = do + x <- Stream.fold (fldm ls) $ Stream.fromList ls + lst <- MArray.toList x + if asc + then assert (sort ls == lst) + else assert (sort ls == reverse lst) + + fldm ls = + Fold.foldlM' + (\b a -> do + arr <- MArray.snoc b a + if asc + then MArray.bubble compare arr + else MArray.bubble (flip compare) arr + return arr + ) + (MArray.emptyOf' $ length ls) + +testBubbleAsc :: Property +testBubbleAsc = testBubbleWith True + +testBubbleDesc :: Property +testBubbleDesc = testBubbleWith False + +testReallocBytes :: Property +testReallocBytes = + let len = 10000 + bSize = len * sizeOf (Proxy :: Proxy Char) + in forAll (vectorOf len (arbitrary :: Gen Char)) $ \vec -> + forAll (chooseInt (bSize - 2000, bSize + 2000)) $ \newBLen -> do + arr <- MArray.fromList vec + arr1 <- MArray.reallocBytes newBLen arr + lst <- MArray.toList arr + lst1 <- MArray.toList arr1 + lst `shouldBe` lst1 + +------------------------------------------------------------------------------- +-- MutArray/Type.hs (Unboxed-only functions) +------------------------------------------------------------------------------- + +testPinUnpin :: IO () +testPinUnpin = do + arr <- MArray.fromList ([1..5] :: [Int]) + pinned <- MArray.pin arr + MArray.isPinned pinned `shouldBe` True + unpinned <- MArray.unpin pinned + MArray.isPinned unpinned `shouldBe` False + lst <- MArray.toList unpinned + lst `shouldBe` [1..5] + +testBreakEndByWord8_ :: IO () +testBreakEndByWord8_ = do + arr <- MArray.fromList ([1,2,0,3,4] :: [Word8]) + (before, mafter) <- MArray.breakEndByWord8_ 0 arr + MArray.toList before >>= (`shouldBe` [1,2]) + case mafter of + Nothing -> fail "expected Just after" + Just after -> MArray.toList after >>= (`shouldBe` [3,4]) + +testBreakEndByWord8_NotFound :: IO () +testBreakEndByWord8_NotFound = do + arr <- MArray.fromList ([1,2,3] :: [Word8]) + (before, mafter) <- MArray.breakEndByWord8_ 0 arr + MArray.toList before >>= (`shouldBe` [1,2,3]) + case mafter of + Just _ -> fail "expected Nothing" + Nothing -> return () + +testReverse :: IO () +testReverse = do + arr <- MArray.fromList ([1..5] :: [Int]) + MArray.reverse arr + lst <- MArray.toList arr + lst `shouldBe` [5,4,3,2,1] + +testFoldl' :: IO () +testFoldl' = do + arr <- MArray.fromList ([1..5] :: [Int]) + result <- MArray.foldl' (+) 0 arr + result `shouldBe` 15 + +testFoldr :: IO () +testFoldr = do + arr <- MArray.fromList ([1..5] :: [Int]) + result <- MArray.foldr (:) [] arr + result `shouldBe` [1..5] + +testFold :: IO () +testFold = do + arr <- MArray.fromList ([1..5] :: [Int]) + result <- MArray.fold Fold.sum arr + result `shouldBe` 15 + +testSplice :: IO () +testSplice = do + arr1 <- MArray.fromList ([1..5] :: [Int]) + arr2 <- MArray.fromList ([6..10] :: [Int]) + arr3 <- MArray.splice arr1 arr2 + lst <- MArray.toList arr3 + lst `shouldBe` [1..10] + +testSplitEndBy_ :: IO () +testSplitEndBy_ = do + arr <- MArray.fromList ([1,2,0,3,4,0,5] :: [Word8]) + chunks <- Stream.fold Fold.toList $ MArray.splitEndBy_ (== 0) arr + lsts <- mapM MArray.toList chunks + lsts `shouldBe` [[1,2],[3,4],[5]] + +testGetIndexRev :: IO () +testGetIndexRev = do + arr <- MArray.fromList ([1..5] :: [Int]) + MArray.getIndexRev 0 arr `shouldReturn` 5 + MArray.getIndexRev 4 arr `shouldReturn` 1 + +------------------------------------------------------------------------------- +-- Pinned variants +------------------------------------------------------------------------------- + +testClone' :: IO () +testClone' = do + arr <- MArray.fromList ([1..5] :: [Int]) + arr2 <- MArray.clone' arr + MArray.isPinned arr2 `shouldBe` True + lst <- MArray.toList arr2 + lst `shouldBe` [1..5] + +testFromList' :: IO () +testFromList' = do + arr <- MArray.fromList' ([1..5] :: [Int]) + MArray.isPinned arr `shouldBe` True + lst <- MArray.toList arr + lst `shouldBe` [1..5] + +testFromListN' :: IO () +testFromListN' = do + arr <- MArray.fromListN' 5 ([1..10] :: [Int]) + MArray.isPinned arr `shouldBe` True + lst <- MArray.toList arr + lst `shouldBe` [1..5] + +testCreateOf' :: IO () +testCreateOf' = do + arr <- Stream.fold (MArray.createOf' 5) $ Stream.fromList ([1..10] :: [Int]) + MArray.isPinned arr `shouldBe` True + lst <- MArray.toList arr + lst `shouldBe` [1..5] + +testCreate' :: IO () +testCreate' = do + arr <- Stream.fold MArray.create' $ Stream.fromList ([1..5] :: [Int]) + MArray.isPinned arr `shouldBe` True + lst <- MArray.toList arr + lst `shouldBe` [1..5] + +testUnsafeCreateOf' :: IO () +testUnsafeCreateOf' = do + arr <- Stream.fold (MArray.unsafeCreateOf' 5) $ Stream.fromList ([1..5] :: [Int]) + MArray.isPinned arr `shouldBe` True + lst <- MArray.toList arr + lst `shouldBe` [1..5] + +------------------------------------------------------------------------------- +-- Reverse creation +------------------------------------------------------------------------------- + +testRevCreateOf :: IO () +testRevCreateOf = do + arr <- Stream.fold (MArray.revCreateOf 5) $ Stream.fromList ([1..5] :: [Int]) + lst <- MArray.toList arr + lst `shouldBe` [5,4,3,2,1] + +testFromListRev :: IO () +testFromListRev = do + arr <- MArray.fromListRev ([1..5] :: [Int]) + lst <- MArray.toList arr + lst `shouldBe` [5,4,3,2,1] + +testFromListRevN :: IO () +testFromListRevN = do + arr <- MArray.fromListRevN 5 ([1..10] :: [Int]) + lst <- MArray.toList arr + lst `shouldBe` [5,4,3,2,1] + +------------------------------------------------------------------------------- +-- From pure/chunked streams +------------------------------------------------------------------------------- + +testFromPureStreamN :: IO () +testFromPureStreamN = do + arr <- MArray.fromPureStreamN 5 (Stream.fromList ([1..10] :: [Int])) + lst <- MArray.toList arr + lst `shouldBe` [1..5] + +testFromPureStreamMin :: IO () +testFromPureStreamMin = do + arr <- MArray.fromPureStreamMin 3 (Stream.fromList ([1..5] :: [Int])) + lst <- MArray.toList arr + lst `shouldBe` [1..5] + +testFromChunksRealloced :: IO () +testFromChunksRealloced = do + arrs <- mapM MArray.fromList ([[1,2,3],[4,5,6]] :: [[Int]]) + arr <- MArray.fromChunksRealloced $ Stream.fromList arrs + lst <- MArray.toList arr + lst `shouldBe` [1..6] + +testFromChunksK :: IO () +testFromChunksK = do + arrs <- mapM MArray.fromList ([[1,2,3],[4,5,6]] :: [[Int]]) + arr <- MArray.fromChunksK $ Stream.toStreamK $ Stream.fromList arrs + lst <- MArray.toList arr + lst `shouldBe` [1..6] + +testBuildChunks :: IO () +testBuildChunks = do + sk <- Stream.fold (MArray.buildChunks 3) $ Stream.fromList ([1..7] :: [Int]) + arrs <- Stream.fold Fold.toList $ Stream.fromStreamK sk + lsts <- mapM MArray.toList arrs + lsts `shouldBe` [[1,2,3],[4,5,6],[7]] + +------------------------------------------------------------------------------- +-- Slicing +------------------------------------------------------------------------------- + +testUnsafeBreakAt :: IO () +testUnsafeBreakAt = do + arr <- MArray.fromList ([1..10] :: [Int]) + let (before, after) = MArray.unsafeBreakAt 3 arr + bl <- MArray.toList before + al <- MArray.toList after + bl `shouldBe` [1,2,3] + al `shouldBe` [4..10] + +testBreakAt :: IO () +testBreakAt = do + arr <- MArray.fromList ([1..10] :: [Int]) + let (before, after) = MArray.breakAt 3 arr + bl <- MArray.toList before + al <- MArray.toList after + bl `shouldBe` [1,2,3] + al `shouldBe` [4..10] + +------------------------------------------------------------------------------- +-- Element-aware slicing +------------------------------------------------------------------------------- + +testBreakEndBy :: IO () +testBreakEndBy = do + arr <- MArray.fromList "hello world" + (a, b) <- MArray.breakEndBy (== ' ') arr + MArray.toList a >>= (`shouldBe` "hello ") + MArray.toList b >>= (`shouldBe` "world") + +testBreakEndBy_ :: IO () +testBreakEndBy_ = do + arr <- MArray.fromList "hello world" + (a, b) <- MArray.breakEndBy_ (== ' ') arr + MArray.toList a >>= (`shouldBe` "hello") + MArray.toList b >>= (`shouldBe` "world") + +testDropWhile :: IO () +testDropWhile = do + arr <- MArray.fromList " hello" + arr' <- MArray.dropWhile (== ' ') arr + MArray.toList arr' >>= (`shouldBe` "hello") + +testRevBreakEndBy :: IO () +testRevBreakEndBy = do + arr <- MArray.fromList "hello world" + (a, b) <- MArray.revBreakEndBy (== ' ') arr + MArray.toList a >>= (`shouldBe` "hello") + MArray.toList b >>= (`shouldBe` " world") + +testRevBreakEndBy_ :: IO () +testRevBreakEndBy_ = do + arr <- MArray.fromList "hello world" + (a, b) <- MArray.revBreakEndBy_ (== ' ') arr + MArray.toList a >>= (`shouldBe` "hello") + MArray.toList b >>= (`shouldBe` "world") + +testRevDropWhile :: IO () +testRevDropWhile = do + arr <- MArray.fromList "hello " + arr' <- MArray.revDropWhile (== ' ') arr + MArray.toList arr' >>= (`shouldBe` "hello") + +------------------------------------------------------------------------------- +-- Casting +------------------------------------------------------------------------------- + +testAsBytes :: IO () +testAsBytes = do + arr <- MArray.fromList ([1] :: [Word8]) + let bytes = MArray.asBytes arr + MArray.length bytes `shouldBe` 1 + +testCast :: IO () +testCast = do + arr <- MArray.fromList ([1,2,3,4] :: [Word8]) + case MArray.cast arr :: Maybe (MutArray Word16) of + Nothing -> fail "expected Just" + Just arr16 -> MArray.length arr16 `shouldBe` 2 + +------------------------------------------------------------------------------- +-- Size and Capacity +------------------------------------------------------------------------------- + +testCapacity :: IO () +testCapacity = do + arr <- MArray.fromList ([1..5] :: [Int]) + MArray.capacity arr `shouldBe` 5 + +testFreeSpace :: IO () +testFreeSpace = do + arr <- MArray.emptyOf' 10 :: IO (MutArray Int) + MArray.free arr `shouldBe` 10 + +testByteCapacity :: IO () +testByteCapacity = do + arr <- MArray.fromList ([1..5] :: [Int]) + MArray.byteCapacity arr `shouldBe` MArray.byteLength arr + +testBytesFree :: IO () +testBytesFree = do + arr <- MArray.emptyOf' 5 :: IO (MutArray Int) + MArray.bytesFree arr `shouldBe` 5 * sizeOf (Proxy :: Proxy Int) + +testBlockSize :: IO () +testBlockSize = MArray.blockSize `shouldBe` MArray.blockSize -- constant, just call it + +testArrayChunkBytes :: IO () +testArrayChunkBytes = MArray.arrayChunkBytes > 0 `shouldBe` True + +testAllocBytesToElemCount :: IO () +testAllocBytesToElemCount = do + let n = MArray.allocBytesToElemCount (undefined :: Int) 1024 + -- subtracts byteArrayOverhead then divides by element size + (n > 0) `shouldBe` True + (n * sizeOf (Proxy :: Proxy Int) <= 1024) `shouldBe` True + +testGrowTo :: IO () +testGrowTo = do + arr <- MArray.fromList ([1..5] :: [Int]) + arr1 <- MArray.growTo 10 arr + MArray.capacity arr1 >= 10 `shouldBe` True + lst <- MArray.toList arr1 + lst `shouldBe` [1..5] + +testGrowBy :: IO () +testGrowBy = do + arr <- MArray.fromList ([1..5] :: [Int]) + arr1 <- MArray.growBy 10 arr + MArray.capacity arr1 >= MArray.capacity arr + 10 `shouldBe` True + lst <- MArray.toList arr1 + lst `shouldBe` [1..5] + +testGrowExp :: IO () +testGrowExp = do + arr <- MArray.fromList ([1..5] :: [Int]) + arr1 <- MArray.growExp 10 arr + MArray.capacity arr1 >= 10 `shouldBe` True + lst <- MArray.toList arr1 + lst `shouldBe` [1..5] + +testRightSize :: IO () +testRightSize = do + arr <- MArray.emptyOf' 100 :: IO (MutArray Int) + arr1 <- MArray.snoc arr 42 + arr2 <- MArray.rightSize arr1 + MArray.length arr2 `shouldBe` 1 + MArray.capacity arr2 `shouldBe` 1 + +testVacate :: IO () +testVacate = do + arr <- MArray.fromList ([1..5] :: [Int]) + let arr1 = MArray.vacate arr + MArray.length arr1 `shouldBe` 0 + MArray.capacity arr1 `shouldBe` 5 + +------------------------------------------------------------------------------- +-- Random writes +------------------------------------------------------------------------------- + +testModify :: IO () +testModify = do + arr <- MArray.fromList ([1..5] :: [Int]) + MArray.modify arr (* 2) + lst <- MArray.toList arr + lst `shouldBe` [2,4,6,8,10] + +testModifyIndices :: IO () +testModifyIndices = do + arr <- MArray.fromList ([1..5] :: [Int]) + Stream.fold (MArray.modifyIndices arr (\i _ -> i * 10)) $ Stream.fromList [0, 2, 4] + lst <- MArray.toList arr + lst `shouldBe` [0,2,20,4,40] + +testSwapIndices :: IO () +testSwapIndices = do + arr <- MArray.fromList ([1..5] :: [Int]) + MArray.swapIndices 0 4 arr + lst <- MArray.toList arr + lst `shouldBe` [5,2,3,4,1] + +testUnsafeSwapIndices :: IO () +testUnsafeSwapIndices = do + arr <- MArray.fromList ([1..5] :: [Int]) + MArray.unsafeSwapIndices 1 3 arr + lst <- MArray.toList arr + lst `shouldBe` [1,4,3,2,5] + +------------------------------------------------------------------------------- +-- Reading +------------------------------------------------------------------------------- + +testUnsafeGetIndexRev :: IO () +testUnsafeGetIndexRev = do + arr <- MArray.fromList ([1..5] :: [Int]) + MArray.unsafeGetIndexRev 0 arr `shouldReturn` 5 + MArray.unsafeGetIndexRev 4 arr `shouldReturn` 1 + +testIndexReader :: IO () +testIndexReader = do + arr <- MArray.fromList ([10,20,30,40,50] :: [Int]) + let indices = Stream.fromList [4,0,2] + lst <- Stream.fold Fold.toList $ Stream.unfold (MArray.indexReader indices) arr + lst `shouldBe` [50,10,30] + +testToStreamKRev :: IO () +testToStreamKRev = do + arr <- MArray.fromList ([1..5] :: [Int]) + lst <- Stream.fold Fold.toList $ Stream.fromStreamK (MArray.toStreamKRev arr) + lst `shouldBe` [5,4,3,2,1] + +------------------------------------------------------------------------------- +-- Unfolds +------------------------------------------------------------------------------- + +testReaderRev :: IO () +testReaderRev = do + arr <- MArray.fromList ([1..5] :: [Int]) + lst <- Stream.fold Fold.toList $ Stream.unfold MArray.readerRev arr + lst `shouldBe` [5,4,3,2,1] + +------------------------------------------------------------------------------- +-- Folding +------------------------------------------------------------------------------- + +testFoldRev :: IO () +testFoldRev = do + arr <- MArray.fromList ([1..5] :: [Int]) + result <- MArray.foldRev Fold.toList arr + result `shouldBe` [5,4,3,2,1] + +testByteCmp :: IO () +testByteCmp = do + arr1 <- MArray.fromList ([1,2,3] :: [Int]) + arr2 <- MArray.fromList ([1,2,3] :: [Int]) + arr3 <- MArray.fromList ([1,2,4] :: [Int]) + MArray.byteCmp arr1 arr2 `shouldReturn` EQ + MArray.byteCmp arr1 arr3 `shouldReturn` LT + +testByteEq :: IO () +testByteEq = do + arr1 <- MArray.fromList ([1,2,3] :: [Int]) + arr2 <- MArray.fromList ([1,2,3] :: [Int]) + arr3 <- MArray.fromList ([1,2,4] :: [Int]) + MArray.byteEq arr1 arr2 `shouldReturn` True + MArray.byteEq arr1 arr3 `shouldReturn` False + +------------------------------------------------------------------------------- +-- In-place Mutation +------------------------------------------------------------------------------- + +testPartitionBy :: IO () +testPartitionBy = do + arr <- MArray.fromList ([1..6] :: [Int]) + -- partitionBy returns (falsePartition, truePartition) + (fs, ts) <- MArray.partitionBy even arr + fl <- MArray.toList fs + tl <- MArray.toList ts + sort (tl ++ fl) `shouldBe` [1..6] + all even tl `shouldBe` True + all odd fl `shouldBe` True + +------------------------------------------------------------------------------- +-- Snoc variants +------------------------------------------------------------------------------- + +testSnocGrowBy :: IO () +testSnocGrowBy = do + arr <- MArray.fromList ([] :: [Int]) + arr1 <- MArray.snocGrowBy 10 arr 1 + arr2 <- MArray.snocGrowBy 10 arr1 2 + lst <- MArray.toList arr2 + lst `shouldBe` [1, 2] + +testSnocMay :: IO () +testSnocMay = do + arr <- MArray.emptyOf' 1 :: IO (MutArray Int) + r1 <- MArray.snocMay arr 1 + case r1 of + Nothing -> fail "expected Just (had space)" + Just arr1 -> do + r2 <- MArray.snocMay arr1 2 + case r2 of + Nothing -> return () + Just _ -> fail "expected Nothing when array is full" + +------------------------------------------------------------------------------- +-- Append folds +------------------------------------------------------------------------------- + +testAppendWith :: IO () +testAppendWith = do + arr <- MArray.fromList ([1,2,3] :: [Int]) + result <- Stream.fold (MArray.appendWith (+ 64) (pure arr)) $ Stream.fromList ([4,5,6] :: [Int]) + lst <- MArray.toList result + lst `shouldBe` [1..6] + +testUnsafeAppendMax :: IO () +testUnsafeAppendMax = do + arr <- MArray.fromList ([1,2,3] :: [Int]) + result <- Stream.fold (MArray.unsafeAppendMax 3 arr) $ Stream.fromList ([4,5,6] :: [Int]) + lst <- MArray.toList result + lst `shouldBe` [1..6] + +testAppendMax :: IO () +testAppendMax = do + arr <- MArray.fromList ([1,2,3] :: [Int]) + result <- Stream.fold (MArray.appendMax 3 arr) $ Stream.fromList ([4,5,6,7,8] :: [Int]) + lst <- MArray.toList result + lst `shouldBe` [1..6] + +testAppendGrowBy :: IO () +testAppendGrowBy = do + arr <- MArray.fromList ([1,2,3] :: [Int]) + result <- Stream.fold (MArray.appendGrowBy 10 arr) $ Stream.fromList ([4..8] :: [Int]) + lst <- MArray.toList result + lst `shouldBe` [1..8] + +------------------------------------------------------------------------------- +-- Append streams +------------------------------------------------------------------------------- + +testAppendStream :: IO () +testAppendStream = do + arr <- MArray.fromList ([1,2,3] :: [Int]) + result <- MArray.appendStream arr $ Stream.fromList [4,5,6] + lst <- MArray.toList result + lst `shouldBe` [1..6] + +testAppendStreamN :: IO () +testAppendStreamN = do + arr <- MArray.emptyOf 3 :: IO (MutArray Int) + result <- MArray.appendStreamN 3 arr $ Stream.fromList ([1..10] :: [Int]) + lst <- MArray.toList result + lst `shouldBe` [1..3] + +------------------------------------------------------------------------------- +-- Splicing +------------------------------------------------------------------------------- + +testSpliceCopy :: IO () +testSpliceCopy = do + arr1 <- MArray.fromList ([1,2,3] :: [Int]) + arr2 <- MArray.fromList ([4,5,6] :: [Int]) + arr3 <- MArray.spliceCopy arr1 arr2 + lst <- MArray.toList arr3 + lst `shouldBe` [1..6] + lst1 <- MArray.toList arr1 + lst1 `shouldBe` [1,2,3] + +testSpliceWith :: IO () +testSpliceWith = do + arr1 <- MArray.fromList ([1,2,3] :: [Int]) + arr2 <- MArray.fromList ([4,5,6] :: [Int]) + arr3 <- MArray.spliceWith (+) arr1 arr2 + lst <- MArray.toList arr3 + lst `shouldBe` [1..6] + +testSpliceExp :: IO () +testSpliceExp = do + arr1 <- MArray.fromList ([1,2,3] :: [Int]) + arr2 <- MArray.fromList ([4,5,6] :: [Int]) + arr3 <- MArray.spliceExp arr1 arr2 + lst <- MArray.toList arr3 + lst `shouldBe` [1..6] + +testUnsafeSplice :: IO () +testUnsafeSplice = do + arr1 <- MArray.fromList ([1,2,3] :: [Int]) + arr2 <- MArray.fromList ([4,5,6] :: [Int]) + arr1' <- MArray.growTo 6 arr1 + arr3 <- MArray.unsafeSplice arr1' arr2 + lst <- MArray.toList arr3 + lst `shouldBe` [1..6] + +------------------------------------------------------------------------------- +-- Serialization using Unbox (poke/peek) +------------------------------------------------------------------------------- + +testPoke :: IO () +testPoke = do + arr <- MArray.poke MArray.empty (42 :: Int) + MArray.byteLength arr `shouldBe` sizeOf (Proxy :: Proxy Int) + (val, _) <- MArray.unsafePeek arr :: IO (Int, MutArray Word8) + val `shouldBe` 42 + +testPokeMay :: IO () +testPokeMay = do + arr <- MArray.poke MArray.empty (42 :: Int) + r <- MArray.pokeMay arr (99 :: Int) + case r of + Nothing -> return () + Just _ -> fail "expected Nothing when byte array is full" + +testUnsafePokeSkip :: IO () +testUnsafePokeSkip = do + arr <- MArray.emptyOf' 8 :: IO (MutArray Word8) + let arr1 = MArray.unsafePokeSkip 4 arr + MArray.byteLength arr1 `shouldBe` 4 + +testUnsafePeek :: IO () +testUnsafePeek = do + arr <- MArray.poke MArray.empty (42 :: Int) + (val, rest) <- MArray.unsafePeek arr :: IO (Int, MutArray Word8) + val `shouldBe` 42 + MArray.byteLength rest `shouldBe` 0 + +testUnsafePeekSkip :: IO () +testUnsafePeekSkip = do + arr <- MArray.fromList ([1,2,3,4,5] :: [Word8]) + let arr1 = MArray.unsafePeekSkip 2 arr + MArray.toList arr1 `shouldReturn` [3,4,5] + +------------------------------------------------------------------------------- +-- Streams of Arrays - Chunk +------------------------------------------------------------------------------- + +testChunksOf' :: IO () +testChunksOf' = do + chunks <- Stream.fold Fold.toList + $ MArray.chunksOf' 3 + $ Stream.fromList ([1..7] :: [Int]) + lsts <- mapM MArray.toList chunks + lsts `shouldBe` [[1,2,3],[4,5,6],[7]] + mapM_ (\c -> MArray.isPinned c `shouldBe` True) chunks + +testChunksEndBy :: IO () +testChunksEndBy = do + chunks <- Stream.fold Fold.toList + $ MArray.chunksEndBy (== (0 :: Int)) + $ Stream.fromList [1,2,0,3,4,0,5] + lsts <- mapM MArray.toList chunks + lsts `shouldBe` [[1,2,0],[3,4,0],[5]] + +testChunksEndByLn :: IO () +testChunksEndByLn = do + let nl = fromIntegral (ord '\n') :: Word8 + chunks <- Stream.fold Fold.toList + $ MArray.chunksEndByLn + $ Stream.fromList [65,66,nl,67,68,nl,69] + lsts <- mapM MArray.toList chunks + lsts `shouldBe` [[65,66,nl],[67,68,nl],[69]] + +------------------------------------------------------------------------------- +-- Streams of Arrays - Concat +------------------------------------------------------------------------------- + +testConcat :: IO () +testConcat = do + arrs <- mapM MArray.fromList ([[1,2,3],[4,5,6],[7,8,9]] :: [[Int]]) + lst <- Stream.fold Fold.toList + $ MArray.concat + $ Stream.fromList arrs + lst `shouldBe` [1..9] + +testConcatRev :: IO () +testConcatRev = do + arrs <- mapM MArray.fromList ([[1,2,3],[4,5,6]] :: [[Int]]) + lst <- Stream.fold Fold.toList + $ MArray.concatRev + $ Stream.fromList arrs + lst `shouldBe` [3,2,1,6,5,4] + +------------------------------------------------------------------------------- +-- Streams of Arrays - Compact +------------------------------------------------------------------------------- + +testCreateCompactMin :: IO () +testCreateCompactMin = do + arrs <- mapM MArray.fromList ([[1,2],[3,4],[5,6]] :: [[Int]]) + result <- Stream.fold (MArray.createCompactMin 5) $ Stream.fromList arrs + lst <- MArray.toList result + lst `shouldBe` [1,2,3,4,5,6] + +testCompactMin :: IO () +testCompactMin = do + arrs <- mapM MArray.fromList ([[1],[2],[3],[4,5,6,7]] :: [[Int]]) + result <- Stream.fold Fold.toList + $ MArray.compactMin 3 + $ Stream.fromList arrs + lsts <- mapM MArray.toList result + lsts `shouldBe` [[1,2,3],[4,5,6,7]] + +testCreateCompactMax :: IO () +testCreateCompactMax = do + arrs <- mapM MArray.fromList ([[1,2],[3,4],[5,6,7,8]] :: [[Int]]) + rights <- Stream.fold Fold.toList + $ Stream.parseMany (MArray.createCompactMax 4) + $ Stream.fromList arrs + let chunks = [a | Right a <- rights] + lsts <- mapM MArray.toList chunks + lsts `shouldBe` [[1,2,3,4],[5,6,7,8]] + +testScanCompactMin :: IO () +testScanCompactMin = do + arrs <- mapM MArray.fromList ([[1,2],[3,4],[5,6,7,8]] :: [[Int]]) + results <- Stream.fold Fold.toList + $ Stream.scanl (MArray.scanCompactMin 3) + $ Stream.fromList arrs + let completes = [arr | Just arr <- results] + lsts <- mapM MArray.toList completes + lsts `shouldBe` [[1,2,3,4],[5,6,7,8]] + +------------------------------------------------------------------------------- +-- Utilities +------------------------------------------------------------------------------- + +testIsPower2 :: IO () +testIsPower2 = do + MArray.isPower2 1 `shouldBe` True + MArray.isPower2 2 `shouldBe` True + MArray.isPower2 4 `shouldBe` True + MArray.isPower2 3 `shouldBe` False + MArray.isPower2 6 `shouldBe` False + +testRoundUpToPower2 :: IO () +testRoundUpToPower2 = do + MArray.roundUpToPower2 1 `shouldBe` 1 + MArray.roundUpToPower2 2 `shouldBe` 2 + MArray.roundUpToPower2 3 `shouldBe` 4 + MArray.roundUpToPower2 5 `shouldBe` 8 + + +-- Tests for exports of the Streamly.Internal.Data.MutArray.Type source module. +typeMain :: SpecWith () +typeMain = do + -- IMPORTANT NOTE: Before adding any test here first consider if it + -- can be added to the MutArray/Common test module. Only those tests + -- which are specific to the Unboxed MutArray module and do not + -- apply to the Generic MutArray module should be added here. + + -- MutArray/Type.hs module (Unboxed-only) + describe "pin/unpin/isPinned" $ do + it "roundtrip" testPinUnpin + describe "breakEndByWord8_" $ do + it "separator found" testBreakEndByWord8_ + it "separator not found" testBreakEndByWord8_NotFound + it "reverse" testReverse + it "foldl'" testFoldl' + it "foldr" testFoldr + it "fold" testFold + it "splice" testSplice + describe "splitEndBy_" $ do + it "basic" testSplitEndBy_ + describe "getIndexRev" $ do + it "first and last" testGetIndexRev + it "unsafeAsPtr" testUnsafeAsPtr + describe "byteLength" $ do + it "Int" (testByteLength (undefined :: Int)) + it "Char" (testByteLength (undefined :: Char)) + describe "bubble" $ do + prop "ascending" testBubbleAsc + prop "descending" testBubbleDesc + prop "reallocBytes" testReallocBytes + describe "Stream Append" $ do + prop "append2" testAppend + + -- Pinned variants + it "clone'" testClone' + it "fromList'" testFromList' + it "fromListN'" testFromListN' + it "createOf'" testCreateOf' + it "create'" testCreate' + it "unsafeCreateOf'" testUnsafeCreateOf' + + -- Reverse creation + it "revCreateOf" testRevCreateOf + it "fromListRev" testFromListRev + it "fromListRevN" testFromListRevN + + -- From pure/chunked streams + it "fromPureStreamN" testFromPureStreamN + it "fromPureStreamMin" testFromPureStreamMin + it "fromChunksRealloced" testFromChunksRealloced + it "fromChunksK" testFromChunksK + it "buildChunks" testBuildChunks + + -- Slicing + it "unsafeBreakAt" testUnsafeBreakAt + it "breakAt" testBreakAt + describe "breakEndBy" $ do + it "split on space" testBreakEndBy + describe "breakEndBy_" $ do + it "split on space, drop it" testBreakEndBy_ + describe "dropWhile" $ do + it "drop leading spaces" testDropWhile + describe "revBreakEndBy" $ do + it "split from end" testRevBreakEndBy + describe "revBreakEndBy_" $ do + it "split from end, drop it" testRevBreakEndBy_ + describe "revDropWhile" $ do + it "drop trailing spaces" testRevDropWhile + + -- Casting + it "asBytes" testAsBytes + describe "cast" $ do + it "Word8 to Word16" testCast + + -- Size and Capacity + describe "capacity" $ do it "equals length for exact alloc" testCapacity + describe "free" $ do it "equals capacity for empty array" testFreeSpace + describe "byteCapacity" $ do it "equals byteLength for exact alloc" testByteCapacity + describe "bytesFree" $ do it "full capacity for empty" testBytesFree + describe "blockSize" $ do it "is a constant" testBlockSize + describe "arrayChunkBytes" $ do it "is positive" testArrayChunkBytes + describe "allocBytesToElemCount" $ do it "converts bytes to elem count" testAllocBytesToElemCount + describe "growTo" $ do it "capacity increases" testGrowTo + describe "growBy" $ do it "capacity grows by n" testGrowBy + describe "growExp" $ do it "capacity grows" testGrowExp + describe "rightSize" $ do it "capacity shrinks to length" testRightSize + describe "vacate" $ do it "resets length to 0" testVacate + + -- Random writes + describe "modify" $ do it "all elements" testModify + describe "modifyIndices" $ do it "at specified indices" testModifyIndices + describe "swapIndices" $ do it "swaps two elements" testSwapIndices + describe "unsafeSwapIndices" $ do it "swaps two elements" testUnsafeSwapIndices + + -- Reading + describe "unsafeGetIndexRev" $ do it "from end" testUnsafeGetIndexRev + describe "indexReader" $ do it "reads at given indices" testIndexReader + describe "toStreamKRev" $ do it "reversed" testToStreamKRev + + -- Unfolds + describe "readerRev" $ do it "reads in reverse" testReaderRev + + -- Folding + describe "foldRev" $ do it "reverses order" testFoldRev + describe "byteCmp" $ do it "equal and less-than" testByteCmp + describe "byteEq" $ do it "equal and unequal" testByteEq + + -- In-place + describe "partitionBy" $ do it "separates evens from odds" testPartitionBy + + -- Snoc variants + describe "snocGrowBy" $ do it "appends with growth" testSnocGrowBy + describe "snocMay" $ do it "snoc if space, Nothing if full" testSnocMay + + -- Append folds + describe "appendWith" $ do it "appends with growth function" testAppendWith + describe "unsafeAppendMax" $ do it "appends n elements" testUnsafeAppendMax + describe "appendMax" $ do it "appends at most n elements" testAppendMax + describe "appendGrowBy" $ do it "appends with grow by n" testAppendGrowBy + + -- Append streams + describe "appendStream" $ do it "appends whole stream" testAppendStream + describe "appendStreamN" $ do it "appends n from stream" testAppendStreamN + + -- Splicing + describe "spliceCopy" $ do it "copies and splices" testSpliceCopy + describe "spliceWith" $ do it "splices with growth fn" testSpliceWith + describe "spliceExp" $ do it "splices exponentially" testSpliceExp + describe "unsafeSplice" $ do it "unsafe splice" testUnsafeSplice + + -- Poke/Peek (serialization) + describe "poke" $ do it "serializes to Word8 array" testPoke + describe "pokeMay" $ do it "Nothing when full" testPokeMay + describe "unsafePokeSkip" $ do it "advances end pointer" testUnsafePokeSkip + describe "unsafePeek" $ do it "deserializes from Word8 array" testUnsafePeek + describe "unsafePeekSkip" $ do it "advances start pointer" testUnsafePeekSkip + + -- Chunks + describe "chunksOf'" $ do it "pinned chunksOf" testChunksOf' + describe "chunksEndBy" $ do it "ends chunk on predicate" testChunksEndBy + describe "chunksEndByLn" $ do it "ends chunk on newline" testChunksEndByLn + + -- Concat + describe "concat" $ do it "concatenates arrays" testConcat + describe "concatRev" $ do it "concatenates reversed" testConcatRev + + -- Compact + describe "createCompactMin" $ do it "fold compact min" testCreateCompactMin + describe "compactMin" $ do it "stream compact min" testCompactMin + describe "createCompactMax" $ do it "parser compact max" testCreateCompactMax + describe "scanCompactMin" $ do it "scan compact min" testScanCompactMin + + -- Utilities + describe "isPower2" $ do it "identifies powers of 2" testIsPower2 + describe "roundUpToPower2" $ do it "rounds up" testRoundUpToPower2 + +main :: IO () +main = + hspec $ + Hspec.parallel $ + modifyMaxSuccess (const maxTestCount) $ + describe moduleName $ do + arrayCommon + typeCommon + typeMain diff --git a/test/Streamly/Test/Data/MutArray/TypeCommon.hs b/test/Streamly/Test/Data/MutArray/TypeCommon.hs new file mode 100644 index 0000000000..4b635a0389 --- /dev/null +++ b/test/Streamly/Test/Data/MutArray/TypeCommon.hs @@ -0,0 +1,234 @@ + +------------------------------------------------------------------------------- +-- Construction +------------------------------------------------------------------------------- + +testFromListN :: IO () +testFromListN = do + arr <- MArray.fromListN 5 ([1..10] :: [Int]) + lst <- MArray.toList arr + lst `shouldBe` [1..5] + +testUnsafeCreateOf :: IO () +testUnsafeCreateOf = do + arr <- Stream.fold (MArray.unsafeCreateOf 5) $ Stream.fromList ([1..5] :: [Int]) + lst <- MArray.toList arr + lst `shouldBe` [1..5] + +testFromPureStream :: IO () +testFromPureStream = do + arr <- MArray.fromPureStream (Stream.fromList ([1..5] :: [Int])) + lst <- MArray.toList arr + lst `shouldBe` [1..5] + +testClone :: IO () +testClone = do + arr <- MArray.fromList ([1..5] :: [Int]) + arr2 <- MArray.clone arr + MArray.putIndex 0 arr 99 + MArray.getIndex 0 arr `shouldReturn` Just 99 + MArray.getIndex 0 arr2 `shouldReturn` Just 1 + lst <- MArray.toList arr2 + lst `shouldBe` [1..5] + +------------------------------------------------------------------------------- +-- Random access +------------------------------------------------------------------------------- + +testGetIndex :: IO () +testGetIndex = do + arr <- MArray.fromList ([1..10] :: [Int]) + MArray.getIndex 0 arr `shouldReturn` Just 1 + MArray.getIndex 9 arr `shouldReturn` Just 10 + MArray.getIndex 10 arr `shouldReturn` Nothing + +testUnsafeGetIndex :: IO () +testUnsafeGetIndex = do + arr <- MArray.fromList ([1..10] :: [Int]) + MArray.unsafeGetIndex 0 arr `shouldReturn` 1 + MArray.unsafeGetIndex 9 arr `shouldReturn` 10 + +testPutIndex :: IO () +testPutIndex = do + arr <- MArray.fromList ([1..10] :: [Int]) + MArray.putIndex 0 arr 99 + MArray.getIndex 0 arr `shouldReturn` Just 99 + +testModifyIndex :: IO () +testModifyIndex = do + arr <- MArray.fromList ([1..10] :: [Int]) + _ <- MArray.modifyIndex 0 arr (\x -> (x + 10, ())) + MArray.getIndex 0 arr `shouldReturn` Just 11 + +testUnsafeModifyIndex :: IO () +testUnsafeModifyIndex = do + arr <- MArray.fromList ([1..10] :: [Int]) + _ <- MArray.unsafeModifyIndex 0 arr (\x -> (x + 10, ())) + MArray.unsafeGetIndex 0 arr `shouldReturn` 11 + +unsafeWriteIndex :: [Int] -> Int -> Int -> IO Bool +unsafeWriteIndex xs i x = do + arr <- MArray.fromList xs + MArray.unsafePutIndex i arr x + x1 <- MArray.unsafeGetIndex i arr + return $ x1 == x + +testPutIndices :: IO () +testPutIndices = do + arr <- MArray.fromList ([1..10] :: [Int]) + Stream.fold (MArray.putIndices arr) $ Stream.fromList [(0, 99), (5, 88)] + MArray.getIndex 0 arr `shouldReturn` Just 99 + MArray.getIndex 5 arr `shouldReturn` Just 88 + +------------------------------------------------------------------------------- +-- Slicing +------------------------------------------------------------------------------- + +testUnsafeSliceOffLen :: IO () +testUnsafeSliceOffLen = do + arr <- MArray.fromList ([1..10] :: [Int]) + lst <- MArray.toList $ MArray.unsafeSliceOffLen 2 4 arr + lst `shouldBe` [3..6] + +testSliceOffLen :: IO () +testSliceOffLen = do + arr <- MArray.fromList ([1..10] :: [Int]) + lst <- MArray.toList $ MArray.sliceOffLen 2 4 arr + lst `shouldBe` [3..6] + +------------------------------------------------------------------------------- +-- Growing +------------------------------------------------------------------------------- + +testSnoc :: IO () +testSnoc = do + arr0 <- MArray.fromList ([] :: [Int]) + arr1 <- MArray.snoc arr0 1 + arr2 <- MArray.snoc arr1 2 + lst <- MArray.toList arr2 + lst `shouldBe` [1, 2] + +testSnocWith :: IO () +testSnocWith = do + arr <- MArray.emptyOf 2 + arr1 <- MArray.snocWith (+ 64) arr (1 :: Int) + arr2 <- MArray.snocWith (+ 64) arr1 2 + lst <- MArray.toList arr2 + lst `shouldBe` [1, 2] + +testUnsafeSnoc :: IO () +testUnsafeSnoc = do + arr <- MArray.emptyOf 2 + arr1 <- MArray.unsafeSnoc arr (1 :: Int) + arr2 <- MArray.unsafeSnoc arr1 2 + lst <- MArray.toList arr2 + lst `shouldBe` [1, 2] + +------------------------------------------------------------------------------- +-- Reading / Streaming +------------------------------------------------------------------------------- + +testReaderWith :: IO () +testReaderWith = do + arr <- MArray.fromList ([1..5] :: [Int]) + lst <- Stream.fold Fold.toList $ Stream.unfold (MArray.readerWith liftIO) arr + lst `shouldBe` [1..5] + +testToStreamK :: IO () +testToStreamK = do + arr <- MArray.fromList ([1..5] :: [Int]) + lst <- Stream.fold Fold.toList $ Stream.fromStreamK (MArray.toStreamK arr) + lst `shouldBe` [1..5] + +------------------------------------------------------------------------------- +-- In-place mutation +------------------------------------------------------------------------------- + +testDropAround :: IO Bool +testDropAround = do + dt <- MArray.fromList "abcDEFgeh" + dt' <- MArray.dropAround isLower dt + x <- MArray.toList dt' + return $ x == "DEF" + +testDropAroundLeft :: IO Bool +testDropAroundLeft = do + dt <- MArray.fromList "abcDEF" + dt' <- MArray.dropAround isLower dt + x <- MArray.toList dt' + return $ x == "DEF" + +testDropAroundRight :: IO Bool +testDropAroundRight = do + dt <- MArray.fromList "DEFgeh" + dt' <- MArray.dropAround isLower dt + x <- MArray.toList dt' + return $ x == "DEF" + +testDropAroundNone :: IO Bool +testDropAroundNone = do + dt <- MArray.fromList "DEF" + dt' <- MArray.dropAround isLower dt + x <- MArray.toList dt' + return $ x == "DEF" + +testDropAroundAll :: IO Bool +testDropAroundAll = do + dt <- MArray.fromList "abc" + dt' <- MArray.dropAround isLower dt + x <- MArray.toList dt' + return $ x == "" + +testDropAroundEmpty :: IO Bool +testDropAroundEmpty = do + dt <- MArray.fromList "" + dt' <- MArray.dropAround isLower dt + x <- MArray.toList dt' + return $ x == "" + +-- Tests common to the mutable array variants MutArray (Unboxed) and +-- MutArray.Generic. Only tests that apply to both mutable variants should be +-- added here. Tests common to all array variants (including the immutable +-- Array) live in MutArray/Common.hs (arrayCommon). +typeCommon :: SpecWith () +typeCommon = do + -- Construction + it "fromListN" testFromListN + it "unsafeCreateOf" testUnsafeCreateOf + it "fromPureStream" testFromPureStream + it "clone" testClone + -- Random access + describe "getIndex" $ do + it "valid and out of bounds" testGetIndex + describe "unsafeGetIndex" $ do + it "valid indices" testUnsafeGetIndex + describe "putIndex" $ do + it "writes and reads back" testPutIndex + describe "modifyIndex" $ do + it "applies function" testModifyIndex + describe "unsafeModifyIndex" $ do + it "applies function" testUnsafeModifyIndex + describe "unsafePutIndex" $ do + it "first" (unsafeWriteIndex [1..10] 0 0 `shouldReturn` True) + it "middle" (unsafeWriteIndex [1..10] 5 0 `shouldReturn` True) + it "last" (unsafeWriteIndex [1..10] 9 0 `shouldReturn` True) + describe "putIndices" $ do + it "multiple writes" testPutIndices + -- Slicing + it "unsafeSliceOffLen" testUnsafeSliceOffLen + it "sliceOffLen" testSliceOffLen + -- Growing + it "snoc" testSnoc + it "snocWith" testSnocWith + it "unsafeSnoc" testUnsafeSnoc + -- Reading + it "readerWith" testReaderWith + it "toStreamK" testToStreamK + -- In-place mutation + describe "dropAround" $ do + it "both sides" (testDropAround `shouldReturn` True) + it "left only" (testDropAroundLeft `shouldReturn` True) + it "right only" (testDropAroundRight `shouldReturn` True) + it "no match" (testDropAroundNone `shouldReturn` True) + it "all match" (testDropAroundAll `shouldReturn` True) + it "empty" (testDropAroundEmpty `shouldReturn` True) diff --git a/test/Streamly/Test/Data/Serialize/CompatV0.hs b/test/Streamly/Test/Data/MutByteArray/CompatV0.hs similarity index 96% rename from test/Streamly/Test/Data/Serialize/CompatV0.hs rename to test/Streamly/Test/Data/MutByteArray/CompatV0.hs index b92708cce9..0688dc5f5c 100644 --- a/test/Streamly/Test/Data/Serialize/CompatV0.hs +++ b/test/Streamly/Test/Data/MutByteArray/CompatV0.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} -module Streamly.Test.Data.Serialize.CompatV0 +module Streamly.Test.Data.MutByteArray.CompatV0 ( Rec(..) , River(..) ) where diff --git a/test/Streamly/Test/Data/Serialize/CompatV1.hs b/test/Streamly/Test/Data/MutByteArray/CompatV1.hs similarity index 96% rename from test/Streamly/Test/Data/Serialize/CompatV1.hs rename to test/Streamly/Test/Data/MutByteArray/CompatV1.hs index b9d6951ebb..4de02021f8 100644 --- a/test/Streamly/Test/Data/Serialize/CompatV1.hs +++ b/test/Streamly/Test/Data/MutByteArray/CompatV1.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} -module Streamly.Test.Data.Serialize.CompatV1 +module Streamly.Test.Data.MutByteArray.CompatV1 ( Rec(..) , River(..) ) where diff --git a/test/Streamly/Test/Data/Unbox.hs b/test/Streamly/Test/Data/MutByteArray/DeriveInstances.hs similarity index 89% rename from test/Streamly/Test/Data/Unbox.hs rename to test/Streamly/Test/Data/MutByteArray/DeriveInstances.hs index da59085c65..257c4a0e01 100644 --- a/test/Streamly/Test/Data/Unbox.hs +++ b/test/Streamly/Test/Data/MutByteArray/DeriveInstances.hs @@ -7,20 +7,20 @@ {-# OPTIONS_GHC -Wno-orphans #-} -- | --- Module : Streamly.Test.Data.Unbox +-- Module : Streamly.Test.Data.MutByteArray.DeriveInstances -- Copyright : (c) 2022 Composewell technologies -- License : BSD-3-Clause -- Maintainer : streamly@composewell.com -- Stability : experimental -- Portability : GHC -module Streamly.Test.Data.Unbox (main) where +module Streamly.Test.Data.MutByteArray.DeriveInstances (main) where -------------------------------------------------------------------------------- -- Imports -------------------------------------------------------------------------------- -#ifdef USE_SERIALIZE +#ifdef TEST_DERIVE_SERIALIZE import Data.Foldable (forM_) import Data.Word (Word8) import qualified Streamly.Internal.Data.Array as Array @@ -44,27 +44,38 @@ import Test.Hspec as H -- Types -------------------------------------------------------------------------------- -#ifdef USE_SERIALIZE +-- There are three cases, one for Serialize and two for Unbox +-- 1. TEST_DERIVE_SERIALIZE defined: tests work using Serialize type class +-- 2. TEST_DERIVE_SERIALIZE NOT defined: tests work using Unbox type class +-- there are two further cases in Unbox case +-- 2a. TEST_DERIVE_UNBOX defined: Unbox type class uses deriveUnbox +-- 2b. TEST_DERIVE_UNBOX NOT defined: Unbox uses Generic deriving +#ifdef TEST_DERIVE_SERIALIZE + +-- Tests for Serialize type class +#define TYPE_CLASS Serialize #define MODULE_NAME "Data.Serialize.Deriving.TH" #define DERIVE_UNBOX(typ) $(deriveSerialize [d|instance Serialize typ|]) #define PEEK(i, arr, sz) (deserializeAt i arr sz) #define POKE(i, arr, val) (serializeAt i arr val) -#define TYPE_CLASS Serialize #else +-- Tests for Unbox type class +#define TYPE_CLASS Unbox #define PEEK(i, arr, sz) peekAtWithNextOff i arr #define POKE(i, arr, val) pokeAtWithNextOff i arr val -#define TYPE_CLASS Unbox -#ifdef USE_TH +#ifdef TEST_DERIVE_UNBOX +-- Derive Unbox instances using deriveUnbox (TH) #define MODULE_NAME "Data.Unbox.Deriving.TH" #define DERIVE_UNBOX(typ) $(deriveUnbox [d|instance Unbox typ|]) #else +-- Derive Unbox instances using Generic deriving. #define MODULE_NAME "Data.Unbox.Deriving.Generic" #define DERIVE_UNBOX(typ) deriving instance Unbox (typ) @@ -76,8 +87,9 @@ import Test.Hspec as H -- Helpers -------------------------------------------------------------------------------- -#ifndef USE_SERIALIZE +#ifndef TEST_DERIVE_SERIALIZE +-- For the Unbox case peekAtWithNextOff :: forall a. Unbox a => Int @@ -176,7 +188,7 @@ deriving instance Generic (Ratio Int) deriving instance Generic (Fingerprint) #endif -#if defined(USE_SERIALIZE) +#if defined(TEST_DERIVE_SERIALIZE) $(deriveSerialize [d|instance Serialize a => Serialize (Complex a)|]) $(deriveSerialize @@ -191,7 +203,7 @@ $(deriveSerialize -- Test helpers -------------------------------------------------------------------------------- -#ifdef USE_SERIALIZE +#ifdef TEST_DERIVE_SERIALIZE variableSizeOf :: forall a. Serialize a => a @@ -205,14 +217,14 @@ testSerialization :: -> IO () testSerialization val = do let len = -#ifdef USE_SERIALIZE +#ifdef TEST_DERIVE_SERIALIZE (variableSizeOf val) #else (sizeOf (Proxy :: Proxy a)) #endif arr <- MBA.new len nextOff <- POKE(0, arr, val) -#ifdef USE_SERIALIZE +#ifdef TEST_DERIVE_SERIALIZE arr2 <- MBA.new len -- Re-initialize the array with random value forM_ [0..(len - 1)] $ \i -> POKE(i, arr2, (8 :: Word8)) @@ -234,7 +246,7 @@ testGenericConsistency :: forall a. ( Eq a , Show a -#ifdef USE_SERIALIZE +#ifdef TEST_DERIVE_SERIALIZE , Serialize a #endif , Unbox a @@ -249,7 +261,7 @@ testGenericConsistency val = do -- Test the generic sizeOf let len = -#ifdef USE_SERIALIZE +#ifdef TEST_DERIVE_SERIALIZE variableSizeOf val #else sizeOf (Proxy :: Proxy a) @@ -270,7 +282,7 @@ testGenericConsistency val = do nextOff `shouldBe` len -#ifndef USE_SERIALIZE +#ifndef TEST_DERIVE_SERIALIZE -- Size is also implicitly tested while serializing and deserializing. checkSizeOf :: forall a. Unbox a => Proxy a -> Int -> IO () checkSizeOf _ sz = sizeOf (Proxy :: Proxy a) `shouldBe` sz @@ -306,7 +318,7 @@ testCases = do it "SumOfProducts SOP2" $ testSerialization (SOP2 1 'a') it "SumOfProducts SOP3" $ testSerialization (SOP3 1 2 3) -#ifndef USE_SERIALIZE +#ifndef TEST_DERIVE_SERIALIZE CHECK_SIZE(Unit, 1) CHECK_SIZE(Unit1, 1) CHECK_SIZE(Unit2, 2) @@ -348,4 +360,5 @@ moduleName :: String moduleName = MODULE_NAME main :: IO () -main = hspec $ H.parallel $ describe moduleName testCases +main = hspec $ H.parallel $ describe moduleName $ do + testCases diff --git a/test/Streamly/Test/Data/Unbox/TH.hs b/test/Streamly/Test/Data/MutByteArray/DeriveUnbox.hs similarity index 58% rename from test/Streamly/Test/Data/Unbox/TH.hs rename to test/Streamly/Test/Data/MutByteArray/DeriveUnbox.hs index f25d41dc2b..7dcf29bc2a 100644 --- a/test/Streamly/Test/Data/Unbox/TH.hs +++ b/test/Streamly/Test/Data/MutByteArray/DeriveUnbox.hs @@ -1,21 +1,38 @@ {-# LANGUAGE TemplateHaskell #-} -- | --- Module : Streamly.Test.Data.Unbox.TH +-- Module : Streamly.Test.Data.MutByteArray.DeriveUnbox -- Copyright : (c) 2022 Composewell technologies -- License : BSD-3-Clause -- Maintainer : streamly@composewell.com -- Stability : experimental -- Portability : GHC -module Streamly.Test.Data.Unbox.TH (main) where +module Streamly.Test.Data.MutByteArray.DeriveUnbox (main) where -------------------------------------------------------------------------------- -- Imports -------------------------------------------------------------------------------- +import Control.Monad (void) +import Data.Complex (Complex) +import Data.Functor.Const (Const) +import Data.Functor.Identity (Identity) +#if MIN_VERSION_base(4,14,0) +import Data.Ord (Down) +#endif import Data.Proxy (Proxy(..)) +import Foreign.Ptr (FunPtr, IntPtr, Ptr, WordPtr) +import GHC.Fingerprint (Fingerprint) +import GHC.Int (Int8, Int16, Int32, Int64) +#if MIN_VERSION_base(4,15,0) +import GHC.IO.SubSystem (IoSubSystem) +#endif +import GHC.Real (Ratio) +import GHC.Stable (StablePtr) +import GHC.Word (Word8, Word16, Word32, Word64) import Streamly.Internal.Data.MutByteArray +import qualified Streamly.Internal.Data.MutArray as MArray import qualified Streamly.Internal.Data.MutByteArray as MBA import Test.Hspec as H @@ -76,6 +93,9 @@ $(deriveUnbox [d|instance Unbox b => Unbox (CustomDataType4 a b)|]) #define CHECK_SIZE(type, expectation) \ it "checkSizeOf type" $ checkSizeOf (Proxy :: Proxy type) expectation +-- Unbox instance existence tests via MutArray creation +#define TEST_IE(_type) it "_type" $ testIE ([] :: [_type]) + -------------------------------------------------------------------------------- -- Tests -------------------------------------------------------------------------------- @@ -127,6 +147,97 @@ testCustomDatatype4TH = do (Proxy :: Proxy (CustomDataType4 a Int)) (1 + sizeOf (Proxy :: Proxy Bool) + sizeOf (Proxy :: Proxy Int)) +-- C-ish foreign types are platform specific. The platform needs to be taken +-- into consideration when making instances. +testUnboxInstanceExistance :: Spec +testUnboxInstanceExistance = do + describe "Unbox instances" $ do + -- TEST_IE(CBool) + -- TEST_IE(CChar) + -- TEST_IE(CClock) + -- TEST_IE(CDouble) + -- TEST_IE(CFloat) + -- TEST_IE(CInt) + -- TEST_IE(CIntMax) + -- TEST_IE(CIntPtr) + -- TEST_IE(CLLong) + -- TEST_IE(CLong) + -- TEST_IE(CPtrdiff) + -- TEST_IE(CSChar) + -- TEST_IE(CSUSeconds) + -- TEST_IE(CShort) + -- TEST_IE(CSigAtomic) + -- TEST_IE(CSize) + -- TEST_IE(CTime) + -- TEST_IE(CUChar) + -- TEST_IE(CUInt) + -- TEST_IE(CUIntMax) + -- TEST_IE(CUIntPtr) + -- TEST_IE(CULLong) + -- TEST_IE(CULong) + -- TEST_IE(CUSeconds) + -- TEST_IE(CUShort) + -- TEST_IE(CWchar) + TEST_IE(IntPtr) + TEST_IE(WordPtr) + TEST_IE(Fingerprint) + TEST_IE(Int16) + TEST_IE(Int32) + TEST_IE(Int64) + TEST_IE(Int8) +#if MIN_VERSION_base(4,15,0) + TEST_IE(IoSubSystem) +#endif + TEST_IE(Word16) + TEST_IE(Word32) + TEST_IE(Word64) + TEST_IE(Word8) + -- TEST_IE(CBlkCnt) + -- TEST_IE(CBlkSize) + -- TEST_IE(CCc) + -- TEST_IE(CClockId) + -- TEST_IE(CDev) + -- TEST_IE(CFsBlkCnt) + -- TEST_IE(CFsFilCnt) + -- TEST_IE(CGid) + -- TEST_IE(CId) + -- TEST_IE(CIno) + -- TEST_IE(CKey) + -- TEST_IE(CMode) + -- TEST_IE(CNfds) + -- TEST_IE(CNlink) + -- TEST_IE(COff) + -- TEST_IE(CPid) + -- TEST_IE(CRLim) + -- TEST_IE(CSocklen) + -- TEST_IE(CSpeed) + -- TEST_IE(CSsize) + -- TEST_IE(CTcflag) + -- TEST_IE(CTimer) + -- TEST_IE(CUid) + -- TEST_IE(Fd) + TEST_IE(()) + TEST_IE(Bool) + TEST_IE(Char) + TEST_IE(Double) + TEST_IE(Float) + TEST_IE(Int) + TEST_IE(Word) + TEST_IE(Complex Int) + TEST_IE(Identity Int) +#if MIN_VERSION_base(4,14,0) + TEST_IE(Down Int) +#endif + TEST_IE(FunPtr Int) + TEST_IE(Ptr Int) + TEST_IE(Ratio Int) + TEST_IE(StablePtr Int) + TEST_IE(Const Int Int) + where + + testIE :: Unbox a => [a] -> IO () + testIE lst = void $ MArray.fromList lst + testCases :: Spec testCases = do @@ -134,6 +245,7 @@ testCases = do testCustomDatatype2TH testCustomDatatype3TH testCustomDatatype4TH + testUnboxInstanceExistance -------------------------------------------------------------------------------- -- Main function diff --git a/test/Streamly/Test/Data/Serialize.hs b/test/Streamly/Test/Data/MutByteArray/Serialize.hs similarity index 92% rename from test/Streamly/Test/Data/Serialize.hs rename to test/Streamly/Test/Data/MutByteArray/Serialize.hs index 4d4e786926..6c82dc0efc 100644 --- a/test/Streamly/Test/Data/Serialize.hs +++ b/test/Streamly/Test/Data/MutByteArray/Serialize.hs @@ -8,14 +8,14 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -- | --- Module : Streamly.Test.Data.Serialize +-- Module : Streamly.Test.Data.MutByteArray.Serialize -- Copyright : (c) 2022 Composewell technologies -- License : BSD-3-Clause -- Maintainer : streamly@composewell.com -- Stability : experimental -- Portability : GHC -module Streamly.Test.Data.Serialize (main) where +module Streamly.Test.Data.MutByteArray.Serialize (main) where -------------------------------------------------------------------------------- -- Imports @@ -27,16 +27,15 @@ import System.Random (randomRIO) import Streamly.Internal.Data.MutByteArray (MutByteArray) import GHC.Generics (Generic) import Streamly.Data.MutByteArray (Serialize) -import Streamly.Test.Data.Serialize.TH (genDatatype) +import Streamly.Test.Data.MutByteArray.TH (genDatatype) import Data.Functor.Identity (Identity (..)) import qualified Streamly.Internal.Data.Array as Array -import qualified Streamly.Internal.Data.MutArray as MutArray import qualified Streamly.Internal.Data.MutByteArray as Serialize -import qualified Streamly.Test.Data.Serialize.CompatV0 as CompatV0 -import qualified Streamly.Test.Data.Serialize.CompatV1 as CompatV1 +import qualified Streamly.Test.Data.MutByteArray.CompatV0 as CompatV0 +import qualified Streamly.Test.Data.MutByteArray.CompatV1 as CompatV1 import Test.Hspec.QuickCheck import Test.QuickCheck @@ -207,11 +206,6 @@ peekAndVerify (arr, serStartOff, serEndOff) val = do (off2, val2) <- Serialize.deserializeAt serStartOff arr serEndOff val2 `shouldBe` val off2 `shouldBe` serEndOff - let slice = Array.Array arr serStartOff serEndOff - val `shouldBe` fst (Array.deserialize slice) - clonedSlice <- - fmap Array.unsafeFreeze $ MutArray.clone $ Array.unsafeThaw slice - val `shouldBe` fst (Array.deserialize clonedSlice) roundtrip :: forall a. (Eq a, Show a, Serialize.Serialize a) @@ -223,8 +217,6 @@ roundtrip val = do -- let sz = Serialize.addSizeTo 0 val -- putStrLn $ "Size is: " ++ show sz - val `shouldBe` fst (Array.deserialize (Array.serialize' val)) - res <- poke val peekAndVerify res val @@ -268,9 +260,6 @@ testCases = do prop "([Integer], [Int])" $ \(x :: ([Integer], [Int])) -> roundtrip x - prop "Array Int" - $ \(x :: [Int]) -> roundtrip (Array.fromList x) - prop "Compatible Record" $ \(a :: CompatV1.Rec (CompatV0.Rec CompatV1.River)) -> roundtrip a diff --git a/test/Streamly/Test/Data/Serialize/TH.hs b/test/Streamly/Test/Data/MutByteArray/TH.hs similarity index 95% rename from test/Streamly/Test/Data/Serialize/TH.hs rename to test/Streamly/Test/Data/MutByteArray/TH.hs index e6b45dea07..944ad23d38 100644 --- a/test/Streamly/Test/Data/Serialize/TH.hs +++ b/test/Streamly/Test/Data/MutByteArray/TH.hs @@ -1,14 +1,14 @@ {-# LANGUAGE TemplateHaskell #-} -- | --- Module : Streamly.Test.Data.Serialize.TH +-- Module : Streamly.Test.Data.MutByteArray.TH -- Copyright : (c) 2022 Composewell technologies -- License : BSD-3-Clause -- Maintainer : streamly@composewell.com -- Stability : experimental -- Portability : GHC -module Streamly.Test.Data.Serialize.TH (genDatatype) where +module Streamly.Test.Data.MutByteArray.TH (genDatatype) where -------------------------------------------------------------------------------- -- Imports diff --git a/test/Streamly/Test/Data/Parser.hs b/test/Streamly/Test/Data/Parser.hs index 2d1ed9c614..83e452d263 100644 --- a/test/Streamly/Test/Data/Parser.hs +++ b/test/Streamly/Test/Data/Parser.hs @@ -11,28 +11,23 @@ import Control.Monad.IO.Class (MonadIO(..)) import Data.Char (isSpace) import Data.Foldable (for_) import Data.Word (Word8, Word32, Word64) -import Streamly.Internal.Data.Fold (Fold(..)) -import Streamly.Internal.Data.Parser (Parser(..), Step(..), Initial(..), Final(..)) import Streamly.Test.Common (listEquals, checkListEqual, chooseInt) -import Streamly.Internal.Data.Parser (ParseError(..)) import Test.QuickCheck (forAll, Property, property, listOf, vectorOf, Gen) import Test.QuickCheck.Monadic (monadicIO, assert, run) import Prelude hiding (sequence) -import qualified Streamly.Test.Data.Parser.Common as Common +import qualified Streamly.Test.Data.Parser.CommonTests as Common import qualified Streamly.Data.Stream as S import qualified Streamly.Internal.Data.Array as A import qualified Streamly.Internal.Data.Fold as FL import qualified Streamly.Internal.Data.Parser as P -import qualified Streamly.Internal.Data.ParserK as PK import qualified Streamly.Internal.Data.Stream as SI -import qualified Streamly.Internal.Data.StreamK as K import qualified Test.Hspec as H import Test.Hspec import Test.Hspec.QuickCheck -import Streamly.Test.Parser.Common +import Streamly.Test.Data.Parser.CommonUtilities #if MIN_VERSION_QuickCheck(2,14,0) @@ -301,22 +296,6 @@ sanityParseBreak jumps = it (show jumps) $ do lst <- S.toList rest (val, lst) `shouldBe` (expectedResult jumps tape) -sanityParseDBreak :: [Move] -> SpecWith () -sanityParseDBreak jumps = it (show jumps) $ do - (val, rest) <- K.parseBreakPos (PK.toParserK (jumpParser jumps)) $ K.fromList tape - lst <- K.toList rest - (val, lst) `shouldBe` (expectedResult jumps tape) - -{- -sanityParseBreakChunksK :: [Move] -> SpecWith () -sanityParseBreakChunksK jumps = it (show jumps) $ do - (val, rest) <- - A.parseBreakChunksK (jumpParser jumps) - $ K.fromList $ Prelude.map A.fromList chunkedTape - lst <- Prelude.map A.toList <$> K.toList rest - (val, concat lst) `shouldBe` (expectedResult jumps tape) --} - sanityParseMany :: [Move] -> SpecWith () sanityParseMany jumps = it (show jumps) $ do res <- S.toList $ SI.parseManyPos (jumpParser jumps) $ S.fromList tape @@ -333,62 +312,14 @@ sanityParseIterate jumps = it (show jumps) $ do -- Instances ------------------------------------------------------------------------------- -{-# INLINE takeWhileFailD #-} -takeWhileFailD :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b -takeWhileFailD predicate (Fold fstep finitial _ ffinal) = - Parser step initial extract - - where - - initial = do - res <- finitial - return $ case res of - FL.Partial s -> IPartial s - FL.Done b -> IDone b - - step s a = - if predicate a - then do - fres <- fstep s a - return - $ case fres of - FL.Partial s1 -> SContinue 1 s1 - FL.Done b -> SDone 1 b - else return $ SError "fail" - - extract s = fmap (FDone 0) (ffinal s) - -{-# INLINE takeWhileFail #-} -takeWhileFail :: MonadIO m => - (a -> Bool) -> Fold m a b -> PK.ParserK a m b -takeWhileFail p f = PK.toParserK (takeWhileFailD p f) - -{-# INLINE takeWhileK #-} -takeWhileK :: MonadIO m => (a -> Bool) -> PK.ParserK a m [a] -takeWhileK p = PK.toParserK $ P.takeWhile p FL.toList - -{-# INLINE alt2 #-} -alt2 :: MonadIO m => K.StreamK m Int -> m (Either ParseError [Int]) -alt2 = - K.parse - ( takeWhileFail (<= 5) FL.toList - <|> takeWhileK (<= 7) - ) - -{-# INLINE altD #-} -altD :: MonadIO m => S.Stream m Int -> m (Either P.ParseError [Int]) -altD = +{-# INLINE alt #-} +alt :: MonadIO m => S.Stream m Int -> m (Either P.ParseError [Int]) +alt = S.parse - ( takeWhileFailD (<= 5) FL.toList + ( Common.takeWhileFailD (<= 5) FL.toList <|> P.takeWhile (<= 7) FL.toList ) -altTests :: Spec -altTests = - describe "alt" $ do - it "alt2 [1..20]" $ alt2 (K.fromList [1..20]) `shouldReturn` Right [1..7] - it "altD [1..20]" $ altD (S.fromList [1..20]) `shouldReturn` Right [1..7] - ------------------------------------------------------------------------------- -- Main ------------------------------------------------------------------------------- @@ -402,8 +333,8 @@ main = do H.parallel $ modifyMaxSuccess (const maxTestCount) $ do describe moduleName $ do + Common.mainCommon Common.TMParserStream parserSanityTests "Stream.parseBreak" sanityParseBreak - parserSanityTests "StreamK.parseDBreak" sanityParseDBreak -- parserSanityTests "A.sanityParseBreakChunksK" sanityParseBreakChunksK parserSanityTests "Stream.parseMany" sanityParseMany parserSanityTests "Stream.parseIterate" sanityParseIterate @@ -426,6 +357,4 @@ main = do "\"hello\\\"\\\\w\\'orld\"" ["hello\"\\w\\'orld"] - - altTests - Common.main + it "alt [1..20]" $ alt (S.fromList [1..20]) `shouldReturn` Right [1..7] diff --git a/test/Streamly/Test/Data/ParserK.hs b/test/Streamly/Test/Data/ParserK.hs index 35e47a1f32..55c06b63d7 100644 --- a/test/Streamly/Test/Data/ParserK.hs +++ b/test/Streamly/Test/Data/ParserK.hs @@ -5,12 +5,13 @@ module Main (main) where +import Control.Applicative ((<|>)) +import Control.Monad.IO.Class (MonadIO(..)) import Data.Either (fromRight) -import Test.Hspec (Spec, hspec, describe, it, expectationFailure, shouldBe) +import Streamly.Internal.Data.Parser (ParseError(..)) +import Test.Hspec (Spec, hspec, describe, it, expectationFailure, shouldBe, shouldReturn) import Test.Hspec.QuickCheck -import qualified Streamly.Internal.Data.Array as A -import qualified Streamly.Internal.Data.Array.Generic as AG import qualified Streamly.Internal.Data.Fold as FL import qualified Streamly.Internal.Data.Parser as Parser import qualified Streamly.Internal.Data.ParserK as ParserK @@ -18,7 +19,8 @@ import qualified Streamly.Internal.Data.Stream as Stream import qualified Streamly.Internal.Data.StreamK as StreamK import qualified Test.Hspec as H -import Streamly.Test.Parser.Common +import Streamly.Test.Data.Parser.CommonUtilities +import qualified Streamly.Test.Data.Parser.CommonTests as Common import Prelude hiding (sequence) @@ -110,21 +112,27 @@ sanityParseBreak jumps = it (show jumps) $ do lst <- StreamK.toList rest (val, lst) `shouldBe` (expectedResult jumps tape) -sanityParseBreakChunks :: [Move] -> H.SpecWith () -sanityParseBreakChunks jumps = it (show jumps) $ do - (val, rest) <- - A.parseBreakPos (A.toParserK (jumpParser jumps)) - $ StreamK.fromList $ Prelude.map A.fromList chunkedTape - lst <- Prelude.map A.toList <$> StreamK.toList rest - (val, concat lst) `shouldBe` (expectedResult jumps tape) -sanityParseBreakChunksGeneric :: [Move] -> H.SpecWith () -sanityParseBreakChunksGeneric jumps = it (show jumps) $ do - (val, rest) <- - AG.parseBreakPos (AG.toParserK (jumpParser jumps)) - $ StreamK.fromList $ Prelude.map AG.fromList chunkedTape - lst <- Prelude.map AG.toList <$> StreamK.toList rest - (val, concat lst) `shouldBe` (expectedResult jumps tape) +------------------------------------------------------------------------------- +-- Instances +------------------------------------------------------------------------------- + +{-# INLINE takeWhileFail #-} +takeWhileFail :: MonadIO m => + (a -> Bool) -> FL.Fold m a b -> ParserK.ParserK a m b +takeWhileFail p f = ParserK.toParserK (Common.takeWhileFailD p f) + +{-# INLINE takeWhileK #-} +takeWhileK :: MonadIO m => (a -> Bool) -> ParserK.ParserK a m [a] +takeWhileK p = ParserK.toParserK $ Parser.takeWhile p FL.toList + +{-# INLINE alt2 #-} +alt2 :: MonadIO m => StreamK.StreamK m Int -> m (Either ParseError [Int]) +alt2 = + StreamK.parse + ( takeWhileFail (<= 5) FL.toList + <|> takeWhileK (<= 7) + ) ------------------------------------------------------------------------------- -- Main @@ -133,14 +141,13 @@ sanityParseBreakChunksGeneric jumps = it (show jumps) $ do moduleName :: String moduleName = "Data.ParserK" --- Many ParserK tests are tested in Test.Parser module main :: IO () main = hspec $ H.parallel $ modifyMaxSuccess (const maxTestCount) $ do describe moduleName $ do - parserSanityTests "StreamK.parseBreak" sanityParseBreak - parserSanityTests "StreamK.parseBreakChunks" sanityParseBreakChunks - parserSanityTests "StreamK.parseBreakChunksGeneric" sanityParseBreakChunksGeneric + Common.mainCommon Common.TMParserKStreamK toParser + parserSanityTests "StreamK.parseBreak" sanityParseBreak + it "alt2 [1..20]" $ alt2 (StreamK.fromList [1..20]) `shouldReturn` Right [1..7] diff --git a/test/Streamly/Test/Data/ParserK/Chunked.hs b/test/Streamly/Test/Data/ParserK/Chunked.hs new file mode 100644 index 0000000000..0a420dd5fc --- /dev/null +++ b/test/Streamly/Test/Data/ParserK/Chunked.hs @@ -0,0 +1,34 @@ +module Main (main) where + +import Test.Hspec (hspec, describe, it, shouldBe) +import Test.Hspec.QuickCheck (modifyMaxSuccess) + +import qualified Streamly.Internal.Data.Array as A +import qualified Streamly.Internal.Data.StreamK as StreamK +import qualified Test.Hspec as H + +import Streamly.Test.Data.Parser.CommonUtilities +import qualified Streamly.Test.Data.Parser.CommonTests as Common + +maxTestCount :: Int +maxTestCount = 100 + +sanityParseBreakChunks :: [Move] -> H.SpecWith () +sanityParseBreakChunks jumps = it (show jumps) $ do + (val, rest) <- + A.parseBreakPos (A.toParserK (jumpParser jumps)) + $ StreamK.fromList $ map A.fromList chunkedTape + lst <- map A.toList <$> StreamK.toList rest + (val, concat lst) `shouldBe` (expectedResult jumps tape) + +moduleName :: String +moduleName = "Data.ParserK.Chunked" + +main :: IO () +main = + hspec $ + H.parallel $ + modifyMaxSuccess (const maxTestCount) $ + describe moduleName $ do + Common.mainCommon Common.TMParserKStreamKChunks + parserSanityTests "StreamK.parseBreakChunks" sanityParseBreakChunks diff --git a/test/Streamly/Test/Data/ParserK/ChunkedGeneric.hs b/test/Streamly/Test/Data/ParserK/ChunkedGeneric.hs new file mode 100644 index 0000000000..496bd3e0b9 --- /dev/null +++ b/test/Streamly/Test/Data/ParserK/ChunkedGeneric.hs @@ -0,0 +1,34 @@ +module Main (main) where + +import Test.Hspec (hspec, describe, it, shouldBe) +import Test.Hspec.QuickCheck (modifyMaxSuccess) + +import qualified Streamly.Internal.Data.Array.Generic as AG +import qualified Streamly.Internal.Data.StreamK as StreamK +import qualified Test.Hspec as H + +import Streamly.Test.Data.Parser.CommonUtilities +import qualified Streamly.Test.Data.Parser.CommonTests as Common + +maxTestCount :: Int +maxTestCount = 100 + +sanityParseBreakChunksGeneric :: [Move] -> H.SpecWith () +sanityParseBreakChunksGeneric jumps = it (show jumps) $ do + (val, rest) <- + AG.parseBreakPos (AG.toParserK (jumpParser jumps)) + $ StreamK.fromList $ map AG.fromList chunkedTape + lst <- map AG.toList <$> StreamK.toList rest + (val, concat lst) `shouldBe` (expectedResult jumps tape) + +moduleName :: String +moduleName = "Data.ParserK.Chunked.Generic" + +main :: IO () +main = + hspec $ + H.parallel $ + modifyMaxSuccess (const maxTestCount) $ + describe moduleName $ do + Common.mainCommon Common.TMParserKStreamKChunksGeneric + parserSanityTests "StreamK.parseBreakChunksGeneric" sanityParseBreakChunksGeneric diff --git a/test/Streamly/Test/Data/SmallArray.hs b/test/Streamly/Test/Data/SmallArray.hs index 3f4e8f83a2..07dd546958 100644 --- a/test/Streamly/Test/Data/SmallArray.hs +++ b/test/Streamly/Test/Data/SmallArray.hs @@ -10,7 +10,18 @@ module Streamly.Test.Data.SmallArray (main) where -#include "Streamly/Test/Data/Array/CommonImports.hs" +import Test.Hspec.QuickCheck +import Test.QuickCheck (Property, forAll, Gen, vectorOf, arbitrary, choose) +import Test.QuickCheck.Monadic (monadicIO, assert, run) +import Test.Hspec as H + +import Streamly.Data.Fold (Fold) +import Streamly.Internal.Data.Stream (Stream) +import Streamly.Internal.System.IO (defaultChunkSize) +import Streamly.Test.Common (listEquals) + +import qualified Streamly.Data.Fold as Fold +import qualified Streamly.Internal.Data.Stream as S import qualified Streamly.Internal.Data.SmallArray as A type Array = A.SmallArray @@ -18,7 +29,15 @@ type Array = A.SmallArray moduleName :: String moduleName = "Data.SmallArray" -#include "Streamly/Test/Data/Array/Common.hs" +-- Coverage build takes too long with default number of tests +maxTestCount :: Int +#ifdef DEVBUILD +maxTestCount = 100 +#else +maxTestCount = 10 +#endif + +#include "Streamly/Test/Data/Array/TypeCommon.hs" main :: IO () main = @@ -26,4 +45,4 @@ main = H.parallel $ modifyMaxSuccess (const maxTestCount) $ do describe moduleName $ do - commonMain + typeCommon diff --git a/test/Streamly/Test/Data/Parser/Common.hs b/test/lib/Streamly/Test/Data/Parser/CommonTests.hs similarity index 96% rename from test/Streamly/Test/Data/Parser/Common.hs rename to test/lib/Streamly/Test/Data/Parser/CommonTests.hs index 1284fa25c8..53aa339946 100644 --- a/test/Streamly/Test/Data/Parser/Common.hs +++ b/test/lib/Streamly/Test/Data/Parser/CommonTests.hs @@ -3,20 +3,35 @@ #if __GLASGOW_HASKELL__ >= 908 {-# OPTIONS_GHC -Wno-x-partial #-} #endif -module Streamly.Test.Data.Parser.Common (main) where +-- We keep Parser and ParserK tests in the same (Parser) executable for 2 +-- reasons: +-- 1. We almost always write Parser tests hence we prioritize Parser over +-- ParserK +-- 2. This results in minimal compilation overhead compared to duplicating +-- or keeping the common part in the library. +-- 2.1. Duplication will result in compilation of this code twice +-- 2.2. Keeping the common part in the library will compile the Parser +-- code even when it's not necessary. For example, if we are running +-- non-parser test suites. +-- +-- One problem is that this module becomes very big for compilation. We can +-- break this further and keep them as a part of "other-modules" in +-- Test.Parser test-suite. +module Streamly.Test.Data.Parser.CommonTests (mainCommon, TestMode(..), takeWhileFailD) where import Control.Applicative ((<|>)) import Control.Exception (displayException, try, evaluate, SomeException) import Data.List (isSuffixOf) +import Streamly.Internal.Data.Fold (Fold(..)) import Streamly.Internal.Data.MutByteArray (Unbox) import Streamly.Test.Common (listEquals, checkListEqual, chooseInt) -import Streamly.Internal.Data.Parser (ParseErrorPos(..)) +import Streamly.Internal.Data.Parser (ParseErrorPos(..), Parser(..), Step(..), Initial(..), Final(..)) import Test.QuickCheck (arbitrary, forAll, elements, Property, property, listOf, vectorOf, Gen, (.&&.), ioProperty) import Test.QuickCheck.Monadic (monadicIO, assert, run, PropertyM) -import Prelude hiding (sequence) +import Prelude hiding (sequence, take, takeWhile) import qualified Control.Monad.Fail as Fail import qualified Data.List as List @@ -1070,6 +1085,31 @@ takeStartBy_ producer consumer = predicate = odd parser = P.takeBeginBy_ predicate FL.toList +{-# INLINE takeWhileFailD #-} +takeWhileFailD :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b +takeWhileFailD predicate (Fold fstep finitial _ ffinal) = + Parser step initial extract + + where + + initial = do + res <- finitial + return $ case res of + FL.Partial s -> IPartial s + FL.Done b -> IDone b + + step s a = + if predicate a + then do + fres <- fstep s a + return + $ case fres of + FL.Partial s1 -> SContinue 1 s1 + FL.Done b -> SDone 1 b + else return $ SError "fail" + + extract s = fmap (FDone 0) (ffinal s) + ------------------------------------------------------------------------------- -- Main ------------------------------------------------------------------------------- @@ -1167,18 +1207,18 @@ mainCommon ptt = do $ runParserTC_temp ptt takeBetweenPass prop ("P.takeBetween = Prelude.take when len >= m and len <= n and fail" ++ "otherwise fail") $ runParserTC_temp ptt takeBetween - prop "P.take = Prelude.take" $ runParserTC_temp ptt Streamly.Test.Data.Parser.Common.take + prop "P.take = Prelude.take" $ runParserTC_temp ptt take prop "P.takeEQ = Prelude.take when len >= n" $ runParserTC_temp ptt takeEQPass prop "P.takeEQ = Prelude.take when len >= n and fail otherwise" - $ runParserTC_temp ptt Streamly.Test.Data.Parser.Common.takeEQ + $ runParserTC_temp ptt takeEQ prop "P.takeGE n ls = ls when len >= n" $ runParserTC_temp ptt takeGEPass - prop "P.takeGE n ls = ls when len >= n and fail otherwise" $ runParserTC_temp ptt Streamly.Test.Data.Parser.Common.takeGE + prop "P.takeGE n ls = ls when len >= n and fail otherwise" $ runParserTC_temp ptt takeGE prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" $ runParserTC_temp ptt lookAheadPass -- prop "Fail when stream length exceeded" lookAheadFail prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" $ runParserTC_temp ptt lookAhead prop ("P.takeStartBy pred = head : Prelude.takeWhile (not . pred)" ++ " tail") $ runParserTC ptt takeStartBy - prop "P.takeWhile = Prelude.takeWhile" $ runParserTC ptt Streamly.Test.Data.Parser.Common.takeWhile + prop "P.takeWhile = Prelude.takeWhile" $ runParserTC ptt takeWhile prop ("P.takeWhile1 = Prelude.takeWhile if taken something," ++ " else check why failed") $ runParserTC ptt takeWhile1 prop "takeWhileP prd P.take = takeWhileMaxLen prd" $ runParserTC ptt takeWhileP @@ -1219,23 +1259,3 @@ mainCommon ptt = do runParserTC_temp ptt takeProperties -main :: Spec -main = do - -- We keep Parser and ParserK tests in the same (Parser) executable for 2 - -- reasons: - -- 1. We almost always write Parser tests hence we prioritize Parser over - -- ParserK - -- 2. This results in minimal compilation overhead compared to duplicating - -- or keeping the common part in the library. - -- 2.1. Duplication will result in compilation of this code twice - -- 2.2. Keeping the common part in the library will compile the Parser - -- code even when it's not necessary. For example, if we are running - -- non-parser test suites. - -- - -- One problem is that this module becomes very big for compilation. We can - -- break this further and keep them as a part of "other-modules" in - -- Test.Parser test-suite. - mainCommon TMParserStream - mainCommon TMParserKStreamKChunks - mainCommon TMParserKStreamK - mainCommon TMParserKStreamKChunksGeneric diff --git a/test/lib/Streamly/Test/Parser/Common.hs b/test/lib/Streamly/Test/Data/Parser/CommonUtilities.hs similarity index 99% rename from test/lib/Streamly/Test/Parser/Common.hs rename to test/lib/Streamly/Test/Data/Parser/CommonUtilities.hs index 99befeaa47..9d83a0a31a 100644 --- a/test/lib/Streamly/Test/Parser/Common.hs +++ b/test/lib/Streamly/Test/Data/Parser/CommonUtilities.hs @@ -1,4 +1,4 @@ -module Streamly.Test.Parser.Common +module Streamly.Test.Data.Parser.CommonUtilities ( Move(..) , jumpParser , chunkedTape diff --git a/test/streamly-tests.cabal b/test/streamly-tests.cabal index e11bc0bb6e..089e0e6cce 100644 --- a/test/streamly-tests.cabal +++ b/test/streamly-tests.cabal @@ -193,7 +193,8 @@ library hs-source-dirs: lib exposed-modules: Streamly.Test.Common - Streamly.Test.Parser.Common + Streamly.Test.Data.Parser.CommonUtilities + Streamly.Test.Data.Parser.CommonTests Streamly.Test.Control.Exception.Common if !flag(use-streamly-core) && flag(dev) exposed-modules: Streamly.Test.Prelude.Common @@ -248,6 +249,7 @@ test-suite Data.Array type: exitcode-stdio-1.0 main-is: Streamly/Test/Data/Array.hs ghc-options: -main-is Streamly.Test.Data.Array.main + other-modules: Streamly.Test.Data.Array.Type test-suite Data.Array.Generic import: test-options @@ -257,13 +259,6 @@ test-suite Data.Array.Generic if flag(use-streamly-core) buildable: False -test-suite Data.Array.Stream - import: test-options - type: exitcode-stdio-1.0 - main-is: Streamly/Test/Data/Array/Stream.hs - if flag(use-streamly-core) - buildable: False - test-suite Data.Binary import: test-options type: exitcode-stdio-1.0 @@ -302,70 +297,103 @@ test-suite Data.MutArray type: exitcode-stdio-1.0 main-is: Streamly/Test/Data/MutArray.hs ghc-options: -main-is Streamly.Test.Data.MutArray.main + other-modules: Streamly.Test.Data.MutArray.Type -test-suite Data.Parser +test-suite Data.MutArray.Generic import: test-options type: exitcode-stdio-1.0 - main-is: Streamly/Test/Data/Parser.hs - hs-source-dirs: . - other-modules: Streamly.Test.Data.Parser.Common - if flag(limit-build-mem) - ghc-options: +RTS -M2000M -RTS + main-is: Streamly/Test/Data/MutArray/Generic.hs + ghc-options: -main-is Streamly.Test.Data.MutArray.Generic.main + if flag(use-streamly-core) + buildable: False -test-suite Data.ParserK +test-suite Data.MutByteArray.DeriveSerialize import: test-options type: exitcode-stdio-1.0 - main-is: Streamly/Test/Data/ParserK.hs - if flag(limit-build-mem) - ghc-options: +RTS -M1500M -RTS + cpp-options: -DTEST_DERIVE_SERIALIZE + main-is: Streamly/Test/Data/MutByteArray/DeriveInstances.hs + ghc-options: -main-is Streamly.Test.Data.MutByteArray.DeriveInstances.main -test-suite Data.RingArray +test-suite Data.MutByteArray.DeriveUnboxGeneric import: test-options type: exitcode-stdio-1.0 - main-is: Streamly/Test/Data/RingArray.hs - ghc-options: -main-is Streamly.Test.Data.RingArray.main + main-is: Streamly/Test/Data/MutByteArray/DeriveInstances.hs + ghc-options: -main-is Streamly.Test.Data.MutByteArray.DeriveInstances.main -test-suite Data.Scanl.Concurrent +test-suite Data.MutByteArray.DeriveUnboxTH import: test-options type: exitcode-stdio-1.0 - main-is: Streamly/Test/Data/Scanl/Concurrent.hs - ghc-options: -main-is Streamly.Test.Data.Scanl.Concurrent.main - if flag(use-streamly-core) - buildable: False + cpp-options: -DTEST_DERIVE_UNBOX + main-is: Streamly/Test/Data/MutByteArray/DeriveInstances.hs + ghc-options: -main-is Streamly.Test.Data.MutByteArray.DeriveInstances.main --- XXX Rename to MutByteArray -test-suite Data.Serialize +test-suite Data.MutByteArray.DeriveUnboxTHCustom import: test-options type: exitcode-stdio-1.0 - main-is: Streamly/Test/Data/Serialize.hs - other-modules: - Streamly.Test.Data.Serialize.TH - Streamly.Test.Data.Serialize.CompatV0 - Streamly.Test.Data.Serialize.CompatV1 - ghc-options: -main-is Streamly.Test.Data.Serialize.main - if flag(limit-build-mem) - ghc-options: +RTS -M1500M -RTS + main-is: Streamly/Test/Data/MutByteArray/DeriveUnbox.hs + ghc-options: -main-is Streamly.Test.Data.MutByteArray.DeriveUnbox.main -test-suite Data.Serialize.Derive.TH +test-suite Data.MutByteArray.Serialize import: test-options type: exitcode-stdio-1.0 - cpp-options: -DUSE_SERIALIZE - main-is: Streamly/Test/Data/Unbox.hs - ghc-options: -main-is Streamly.Test.Data.Unbox.main + main-is: Streamly/Test/Data/MutByteArray/Serialize.hs + other-modules: + Streamly.Test.Data.MutByteArray.TH + Streamly.Test.Data.MutByteArray.CompatV0 + Streamly.Test.Data.MutByteArray.CompatV1 + ghc-options: -main-is Streamly.Test.Data.MutByteArray.Serialize.main + if flag(limit-build-mem) + ghc-options: +RTS -M1500M -RTS -test-suite Data.Serialize.ENABLE_constructorTagAsString +test-suite Data.MutByteArray.SerializeConstrTags import: test-options type: exitcode-stdio-1.0 - main-is: Streamly/Test/Data/Serialize.hs + main-is: Streamly/Test/Data/MutByteArray/Serialize.hs other-modules: - Streamly.Test.Data.Serialize.TH - Streamly.Test.Data.Serialize.CompatV0 - Streamly.Test.Data.Serialize.CompatV1 + Streamly.Test.Data.MutByteArray.TH + Streamly.Test.Data.MutByteArray.CompatV0 + Streamly.Test.Data.MutByteArray.CompatV1 cpp-options: -DENABLE_constructorTagAsString - ghc-options: -main-is Streamly.Test.Data.Serialize.main + ghc-options: -main-is Streamly.Test.Data.MutByteArray.Serialize.main if flag(limit-build-mem) ghc-options: +RTS -M1500M -RTS +test-suite Data.Parser + import: test-options + type: exitcode-stdio-1.0 + main-is: Streamly/Test/Data/Parser.hs + if flag(limit-build-mem) + ghc-options: +RTS -M1000M -RTS + +test-suite Data.ParserK + import: test-options + type: exitcode-stdio-1.0 + main-is: Streamly/Test/Data/ParserK.hs + +test-suite Data.ParserK.Chunked + import: test-options + type: exitcode-stdio-1.0 + main-is: Streamly/Test/Data/ParserK/Chunked.hs + +test-suite Data.ParserK.Chunked.Generic + import: test-options + type: exitcode-stdio-1.0 + main-is: Streamly/Test/Data/ParserK/ChunkedGeneric.hs + +test-suite Data.RingArray + import: test-options + type: exitcode-stdio-1.0 + main-is: Streamly/Test/Data/RingArray.hs + ghc-options: -main-is Streamly.Test.Data.RingArray.main + +test-suite Data.Scanl.Concurrent + import: test-options + type: exitcode-stdio-1.0 + main-is: Streamly/Test/Data/Scanl/Concurrent.hs + ghc-options: -main-is Streamly.Test.Data.Scanl.Concurrent.main + if flag(use-streamly-core) + buildable: False + test-suite Data.SmallArray import: test-options type: exitcode-stdio-1.0 @@ -441,26 +469,6 @@ test-suite Data.Stream.Rate if flag(use-streamly-core) || !flag(include-flaky-tests) buildable: False --- XXX Rename to MutByteArray.Unbox -test-suite Data.Unbox.Derive.Generic - import: test-options - type: exitcode-stdio-1.0 - main-is: Streamly/Test/Data/Unbox.hs - ghc-options: -main-is Streamly.Test.Data.Unbox.main - -test-suite Data.Unbox.Derive.TH - import: test-options - type: exitcode-stdio-1.0 - cpp-options: -DUSE_TH - main-is: Streamly/Test/Data/Unbox.hs - ghc-options: -main-is Streamly.Test.Data.Unbox.main - -test-suite Data.Unbox.TH - import: test-options - type: exitcode-stdio-1.0 - main-is: Streamly/Test/Data/Unbox/TH.hs - ghc-options: -main-is Streamly.Test.Data.Unbox.TH.main - test-suite Data.Unfold import: test-options type: exitcode-stdio-1.0