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
112
|
{-# LANGUAGE CPP #-}
module UnitTests.Distribution.Client.UserConfig
( tests
) where
import Control.Exception (bracket)
import Control.Monad (replicateM_)
import Data.List (sort, nub)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid
#endif
import System.Directory (doesFileExist,
getCurrentDirectory, getTemporaryDirectory)
import System.FilePath ((</>))
import Test.Tasty
import Test.Tasty.HUnit
import Distribution.Client.Config
import Distribution.Utils.NubList (fromNubList)
import Distribution.Client.Setup (GlobalFlags (..), InstallFlags (..))
import Distribution.Client.Utils (removeExistingFile)
import Distribution.Simple.Setup (Flag (..), ConfigFlags (..), fromFlag)
import Distribution.Simple.Utils (withTempDirectory)
import Distribution.Verbosity (silent)
tests :: [TestTree]
tests = [ testCase "nullDiffOnCreate" nullDiffOnCreateTest
, testCase "canDetectDifference" canDetectDifference
, testCase "canUpdateConfig" canUpdateConfig
, testCase "doubleUpdateConfig" doubleUpdateConfig
, testCase "newDefaultConfig" newDefaultConfig
]
nullDiffOnCreateTest :: Assertion
nullDiffOnCreateTest = bracketTest $ \configFile -> do
-- Create a new default config file in our test directory.
_ <- createDefaultConfigFile silent [] configFile
-- Now we read it in and compare it against the default.
diff <- userConfigDiff silent (globalFlags configFile) []
assertBool (unlines $ "Following diff should be empty:" : diff) $ null diff
canDetectDifference :: Assertion
canDetectDifference = bracketTest $ \configFile -> do
-- Create a new default config file in our test directory.
_ <- createDefaultConfigFile silent [] configFile
appendFile configFile "verbose: 0\n"
diff <- userConfigDiff silent (globalFlags configFile) []
assertBool (unlines $ "Should detect a difference:" : diff) $
diff == [ "+ verbose: 0" ]
canUpdateConfig :: Assertion
canUpdateConfig = bracketTest $ \configFile -> do
-- Write a trivial cabal file.
writeFile configFile "tests: True\n"
-- Update the config file.
userConfigUpdate silent (globalFlags configFile) []
-- Load it again.
updated <- loadConfig silent (Flag configFile)
assertBool ("Field 'tests' should be True") $
fromFlag (configTests $ savedConfigureFlags updated)
doubleUpdateConfig :: Assertion
doubleUpdateConfig = bracketTest $ \configFile -> do
-- Create a new default config file in our test directory.
_ <- createDefaultConfigFile silent [] configFile
-- Update it twice.
replicateM_ 2 $ userConfigUpdate silent (globalFlags configFile) []
-- Load it again.
updated <- loadConfig silent (Flag configFile)
assertBool ("Field 'remote-repo' doesn't contain duplicates") $
listUnique (map show . fromNubList . globalRemoteRepos $ savedGlobalFlags updated)
assertBool ("Field 'extra-prog-path' doesn't contain duplicates") $
listUnique (map show . fromNubList . configProgramPathExtra $ savedConfigureFlags updated)
assertBool ("Field 'build-summary' doesn't contain duplicates") $
listUnique (map show . fromNubList . installSummaryFile $ savedInstallFlags updated)
newDefaultConfig :: Assertion
newDefaultConfig = do
sysTmpDir <- getTemporaryDirectory
withTempDirectory silent sysTmpDir "cabal-test" $ \tmpDir -> do
let configFile = tmpDir </> "tmp.config"
_ <- createDefaultConfigFile silent [] configFile
exists <- doesFileExist configFile
assertBool ("Config file should be written to " ++ configFile) exists
globalFlags :: FilePath -> GlobalFlags
globalFlags configFile = mempty { globalConfigFile = Flag configFile }
listUnique :: Ord a => [a] -> Bool
listUnique xs =
let sorted = sort xs
in nub sorted == xs
bracketTest :: (FilePath -> IO ()) -> Assertion
bracketTest =
bracket testSetup testTearDown
where
testSetup :: IO FilePath
testSetup = fmap (</> "test-user-config") getCurrentDirectory
testTearDown :: FilePath -> IO ()
testTearDown configFile =
mapM_ removeExistingFile [configFile, configFile ++ ".backup"]
|
