PackageTests.hs 8.27 KB
Newer Older
1
2
3
4
5
6
7
8
-- The intention is that this will be the new unit test framework.
-- Please add any working tests here.  This file should do nothing
-- but import tests from other modules.
--
-- Stephen Blackheath, 2009

module Main where

tibbe's avatar
tibbe committed
9
import PackageTests.BenchmarkExeV10.Check
10
import PackageTests.BenchmarkOptions.Check
tibbe's avatar
tibbe committed
11
import PackageTests.BenchmarkStanza.Check
tibbe's avatar
tibbe committed
12
13
-- import PackageTests.BuildDeps.GlobalBuildDepsNotAdditive1.Check
-- import PackageTests.BuildDeps.GlobalBuildDepsNotAdditive2.Check
14
import PackageTests.BuildDeps.InternalLibrary0.Check
15
16
17
18
import PackageTests.BuildDeps.InternalLibrary1.Check
import PackageTests.BuildDeps.InternalLibrary2.Check
import PackageTests.BuildDeps.InternalLibrary3.Check
import PackageTests.BuildDeps.InternalLibrary4.Check
tibbe's avatar
tibbe committed
19
20
21
22
import PackageTests.BuildDeps.SameDepsAllRound.Check
import PackageTests.BuildDeps.TargetSpecificDeps1.Check
import PackageTests.BuildDeps.TargetSpecificDeps2.Check
import PackageTests.BuildDeps.TargetSpecificDeps3.Check
ttuegel's avatar
ttuegel committed
23
import PackageTests.BuildTestSuiteDetailedV09.Check
24
import PackageTests.PackageTester (PackageSpec(..), compileSetup)
tibbe's avatar
tibbe committed
25
26
import PackageTests.PathsModule.Executable.Check
import PackageTests.PathsModule.Library.Check
tibbe's avatar
tibbe committed
27
import PackageTests.PreProcess.Check
tibbe's avatar
tibbe committed
28
import PackageTests.TemplateHaskell.Check
29
import PackageTests.CMain.Check
30
import PackageTests.DeterministicAr.Check
refold's avatar
refold committed
31
import PackageTests.EmptyLib.Check
ttuegel's avatar
ttuegel committed
32
import PackageTests.TestOptions.Check
ttuegel's avatar
ttuegel committed
33
import PackageTests.TestStanza.Check
34
import PackageTests.TestSuiteExeV10.Check
35
import PackageTests.OrderFlags.Check
36

37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
import Distribution.Compat.Exception (catchIO)
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
import Distribution.Simple.Program.Types (programPath)
import Distribution.Simple.Program.Builtin (ghcProgram, ghcPkgProgram)
import Distribution.Simple.Program.Db (requireProgram)
import Distribution.Simple.Utils (cabalVersion, die, withFileContents)
import Distribution.Text (display)
import Distribution.Verbosity (normal)
import Distribution.Version (Version(Version))

import Data.Maybe (isJust)
import System.Directory (doesFileExist, getCurrentDirectory,
                         setCurrentDirectory)
import System.Environment (getEnv)
import System.FilePath ((</>))
import Test.Framework (Test, TestName, defaultMain, testGroup)
import Test.Framework.Providers.HUnit (hUnitTestToTests)
import qualified Test.HUnit as HUnit


57
58
59
hunit :: TestName -> HUnit.Test -> Test
hunit name test = testGroup name $ hUnitTestToTests test

