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