1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
{-# LANGUAGE CPP #-}
import Test.Tasty
import Test.Tasty.HUnit
import Control.Monad
import Control.Concurrent
import Control.Concurrent.MVar
import Control.Exception
import System.Directory
import System.IO
import System.FilePath
import System.Environment.Compat
import Data.Bits
import Data.List
import GHC.IO.Handle
#ifndef mingw32_HOST_OS
import System.Posix.Files
#endif
import System.IO.Temp
main = do
-- force single-thread execution, because changing TMPDIR in one of the
-- tests may leak to the other tests
setEnv "TASTY_NUM_THREADS" "1"
#ifndef mingw32_HOST_OS
setFileCreationMask 0
#endif
sys_tmp_dir <- getCanonicalTemporaryDirectory
defaultMain $ testGroup "Tests"
[ testCase "openNewBinaryFile" $ do
(fp, fh) <- openNewBinaryFile sys_tmp_dir "test.txt"
let fn = takeFileName fp
assertBool ("Does not match template: " ++ fn) $
("test" `isPrefixOf` fn) && (".txt" `isSuffixOf` fn)
assertBool (fp ++ " is not in the right directory " ++ sys_tmp_dir) $
takeDirectory fp `equalFilePath` sys_tmp_dir
hClose fh
assertBool "File does not exist" =<< doesFileExist fp
#ifndef mingw32_HOST_OS
status <- getFileStatus fp
fileMode status .&. 0o777 @?= 0o666
#endif
removeFile fp
, testCase "withSystemTempFile" $ do
(fp, fh) <- withSystemTempFile "test.txt" $ \fp fh -> do
let fn = takeFileName fp
assertBool ("Does not match template: " ++ fn) $
("test" `isPrefixOf` fn) && (".txt" `isSuffixOf` fn)
assertBool (fp ++ " is not in the right directory " ++ sys_tmp_dir) $
takeDirectory fp `equalFilePath` sys_tmp_dir
assertBool "File not open" =<< hIsOpen fh
hPutStrLn fh "hi"
assertBool "File does not exist" =<< doesFileExist fp
#ifndef mingw32_HOST_OS
status <- getFileStatus fp
fileMode status .&. 0o777 @?= 0o600
#endif
return (fp, fh)
assertBool "File still exists" . not =<< doesFileExist fp
assertBool "File not closed" =<< hIsClosed fh
, testCase "withSystemTempDirectory" $ do
fp <- withSystemTempDirectory "test.dir" $ \fp -> do
let fn = takeFileName fp
assertBool ("Does not match template: " ++ fn) $
("test.dir" `isPrefixOf` fn)
assertBool (fp ++ " is not in the right directory " ++ sys_tmp_dir) $
takeDirectory fp `equalFilePath` sys_tmp_dir
assertBool "Directory does not exist" =<< doesDirectoryExist fp
#ifndef mingw32_HOST_OS
status <- getFileStatus fp
fileMode status .&. 0o777 @?= 0o700
#endif
return fp
assertBool "Directory still exists" . not =<< doesDirectoryExist fp
, testCase "writeSystemTempFile" $ do
fp <- writeSystemTempFile "blah.txt" "hello"
str <- readFile fp
"hello" @?= str
removeFile fp
, testCase "emptySystemTempFile" $ do
fp <- emptySystemTempFile "empty.txt"
assertBool "File doesn't exist" =<< doesFileExist fp
removeFile fp
, testCase "withSystemTempFile returns absolute path" $ do
bracket_ (setEnv "TMPDIR" ".") (unsetEnv "TMPDIR") $ do
withSystemTempFile "temp.txt" $ \fp _ ->
assertBool "Not absolute" $ isAbsolute fp
, testCase "withSystemTempDirectory is not interrupted" $ do
-- this mvar is both a channel to pass the name of the directory
-- and a signal that we finished creating files and are ready
-- to be killed
mvar1 <- newEmptyMVar
-- this mvar signals that the withSystemTempDirectory function
-- returned and we can check whether the directory has survived
mvar2 <- newEmptyMVar
threadId <- forkIO $
(withSystemTempDirectory "temp.test." $ \dir -> do
replicateM_ 100 $ emptyTempFile dir "file.xyz"
putMVar mvar1 dir
threadDelay $ 10^6
) `finally` (putMVar mvar2 ())
dir <- readMVar mvar1
-- start sending exceptions
replicateM_ 10 $ forkIO $ killThread threadId
-- wait for the thread to finish
readMVar mvar2
-- check whether the directory was successfully removed
assertBool "Directory was not removed" . not =<< doesDirectoryExist dir
]
|
