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