Utils.hs 1.8 KB
Newer Older
1
2
3
4
5
6
7
module UnitTests.Distribution.Simple.Utils
    ( tests
    ) where

import Distribution.Simple.Utils
import Distribution.Verbosity

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
8
9
10
11
import Data.IORef
import System.Directory ( doesDirectoryExist, doesFileExist
                        , getTemporaryDirectory
                        , removeDirectoryRecursive, removeFile )
12
13
14
15
16
17
18
import System.IO (hClose)

import Test.Tasty
import Test.Tasty.HUnit

withTempFileTest :: Assertion
withTempFileTest = do
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
19
20
21
22
23
24
25
26
27
  fileName <- newIORef ""
  tempDir  <- getTemporaryDirectory
  withTempFile tempDir ".foo" $ \fileName' _handle -> do
    writeIORef fileName fileName'
  fileExists <- readIORef fileName >>= doesFileExist
  assertBool "Temporary file not deleted by 'withTempFile'!" (not fileExists)

withTempFileRemovedTest :: Assertion
withTempFileRemovedTest = do
28
29
30
31
32
33
34
  tempDir <- getTemporaryDirectory
  withTempFile tempDir ".foo" $ \fileName handle -> do
    hClose handle
    removeFile fileName

withTempDirTest :: Assertion
withTempDirTest = do
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
35
36
37
38
39
40
41
42
43
44
  dirName <- newIORef ""
  tempDir <- getTemporaryDirectory
  withTempDirectory normal tempDir "foo" $ \dirName' -> do
    writeIORef dirName dirName'
  dirExists <- readIORef dirName >>= doesDirectoryExist
  assertBool "Temporary directory not deleted by 'withTempDirectory'!"
    (not dirExists)

withTempDirRemovedTest :: Assertion
withTempDirRemovedTest = do
45
46
47
48
49
50
  tempDir <- getTemporaryDirectory
  withTempDirectory normal tempDir "foo" $ \dirPath -> do
    removeDirectoryRecursive dirPath

tests :: [TestTree]
tests =
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
51
    [ testCase "withTempFile works as expected" $
52
      withTempFileTest
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
53
54
55
    , testCase "withTempFile can handle removed files" $
      withTempFileRemovedTest
    , testCase "withTempDirectory works as expected" $
56
      withTempDirTest
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
57
58
    , testCase "withTempDirectory can handle removed directories" $
      withTempDirRemovedTest
59
    ]