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