|
1 | | -module Main (main) where |
| 1 | +module LazyHClose (testSuite) where |
2 | 2 |
|
3 | 3 | import Control.Monad (void, forM_) |
4 | 4 | import Data.ByteString.Internal (toForeignPtr) |
5 | 5 | import Foreign.C.String (withCString) |
6 | 6 | import Foreign.ForeignPtr (finalizeForeignPtr) |
7 | 7 | import System.IO (openFile, openTempFile, hClose, hPutStrLn, IOMode(..)) |
8 | 8 | import System.Posix.Internals (c_unlink) |
| 9 | +import Test.Tasty (TestTree, testGroup, withResource) |
| 10 | +import Test.Tasty.QuickCheck (testProperty, ioProperty) |
9 | 11 |
|
10 | 12 | import qualified Data.ByteString as S |
11 | 13 | import qualified Data.ByteString.Char8 as S8 |
12 | 14 | import qualified Data.ByteString.Lazy as L |
13 | 15 | import qualified Data.ByteString.Lazy.Char8 as L8 |
14 | 16 |
|
15 | | -main :: IO () |
16 | | -main = do |
17 | | - let n = 1000 |
18 | | - (fn, h) <- openTempFile "." "lazy-hclose-test.tmp" |
19 | | - hPutStrLn h "x" |
20 | | - hClose h |
| 17 | +n :: Int |
| 18 | +n = 1000 |
21 | 19 |
|
22 | | - ------------------------------------------------------------------------ |
23 | | - -- readFile tests |
| 20 | +testSuite :: TestTree |
| 21 | +testSuite = withResource |
| 22 | + (do (fn, h) <- openTempFile "." "lazy-hclose-test.tmp"; hPutStrLn h "x"; hClose h; pure fn) |
| 23 | + removeFile $ \fn' -> |
| 24 | + testGroup "LazyHClose" |
| 25 | + [ testProperty "Testing resource leaks for Strict.readFile" $ ioProperty $ |
| 26 | + forM_ [1..n] $ const $ do |
| 27 | + fn <- fn' |
| 28 | + r <- S.readFile fn |
| 29 | + appendFile fn "" -- will fail, if fn has not been closed yet |
24 | 30 |
|
25 | | - putStrLn "Testing resource leaks for Strict.readFile" |
26 | | - forM_ [1..n] $ const $ do |
27 | | - r <- S.readFile fn |
28 | | - appendFile fn "" -- will fail, if fn has not been closed yet |
| 31 | + , testProperty "Testing resource leaks for Lazy.readFile" $ ioProperty $ |
| 32 | + forM_ [1..n] $ const $ do |
| 33 | + fn <- fn' |
| 34 | + r <- L.readFile fn |
| 35 | + L.length r `seq` return () |
| 36 | + appendFile fn "" -- will fail, if fn has not been closed yet |
29 | 37 |
|
30 | | - putStrLn "Testing resource leaks for Lazy.readFile" |
31 | | - forM_ [1..n] $ const $ do |
32 | | - r <- L.readFile fn |
33 | | - L.length r `seq` return () |
34 | | - appendFile fn "" -- will fail, if fn has not been closed yet |
| 38 | + , testProperty "Testing resource leaks when converting lazy to strict" $ ioProperty $ |
| 39 | + forM_ [1..n] $ const $ do |
| 40 | + fn <- fn' |
| 41 | + let release c = finalizeForeignPtr fp where (fp,_,_) = toForeignPtr c |
| 42 | + r <- L.readFile fn |
| 43 | + mapM_ release (L.toChunks r) |
| 44 | + appendFile fn "" -- will fail, if fn has not been closed yet |
35 | 45 |
|
36 | | - -- manage the resources explicitly. |
37 | | - putStrLn "Testing resource leaks when converting lazy to strict" |
38 | | - forM_ [1..n] $ const $ do |
39 | | - let release c = finalizeForeignPtr fp where (fp,_,_) = toForeignPtr c |
40 | | - r <- L.readFile fn |
41 | | - mapM_ release (L.toChunks r) |
42 | | - appendFile fn "" -- will fail, if fn has not been closed yet |
| 46 | + , testProperty "Testing strict hGetContents" $ ioProperty $ |
| 47 | + forM_ [1..n] $ const $ do |
| 48 | + fn <- fn' |
| 49 | + h <- openFile fn ReadMode |
| 50 | + r <- S.hGetContents h |
| 51 | + S.last r `seq` return () |
| 52 | + appendFile fn "" -- will fail, if fn has not been closed yet |
43 | 53 |
|
44 | | - ------------------------------------------------------------------------ |
45 | | - -- hGetContents tests |
46 | | - |
47 | | - putStrLn "Testing strict hGetContents" |
48 | | - forM_ [1..n] $ const $ do |
49 | | - h <- openFile fn ReadMode |
50 | | - r <- S.hGetContents h |
51 | | - S.last r `seq` return () |
52 | | - appendFile fn "" -- will fail, if fn has not been closed yet |
53 | | - |
54 | | - putStrLn "Testing lazy hGetContents" |
55 | | - forM_ [1..n] $ const $ do |
56 | | - h <- openFile fn ReadMode |
57 | | - r <- L.hGetContents h |
58 | | - L.last r `seq` return () |
59 | | - appendFile fn "" -- will fail, if fn has not been closed yet |
60 | | - |
61 | | - removeFile fn |
| 54 | + , testProperty "Testing lazy hGetContents" $ ioProperty $ |
| 55 | + forM_ [1..n] $ const $ do |
| 56 | + fn <- fn' |
| 57 | + h <- openFile fn ReadMode |
| 58 | + r <- L.hGetContents h |
| 59 | + L.last r `seq` return () |
| 60 | + appendFile fn "" -- will fail, if fn has not been closed yet |
| 61 | + ] |
62 | 62 |
|
63 | 63 | removeFile :: String -> IO () |
64 | 64 | removeFile fn = void $ withCString fn c_unlink |
0 commit comments