git.iko.soy/streamly
on acc37cf help sign in
streamly/test/Streamly/Test/Data/Array/Foreign.hs
224 lines 7.3 kB history raw
1-- |
2-- Module : Streamly.Test.Data.Array.Foreign
3-- Copyright : (c) 2019 Composewell technologies
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Stability : experimental
7-- Portability : GHC
9module Streamly.Test.Data.Array.Foreign (main) where
11#include "Streamly/Test/Data/Array/CommonImports.hs"
13import Data.Char (isLower)
14import Data.List (sort)
15import Data.Word(Word8)
16import Test.QuickCheck (chooseInt, listOf)
18import qualified Streamly.Internal.Data.Fold as Fold
19import qualified Streamly.Internal.Data.Array.Foreign as A
20import qualified Streamly.Internal.Data.Array.Foreign.Type as A
21import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA
22import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS
24type Array = A.Array
26moduleName :: String
27moduleName = "Data.Array.Foreign"
29#include "Streamly/Test/Data/Array/Common.hs"
31testFromStreamToStream :: Property
32testFromStreamToStream = genericTestFromTo (const A.fromStream) A.toStream (==)
34testFoldUnfold :: Property
35testFoldUnfold = genericTestFromTo (const (S.fold A.write)) (S.unfold A.read) (==)
37testFromList :: Property
38testFromList =
39 forAll (choose (0, maxArrLen)) $ \len ->
40 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
41 monadicIO $ do
42 let arr = A.fromList list
43 xs <- run $ S.toList $ (S.unfold A.read) arr
44 assert (xs == list)
46testLengthFromStream :: Property
47testLengthFromStream = genericTestFrom (const A.fromStream)
50unsafeWriteIndex :: [Int] -> Int -> Int -> IO Bool
51unsafeWriteIndex xs i x = do
52 arr <- MA.fromList xs
53 MA.putIndexUnsafe i x arr
54 x1 <- MA.getIndexUnsafe i arr
55 return $ x1 == x
57lastN :: Int -> [a] -> [a]
58lastN n l = drop (length l - n) l
60testLastN :: Property
61testLastN =
62 forAll (choose (0, maxArrLen)) $ \len ->
63 forAll (choose (0, len)) $ \n ->
64 forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->
65 monadicIO $ do
66 xs <- run
67 $ fmap A.toList
68 $ S.fold (A.writeLastN n)
69 $ S.fromList list
70 assert (xs == lastN n list)
72testLastN_LN :: Int -> Int -> IO Bool
73testLastN_LN len n = do
74 let list = [1..len]
75 l1 <- fmap A.toList $ S.fold (A.writeLastN n) $ S.fromList list
76 let l2 = lastN n list
77 return $ l1 == l2
79testStrip :: IO Bool
80testStrip = do
81 dt <- MA.fromList "abcDEFgeh"
82 dt' <- MA.strip isLower dt
83 x <- MA.toList dt'
84 return $ x == "DEF"
86testStripLeft :: IO Bool
87testStripLeft = do
88 dt <- MA.fromList "abcDEF"
89 dt' <- MA.strip isLower dt
90 x <- MA.toList dt'
91 return $ x == "DEF"
93testStripRight :: IO Bool
94testStripRight = do
95 dt <- MA.fromList "DEFgeh"
96 dt' <- MA.strip isLower dt
97 x <- MA.toList dt'
98 return $ x == "DEF"
100testStripZero :: IO Bool
101testStripZero = do
102 dt <- MA.fromList "DEF"
103 dt' <- MA.strip isLower dt
104 x <- MA.toList dt'
105 return $ x == "DEF"
107testStripEmpty :: IO Bool
108testStripEmpty = do
109 dt <- MA.fromList "abc"
110 dt' <- MA.strip isLower dt
111 x <- MA.toList dt'
112 return $ x == ""
114testStripNull :: IO Bool
115testStripNull = do
116 dt <- MA.fromList ""
117 dt' <- MA.strip isLower dt
118 x <- MA.toList dt'
119 return $ x == ""
121-- Instead of hard coding 10000 here we can have maxStreamLength for operations
122-- that use stream of arrays.
123concatArrayW8 :: Property
124concatArrayW8 =
125 forAll (vectorOf 10000 (arbitrary :: Gen Word8))
126 $ \w8List -> do
127 let w8ArrList = A.fromList . (: []) <$> w8List
128 f2 <- S.toList $ AS.concat $ S.fromList w8ArrList
129 w8List `shouldBe` f2
131unsafeSlice :: Int -> Int -> [Int] -> Bool
132unsafeSlice i n list =
133 let lst = take n $ drop i $ list
134 arr = A.toList $ A.getSliceUnsafe i n $ A.fromList list
135 in arr == lst
137{-
138testAppend :: Property
139testAppend =
140 forAll (listOf (chooseInt (-50, 100))) $ \ls0 ->
141 monadicIO $ action ls0
143 where
145 action ls = do
146 x <- S.fold
147 (MA.append (MA.newArray 0))
148 (S.fromList (ls::[Int]))
149 lst <- MA.toList x
150 assert (ls == lst)
151-}
153testBubbleWith :: Bool -> Property
154testBubbleWith asc =
155 forAll (listOf (chooseInt (-50, 100))) $ \ls0 ->
156 monadicIO $ action ls0
158 where
160 action ls = do
161 x <- S.fold (fldm ls) $ S.fromList ls
162 lst <- MA.toList x
163 if asc
164 then assert (sort ls == lst)
165 else assert (sort ls == reverse lst)
167 fldm ls =
168 Fold.foldlM'
169 (\b a -> do
170 arr <- MA.snoc b a
171 if asc
172 then MA.bubble compare arr
173 else MA.bubble (flip compare) arr
174 return arr
175 )
176 (MA.newArray $ length ls)
178testBubbleAsc :: Property
179testBubbleAsc = testBubbleWith True
181testBubbleDesc :: Property
182testBubbleDesc = testBubbleWith False
184main :: IO ()
185main =
186 hspec $
187 H.parallel $
188 modifyMaxSuccess (const maxTestCount) $ do
189 describe moduleName $ do
190 commonMain
191 describe "Construction" $ do
192 -- XXX There is an issue https://github.com/composewell/streamly/issues/1577
193 --prop "testAppend" testAppend
194 prop "testBubbleAsc" testBubbleAsc
195 prop "testBubbleDesc" testBubbleDesc
196 prop "length . fromStream === n" testLengthFromStream
197 prop "toStream . fromStream === id" testFromStreamToStream
198 prop "read . write === id" testFoldUnfold
199 prop "fromList" testFromList
200 prop "foldMany with writeNUnsafe concats to original"
201 (foldManyWith (\n -> Fold.take n (A.writeNUnsafe n)))
202 prop "AS.concat . (A.fromList . (:[]) <$>) === id" $ concatArrayW8
203 describe "unsafeSlice" $ do
204 it "partial" $ unsafeSlice 2 4 [1..10]
205 it "none" $ unsafeSlice 10 0 [1..10]
206 it "full" $ unsafeSlice 0 10 [1..10]
207 describe "Mut.unsafeWriteIndex" $ do
208 it "first" (unsafeWriteIndex [1..10] 0 0 `shouldReturn` True)
209 it "middle" (unsafeWriteIndex [1..10] 5 0 `shouldReturn` True)
210 it "last" (unsafeWriteIndex [1..10] 9 0 `shouldReturn` True)
211 describe "Fold" $ do
212 prop "writeLastN : 0 <= n <= len" $ testLastN
213 describe "writeLastN boundary conditions" $ do
214 it "writeLastN -1" (testLastN_LN 10 (-1) `shouldReturn` True)
215 it "writeLastN 0" (testLastN_LN 10 0 `shouldReturn` True)
216 it "writeLastN length" (testLastN_LN 10 10 `shouldReturn` True)
217 it "writeLastN (length + 1)" (testLastN_LN 10 11 `shouldReturn` True)
218 describe "Strip" $ do
219 it "strip" (testStrip `shouldReturn` True)
220 it "stripLeft" (testStripLeft `shouldReturn` True)
221 it "stripRight" (testStripRight `shouldReturn` True)
222 it "stripZero" (testStripZero `shouldReturn` True)
223 it "stripEmpty" (testStripEmpty `shouldReturn` True)
224 it "stripNull" (testStripNull `shouldReturn` True)