git.iko.soy/streamly
on d2aaef0 help sign in
streamly/test/Streamly/Test/Data/Array/Foreign.hs
304 lines 10 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 Foreign.Storable (peek)
17import Streamly.Internal.Data.Unboxed (Unboxed)
18import Test.QuickCheck (chooseInt, listOf)
19import GHC.Ptr (plusPtr)
21import qualified Streamly.Internal.Data.Fold as Fold
22import qualified Streamly.Internal.Data.Array.Unboxed as A
23import qualified Streamly.Internal.Data.Array.Unboxed.Type as A
24import qualified Streamly.Internal.Data.Array.Unboxed.Mut.Type as MA
25import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS
27type Array = A.Array
29moduleName :: String
30moduleName = "Data.Array.Foreign"
32#include "Streamly/Test/Data/Array/Common.hs"
34testFromStreamToStream :: Property
35testFromStreamToStream = genericTestFromTo (const A.fromStream) A.toStream (==)
37testFoldUnfold :: Property
38testFoldUnfold = genericTestFromTo (const (S.fold A.write)) (S.unfold A.read) (==)
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.toList $ (S.unfold A.read) arr
47 assert (xs == list)
49testLengthFromStream :: Property
50testLengthFromStream = genericTestFrom (const A.fromStream)
53unsafeWriteIndex :: [Int] -> Int -> Int -> IO Bool
54unsafeWriteIndex xs i x = do
55 arr <- MA.fromList xs
56 MA.putIndexUnsafe i x arr
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 == ""
124-- Instead of hard coding 10000 here we can have maxStreamLength for operations
125-- that use stream of arrays.
126concatArrayW8 :: Property
127concatArrayW8 =
128 forAll (vectorOf 10000 (arbitrary :: Gen Word8))
129 $ \w8List -> do
130 let w8ArrList = A.fromList . (: []) <$> w8List
131 f2 <- S.toList $ AS.concat $ S.fromList w8ArrList
132 w8List `shouldBe` f2
134unsafeSlice :: Int -> Int -> [Int] -> Bool
135unsafeSlice i n list =
136 let lst = take n $ drop i $ list
137 arr = A.toList $ A.getSliceUnsafe i n $ A.fromList list
138 in arr == lst
140{-
141testAppend :: Property
142testAppend =
143 forAll (listOf (chooseInt (-50, 100))) $ \ls0 ->
144 monadicIO $ action ls0
146 where
148 action ls = do
149 x <- S.fold
150 (MA.append (MA.newArray 0))
151 (S.fromList (ls::[Int]))
152 lst <- MA.toList x
153 assert (ls == lst)
154-}
156testBubbleWith :: Bool -> Property
157testBubbleWith asc =
158 forAll (listOf (chooseInt (-50, 100))) $ \ls0 ->
159 monadicIO $ action ls0
161 where
163 action ls = do
164 x <- S.fold (fldm ls) $ S.fromList ls
165 lst <- MA.toList x
166 if asc
167 then assert (sort ls == lst)
168 else assert (sort ls == reverse lst)
170 fldm ls =
171 Fold.foldlM'
172 (\b a -> do
173 arr <- MA.snoc b a
174 if asc
175 then MA.bubble compare arr
176 else MA.bubble (flip compare) arr
177 return arr
178 )
179 (MA.newArray $ length ls)
181testBubbleAsc :: Property
182testBubbleAsc = testBubbleWith True
184testBubbleDesc :: Property
185testBubbleDesc = testBubbleWith False
187testByteLengthWithMA :: forall a. Unboxed a => a -> IO ()
188testByteLengthWithMA _ = do
189 arrA <- MA.newArray 100 :: IO (MA.Array a)
190 let arrW8 = MA.castUnsafe arrA :: MA.Array Word8
191 MA.byteLength arrA `shouldBe` MA.length arrW8
193testBreakOn :: [Word8] -> Word8 -> [Word8] -> (Maybe [Word8]) -> IO ()
194testBreakOn inp sep bef aft = do
195 (bef_, aft_) <- A.breakOn sep (A.fromList inp)
196 bef_ `shouldBe` A.fromList bef
197 aft_ `shouldBe` fmap A.fromList aft
199testWrite :: [Char] -> IO ()
200testWrite inp = do
201 arr <- S.fold A.write (S.fromList inp)
202 A.toList arr `shouldBe` inp
204testFromToList :: [Char] -> IO ()
205testFromToList inp = A.toList (A.fromList inp) `shouldBe` inp
207testUnsafeIndxedFromList :: [Char] -> IO ()
208testUnsafeIndxedFromList inp =
209 let arr = A.fromList inp
210 in fmap (flip A.unsafeIndex arr) [0 .. (length inp - 1)] `shouldBe` inp
212testAsPtrUnsafeMA :: IO ()
213testAsPtrUnsafeMA = do
214 arr <- MA.fromList ([0 .. 99] :: [Int])
215 MA.asPtrUnsafe arr (getList (0 :: Int)) `shouldReturn` [0 .. 99]
217 where
219 sizeOfInt = sizeOf (undefined :: Int)
221 -- We need to be careful here. We assume Unboxed and Storable are compatible
222 -- with each other. For Int, they are compatible.
223 getList i _
224 | i >= 100 = return []
225 getList i p = do
226 val <- peek p
227 rest <- getList (i + 1) (p `plusPtr` sizeOfInt)
228 return $ val : rest
230reallocMA :: Property
231reallocMA =
232 let len = 10000
233 bSize = len * sizeOf (undefined :: Char)
234 in forAll (vectorOf len (arbitrary :: Gen Char)) $ \vec ->
235 forAll (chooseInt (bSize - 2000, bSize + 2000)) $ \newBLen -> do
236 arr <- MA.fromList vec
237 arr1 <- MA.realloc newBLen arr
238 lst <- MA.toList arr
239 lst1 <- MA.toList arr1
240 lst `shouldBe` lst1
242main :: IO ()
243main =
244 hspec $
245 H.parallel $
246 modifyMaxSuccess (const maxTestCount) $ do
247 describe moduleName $ do
248 commonMain
249 describe "Construction" $ do
250 -- XXX There is an issue https://github.com/composewell/streamly/issues/1577
251 --prop "testAppend" testAppend
252 prop "testBubbleAsc" testBubbleAsc
253 prop "testBubbleDesc" testBubbleDesc
254 prop "length . fromStream === n" testLengthFromStream
255 prop "toStream . fromStream === id" testFromStreamToStream
256 prop "read . write === id" testFoldUnfold
257 prop "fromList" testFromList
258 prop "foldMany with writeNUnsafe concats to original"
259 (foldManyWith (\n -> Fold.take n (A.writeNUnsafe n)))
260 prop "AS.concat . (A.fromList . (:[]) <$>) === id" $ concatArrayW8
261 describe "unsafeSlice" $ do
262 it "partial" $ unsafeSlice 2 4 [1..10]
263 it "none" $ unsafeSlice 10 0 [1..10]
264 it "full" $ unsafeSlice 0 10 [1..10]
265 describe "Mut.unsafeWriteIndex" $ do
266 it "first" (unsafeWriteIndex [1..10] 0 0 `shouldReturn` True)
267 it "middle" (unsafeWriteIndex [1..10] 5 0 `shouldReturn` True)
268 it "last" (unsafeWriteIndex [1..10] 9 0 `shouldReturn` True)
269 describe "Fold" $ do
270 prop "writeLastN : 0 <= n <= len" $ testLastN
271 describe "writeLastN boundary conditions" $ do
272 it "writeLastN -1" (testLastN_LN 10 (-1) `shouldReturn` True)
273 it "writeLastN 0" (testLastN_LN 10 0 `shouldReturn` True)
274 it "writeLastN length" (testLastN_LN 10 10 `shouldReturn` True)
275 it "writeLastN (length + 1)" (testLastN_LN 10 11 `shouldReturn` True)
276 describe "Strip" $ do
277 it "strip" (testStrip `shouldReturn` True)
278 it "stripLeft" (testStripLeft `shouldReturn` True)
279 it "stripRight" (testStripRight `shouldReturn` True)
280 it "stripZero" (testStripZero `shouldReturn` True)
281 it "stripEmpty" (testStripEmpty `shouldReturn` True)
282 it "stripNull" (testStripNull `shouldReturn` True)
283 describe "Mut" $ do
284 it "testByteLengthWithMA Int"
285 (testByteLengthWithMA (undefined :: Int))
286 it "testByteLengthWithMA Char"
287 (testByteLengthWithMA (undefined :: Char))
288 it "testAsPtrUnsafeMA" testAsPtrUnsafeMA
289 it "reallocMA" reallocMA
290 describe "breakOn" $ do
291 it "testBreakOn [1, 0, 2] 0"
292 (testBreakOn [1, 0, 2] 0 [1] (Just [2]))
293 it "testBreakOn [1, 0] 0" (testBreakOn [1, 0] 0 [1] (Just []))
294 it "testBreakOn [1] 0" (testBreakOn [1] 0 [1] Nothing)
295 describe "toList . fromList" $ do
296 it "testFromToList abc" (testFromToList "abc")
297 it "testFromToList \\22407" (testFromToList "\22407")
298 describe "unsafeIndex . fromList" $ do
299 it "testUnsafeIndxedFromList abc" (testUnsafeIndxedFromList "abc")
300 it "testUnsafeIndxedFromList \\22407"
301 (testUnsafeIndxedFromList "\22407")
302 describe "write" $ do
303 it "testWrite abc" (testWrite "abc")
304 it "testWrite \\22407" (testWrite "\22407")