git.iko.soy/streamly
on aaa279c help sign in
streamly/test/Streamly/Test/Data/Array/Foreign.hs
326 lines 11 kB history raw
1-- |
2-- Module : Streamly.Test.Data.Array.Foreign
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.Foreign (main) where
11#include "Streamly/Test/Data/Array/CommonImports.hs"
13import Data.Char (isLower)
14import Data.List (sort)
15import Data.Word(Word8)
16import Test.QuickCheck (chooseInt, listOf)
17import Streamly.Internal.Data.Unboxed (Storable, alignment, peek, poke)
18import GHC.Ptr (plusPtr)
19import Foreign.ForeignPtr (withForeignPtr)
21import qualified Streamly.Internal.Data.Fold as Fold
22import qualified Streamly.Internal.Data.Array.Foreign as A
23import qualified Streamly.Internal.Data.Array.Foreign.Type as A
24import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA
25import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS
26import qualified Streamly.Internal.Foreign.Malloc as Malloc
28type Array = A.Array
30moduleName :: String
31moduleName = "Data.Array.Foreign"
33#include "Streamly/Test/Data/Array/Common.hs"
35testFromStreamToStream :: Property
36testFromStreamToStream = genericTestFromTo (const A.fromStream) A.toStream (==)
38testFoldUnfold :: Property
39testFoldUnfold = genericTestFromTo (const (S.fold A.write)) (S.unfold A.read) (==)
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.toList $ (S.unfold A.read) arr
48 assert (xs == list)
50testLengthFromStream :: Property
51testLengthFromStream = genericTestFrom (const A.fromStream)
54unsafeWriteIndex :: [Int] -> Int -> Int -> IO Bool
55unsafeWriteIndex xs i x = do
56 arr <- MA.fromList xs
57 MA.putIndexUnsafe i x arr
58 x1 <- MA.getIndexUnsafe i arr
59 return $ x1 == x
61lastN :: Int -> [a] -> [a]
62lastN n l = drop (length l - n) l
64testLastN :: Property
65testLastN =
66 forAll (choose (0, maxArrLen)) $ \len ->
67 forAll (choose (0, len)) $ \n ->
68 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
69 monadicIO $ do
70 xs <- run
71 $ fmap A.toList
72 $ S.fold (A.writeLastN n)
73 $ S.fromList list
74 assert (xs == lastN n list)
76testLastN_LN :: Int -> Int -> IO Bool
77testLastN_LN len n = do
78 let list = [1..len]
79 l1 <- fmap A.toList $ S.fold (A.writeLastN n) $ S.fromList list
80 let l2 = lastN n list
81 return $ l1 == l2
83testStrip :: IO Bool
84testStrip = do
85 dt <- MA.fromList "abcDEFgeh"
86 dt' <- MA.strip isLower dt
87 x <- MA.toList dt'
88 return $ x == "DEF"
90testStripLeft :: IO Bool
91testStripLeft = do
92 dt <- MA.fromList "abcDEF"
93 dt' <- MA.strip isLower dt
94 x <- MA.toList dt'
95 return $ x == "DEF"
97testStripRight :: IO Bool
98testStripRight = do
99 dt <- MA.fromList "DEFgeh"
100 dt' <- MA.strip isLower dt
101 x <- MA.toList dt'
102 return $ x == "DEF"
104testStripZero :: IO Bool
105testStripZero = do
106 dt <- MA.fromList "DEF"
107 dt' <- MA.strip isLower dt
108 x <- MA.toList dt'
109 return $ x == "DEF"
111testStripEmpty :: IO Bool
112testStripEmpty = do
113 dt <- MA.fromList "abc"
114 dt' <- MA.strip isLower dt
115 x <- MA.toList dt'
116 return $ x == ""
118testStripNull :: IO Bool
119testStripNull = do
120 dt <- MA.fromList ""
121 dt' <- MA.strip isLower dt
122 x <- MA.toList dt'
123 return $ x == ""
125-- Instead of hard coding 10000 here we can have maxStreamLength for operations
126-- that use stream of arrays.
127concatArrayW8 :: Property
128concatArrayW8 =
129 forAll (vectorOf 10000 (arbitrary :: Gen Word8))
130 $ \w8List -> do
131 let w8ArrList = A.fromList . (: []) <$> w8List
132 f2 <- S.toList $ AS.concat $ S.fromList w8ArrList
133 w8List `shouldBe` f2
135unsafeSlice :: Int -> Int -> [Int] -> Bool
136unsafeSlice i n list =
137 let lst = take n $ drop i $ list
138 arr = A.toList $ A.getSliceUnsafe i n $ A.fromList list
139 in arr == lst
141{-
142testAppend :: Property
143testAppend =
144 forAll (listOf (chooseInt (-50, 100))) $ \ls0 ->
145 monadicIO $ action ls0
147 where
149 action ls = do
150 x <- S.fold
151 (MA.append (MA.newArray 0))
152 (S.fromList (ls::[Int]))
153 lst <- MA.toList x
154 assert (ls == lst)
155-}
157testBubbleWith :: Bool -> Property
158testBubbleWith asc =
159 forAll (listOf (chooseInt (-50, 100))) $ \ls0 ->
160 monadicIO $ action ls0
162 where
164 action ls = do
165 x <- S.fold (fldm ls) $ S.fromList ls
166 lst <- MA.toList x
167 if asc
168 then assert (sort ls == lst)
169 else assert (sort ls == reverse lst)
171 fldm ls =
172 Fold.foldlM'
173 (\b a -> do
174 arr <- MA.snoc b a
175 if asc
176 then MA.bubble compare arr
177 else MA.bubble (flip compare) arr
178 return arr
179 )
180 (MA.newArray $ length ls)
182testBubbleAsc :: Property
183testBubbleAsc = testBubbleWith True
185testBubbleDesc :: Property
186testBubbleDesc = testBubbleWith False
188testByteLengthWithMA :: forall a. Storable a => a -> IO ()
189testByteLengthWithMA _ = do
190 arrA <- MA.newArray 100 :: IO (MA.Array a)
191 let arrW8 = MA.castUnsafe arrA :: MA.Array Word8
192 MA.byteLength arrA `shouldBe` MA.length arrW8
194testBreakOn :: [Word8] -> Word8 -> [Word8] -> (Maybe [Word8]) -> IO ()
195testBreakOn inp sep bef aft = do
196 (bef_, aft_) <- A.breakOn sep (A.fromList inp)
197 bef_ `shouldBe` A.fromList bef
198 aft_ `shouldBe` fmap A.fromList aft
200testWrite :: [Char] -> IO ()
201testWrite inp = do
202 arr <- S.fold A.write (S.fromList inp)
203 A.toList arr `shouldBe` inp
205testFromToList :: [Char] -> IO ()
206testFromToList inp = A.toList (A.fromList inp) `shouldBe` inp
208testUnsafeIndxedFromList :: [Char] -> IO ()
209testUnsafeIndxedFromList inp =
210 let arr = A.fromList inp
211 in fmap (flip A.unsafeIndex arr) [0 .. (length inp - 1)] `shouldBe` inp
213testFromForeignPtrUnsafeMA :: IO ()
214testFromForeignPtrUnsafeMA = do
215 fp <- Malloc.mallocForeignPtrAlignedBytes numBytes alignmentInt
216 arr <-
217 withForeignPtr fp $ \p -> do
218 writeNext (0 :: Int) p
219 return
220 $ MA.fromForeignPtrUnsafe
221 fp
222 (p `plusPtr` numBytes)
223 (p `plusPtr` numBytes)
224 MA.toList arr `shouldReturn` [0..99]
226 where
228 sizeOfInt = sizeOf (undefined :: Int)
229 alignmentInt = alignment (undefined :: Int)
230 numBytes = sizeOfInt * 100
231 writeNext i _
232 | i >= 100 = return ()
233 writeNext i p = poke p i >> writeNext (i + 1) (p `plusPtr` sizeOfInt)
235testAsPtrUnsafeMA :: IO ()
236testAsPtrUnsafeMA = do
237 arr <- MA.fromList ([0 .. 99] :: [Int])
238 MA.asPtrUnsafe arr (getList (0 :: Int)) `shouldReturn` [0 .. 99]
240 where
242 sizeOfInt = sizeOf (undefined :: Int)
244 getList i _
245 | i >= 100 = return []
246 getList i p = do
247 val <- peek p
248 rest <- getList (i + 1) (p `plusPtr` sizeOfInt)
249 return $ val : rest
251reallocMA :: Property
252reallocMA =
253 let len = 10000
254 bSize = len * sizeOf (undefined :: Char)
255 in forAll (vectorOf len (arbitrary :: Gen Char)) $ \vec ->
256 forAll (chooseInt (bSize - 2000, bSize + 2000)) $ \newBLen -> do
257 arr <- MA.fromList vec
258 arr1 <- MA.realloc newBLen arr
259 lst <- MA.toList arr
260 lst1 <- MA.toList arr1
261 lst `shouldBe` lst1
263main :: IO ()
264main =
265 hspec $
266 H.parallel $
267 modifyMaxSuccess (const maxTestCount) $ do
268 describe moduleName $ do
269 commonMain
270 describe "Construction" $ do
271 -- XXX There is an issue https://github.com/composewell/streamly/issues/1577
272 --prop "testAppend" testAppend
273 prop "testBubbleAsc" testBubbleAsc
274 prop "testBubbleDesc" testBubbleDesc
275 prop "length . fromStream === n" testLengthFromStream
276 prop "toStream . fromStream === id" testFromStreamToStream
277 prop "read . write === id" testFoldUnfold
278 prop "fromList" testFromList
279 prop "foldMany with writeNUnsafe concats to original"
280 (foldManyWith (\n -> Fold.take n (A.writeNUnsafe n)))
281 prop "AS.concat . (A.fromList . (:[]) <$>) === id" $ concatArrayW8
282 describe "unsafeSlice" $ do
283 it "partial" $ unsafeSlice 2 4 [1..10]
284 it "none" $ unsafeSlice 10 0 [1..10]
285 it "full" $ unsafeSlice 0 10 [1..10]
286 describe "Mut.unsafeWriteIndex" $ do
287 it "first" (unsafeWriteIndex [1..10] 0 0 `shouldReturn` True)
288 it "middle" (unsafeWriteIndex [1..10] 5 0 `shouldReturn` True)
289 it "last" (unsafeWriteIndex [1..10] 9 0 `shouldReturn` True)
290 describe "Fold" $ do
291 prop "writeLastN : 0 <= n <= len" $ testLastN
292 describe "writeLastN boundary conditions" $ do
293 it "writeLastN -1" (testLastN_LN 10 (-1) `shouldReturn` True)
294 it "writeLastN 0" (testLastN_LN 10 0 `shouldReturn` True)
295 it "writeLastN length" (testLastN_LN 10 10 `shouldReturn` True)
296 it "writeLastN (length + 1)" (testLastN_LN 10 11 `shouldReturn` True)
297 describe "Strip" $ do
298 it "strip" (testStrip `shouldReturn` True)
299 it "stripLeft" (testStripLeft `shouldReturn` True)
300 it "stripRight" (testStripRight `shouldReturn` True)
301 it "stripZero" (testStripZero `shouldReturn` True)
302 it "stripEmpty" (testStripEmpty `shouldReturn` True)
303 it "stripNull" (testStripNull `shouldReturn` True)
304 describe "Mut" $ do
305 it "testByteLengthWithMA Int"
306 (testByteLengthWithMA (undefined :: Int))
307 it "testByteLengthWithMA Char"
308 (testByteLengthWithMA (undefined :: Char))
309 it "testFromForeignPtrUnsafeMA" testFromForeignPtrUnsafeMA
310 it "testAsPtrUnsafeMA" testAsPtrUnsafeMA
311 it "reallocMA" reallocMA
312 describe "breakOn" $ do
313 it "testBreakOn [1, 0, 2] 0"
314 (testBreakOn [1, 0, 2] 0 [1] (Just [2]))
315 it "testBreakOn [1, 0] 0" (testBreakOn [1, 0] 0 [1] (Just []))
316 it "testBreakOn [1] 0" (testBreakOn [1] 0 [1] Nothing)
317 describe "toList . fromList" $ do
318 it "testFromToList abc" (testFromToList "abc")
319 it "testFromToList \\22407" (testFromToList "\22407")
320 describe "unsafeIndex . fromList" $ do
321 it "testUnsafeIndxedFromList abc" (testUnsafeIndxedFromList "abc")
322 it "testUnsafeIndxedFromList \\22407"
323 (testUnsafeIndxedFromList "\22407")
324 describe "write" $ do
325 it "testWrite abc" (testWrite "abc")
326 it "testWrite \\22407" (testWrite "\22407")