on 7b5bc73 help sign in
284 lines 9.5 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.Array.Foreign.Mut.Type as MA
34import qualified Streamly.Internal.Data.Stream.IsStream as IP
35import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS
36type Array = A.Array
37#elif defined(DATA_ARRAY_PRIM_PINNED)
38import qualified Streamly.Internal.Data.Array.Prim.Pinned as A
39import qualified Streamly.Internal.Data.Array.Prim.Pinned.Type as A
40import qualified Streamly.Internal.Data.Stream.IsStream as IP
41type Array = A.Array
42#elif defined(DATA_ARRAY_PRIM)
43import qualified Streamly.Internal.Data.Array.Prim as A
44import qualified Streamly.Internal.Data.Array.Prim.Type as A
45import qualified Streamly.Internal.Data.Stream.IsStream as IP
46type Array = A.Array
47#else
48import qualified Streamly.Internal.Data.Array as A
49type Array = A.Array
50#endif
52moduleName :: String
53#ifdef TEST_SMALL_ARRAY
54moduleName = "Data.SmallArray"
55#elif defined(TEST_ARRAY)
56moduleName = "Data.Array.Foreign"
57#elif defined(DATA_ARRAY_PRIM_PINNED)
58moduleName = "Data.Array.Prim.Pinned"
59#elif defined(DATA_ARRAY_PRIM)
60moduleName = "Data.Array.Prim"
61#else
62moduleName = "Data.Array"
63#endif
65-- Coverage build takes too long with default number of tests
66maxTestCount :: Int
67#ifdef DEVBUILD
68maxTestCount = 100
69#else
70maxTestCount = 10
71#endif
73allocOverhead :: Int
74allocOverhead = 2 * sizeOf (undefined :: Int)
76-- XXX this should be in sync with the defaultChunkSize in Array code, or we
77-- should expose that and use that. For fast testing we could reduce the
78-- defaultChunkSize under CPP conditionals.
79--
80defaultChunkSize :: Int
81defaultChunkSize = 32 * k - allocOverhead
82 where k = 1024
84maxArrLen :: Int
85maxArrLen = defaultChunkSize * 8
87genericTestFrom ::
88 (Int -> SerialT IO Int -> IO (Array Int))
89 -> Property
90genericTestFrom arrFold =
91 forAll (choose (0, maxArrLen)) $ \len ->
92 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
93 monadicIO $ do
94 arr <- run $ arrFold len $ S.fromList list
95 assert (A.length arr == len)
97testLength :: Property
98testLength = genericTestFrom (\n -> S.fold (A.writeN n))
100testLengthFromStreamN :: Property
101testLengthFromStreamN = genericTestFrom A.fromStreamN
103#ifndef TEST_SMALL_ARRAY
104testLengthFromStream :: Property
105testLengthFromStream = genericTestFrom (const A.fromStream)
106#endif
108genericTestFromTo ::
109 (Int -> SerialT IO Int -> IO (Array Int))
110 -> (Array Int -> SerialT IO Int)
111 -> ([Int] -> [Int] -> Bool)
112 -> Property
113genericTestFromTo arrFold arrUnfold listEq =
114 forAll (choose (0, maxArrLen)) $ \len ->
115 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
116 monadicIO $ do
117 arr <- run $ arrFold len $ S.fromList list
118 xs <- run $ S.toList $ arrUnfold arr
119 assert (listEq xs list)
121testFoldNUnfold :: Property
122testFoldNUnfold =
123 genericTestFromTo (\n -> S.fold (A.writeN n)) (S.unfold A.read) (==)
125testFoldNToStream :: Property
126testFoldNToStream =
127 genericTestFromTo (\n -> S.fold (A.writeN n)) A.toStream (==)
129testFoldNToStreamRev :: Property
130testFoldNToStreamRev =
131 genericTestFromTo
132 (\n -> S.fold (A.writeN n))
133 A.toStreamRev
134 (\xs list -> xs == reverse list)
136testFromStreamNUnfold :: Property
137testFromStreamNUnfold = genericTestFromTo A.fromStreamN (S.unfold A.read) (==)
139testFromStreamNToStream :: Property
140testFromStreamNToStream = genericTestFromTo A.fromStreamN A.toStream (==)
142testFromListN :: Property
143testFromListN =
144 forAll (choose (0, maxArrLen)) $ \len ->
145 forAll (choose (0, len)) $ \n ->
146 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
147 monadicIO $ do
148 let arr = A.fromListN n list
149 xs <- run $ S.toList $ (S.unfold A.read) arr
150 listEquals (==) xs (take n list)
152#ifndef TEST_SMALL_ARRAY
153testFromStreamToStream :: Property
154testFromStreamToStream = genericTestFromTo (const A.fromStream) A.toStream (==)
156testFoldUnfold :: Property
157testFoldUnfold = genericTestFromTo (const (S.fold A.write)) (S.unfold A.read) (==)
159testFromList :: Property
160testFromList =
161 forAll (choose (0, maxArrLen)) $ \len ->
162 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
163 monadicIO $ do
164 let arr = A.fromList list
165 xs <- run $ S.toList $ (S.unfold A.read) arr
166 assert (xs == list)
167#endif
169#if defined(TEST_ARRAY) ||\
170 defined(DATA_ARRAY_PRIM) ||\
171 defined(DATA_ARRAY_PRIM_PINNED)
173testArraysOf :: Property
174testArraysOf =
175 forAll (choose (0, maxArrLen)) $ \len ->
176 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
177 monadicIO $ do
178 xs <- run
179 $ S.toList
180 $ S.unfoldMany A.read
181 $ arraysOf 240
182 $ S.fromList list
183 assert (xs == list)
184 where
185 arraysOf n = IP.chunksOf n (A.writeNUnsafe n)
187#endif
189#ifdef TEST_ARRAY
191unsafeWriteIndex :: [Int] -> Int -> Int -> IO Bool
192unsafeWriteIndex xs i x = do
193 let arr = MA.fromList xs
194 arr1 <- MA.unsafeWriteIndex arr i x
195 x1 <- MA.unsafeIndexIO arr1 i
196 return $ x1 == x
198lastN :: Int -> [a] -> [a]
199lastN n l = drop (length l - n) l
201testLastN :: Property
202testLastN =
203 forAll (choose (0, maxArrLen)) $ \len ->
204 forAll (choose (0, len)) $ \n ->
205 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
206 monadicIO $ do
207 xs <- run
208 $ fmap A.toList
209 $ S.fold (A.writeLastN n)
210 $ S.fromList list
211 assert (xs == lastN n list)
213testLastN_LN :: Int -> Int -> IO Bool
214testLastN_LN len n = do
215 let list = [1..len]
216 l1 <- fmap A.toList $ S.fold (A.writeLastN n) $ S.fromList list
217 let l2 = lastN n list
218 return $ l1 == l2
220-- Instead of hard coding 10000 here we can have maxStreamLength for operations
221-- that use stream of arrays.
222concatArrayW8 :: Property
223concatArrayW8 =
224 forAll (vectorOf 10000 (arbitrary :: Gen Word8))
225 $ \w8List -> do
226 let w8ArrList = A.fromList . (: []) <$> w8List
227 f2 <- S.toList $ AS.concat $ S.fromList w8ArrList
228 w8List `shouldBe` f2
230unsafeSlice :: Int -> Int -> [Int] -> Bool
231unsafeSlice i n list =
232 let lst = take n $ drop i $ list
233 arr = A.toList $ A.unsafeSlice i n $ A.fromList list
234 in arr == lst
236#endif
238main :: IO ()
239main =
240 hspec $
241 H.parallel $
242 modifyMaxSuccess (const maxTestCount) $ do
243 describe moduleName $ do
244 describe "Construction" $ do
245 prop "length . writeN n === n" testLength
246 prop "length . fromStreamN n === n" testLengthFromStreamN
247 prop "read . writeN === id " testFoldNUnfold
248 prop "toStream . writeN === id" testFoldNToStream
249 prop "toStreamRev . writeN === reverse" testFoldNToStreamRev
250 prop "read . fromStreamN === id" testFromStreamNUnfold
251 prop "toStream . fromStreamN === id" testFromStreamNToStream
252 prop "fromListN" testFromListN
254#ifndef TEST_SMALL_ARRAY
255 prop "length . fromStream === n" testLengthFromStream
256 prop "toStream . fromStream === id" testFromStreamToStream
257 prop "read . write === id" testFoldUnfold
258 prop "fromList" testFromList
259#endif
261#if defined(TEST_ARRAY) ||\
262 defined(DATA_ARRAY_PRIM) ||\
263 defined(DATA_ARRAY_PRIM_PINNED)
264 prop "arraysOf concats to original" testArraysOf
265#endif
267#ifdef TEST_ARRAY
268 prop "AS.concat . (A.fromList . (:[]) <$>) === id" $ concatArrayW8
269 describe "unsafeSlice" $ do
270 it "partial" $ unsafeSlice 2 4 [1..10]
271 it "none" $ unsafeSlice 10 0 [1..10]
272 it "full" $ unsafeSlice 0 10 [1..10]
273 describe "Mut.unsafeWriteIndex" $ do
274 it "first" (unsafeWriteIndex [1..10] 0 0 `shouldReturn` True)
275 it "middle" (unsafeWriteIndex [1..10] 5 0 `shouldReturn` True)
276 it "last" (unsafeWriteIndex [1..10] 9 0 `shouldReturn` True)
277 describe "Fold" $ do
278 prop "writeLastN : 0 <= n <= len" $ testLastN
279 describe "writeLastN boundary conditions" $ do
280 it "writeLastN -1" (testLastN_LN 10 (-1) `shouldReturn` True)
281 it "writeLastN 0" (testLastN_LN 10 0 `shouldReturn` True)
282 it "writeLastN length" (testLastN_LN 10 10 `shouldReturn` True)
283 it "writeLastN (length + 1)" (testLastN_LN 10 11 `shouldReturn` True)
284#endif