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