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