60
61
tests :: Version -> PackageSpec -> FilePath -> FilePath -> Bool -> [Test]
tests version inplaceSpec ghcPath ghcPkgPath runningOnTravis =
62
    [ hunit "BuildDeps/SameDepsAllRound"
tibbe's avatar
tibbe committed
63
      (PackageTests.BuildDeps.SameDepsAllRound.Check.suite ghcPath)
tibbe's avatar
tibbe committed
64
65
66
      -- The two following tests were disabled by Johan Tibell as
      -- they have been failing for a long time:
      -- , hunit "BuildDeps/GlobalBuildDepsNotAdditive1/"
tibbe's avatar
tibbe committed
67
      --   (PackageTests.BuildDeps.GlobalBuildDepsNotAdditive1.Check.suite ghcPath)
tibbe's avatar
tibbe committed
68
      -- , hunit "BuildDeps/GlobalBuildDepsNotAdditive2/"
tibbe's avatar
tibbe committed
69
      --   (PackageTests.BuildDeps.GlobalBuildDepsNotAdditive2.Check.suite ghcPath)
70
    , hunit "BuildDeps/InternalLibrary0"
tibbe's avatar
tibbe committed
71
72
73
      (PackageTests.BuildDeps.InternalLibrary0.Check.suite version ghcPath)
    , hunit "PreProcess" (PackageTests.PreProcess.Check.suite ghcPath)
    , hunit "TestStanza" (PackageTests.TestStanza.Check.suite ghcPath)
tibbe's avatar
tibbe committed
74
75
      -- ^ The Test stanza test will eventually be required
      -- only for higher versions.
tibbe's avatar
tibbe committed
76
    , hunit "TestSuiteExeV10/Test" (PackageTests.TestSuiteExeV10.Check.checkTest ghcPath)
tibbe's avatar
tibbe committed
77
    , hunit "TestSuiteExeV10/TestWithHpc"
tibbe's avatar
tibbe committed
78
79
80
      (PackageTests.TestSuiteExeV10.Check.checkTestWithHpc ghcPath)
    , hunit "TestOptions" (PackageTests.TestOptions.Check.suite ghcPath)
    , hunit "BenchmarkStanza" (PackageTests.BenchmarkStanza.Check.suite ghcPath)
tibbe's avatar
tibbe committed
81
82
83
      -- ^ The benchmark stanza test will eventually be required
      -- only for higher versions.
    , hunit "BenchmarkExeV10/Test"
tibbe's avatar
tibbe committed
84
85
      (PackageTests.BenchmarkExeV10.Check.checkBenchmark ghcPath)
    , hunit "BenchmarkOptions" (PackageTests.BenchmarkOptions.Check.suite ghcPath)
86
    , hunit "TemplateHaskell/vanilla"
tibbe's avatar
tibbe committed
87
      (PackageTests.TemplateHaskell.Check.vanilla ghcPath)
88
89
    , hunit "TemplateHaskell/profiling"
      (PackageTests.TemplateHaskell.Check.profiling ghcPath)
tibbe's avatar
tibbe committed
90
    , hunit "PathsModule/Executable"
tibbe's avatar
tibbe committed
91
92
      (PackageTests.PathsModule.Executable.Check.suite ghcPath)
    , hunit "PathsModule/Library" (PackageTests.PathsModule.Library.Check.suite ghcPath)
93
94
    , hunit "DeterministicAr"
        (PackageTests.DeterministicAr.Check.suite ghcPath ghcPkgPath)
refold's avatar
refold committed
95
    , hunit "EmptyLib/emptyLib"
tibbe's avatar
tibbe committed
96
      (PackageTests.EmptyLib.Check.emptyLib ghcPath)
ttuegel's avatar
ttuegel committed
97
    , hunit "BuildTestSuiteDetailedV09"
tibbe's avatar
tibbe committed
98
      (PackageTests.BuildTestSuiteDetailedV09.Check.suite inplaceSpec ghcPath)
99
    , hunit "OrderFlags"
tibbe's avatar
tibbe committed
100
      (PackageTests.OrderFlags.Check.suite ghcPath)
101
    ] ++
102
    -- These tests are expected to fail on Travis because hvr's PPA GHCs don't
103
    -- include dynamic libs.
104
    (if not runningOnTravis
105
     then [ hunit "TemplateHaskell/dynamic"
106
107
108
            (PackageTests.TemplateHaskell.Check.dynamic ghcPath)
          ]
     else []) ++
109
    -- These tests are only required to pass on cabal version >= 1.7
