on bd5b6fc help sign in
232 lines 8.0 kB history raw
1-- |
2-- Module : Streamly.Test.FileSystem.Handle
3-- Copyright : (c) 2020 Composewell technologies
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Stability : experimental
7-- Portability : GHC
9module Streamly.Test.FileSystem.Handle (main) where
11import Data.Functor.Identity (runIdentity)
12import Data.Word (Word8)
13import Foreign.Storable (Storable(..))
14import Streamly.Internal.Data.Stream.IsStream (IsStream, SerialT)
15import System.FilePath ((</>))
16import System.IO
17 ( Handle
18 , IOMode(..)
19 , SeekMode(..)
20 , hClose
21 , hFlush
22 , hSeek
23 , openFile
24 )
25import System.IO.Temp (withSystemTempDirectory)
26import Test.QuickCheck (Property, forAll, Gen, vectorOf, choose)
27import Test.QuickCheck.Monadic (monadicIO, assert, run)
29import qualified Streamly.Data.Fold as Fold
30import qualified Streamly.Internal.FileSystem.Handle as Handle
31import qualified Streamly.Internal.Data.Stream.IsStream as Stream
32import qualified Streamly.Internal.Data.Array.Foreign as Array
33import qualified Streamly.Internal.Unicode.Stream as Unicode
35import Test.Hspec as H
36import Test.Hspec.QuickCheck
38allocOverhead :: Int
39allocOverhead = 2 * sizeOf (undefined :: Int)
41defaultChunkSize :: Int
42defaultChunkSize = 32 * k - allocOverhead
43 where k = 1024
45maxArrLen :: Int
46maxArrLen = defaultChunkSize * 8
48maxTestCount :: Int
49maxTestCount = 10
51chooseWord8 :: (Word8, Word8) -> Gen Word8
52chooseWord8 = choose
54utf8ToString :: Array.Array Word8 -> String
55utf8ToString =
56 runIdentity . Stream.toList . Unicode.decodeUtf8' . Array.toStream
58testData :: String
59testData = "This is the test data for FileSystem.Handle ??`!@#$%^&*~~))`]"
61testDataLarge :: String
62testDataLarge = concat $ replicate 6000 testData
64testBinData :: String
65testBinData = "01234567890123456789012345678901234567890123456789"
67executor :: (Handle -> SerialT IO Char) -> IO (SerialT IO Char)
68executor f =
69 withSystemTempDirectory "fs_handle" $ \fp -> do
70 let fpath = fp </> "tmp_read.txt"
71 writeFile fpath testDataLarge
72 h <- openFile fpath ReadMode
73 return $ f h
75readFromHandle :: IO (SerialT IO Char)
76readFromHandle =
77 let f = Unicode.decodeUtf8 . Stream.unfold Handle.read
78 in executor f
80readWithBufferFromHandle :: IO (SerialT IO Char)
81readWithBufferFromHandle =
82 let f1 = (\h -> (1024, h))
83 f2 = Unicode.decodeUtf8 . Stream.unfold Handle.readWithBufferOf . f1
84 in executor f2
86readChunksFromHandle :: IO (SerialT IO Char)
87readChunksFromHandle =
88 let f = Unicode.decodeUtf8
89 . Stream.concatMap Array.toStream
90 . Stream.unfold Handle.readChunks
91 in executor f
93readChunksWithBuffer :: IO (SerialT IO Char)
94readChunksWithBuffer =
95 let f1 = (\h -> (1024, h))
96 f2 =
97 Unicode.decodeUtf8
98 . Stream.concatMap Array.toStream
99 . Stream.unfold Handle.readChunksWithBufferOf
100 . f1
101 in executor f2
103testRead :: (IsStream t) => IO (t IO Char) -> Property
104testRead fn = monadicIO $ do
105 let v2 = Stream.fromList testDataLarge
106 v1 <- run fn
107 res <- run $ Stream.eqBy (==) v1 v2
108 assert res
110testWrite :: (Handle -> Fold.Fold IO Word8 ()) -> Property
111testWrite hfold =
112 forAll (choose (0, maxArrLen)) $ \len ->
113 forAll (vectorOf len $ chooseWord8 (0, 255)) $ \list0 ->
114 monadicIO $ do
115 res <- run $ go list0
116 assert res
118 where
120 go list =
121 withSystemTempDirectory "fs_handle" $ \fp -> do
122 let fpathWrite = fp </> "tmp_write.txt"
123 writeFile fpathWrite ""
124 h <- openFile fpathWrite ReadWriteMode
125 hSeek h AbsoluteSeek 0
126 _ <- Stream.fold (hfold h) $ Stream.fromList list
127 hFlush h
128 hSeek h AbsoluteSeek 0
129 ls <- Stream.toList $ Stream.unfold Handle.read h
130 hClose h
131 return (ls == list)
133testWriteWithChunk :: Property
134testWriteWithChunk =
135 monadicIO $ do
136 res <- run go
137 assert res
139 where
141 go =
142 withSystemTempDirectory "fs_handle" $ \fp -> do
143 let fpathRead = fp </> "tmp_read.txt"
144 fpathWrite = fp </> "tmp_write.txt"
145 writeFile fpathRead testDataLarge
146 writeFile fpathWrite ""
147 hr <- openFile fpathRead ReadMode
148 hw <- openFile fpathWrite ReadWriteMode
149 hSeek hw AbsoluteSeek 0
150 _ <- Stream.fold (Handle.writeChunks hw)
151 $ Stream.unfold Handle.readChunksWithBufferOf (1024, hr)
152 hFlush hw
153 hSeek hw AbsoluteSeek 0
154 ls <- Stream.toList $ Stream.unfold Handle.read hw
155 let arr = Array.fromList ls
156 return (testDataLarge == utf8ToString arr)
158testReadChunksFromToWith :: Int -> Int -> Int -> [[Word8]] -> Property
159testReadChunksFromToWith from to buffSize res = monadicIO $ run go
161 where
163 go =
164 withSystemTempDirectory "fs_handle" $ \fp -> do
165 let fpathRead = fp </> "tmp_read.txt"
166 writeFile fpathRead testBinData
167 h <- openFile fpathRead ReadMode
168 ls <-
169 Stream.toList
170 $ Stream.unfold
171 Handle.readChunksFromToWith (from, to, buffSize, h)
172 return (res `shouldBe` fmap Array.toList ls)
174-- Test for first byte
175testReadChunksFromToWithFirstByte :: Property
176testReadChunksFromToWithFirstByte = testReadChunksFromToWith 0 0 15 [[48]]
178-- Test for second byte
179testReadChunksFromToWithSecondByte :: Property
180testReadChunksFromToWithSecondByte = testReadChunksFromToWith 1 1 15 [[49]]
182-- Test for second to 10th bytes
183testReadChunksFromToWithSecondToTenthBytes :: Property
184testReadChunksFromToWithSecondToTenthBytes =
185 testReadChunksFromToWith 1 10 15 [[49,50,51,52,53,54,55,56,57,48]]
187-- Test for offset of buffer size
188testReadChunksFromToWithBuffSizeOffset :: Property
189testReadChunksFromToWithBuffSizeOffset =
190 testReadChunksFromToWith 15 25 15 [[53,54,55,56,57,48,49,50,51,52,53]]
192-- Test with multi buffer size
193testReadChunksFromToWithMultiBuff :: Property
194testReadChunksFromToWithMultiBuff =
195 testReadChunksFromToWith
196 5 22 5 [[53,54,55,56,57],[48,49,50,51,52],[53,54,55,56,57],[48,49,50]]
198testReadChunksFromToWithRangeInvalid :: Property
199testReadChunksFromToWithRangeInvalid = testReadChunksFromToWith 15 5 15 []
201moduleName :: String
202moduleName = "FileSystem.Handle"
204main :: IO ()
205main =
206 hspec $
207 H.parallel $
208 modifyMaxSuccess (const maxTestCount) $ do
209 describe moduleName $ do
210 describe "Read From Handle" $ do
211 prop "read" $ testRead readFromHandle
212 prop "readWithBufferOf" $ testRead readWithBufferFromHandle
213 prop "readChunks" $ testRead readChunksFromHandle
214 prop "readChunksWithBufferOf" $ testRead readChunksWithBuffer
215 prop "readChunksFromToWith (0,0,n)"
216 testReadChunksFromToWithFirstByte
217 prop "readChunksFromToWith (1,1,n)"
218 testReadChunksFromToWithSecondByte
219 prop "readChunksFromToWith (1,10,n)"
220 testReadChunksFromToWithSecondToTenthBytes
221 prop "readChunksFromToWith (n,<2n,n)"
222 testReadChunksFromToWithBuffSizeOffset
223 prop "readChunksFromToWith (n,>2n,n)"
224 testReadChunksFromToWithMultiBuff
225 prop "readChunksFromToWith (n,<n,n)"
226 testReadChunksFromToWithRangeInvalid
227 describe "Write To Handle" $ do
228 prop "write" $ testWrite Handle.write
229 prop "writeWithBufferOf"
230 $ testWrite $ Handle.writeWithBufferOf 1024
231 -- XXX This test needs a lot of stack when built with -O0
232 prop "writeChunks" testWriteWithChunk