git.iko.soy/streamly
on a05abfc help sign in
streamly/test/Streamly/Test/Common/Array.hs
291 lines 9.8 kB history raw
1-- |
2-- Module : Main
3-- Copyright : (c) 2019 Composewell Technologies
4--
5-- License : BSD-3-Clause
6-- Maintainer : streamly@composewell.com
7-- Stability : experimental
8-- Portability : GHC
9--
11-- This is a common array test module that gets included in different
12-- Array test modules with the corresponding macro defined.
13--
14-- Meanings of CPP macros:
15-- Default => Data.Array
16-- TEST_ARRAY => Data.Array.Foreign
17-- TEST_SMALL_ARRAY => Data.SmallArray
18-- DATA_ARRAY_PRIM => Data.Array.Prim
19-- DATA_ARRAY_PRIM_PINNED => Data.Array.Prim.Pinned
21import Foreign.Storable (Storable(..))
23import Test.Hspec.QuickCheck
24import Test.QuickCheck (Property, forAll, Gen, vectorOf, arbitrary, choose)
25import Test.QuickCheck.Monadic (monadicIO, assert, run)
26import Test.Hspec as H
28import Streamly.Data.Fold (Fold)
29import Streamly.Prelude (SerialT)
30import Streamly.Test.Common (listEquals)
32import qualified Streamly.Prelude as S
34#if defined(TEST_ARRAY) ||\
35 defined(DATA_ARRAY_PRIM) ||\
36 defined(DATA_ARRAY_PRIM_PINNED)
37import qualified Streamly.Internal.Data.Fold as Fold
38#endif
40#ifdef TEST_SMALL_ARRAY
41import qualified Streamly.Internal.Data.SmallArray as A
42type Array = A.SmallArray
43#elif defined(TEST_ARRAY)
44import Data.Word(Word8)
46import qualified Streamly.Internal.Data.Array.Foreign as A
47import qualified Streamly.Internal.Data.Array.Foreign.Type as A
48import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA
49import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS
50type Array = A.Array
51#elif defined(DATA_ARRAY_PRIM_PINNED)
52import qualified Streamly.Internal.Data.Array.Prim.Pinned as A
53import qualified Streamly.Internal.Data.Array.Prim.Pinned.Type as A
54type Array = A.Array
55#elif defined(DATA_ARRAY_PRIM)
56import qualified Streamly.Internal.Data.Array.Prim as A
57import qualified Streamly.Internal.Data.Array.Prim.Type as A
58type Array = A.Array
59#else
60import qualified Streamly.Internal.Data.Array as A
61type Array = A.Array
62#endif
64moduleName :: String
65#ifdef TEST_SMALL_ARRAY
66moduleName = "Data.SmallArray"
67#elif defined(TEST_ARRAY)
68moduleName = "Data.Array.Foreign"
69#elif defined(DATA_ARRAY_PRIM_PINNED)
70moduleName = "Data.Array.Prim.Pinned"
71#elif defined(DATA_ARRAY_PRIM)
72moduleName = "Data.Array.Prim"
73#else
74moduleName = "Data.Array"
75#endif
77-- Coverage build takes too long with default number of tests
78maxTestCount :: Int
79#ifdef DEVBUILD
80maxTestCount = 100
81#else
82maxTestCount = 10
83#endif
85allocOverhead :: Int
86allocOverhead = 2 * sizeOf (undefined :: Int)
88-- XXX this should be in sync with the defaultChunkSize in Array code, or we
89-- should expose that and use that. For fast testing we could reduce the
90-- defaultChunkSize under CPP conditionals.
91--
92defaultChunkSize :: Int
93defaultChunkSize = 32 * k - allocOverhead
94 where k = 1024
96maxArrLen :: Int
97maxArrLen = defaultChunkSize * 8
99genericTestFrom ::
100 (Int -> SerialT IO Int -> IO (Array Int))
101 -> Property
102genericTestFrom arrFold =
103 forAll (choose (0, maxArrLen)) $ \len ->
104 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
105 monadicIO $ do
106 arr <- run $ arrFold len $ S.fromList list
107 assert (A.length arr == len)
109testLength :: Property
110testLength = genericTestFrom (\n -> S.fold (A.writeN n))
112testLengthFromStreamN :: Property
113testLengthFromStreamN = genericTestFrom A.fromStreamN
115#ifndef TEST_SMALL_ARRAY
116testLengthFromStream :: Property
117testLengthFromStream = genericTestFrom (const A.fromStream)
118#endif
120genericTestFromTo ::
121 (Int -> SerialT IO Int -> IO (Array Int))
122 -> (Array Int -> SerialT IO Int)
123 -> ([Int] -> [Int] -> Bool)
124 -> Property
125genericTestFromTo arrFold arrUnfold listEq =
126 forAll (choose (0, maxArrLen)) $ \len ->
127 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
128 monadicIO $ do
129 arr <- run $ arrFold len $ S.fromList list
130 xs <- run $ S.toList $ arrUnfold arr
131 assert (listEq xs list)
133testFoldNUnfold :: Property
134testFoldNUnfold =
135 genericTestFromTo (\n -> S.fold (A.writeN n)) (S.unfold A.read) (==)
137testFoldNToStream :: Property
138testFoldNToStream =
139 genericTestFromTo (\n -> S.fold (A.writeN n)) A.toStream (==)
141testFoldNToStreamRev :: Property
142testFoldNToStreamRev =
143 genericTestFromTo
144 (\n -> S.fold (A.writeN n))
145 A.toStreamRev
146 (\xs list -> xs == reverse list)
148testFromStreamNUnfold :: Property
149testFromStreamNUnfold = genericTestFromTo A.fromStreamN (S.unfold A.read) (==)
151testFromStreamNToStream :: Property
152testFromStreamNToStream = genericTestFromTo A.fromStreamN A.toStream (==)
154testFromListN :: Property
155testFromListN =
156 forAll (choose (0, maxArrLen)) $ \len ->
157 forAll (choose (0, len)) $ \n ->
158 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
159 monadicIO $ do
160 let arr = A.fromListN n list
161 xs <- run $ S.toList $ (S.unfold A.read) arr
162 listEquals (==) xs (take n list)
164#ifndef TEST_SMALL_ARRAY
165testFromStreamToStream :: Property
166testFromStreamToStream = genericTestFromTo (const A.fromStream) A.toStream (==)
168testFoldUnfold :: Property
169testFoldUnfold = genericTestFromTo (const (S.fold A.write)) (S.unfold A.read) (==)
171testFromList :: Property
172testFromList =
173 forAll (choose (0, maxArrLen)) $ \len ->
174 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
175 monadicIO $ do
176 let arr = A.fromList list
177 xs <- run $ S.toList $ (S.unfold A.read) arr
178 assert (xs == list)
179#endif
181foldManyWith :: (Int -> Fold IO Int (Array Int)) -> Property
182foldManyWith f =
183 forAll (choose (0, maxArrLen)) $ \len ->
184 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
185 monadicIO $ do
186 xs <- run
187 $ S.toList
188 $ S.unfoldMany A.read
189 $ S.foldMany (f 240)
190 $ S.fromList list
191 assert (xs == list)
193#ifdef TEST_ARRAY
195unsafeWriteIndex :: [Int] -> Int -> Int -> IO Bool
196unsafeWriteIndex xs i x = do
197 arr <- MA.fromList xs
198 MA.putIndexUnsafe arr i x
199 x1 <- MA.getIndexUnsafe arr i
200 return $ x1 == x
202lastN :: Int -> [a] -> [a]
203lastN n l = drop (length l - n) l
205testLastN :: Property
206testLastN =
207 forAll (choose (0, maxArrLen)) $ \len ->
208 forAll (choose (0, len)) $ \n ->
209 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
210 monadicIO $ do
211 xs <- run
212 $ fmap A.toList
213 $ S.fold (A.writeLastN n)
214 $ S.fromList list
215 assert (xs == lastN n list)
217testLastN_LN :: Int -> Int -> IO Bool
218testLastN_LN len n = do
219 let list = [1..len]
220 l1 <- fmap A.toList $ S.fold (A.writeLastN n) $ S.fromList list
221 let l2 = lastN n list
222 return $ l1 == l2
224-- Instead of hard coding 10000 here we can have maxStreamLength for operations
225-- that use stream of arrays.
226concatArrayW8 :: Property
227concatArrayW8 =
228 forAll (vectorOf 10000 (arbitrary :: Gen Word8))
229 $ \w8List -> do
230 let w8ArrList = A.fromList . (: []) <$> w8List
231 f2 <- S.toList $ AS.concat $ S.fromList w8ArrList
232 w8List `shouldBe` f2
234unsafeSlice :: Int -> Int -> [Int] -> Bool
235unsafeSlice i n list =
236 let lst = take n $ drop i $ list
237 arr = A.toList $ A.getSliceUnsafe i n $ A.fromList list
238 in arr == lst
240#endif
242main :: IO ()
243main =
244 hspec $
245 H.parallel $
246 modifyMaxSuccess (const maxTestCount) $ do
247 describe moduleName $ do
248 describe "Construction" $ do
249 prop "length . writeN n === n" testLength
250 prop "length . fromStreamN n === n" testLengthFromStreamN
251 prop "read . writeN === id " testFoldNUnfold
252 prop "toStream . writeN === id" testFoldNToStream
253 prop "toStreamRev . writeN === reverse" testFoldNToStreamRev
254 prop "read . fromStreamN === id" testFromStreamNUnfold
255 prop "toStream . fromStreamN === id" testFromStreamNToStream
256 prop "fromListN" testFromListN
258#ifndef TEST_SMALL_ARRAY
259 prop "length . fromStream === n" testLengthFromStream
260 prop "toStream . fromStream === id" testFromStreamToStream
261 prop "read . write === id" testFoldUnfold
262 prop "fromList" testFromList
263#endif
265#if defined(TEST_ARRAY) ||\
266 defined(DATA_ARRAY_PRIM) ||\
267 defined(DATA_ARRAY_PRIM_PINNED)
268 prop "foldMany with writeNUnsafe concats to original"
269 (foldManyWith (\n -> Fold.take n (A.writeNUnsafe n)))
270#endif
271 prop "foldMany with writeN concats to original"
272 (foldManyWith A.writeN)
274#ifdef TEST_ARRAY
275 prop "AS.concat . (A.fromList . (:[]) <$>) === id" $ concatArrayW8
276 describe "unsafeSlice" $ do
277 it "partial" $ unsafeSlice 2 4 [1..10]
278 it "none" $ unsafeSlice 10 0 [1..10]
279 it "full" $ unsafeSlice 0 10 [1..10]
280 describe "Mut.unsafeWriteIndex" $ do
281 it "first" (unsafeWriteIndex [1..10] 0 0 `shouldReturn` True)
282 it "middle" (unsafeWriteIndex [1..10] 5 0 `shouldReturn` True)
283 it "last" (unsafeWriteIndex [1..10] 9 0 `shouldReturn` True)
284 describe "Fold" $ do
285 prop "writeLastN : 0 <= n <= len" $ testLastN
286 describe "writeLastN boundary conditions" $ do
287 it "writeLastN -1" (testLastN_LN 10 (-1) `shouldReturn` True)
288 it "writeLastN 0" (testLastN_LN 10 0 `shouldReturn` True)
289 it "writeLastN length" (testLastN_LN 10 10 `shouldReturn` True)
290 it "writeLastN (length + 1)" (testLastN_LN 10 11 `shouldReturn` True)
291#endif