git.iko.soy/streamly
on 796bb22 help sign in
streamly/test/Streamly/Test/Common/Array.hs
262 lines 8.6 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.
14import Foreign.Storable (Storable(..))
16import Test.Hspec.QuickCheck
17import Test.QuickCheck (Property, forAll, Gen, vectorOf, arbitrary, choose)
18import Test.QuickCheck.Monadic (monadicIO, assert, run)
19import Test.Hspec as H
21import Streamly.Prelude (SerialT)
22import Streamly.Test.Common (listEquals)
24import qualified Streamly.Prelude as S
25#ifdef TEST_SMALL_ARRAY
26import qualified Streamly.Internal.Data.SmallArray as A
27type Array = A.SmallArray
28#elif defined(TEST_ARRAY)
29import Data.Word(Word8)
31import qualified Streamly.Internal.Data.Array.Foreign as A
32import qualified Streamly.Internal.Data.Array.Foreign.Type as A
33import qualified Streamly.Internal.Data.Stream.IsStream as IP
34import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS
35type Array = A.Array
36#elif defined(DATA_ARRAY_PRIM_PINNED)
37import qualified Streamly.Internal.Data.Array.Prim.Pinned as A
38import qualified Streamly.Internal.Data.Array.Prim.Pinned.Type as A
39import qualified Streamly.Internal.Data.Stream.IsStream as IP
40type Array = A.Array
41#elif defined(DATA_ARRAY_PRIM)
42import qualified Streamly.Internal.Data.Array.Prim as A
43import qualified Streamly.Internal.Data.Array.Prim.Type as A
44import qualified Streamly.Internal.Data.Stream.IsStream as IP
45type Array = A.Array
46#else
47import qualified Streamly.Internal.Data.Array as A
48type Array = A.Array
49#endif
51moduleName :: String
52#ifdef TEST_SMALL_ARRAY
53moduleName = "Data.SmallArray"
54#elif defined(TEST_ARRAY)
55moduleName = "Data.Array.Foreign"
56#elif defined(DATA_ARRAY_PRIM_PINNED)
57moduleName = "Data.Array.Prim.Pinned"
58#elif defined(DATA_ARRAY_PRIM)
59moduleName = "Data.Array.Prim"
60#else
61moduleName = "Data.Array"
62#endif
64-- Coverage build takes too long with default number of tests
65maxTestCount :: Int
66#ifdef DEVBUILD
67maxTestCount = 100
68#else
69maxTestCount = 10
70#endif
72allocOverhead :: Int
73allocOverhead = 2 * sizeOf (undefined :: Int)
75-- XXX this should be in sync with the defaultChunkSize in Array code, or we
76-- should expose that and use that. For fast testing we could reduce the
77-- defaultChunkSize under CPP conditionals.
78--
79defaultChunkSize :: Int
80defaultChunkSize = 32 * k - allocOverhead
81 where k = 1024
83maxArrLen :: Int
84maxArrLen = defaultChunkSize * 8
86genericTestFrom ::
87 (Int -> SerialT IO Int -> IO (Array Int))
88 -> Property
89genericTestFrom arrFold =
90 forAll (choose (0, maxArrLen)) $ \len ->
91 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
92 monadicIO $ do
93 arr <- run $ arrFold len $ S.fromList list
94 assert (A.length arr == len)
96testLength :: Property
97testLength = genericTestFrom (\n -> S.fold (A.writeN n))
99testLengthFromStreamN :: Property
100testLengthFromStreamN = genericTestFrom A.fromStreamN
102#ifndef TEST_SMALL_ARRAY
103testLengthFromStream :: Property
104testLengthFromStream = genericTestFrom (const A.fromStream)
105#endif
107genericTestFromTo ::
108 (Int -> SerialT IO Int -> IO (Array Int))
109 -> (Array Int -> SerialT IO Int)
110 -> ([Int] -> [Int] -> Bool)
111 -> Property
112genericTestFromTo arrFold arrUnfold listEq =
113 forAll (choose (0, maxArrLen)) $ \len ->
114 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
115 monadicIO $ do
116 arr <- run $ arrFold len $ S.fromList list
117 xs <- run $ S.toList $ arrUnfold arr
118 assert (listEq xs list)
120testFoldNUnfold :: Property
121testFoldNUnfold =
122 genericTestFromTo (\n -> S.fold (A.writeN n)) (S.unfold A.read) (==)
124testFoldNToStream :: Property
125testFoldNToStream =
126 genericTestFromTo (\n -> S.fold (A.writeN n)) A.toStream (==)
128testFoldNToStreamRev :: Property
129testFoldNToStreamRev =
130 genericTestFromTo
131 (\n -> S.fold (A.writeN n))
132 A.toStreamRev
133 (\xs list -> xs == reverse list)
135testFromStreamNUnfold :: Property
136testFromStreamNUnfold = genericTestFromTo A.fromStreamN (S.unfold A.read) (==)
138testFromStreamNToStream :: Property
139testFromStreamNToStream = genericTestFromTo A.fromStreamN A.toStream (==)
141testFromListN :: Property
142testFromListN =
143 forAll (choose (0, maxArrLen)) $ \len ->
144 forAll (choose (0, len)) $ \n ->
145 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
146 monadicIO $ do
147 let arr = A.fromListN n list
148 xs <- run $ S.toList $ (S.unfold A.read) arr
149 listEquals (==) xs (take n list)
151#ifndef TEST_SMALL_ARRAY
152testFromStreamToStream :: Property
153testFromStreamToStream = genericTestFromTo (const A.fromStream) A.toStream (==)
155testFoldUnfold :: Property
156testFoldUnfold = genericTestFromTo (const (S.fold A.write)) (S.unfold A.read) (==)
158testFromList :: Property
159testFromList =
160 forAll (choose (0, maxArrLen)) $ \len ->
161 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
162 monadicIO $ do
163 let arr = A.fromList list
164 xs <- run $ S.toList $ (S.unfold A.read) arr
165 assert (xs == list)
166#endif
168#if defined(TEST_ARRAY) ||\
169 defined(DATA_ARRAY_PRIM) ||\
170 defined(DATA_ARRAY_PRIM_PINNED)
172testArraysOf :: Property
173testArraysOf =
174 forAll (choose (0, maxArrLen)) $ \len ->
175 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
176 monadicIO $ do
177 xs <- run
178 $ S.toList
179 $ S.unfoldMany A.read
180 $ arraysOf 240
181 $ S.fromList list
182 assert (xs == list)
183 where
184 arraysOf n = IP.chunksOf n (A.writeNUnsafe n)
186#endif
188#ifdef TEST_ARRAY
190lastN :: Int -> [a] -> [a]
191lastN n l = drop (length l - n) l
193testLastN :: Property
194testLastN =
195 forAll (choose (0, maxArrLen)) $ \len ->
196 forAll (choose (0, len)) $ \n ->
197 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
198 monadicIO $ do
199 xs <- run
200 $ fmap A.toList
201 $ S.fold (A.lastN n)
202 $ S.fromList list
203 assert (xs == lastN n list)
205testLastN_LN :: Int -> Int -> IO Bool
206testLastN_LN len n = do
207 let list = [1..len]
208 l1 <- fmap A.toList $ S.fold (A.lastN n) $ S.fromList list
209 let l2 = lastN n list
210 return $ l1 == l2
212-- Instead of hard coding 10000 here we can have maxStreamLength for operations
213-- that use stream of arrays.
214concatArrayW8 :: Property
215concatArrayW8 =
216 forAll (vectorOf 10000 (arbitrary :: Gen Word8))
217 $ \w8List -> do
218 let w8ArrList = A.fromList . (: []) <$> w8List
219 f2 <- S.toList $ AS.concat $ S.fromList w8ArrList
220 w8List `shouldBe` f2
222#endif
224main :: IO ()
225main =
226 hspec $
227 H.parallel $
228 modifyMaxSuccess (const maxTestCount) $ do
229 describe moduleName $ do
230 describe "Construction" $ do
231 prop "length . writeN n === n" testLength
232 prop "length . fromStreamN n === n" testLengthFromStreamN
233 prop "read . writeN === id " testFoldNUnfold
234 prop "toStream . writeN === id" testFoldNToStream
235 prop "toStreamRev . writeN === reverse" testFoldNToStreamRev
236 prop "read . fromStreamN === id" testFromStreamNUnfold
237 prop "toStream . fromStreamN === id" testFromStreamNToStream
238 prop "fromListN" testFromListN
240#ifndef TEST_SMALL_ARRAY
241 prop "length . fromStream === n" testLengthFromStream
242 prop "toStream . fromStream === id" testFromStreamToStream
243 prop "read . write === id" testFoldUnfold
244 prop "fromList" testFromList
245#endif
247#if defined(TEST_ARRAY) ||\
248 defined(DATA_ARRAY_PRIM) ||\
249 defined(DATA_ARRAY_PRIM_PINNED)
250 prop "arraysOf concats to original" testArraysOf
251#endif
253#ifdef TEST_ARRAY
254 prop "AS.concat . (A.fromList . (:[]) <$>) === id" $ concatArrayW8
255 describe "Fold" $ do
256 prop "lastN : 0 <= n <= len" $ testLastN
257 describe "lastN boundary conditions" $ do
258 it "lastN -1" (testLastN_LN 10 (-1) `shouldReturn` True)
259 it "lastN 0" (testLastN_LN 10 0 `shouldReturn` True)
260 it "lastN length" (testLastN_LN 10 10 `shouldReturn` True)
261 it "lastN (length + 1)" (testLastN_LN 10 11 `shouldReturn` True)
262#endif