110
111
    (if version >= Version [1, 7] []
     then [ hunit "BuildDeps/TargetSpecificDeps1"
tibbe's avatar
tibbe committed
112
            (PackageTests.BuildDeps.TargetSpecificDeps1.Check.suite ghcPath)
113
          , hunit "BuildDeps/TargetSpecificDeps2"
tibbe's avatar
tibbe committed
114
            (PackageTests.BuildDeps.TargetSpecificDeps2.Check.suite ghcPath)
115
          , hunit "BuildDeps/TargetSpecificDeps3"
tibbe's avatar
tibbe committed
116
            (PackageTests.BuildDeps.TargetSpecificDeps3.Check.suite ghcPath)
117
          , hunit "BuildDeps/InternalLibrary1"
tibbe's avatar
tibbe committed
118
            (PackageTests.BuildDeps.InternalLibrary1.Check.suite ghcPath)
119
          , hunit "BuildDeps/InternalLibrary2"
tibbe's avatar
tibbe committed
120
            (PackageTests.BuildDeps.InternalLibrary2.Check.suite ghcPath ghcPkgPath)
121
          , hunit "BuildDeps/InternalLibrary3"
tibbe's avatar
tibbe committed
122
            (PackageTests.BuildDeps.InternalLibrary3.Check.suite ghcPath ghcPkgPath)
123
          , hunit "BuildDeps/InternalLibrary4"
tibbe's avatar
tibbe committed
124
            (PackageTests.BuildDeps.InternalLibrary4.Check.suite ghcPath ghcPkgPath)
125
          , hunit "PackageTests/CMain"
tibbe's avatar
tibbe committed
126
            (PackageTests.CMain.Check.checkBuild ghcPath)
tibbe's avatar
tibbe committed
127
128
          ]
     else [])
129

130
main :: IO ()
131
main = do
132
133
134
135
136
137
138
139
    wd <- getCurrentDirectory
    let dbFile = wd </> "dist/package.conf.inplace"
        inplaceSpec = PackageSpec
            { directory = []
            , configOpts = [ "--package-db=" ++ dbFile
                           , "--constraint=Cabal == " ++ display cabalVersion
                           ]
            }
tibbe's avatar
tibbe committed
140
141
    putStrLn $ "Cabal test suite - testing cabal version " ++
        display cabalVersion
tibbe's avatar
tibbe committed
142
143
144
145
146
147
148
    lbi <- getPersistBuildConfig_ ("dist" </> "setup-config")
    (ghc, _) <- requireProgram normal ghcProgram (withPrograms lbi)
    (ghcPkg, _) <- requireProgram normal ghcPkgProgram (withPrograms lbi)
    let ghcPath = programPath ghc
        ghcPkgPath = programPath ghcPkg
    putStrLn $ "Using ghc: " ++ ghcPath
    putStrLn $ "Using ghc-pkg: " ++ ghcPkgPath
149
    setCurrentDirectory "tests"
150
151
    -- Are we running on Travis-CI?
    runningOnTravis <- checkRunningOnTravis
152
    -- Create a shared Setup executable to speed up Simple tests
tibbe's avatar
tibbe committed
153
    compileSetup "." ghcPath
154
155
156
157
158
159
160
161
162
    defaultMain (tests cabalVersion inplaceSpec
                 ghcPath ghcPkgPath runningOnTravis)

-- | Is the test suite running on the Travis-CI build bot?
checkRunningOnTravis :: IO Bool
checkRunningOnTravis = fmap isJust (lookupEnv "CABAL_TEST_RUNNING_ON_TRAVIS")
  where
    lookupEnv :: String -> IO (Maybe String)
    lookupEnv name = (Just `fmap` getEnv name) `catchIO` const (return Nothing)
tibbe's avatar
tibbe committed
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181

-- Like Distribution.Simple.Configure.getPersistBuildConfig but
-- doesn't check that the Cabal version matches, which it doesn't when
-- we run Cabal's own test suite, due to bootstrapping issues.
getPersistBuildConfig_ :: FilePath -> IO LocalBuildInfo
getPersistBuildConfig_ filename = do
  exists <- doesFileExist filename
  if not exists
    then die missing
    else withFileContents filename $ \str ->
      case lines str of
        [_header, rest] -> case reads rest of
          [(bi,_)] -> return bi
          _        -> die cantParse
        _            -> die cantParse
  where
    missing   = "Run the 'configure' command first."
    cantParse = "Saved package config file seems to be corrupt. "
             ++ "Try re-running the 'configure' command."