git.iko.soy/streamly
on fe28607 help sign in
streamly/test/Streamly/Test/Data/Array.hs
283 lines 9.7 kB history raw
1-- |
2-- Module : Streamly.Test.Data.Array
3-- Copyright : (c) 2019 Composewell technologies
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Stability : experimental
7-- Portability : GHC
9module Streamly.Test.Data.Array (main) where
11import Data.Char (isLower)
12import Data.List (sort)
13import Data.Word(Word8)
14import Foreign.Storable (peek)
15import GHC.Ptr (plusPtr)
16import Streamly.Data.Fold (Fold)
17import Streamly.Internal.Data.Stream (Stream)
18import Streamly.Internal.Data.Unboxed (Unbox, sizeOf)
19import Streamly.Test.Common (listEquals)
21import qualified Streamly.Data.Fold as Fold
22import qualified Streamly.Internal.Data.Array as A
23import qualified Streamly.Internal.Data.Array.Type as A
24import qualified Streamly.Internal.Data.Array.Mut.Type as MA
25import qualified Streamly.Internal.Data.Stream as S
27import Test.Hspec as H
28import Test.Hspec.QuickCheck
29import Test.QuickCheck (Property, chooseInt, listOf
30 , forAll, Gen, vectorOf, arbitrary, choose)
31import Test.QuickCheck.Monadic (monadicIO, assert, run)
33type Array = A.Array
35moduleName :: String
36moduleName = "Data.Array"
38#include "Streamly/Test/Data/Array/Common.hs"
40testFromStreamToStream :: Property
41testFromStreamToStream = genericTestFromTo (const A.fromStream) A.read (==)
43testFoldUnfold :: Property
44testFoldUnfold =
45 genericTestFromTo (const (S.fold A.write)) (S.unfold A.reader) (==)
47testFromList :: Property
48testFromList =
49 forAll (choose (0, maxArrLen)) $ \len ->
50 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
51 monadicIO $ do
52 let arr = A.fromList list
53 xs <- run $ S.fold Fold.toList $ S.unfold A.reader arr
54 assert (xs == list)
56testLengthFromStream :: Property
57testLengthFromStream = genericTestFrom (const A.fromStream)
59unsafeWriteIndex :: [Int] -> Int -> Int -> IO Bool
60unsafeWriteIndex xs i x = do
61 arr <- MA.fromList xs
62 MA.putIndexUnsafe i x arr
63 x1 <- MA.getIndexUnsafe i arr
64 return $ x1 == x
66lastN :: Int -> [a] -> [a]
67lastN n l = drop (length l - n) l
69testLastN :: Property
70testLastN =
71 forAll (choose (0, maxArrLen)) $ \len ->
72 forAll (choose (0, len)) $ \n ->
73 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
74 monadicIO $ do
75 xs <- run
76 $ fmap A.toList
77 $ S.fold (A.writeLastN n)
78 $ S.fromList list
79 assert (xs == lastN n list)
81testLastN_LN :: Int -> Int -> IO Bool
82testLastN_LN len n = do
83 let list = [1..len]
84 l1 <- fmap A.toList $ S.fold (A.writeLastN n) $ S.fromList list
85 let l2 = lastN n list
86 return $ l1 == l2
88testStrip :: IO Bool
89testStrip = do
90 dt <- MA.fromList "abcDEFgeh"
91 dt' <- MA.strip isLower dt
92 x <- MA.toList dt'
93 return $ x == "DEF"
95testStripLeft :: IO Bool
96testStripLeft = do
97 dt <- MA.fromList "abcDEF"
98 dt' <- MA.strip isLower dt
99 x <- MA.toList dt'
100 return $ x == "DEF"
102testStripRight :: IO Bool
103testStripRight = do
104 dt <- MA.fromList "DEFgeh"
105 dt' <- MA.strip isLower dt
106 x <- MA.toList dt'
107 return $ x == "DEF"
109testStripZero :: IO Bool
110testStripZero = do
111 dt <- MA.fromList "DEF"
112 dt' <- MA.strip isLower dt
113 x <- MA.toList dt'
114 return $ x == "DEF"
116testStripEmpty :: IO Bool
117testStripEmpty = do
118 dt <- MA.fromList "abc"
119 dt' <- MA.strip isLower dt
120 x <- MA.toList dt'
121 return $ x == ""
123testStripNull :: IO Bool
124testStripNull = do
125 dt <- MA.fromList ""
126 dt' <- MA.strip isLower dt
127 x <- MA.toList dt'
128 return $ x == ""
130unsafeSlice :: Int -> Int -> [Int] -> Bool
131unsafeSlice i n list =
132 let lst = take n $ drop i list
133 arr = A.toList $ A.getSliceUnsafe i n $ A.fromList list
134 in arr == lst
136testBubbleWith :: Bool -> Property
137testBubbleWith asc =
138 forAll (listOf (chooseInt (-50, 100))) $ \ls0 ->
139 monadicIO $ action ls0
141 where
143 action ls = do
144 x <- S.fold (fldm ls) $ S.fromList ls
145 lst <- MA.toList x
146 if asc
147 then assert (sort ls == lst)
148 else assert (sort ls == reverse lst)
150 fldm ls =
151 Fold.foldlM'
152 (\b a -> do
153 arr <- MA.snoc b a
154 if asc
155 then MA.bubble compare arr
156 else MA.bubble (flip compare) arr
157 return arr
158 )
159 (MA.newPinned $ length ls)
161testBubbleAsc :: Property
162testBubbleAsc = testBubbleWith True
164testBubbleDesc :: Property
165testBubbleDesc = testBubbleWith False
167testByteLengthWithMA :: forall a. Unbox a => a -> IO ()
168testByteLengthWithMA _ = do
169 arrA <- MA.newPinned 100 :: IO (MA.Array a)
170 let arrW8 = MA.castUnsafe arrA :: MA.Array Word8
171 MA.byteLength arrA `shouldBe` MA.length arrW8
173testBreakOn :: [Word8] -> Word8 -> [Word8] -> Maybe [Word8] -> IO ()
174testBreakOn inp sep bef aft = do
175 (bef_, aft_) <- A.breakOn sep (A.fromList inp)
176 bef_ `shouldBe` A.fromList bef
177 aft_ `shouldBe` fmap A.fromList aft
179testWrite :: [Char] -> IO ()
180testWrite inp = do
181 arr <- S.fold A.write (S.fromList inp)
182 A.toList arr `shouldBe` inp
184testFromToList :: [Char] -> IO ()
185testFromToList inp = A.toList (A.fromList inp) `shouldBe` inp
187testUnsafeIndxedFromList :: [Char] -> IO ()
188testUnsafeIndxedFromList inp =
189 let arr = A.fromList inp
190 in fmap (`A.unsafeIndex` arr) [0 .. (length inp - 1)] `shouldBe` inp
192testAsPtrUnsafeMA :: IO ()
193testAsPtrUnsafeMA = do
194 arr <- MA.fromList ([0 .. 99] :: [Int])
195 MA.asPtrUnsafe arr (getList (0 :: Int)) `shouldReturn` [0 .. 99]
197 where
199 sizeOfInt = sizeOf (undefined :: Int)
201 -- We need to be careful here. We assume Unboxed and Storable are compatible
202 -- with each other. For Int, they are compatible.
203 getList i _
204 | i >= 100 = return []
205 getList i p = do
206 val <- peek p
207 rest <- getList (i + 1) (p `plusPtr` sizeOfInt)
208 return $ val : rest
210reallocMA :: Property
211reallocMA =
212 let len = 10000
213 bSize = len * sizeOf (undefined :: Char)
214 in forAll (vectorOf len (arbitrary :: Gen Char)) $ \vec ->
215 forAll (chooseInt (bSize - 2000, bSize + 2000)) $ \newBLen -> do
216 arr <- MA.fromList vec
217 arr1 <- MA.realloc newBLen arr
218 lst <- MA.toList arr
219 lst1 <- MA.toList arr1
220 lst `shouldBe` lst1
222main :: IO ()
223main =
224 hspec $
225 H.parallel $
226 modifyMaxSuccess (const maxTestCount) $ do
227 describe moduleName $ do
228 commonMain
229 describe "Construction" $ do
230 -- XXX There is an issue https://github.com/composewell/streamly/issues/1577
231 --prop "testAppend" testAppend
232 prop "testBubbleAsc" testBubbleAsc
233 prop "testBubbleDesc" testBubbleDesc
234 prop "length . fromStream === n" testLengthFromStream
235 prop "toStream . fromStream === id" testFromStreamToStream
236 prop "read . write === id" testFoldUnfold
237 prop "fromList" testFromList
238 prop "foldMany with writeNUnsafe concats to original"
239 (foldManyWith (\n -> Fold.take n (A.writeNUnsafe n)))
240 describe "unsafeSlice" $ do
241 it "partial" $ unsafeSlice 2 4 [1..10]
242 it "none" $ unsafeSlice 10 0 [1..10]
243 it "full" $ unsafeSlice 0 10 [1..10]
244 describe "Mut.unsafeWriteIndex" $ do
245 it "first" (unsafeWriteIndex [1..10] 0 0 `shouldReturn` True)
246 it "middle" (unsafeWriteIndex [1..10] 5 0 `shouldReturn` True)
247 it "last" (unsafeWriteIndex [1..10] 9 0 `shouldReturn` True)
248 describe "Fold" $ do
249 prop "writeLastN : 0 <= n <= len" testLastN
250 describe "writeLastN boundary conditions" $ do
251 it "writeLastN -1" (testLastN_LN 10 (-1) `shouldReturn` True)
252 it "writeLastN 0" (testLastN_LN 10 0 `shouldReturn` True)
253 it "writeLastN length" (testLastN_LN 10 10 `shouldReturn` True)
254 it "writeLastN (length + 1)" (testLastN_LN 10 11 `shouldReturn` True)
255 describe "Strip" $ do
256 it "strip" (testStrip `shouldReturn` True)
257 it "stripLeft" (testStripLeft `shouldReturn` True)
258 it "stripRight" (testStripRight `shouldReturn` True)
259 it "stripZero" (testStripZero `shouldReturn` True)
260 it "stripEmpty" (testStripEmpty `shouldReturn` True)
261 it "stripNull" (testStripNull `shouldReturn` True)
262 describe "Mut" $ do
263 it "testByteLengthWithMA Int"
264 (testByteLengthWithMA (undefined :: Int))
265 it "testByteLengthWithMA Char"
266 (testByteLengthWithMA (undefined :: Char))
267 it "testAsPtrUnsafeMA" testAsPtrUnsafeMA
268 it "reallocMA" reallocMA
269 describe "breakOn" $ do
270 it "testBreakOn [1, 0, 2] 0"
271 (testBreakOn [1, 0, 2] 0 [1] (Just [2]))
272 it "testBreakOn [1, 0] 0" (testBreakOn [1, 0] 0 [1] (Just []))
273 it "testBreakOn [1] 0" (testBreakOn [1] 0 [1] Nothing)
274 describe "toList . fromList" $ do
275 it "testFromToList abc" (testFromToList "abc")
276 it "testFromToList \\22407" (testFromToList "\22407")
277 describe "unsafeIndex . fromList" $ do
278 it "testUnsafeIndxedFromList abc" (testUnsafeIndxedFromList "abc")
279 it "testUnsafeIndxedFromList \\22407"
280 (testUnsafeIndxedFromList "\22407")
281 describe "write" $ do
282 it "testWrite abc" (testWrite "abc")
283 it "testWrite \\22407" (testWrite "\22407")