streamly-0.10.1: test/Streamly/Test/Data/Array.hs
-- |
-- Module : Streamly.Test.Data.Array
-- Copyright : (c) 2019 Composewell technologies
-- License : BSD-3-Clause
-- Maintainer : streamly@composewell.com
-- Stability : experimental
-- Portability : GHC
module Streamly.Test.Data.Array (main) where
import Data.Char (isLower)
import Data.List (sort)
import Data.Proxy (Proxy(..))
import Data.Word(Word8)
import Foreign.Storable (peek)
import GHC.Ptr (plusPtr)
import Streamly.Internal.Data.MutByteArray (Unbox, sizeOf)
import Streamly.Internal.Data.MutArray (MutArray)
import Test.QuickCheck (chooseInt, listOf)
import qualified Streamly.Internal.Data.Array as A
import qualified Streamly.Internal.Data.MutArray as MA
#include "Streamly/Test/Data/Array/CommonImports.hs"
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.write)) (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.putIndexUnsafe i arr x
x1 <- MA.getIndexUnsafe 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.writeLastN 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.writeLastN n) $ S.fromList list
let l2 = lastN n list
return $ l1 == l2
testStrip :: IO Bool
testStrip = do
dt <- MA.fromList "abcDEFgeh"
dt' <- MA.strip isLower dt
x <- MA.toList dt'
return $ x == "DEF"
testStripLeft :: IO Bool
testStripLeft = do
dt <- MA.fromList "abcDEF"
dt' <- MA.strip isLower dt
x <- MA.toList dt'
return $ x == "DEF"
testStripRight :: IO Bool
testStripRight = do
dt <- MA.fromList "DEFgeh"
dt' <- MA.strip isLower dt
x <- MA.toList dt'
return $ x == "DEF"
testStripZero :: IO Bool
testStripZero = do
dt <- MA.fromList "DEF"
dt' <- MA.strip isLower dt
x <- MA.toList dt'
return $ x == "DEF"
testStripEmpty :: IO Bool
testStripEmpty = do
dt <- MA.fromList "abc"
dt' <- MA.strip isLower dt
x <- MA.toList dt'
return $ x == ""
testStripNull :: IO Bool
testStripNull = do
dt <- MA.fromList ""
dt' <- MA.strip 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.getSliceUnsafe 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.pinnedNew $ length ls)
testBubbleAsc :: Property
testBubbleAsc = testBubbleWith True
testBubbleDesc :: Property
testBubbleDesc = testBubbleWith False
testByteLengthWithMA :: forall a. Unbox a => a -> IO ()
testByteLengthWithMA _ = do
arrA <- MA.pinnedNew 100 :: IO (MutArray a)
let arrW8 = MA.castUnsafe 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.breakOn 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.write (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.getIndexUnsafe` arr) [0 .. (length inp - 1)] `shouldBe` inp
testAsPtrUnsafeMA :: IO ()
testAsPtrUnsafeMA = do
arr <- MA.fromList ([0 .. 99] :: [Int])
MA.unsafePinnedAsPtr arr (getList (0 :: Int)) `shouldReturn` [0 .. 99]
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 i _
| i >= 100 = return []
getList i p = do
val <- peek p
rest <- getList (i + 1) (p `plusPtr` sizeOfInt)
return $ val : rest
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.realloc newBLen arr
lst <- MA.toList arr
lst1 <- MA.toList arr1
lst `shouldBe` lst1
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 "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 "writeLastN : 0 <= n <= len" testLastN
describe "writeLastN boundary conditions" $ do
it "writeLastN -1" (testLastN_LN 10 (-1) `shouldReturn` True)
it "writeLastN 0" (testLastN_LN 10 0 `shouldReturn` True)
it "writeLastN length" (testLastN_LN 10 10 `shouldReturn` True)
it "writeLastN (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 "getIndexUnsafe . 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")