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