git.iko.soy/streamly
on e19f645 help sign in
streamly/test/Streamly/Test/Common/Array.hs
211 lines 6.9 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)
20import Test.Hspec as H
22import Streamly.Prelude (SerialT)
23import 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 qualified Streamly.Internal.Data.Array.Storable.Foreign as A
30import qualified Streamly.Internal.Data.Array.Storable.Foreign.Types as A
31import qualified Streamly.Internal.Data.Stream.IsStream as IP
32type Array = A.Array
33#elif defined(DATA_ARRAY_PRIM_PINNED)
34import qualified Streamly.Internal.Data.Array.Prim.Pinned as A
35import qualified Streamly.Internal.Data.Array.Prim.Pinned.Types as A
36import qualified Streamly.Internal.Data.Stream.IsStream as IP
37type Array = A.Array
38#elif defined(DATA_ARRAY_PRIM)
39import qualified Streamly.Internal.Data.Array.Prim as A
40import qualified Streamly.Internal.Data.Array.Prim.Types as A
41import qualified Streamly.Internal.Data.Stream.IsStream as IP
42type Array = A.Array
43#else
44import qualified Streamly.Internal.Data.Array as A
45type Array = A.Array
46#endif
48-- Coverage build takes too long with default number of tests
49maxTestCount :: Int
50#ifdef DEVBUILD
51maxTestCount = 100
52#else
53maxTestCount = 10
54#endif
56allocOverhead :: Int
57allocOverhead = 2 * sizeOf (undefined :: Int)
59-- XXX this should be in sync with the defaultChunkSize in Array code, or we
60-- should expose that and use that. For fast testing we could reduce the
61-- defaultChunkSize under CPP conditionals.
62--
63defaultChunkSize :: Int
64defaultChunkSize = 32 * k - allocOverhead
65 where k = 1024
67maxArrLen :: Int
68maxArrLen = defaultChunkSize * 8
70genericTestFrom ::
71 (Int -> SerialT IO Int -> IO (Array Int))
72 -> Property
73genericTestFrom arrFold =
74 forAll (choose (0, maxArrLen)) $ \len ->
75 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
76 monadicIO $ do
77 arr <- run $ arrFold len $ S.fromList list
78 assert (A.length arr == len)
80testLength :: Property
81testLength = genericTestFrom (\n -> S.fold (A.writeN n))
83testLengthFromStreamN :: Property
84testLengthFromStreamN = genericTestFrom A.fromStreamN
86#ifndef TEST_SMALL_ARRAY
87testLengthFromStream :: Property
88testLengthFromStream = genericTestFrom (const A.fromStream)
89#endif
91genericTestFromTo ::
92 (Int -> SerialT IO Int -> IO (Array Int))
93 -> (Array Int -> SerialT IO Int)
94 -> ([Int] -> [Int] -> Bool)
95 -> Property
96genericTestFromTo arrFold arrUnfold listEq =
97 forAll (choose (0, maxArrLen)) $ \len ->
98 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
99 monadicIO $ do
100 arr <- run $ arrFold len $ S.fromList list
101 xs <- run $ S.toList $ arrUnfold arr
102 assert (listEq xs list)
104testFoldNUnfold :: Property
105testFoldNUnfold =
106 genericTestFromTo (\n -> S.fold (A.writeN n)) (S.unfold A.read) (==)
108testFoldNToStream :: Property
109testFoldNToStream =
110 genericTestFromTo (\n -> S.fold (A.writeN n)) A.toStream (==)
112testFoldNToStreamRev :: Property
113testFoldNToStreamRev =
114 genericTestFromTo
115 (\n -> S.fold (A.writeN n))
116 A.toStreamRev
117 (\xs list -> xs == reverse list)
119testFromStreamNUnfold :: Property
120testFromStreamNUnfold = genericTestFromTo A.fromStreamN (S.unfold A.read) (==)
122testFromStreamNToStream :: Property
123testFromStreamNToStream = genericTestFromTo A.fromStreamN A.toStream (==)
125#ifndef TEST_SMALL_ARRAY
126testFromStreamToStream :: Property
127testFromStreamToStream = genericTestFromTo (const A.fromStream) A.toStream (==)
129testFoldUnfold :: Property
130testFoldUnfold = genericTestFromTo (const (S.fold A.write)) (S.unfold A.read) (==)
131#endif
133#if defined(TEST_ARRAY) ||\
134 defined(DATA_ARRAY_PRIM) ||\
135 defined(DATA_ARRAY_PRIM_PINNED)
137testArraysOf :: Property
138testArraysOf =
139 forAll (choose (0, maxArrLen)) $ \len ->
140 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
141 monadicIO $ do
142 xs <- run
143 $ S.toList
144 $ S.concatUnfold A.read
145 $ arraysOf 240
146 $ S.fromList list
147 assert (xs == list)
148 where
149 arraysOf n = IP.chunksOf n (A.writeNUnsafe n)
151#endif
153#ifdef TEST_ARRAY
155lastN :: Int -> [a] -> [a]
156lastN n l = drop (length l - n) l
158testLastN :: Property
159testLastN =
160 forAll (choose (0, maxArrLen)) $ \len ->
161 forAll (choose (0, len)) $ \n ->
162 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
163 monadicIO $ do
164 xs <- run
165 $ fmap A.toList
166 $ S.fold (A.lastN n)
167 $ S.fromList list
168 assert (xs == lastN n list)
170testLastN_LN :: Int -> Int -> IO Bool
171testLastN_LN len n = do
172 let list = [1..len]
173 l1 <- fmap A.toList $ S.fold (A.lastN n) $ S.fromList list
174 let l2 = lastN n list
175 return $ l1 == l2
176#endif
178main :: IO ()
179main =
180 hspec $
181 H.parallel $
182 modifyMaxSuccess (const maxTestCount) $ do
183 describe "Construction" $ do
184 prop "length . writeN n === n" testLength
185 prop "length . fromStreamN n === n" testLengthFromStreamN
186 prop "read . writeN === id " testFoldNUnfold
187 prop "toStream . writeN === id" testFoldNToStream
188 prop "toStreamRev . writeN === reverse" testFoldNToStreamRev
189 prop "read . fromStreamN === id" testFromStreamNUnfold
190 prop "toStream . fromStreamN === id" testFromStreamNToStream
191#ifndef TEST_SMALL_ARRAY
192 prop "length . fromStream === n" testLengthFromStream
193 prop "toStream . fromStream === id" testFromStreamToStream
194 prop "read . write === id" testFoldUnfold
195#endif
197#if defined(TEST_ARRAY) ||\
198 defined(DATA_ARRAY_PRIM) ||\
199 defined(DATA_ARRAY_PRIM_PINNED)
200 prop "arraysOf concats to original" testArraysOf
201#endif
203#ifdef TEST_ARRAY
204 describe "Fold" $ do
205 prop "lastN : 0 <= n <= len" $ testLastN
206 describe "lastN boundary conditions" $ do
207 it "lastN -1" (testLastN_LN 10 (-1) `shouldReturn` True)
208 it "lastN 0" (testLastN_LN 10 0 `shouldReturn` True)
209 it "lastN length" (testLastN_LN 10 10 `shouldReturn` True)
210 it "lastN (length + 1)" (testLastN_LN 10 11 `shouldReturn` True)
211#endif