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