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