Commit 323460ec authored by tibbe's avatar tibbe
Browse files

Unit tests: use configure GHC

This means that the package tests will pick up whatever GHC was passed
on the

    cabal configure --enable-tests -w some-ghc

command line.
parent 473f76a4
......@@ -7,9 +7,15 @@
module Main where
import Data.Version (Version(Version))
import Distribution.Simple.Utils (cabalVersion)
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 System.Directory (getCurrentDirectory, setCurrentDirectory)
import Distribution.Verbosity (normal)
import System.Directory (doesFileExist, getCurrentDirectory,
setCurrentDirectory)
import System.FilePath ((</>))
import Test.Framework (Test, TestName, defaultMain, testGroup)
import Test.Framework.Providers.HUnit (hUnitTestToTests)
......@@ -45,66 +51,66 @@ import PackageTests.OrderFlags.Check
hunit :: TestName -> HUnit.Test -> Test
hunit name test = testGroup name $ hUnitTestToTests test
tests :: Version -> PackageSpec -> [Test]
tests version inplaceSpec =
tests :: Version -> PackageSpec -> FilePath -> FilePath -> [Test]
tests version inplaceSpec ghcPath ghcPkgPath =
[ hunit "BuildDeps/SameDepsAllRound"
PackageTests.BuildDeps.SameDepsAllRound.Check.suite
(PackageTests.BuildDeps.SameDepsAllRound.Check.suite ghcPath)
-- The two following tests were disabled by Johan Tibell as
-- they have been failing for a long time:
-- , hunit "BuildDeps/GlobalBuildDepsNotAdditive1/"
-- PackageTests.BuildDeps.GlobalBuildDepsNotAdditive1.Check.suite
-- (PackageTests.BuildDeps.GlobalBuildDepsNotAdditive1.Check.suite ghcPath)
-- , hunit "BuildDeps/GlobalBuildDepsNotAdditive2/"
-- PackageTests.BuildDeps.GlobalBuildDepsNotAdditive2.Check.suite
-- (PackageTests.BuildDeps.GlobalBuildDepsNotAdditive2.Check.suite ghcPath)
, hunit "BuildDeps/InternalLibrary0"
(PackageTests.BuildDeps.InternalLibrary0.Check.suite version)
, hunit "PreProcess" PackageTests.PreProcess.Check.suite
, hunit "TestStanza" PackageTests.TestStanza.Check.suite
(PackageTests.BuildDeps.InternalLibrary0.Check.suite version ghcPath)
, hunit "PreProcess" (PackageTests.PreProcess.Check.suite ghcPath)
, hunit "TestStanza" (PackageTests.TestStanza.Check.suite ghcPath)
-- ^ The Test stanza test will eventually be required
-- only for higher versions.
, hunit "TestSuiteExeV10/Test" PackageTests.TestSuiteExeV10.Check.checkTest
, hunit "TestSuiteExeV10/Test" (PackageTests.TestSuiteExeV10.Check.checkTest ghcPath)
, hunit "TestSuiteExeV10/TestWithHpc"
PackageTests.TestSuiteExeV10.Check.checkTestWithHpc
, hunit "TestOptions" PackageTests.TestOptions.Check.suite
, hunit "BenchmarkStanza" PackageTests.BenchmarkStanza.Check.suite
(PackageTests.TestSuiteExeV10.Check.checkTestWithHpc ghcPath)
, hunit "TestOptions" (PackageTests.TestOptions.Check.suite ghcPath)
, hunit "BenchmarkStanza" (PackageTests.BenchmarkStanza.Check.suite ghcPath)
-- ^ The benchmark stanza test will eventually be required
-- only for higher versions.
, hunit "BenchmarkExeV10/Test"
PackageTests.BenchmarkExeV10.Check.checkBenchmark
, hunit "BenchmarkOptions" PackageTests.BenchmarkOptions.Check.suite
(PackageTests.BenchmarkExeV10.Check.checkBenchmark ghcPath)
, hunit "BenchmarkOptions" (PackageTests.BenchmarkOptions.Check.suite ghcPath)
, hunit "TemplateHaskell/vanilla"
PackageTests.TemplateHaskell.Check.vanilla
(PackageTests.TemplateHaskell.Check.vanilla ghcPath)
, hunit "TemplateHaskell/profiling"
PackageTests.TemplateHaskell.Check.profiling
(PackageTests.TemplateHaskell.Check.profiling ghcPath)
, hunit "TemplateHaskell/dynamic"
PackageTests.TemplateHaskell.Check.dynamic
(PackageTests.TemplateHaskell.Check.dynamic ghcPath)
, hunit "PathsModule/Executable"
PackageTests.PathsModule.Executable.Check.suite
, hunit "PathsModule/Library" PackageTests.PathsModule.Library.Check.suite
(PackageTests.PathsModule.Executable.Check.suite ghcPath)
, hunit "PathsModule/Library" (PackageTests.PathsModule.Library.Check.suite ghcPath)
, hunit "EmptyLib/emptyLib"
PackageTests.EmptyLib.Check.emptyLib
(PackageTests.EmptyLib.Check.emptyLib ghcPath)
, hunit "BuildTestSuiteDetailedV09"
$ PackageTests.BuildTestSuiteDetailedV09.Check.suite inplaceSpec
(PackageTests.BuildTestSuiteDetailedV09.Check.suite inplaceSpec ghcPath)
, hunit "OrderFlags"
PackageTests.OrderFlags.Check.suite
(PackageTests.OrderFlags.Check.suite ghcPath)
] ++
-- These tests are only required to pass on cabal version >= 1.7
(if version >= Version [1, 7] []
then [ hunit "BuildDeps/TargetSpecificDeps1"
PackageTests.BuildDeps.TargetSpecificDeps1.Check.suite
(PackageTests.BuildDeps.TargetSpecificDeps1.Check.suite ghcPath)
, hunit "BuildDeps/TargetSpecificDeps2"
PackageTests.BuildDeps.TargetSpecificDeps2.Check.suite
(PackageTests.BuildDeps.TargetSpecificDeps2.Check.suite ghcPath)
, hunit "BuildDeps/TargetSpecificDeps3"
PackageTests.BuildDeps.TargetSpecificDeps3.Check.suite
(PackageTests.BuildDeps.TargetSpecificDeps3.Check.suite ghcPath)
, hunit "BuildDeps/InternalLibrary1"
PackageTests.BuildDeps.InternalLibrary1.Check.suite
(PackageTests.BuildDeps.InternalLibrary1.Check.suite ghcPath)
, hunit "BuildDeps/InternalLibrary2"
PackageTests.BuildDeps.InternalLibrary2.Check.suite
(PackageTests.BuildDeps.InternalLibrary2.Check.suite ghcPath ghcPkgPath)
, hunit "BuildDeps/InternalLibrary3"
PackageTests.BuildDeps.InternalLibrary3.Check.suite
(PackageTests.BuildDeps.InternalLibrary3.Check.suite ghcPath ghcPkgPath)
, hunit "BuildDeps/InternalLibrary4"
PackageTests.BuildDeps.InternalLibrary4.Check.suite
(PackageTests.BuildDeps.InternalLibrary4.Check.suite ghcPath ghcPkgPath)
, hunit "PackageTests/CMain"
PackageTests.CMain.Check.checkBuild
(PackageTests.CMain.Check.checkBuild ghcPath)
]
else [])
......@@ -120,7 +126,33 @@ main = do
}
putStrLn $ "Cabal test suite - testing cabal version " ++
display cabalVersion
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
setCurrentDirectory "tests"
-- Create a shared Setup executable to speed up Simple tests
compileSetup "."
defaultMain (tests cabalVersion inplaceSpec)
compileSetup "." ghcPath
defaultMain (tests cabalVersion inplaceSpec ghcPath ghcPkgPath)
-- 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."
......@@ -9,8 +9,8 @@ import Test.HUnit
dir :: FilePath
dir = "PackageTests" </> "BenchmarkExeV10"
checkBenchmark :: Test
checkBenchmark = TestCase $ do
checkBenchmark :: FilePath -> Test
checkBenchmark ghcPath = TestCase $ do
let spec = PackageSpec dir ["--enable-benchmarks"]
buildResult <- cabal_build spec
buildResult <- cabal_build spec ghcPath
assertBuildSucceeded buildResult
......@@ -4,12 +4,12 @@ import PackageTests.PackageTester
import System.FilePath
import Test.HUnit
suite :: Test
suite = TestCase $ do
suite :: FilePath -> Test
suite ghcPath = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BenchmarkOptions")
["--enable-benchmarks"]
_ <- cabal_build spec
result <- cabal_bench spec ["--benchmark-options=1 2 3"]
_ <- cabal_build spec ghcPath
result <- cabal_bench spec ["--benchmark-options=1 2 3"] ghcPath
let message = "\"cabal bench\" did not pass the correct options to the "
++ "benchmark executable with \"--benchmark-options\""
assertEqual message True $ successful result
......@@ -17,6 +17,7 @@ suite = TestCase $ do
, "--benchmark-option=2"
, "--benchmark-option=3"
]
ghcPath
let message' = "\"cabal bench\" did not pass the correct options to the "
++ "benchmark executable with \"--benchmark-option\""
assertEqual message' True $ successful result'
......@@ -21,12 +21,12 @@ import Distribution.Compiler
( CompilerId(..), CompilerFlavor(..) )
import Distribution.Text
suite :: Test
suite = TestCase $ do
suite :: FilePath -> Test
suite ghcPath = TestCase $ do
let dir = "PackageTests" </> "BenchmarkStanza"
pdFile = dir </> "my" <.> "cabal"
spec = PackageSpec dir []
result <- cabal_configure spec
result <- cabal_configure spec ghcPath
assertOutputDoesNotContain "unknown section type" result
genPD <- readPackageDescription silent pdFile
let compiler = CompilerId GHC $ Version [6, 12, 2] []
......
......@@ -8,10 +8,10 @@ import Control.Exception
import Prelude hiding (catch)
suite :: Test
suite = TestCase $ do
suite :: FilePath -> Test
suite ghcPath = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "GlobalBuildDepsNotAdditive1") []
result <- cabal_build spec
result <- cabal_build spec ghcPath
do
assertEqual "cabal build should fail - see test-log.txt" False (successful result)
let sb = "Could not find module `Prelude'"
......
......@@ -8,10 +8,10 @@ import Control.Exception
import Prelude hiding (catch)
suite :: Test
suite = TestCase $ do
suite :: FilePath -> Test
suite ghcPath = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "GlobalBuildDepsNotAdditive2") []
result <- cabal_build spec
result <- cabal_build spec ghcPath
do
assertEqual "cabal build should fail - see test-log.txt" False (successful result)
let sb = "Could not find module `Prelude'"
......
......@@ -7,10 +7,10 @@ import System.FilePath
import Test.HUnit
suite :: Version -> Test
suite cabalVersion = TestCase $ do
suite :: Version -> FilePath -> Test
suite cabalVersion ghcPath = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "InternalLibrary0") []
result <- cabal_build spec
result <- cabal_build spec ghcPath
assertBuildFailed result
when (cabalVersion >= Version [1, 7] []) $ do
let sb = "library which is defined within the same package."
......
......@@ -5,8 +5,8 @@ import System.FilePath
import Test.HUnit
suite :: Test
suite = TestCase $ do
suite :: FilePath -> Test
suite ghcPath = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "InternalLibrary1") []
result <- cabal_build spec
result <- cabal_build spec ghcPath
assertBuildSucceeded result
......@@ -6,17 +6,17 @@ import System.FilePath
import Test.HUnit
suite :: Test
suite = TestCase $ do
suite :: FilePath -> FilePath -> Test
suite ghcPath ghcPkgPath = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "InternalLibrary2") []
let specTI = PackageSpec (directory spec </> "to-install") []
unregister "InternalLibrary2"
iResult <- cabal_install specTI
unregister "InternalLibrary2" ghcPkgPath
iResult <- cabal_install specTI ghcPath
assertInstallSucceeded iResult
bResult <- cabal_build spec
bResult <- cabal_build spec ghcPath
assertBuildSucceeded bResult
unregister "InternalLibrary2"
unregister "InternalLibrary2" ghcPkgPath
(_, _, output) <- run (Just $ directory spec) "dist/build/lemon/lemon" []
C.appendFile (directory spec </> "test-log.txt") (C.pack $ "\ndist/build/lemon/lemon\n"++output)
......
......@@ -6,17 +6,17 @@ import System.FilePath
import Test.HUnit
suite :: Test
suite = TestCase $ do
suite :: FilePath -> FilePath -> Test
suite ghcPath ghcPkgPath = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "InternalLibrary3") []
let specTI = PackageSpec (directory spec </> "to-install") []
unregister "InternalLibrary3"
iResult <- cabal_install specTI
unregister "InternalLibrary3" ghcPkgPath
iResult <- cabal_install specTI ghcPath
assertInstallSucceeded iResult
bResult <- cabal_build spec
bResult <- cabal_build spec ghcPath
assertBuildSucceeded bResult
unregister "InternalLibrary3"
unregister "InternalLibrary3"ghcPkgPath
(_, _, output) <- run (Just $ directory spec) "dist/build/lemon/lemon" []
C.appendFile (directory spec </> "test-log.txt") (C.pack $ "\ndist/build/lemon/lemon\n"++output)
......
......@@ -6,17 +6,17 @@ import System.FilePath
import Test.HUnit
suite :: Test
suite = TestCase $ do
suite :: FilePath -> FilePath -> Test
suite ghcPath ghcPkgPath = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "InternalLibrary4") []
let specTI = PackageSpec (directory spec </> "to-install") []
unregister "InternalLibrary4"
iResult <- cabal_install specTI
unregister "InternalLibrary4" ghcPkgPath
iResult <- cabal_install specTI ghcPath
assertInstallSucceeded iResult
bResult <- cabal_build spec
bResult <- cabal_build spec ghcPath
assertBuildSucceeded bResult
unregister "InternalLibrary4"
unregister "InternalLibrary4" ghcPkgPath
(_, _, output) <- run (Just $ directory spec) "dist/build/lemon/lemon" []
C.appendFile (directory spec </> "test-log.txt") (C.pack $ "\ndist/build/lemon/lemon\n"++output)
......
......@@ -6,10 +6,10 @@ import System.FilePath
import qualified Control.Exception as E
suite :: Test
suite = TestCase $ do
suite :: FilePath -> Test
suite ghcPath = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "SameDepsAllRound") []
result <- cabal_build spec
result <- cabal_build spec ghcPath
do
assertEqual "cabal build should succeed - see test-log.txt" True (successful result)
`E.catch` \exc -> do
......
......@@ -8,10 +8,10 @@ import qualified Control.Exception as E
import Text.Regex.Posix
suite :: Test
suite = TestCase $ do
suite :: FilePath -> Test
suite ghcPath = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "TargetSpecificDeps1") []
result <- cabal_build spec
result <- cabal_build spec ghcPath
do
assertEqual "cabal build should fail - see test-log.txt" False (successful result)
assertBool "error should be in MyLibrary.hs" $
......
......@@ -6,10 +6,10 @@ import System.FilePath
import qualified Control.Exception as E
suite :: Test
suite = TestCase $ do
suite :: FilePath -> Test
suite ghcPath = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "TargetSpecificDeps2") []
result <- cabal_build spec
result <- cabal_build spec ghcPath
do
assertEqual "cabal build should succeed - see test-log.txt" True (successful result)
`E.catch` \exc -> do
......
......@@ -8,10 +8,10 @@ import qualified Control.Exception as E
import Text.Regex.Posix
suite :: Test
suite = TestCase $ do
suite :: FilePath -> Test
suite ghcPath = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "BuildDeps" </> "TargetSpecificDeps3") []
result <- cabal_build spec
result <- cabal_build spec ghcPath
do
assertEqual "cabal build should fail - see test-log.txt" False (successful result)
assertBool "error should be in lemon.hs" $
......
......@@ -5,14 +5,14 @@ import System.FilePath ((</>))
import PackageTests.PackageTester
suite :: PackageSpec -> Test
suite inplaceSpec = TestCase $ do
suite :: PackageSpec -> FilePath -> Test
suite inplaceSpec ghcPath = TestCase $ do
let dir = "PackageTests" </> "BuildTestSuiteDetailedV09"
spec = inplaceSpec
{ directory = dir
, configOpts = "--enable-tests" : configOpts inplaceSpec
}
confResult <- cabal_configure spec
confResult <- cabal_configure spec ghcPath
assertEqual "configure failed!" (successful confResult) True
buildResult <- cabal_build spec
buildResult <- cabal_build spec ghcPath
assertEqual "build failed!" (successful buildResult) True
......@@ -9,8 +9,8 @@ import PackageTests.PackageTester
dir :: FilePath
dir = "PackageTests" </> "CMain"
checkBuild :: Test
checkBuild = TestCase $ do
checkBuild :: FilePath -> Test
checkBuild ghcPath = TestCase $ do
let spec = PackageSpec dir []
buildResult <- cabal_build spec
buildResult <- cabal_build spec ghcPath
assertBuildSucceeded buildResult
......@@ -5,9 +5,9 @@ import System.FilePath
import Test.HUnit
-- See https://github.com/haskell/cabal/issues/1241
emptyLib :: Test
emptyLib = TestCase $ do
emptyLib :: FilePath -> Test
emptyLib ghcPath = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "EmptyLib"
</> "empty") []
result <- cabal_build spec
result <- cabal_build spec ghcPath
assertBuildSucceeded result
......@@ -7,10 +7,10 @@ import Control.Exception
import Prelude hiding (catch)
suite :: Test
suite = TestCase $ do
suite :: FilePath -> Test
suite ghcPath = TestCase $ do
let spec = PackageSpec ("PackageTests" </> "OrderFlags") []
result <- cabal_build spec
result <- cabal_build spec ghcPath
do
assertEqual "cabal build should succeed - see test-log.txt" True (successful result)
`catch` \exc -> do
......
......@@ -80,76 +80,75 @@ recordRun (cmd, exitCode, exeOutput) thisSucc res =
cmd ++ "\n" ++ exeOutput
}
cabal_configure :: PackageSpec -> IO Result
cabal_configure spec = do
res <- doCabalConfigure spec
cabal_configure :: PackageSpec -> FilePath -> IO Result
cabal_configure spec ghcPath = do
res <- doCabalConfigure spec ghcPath
record spec res
return res
doCabalConfigure :: PackageSpec -> IO Result
doCabalConfigure spec = do
cleanResult@(_, _, _) <- cabal spec ["clean"]
doCabalConfigure :: PackageSpec -> FilePath -> IO Result
doCabalConfigure spec ghcPath = do
cleanResult@(_, _, _) <- cabal spec ["clean"] ghcPath
requireSuccess cleanResult
ghc <- getGHC
res <- cabal spec $ ["configure", "--user", "-w", ghc] ++ configOpts spec
res <- cabal spec
(["configure", "--user", "-w", ghcPath] ++ configOpts spec)
ghcPath
return $ recordRun res ConfigureSuccess nullResult
doCabalBuild :: PackageSpec -> IO Result
doCabalBuild spec = do
configResult <- doCabalConfigure spec
doCabalBuild :: PackageSpec -> FilePath -> IO Result
doCabalBuild spec ghcPath = do
configResult <- doCabalConfigure spec ghcPath
if successful configResult
then do
res <- cabal spec ["build", "-v"]
res <- cabal spec ["build", "-v"] ghcPath
return $ recordRun res BuildSuccess configResult
else
return configResult
cabal_build :: PackageSpec -> IO Result
cabal_build spec = do
res <- doCabalBuild spec
cabal_build :: PackageSpec -> FilePath -> IO Result
cabal_build spec ghcPath = do
res <- doCabalBuild spec ghcPath
record spec res
return res
unregister :: String -> IO ()
unregister libraryName = do
ghcPkg <- getGHCPkg
res@(_, _, output) <- run Nothing ghcPkg ["unregister", "--user", libraryName]
unregister :: String -> FilePath -> IO ()
unregister libraryName ghcPkgPath = do
res@(_, _, output) <- run Nothing ghcPkgPath ["unregister", "--user", libraryName]
if "cannot find package" `isInfixOf` output
then return ()
else requireSuccess res
-- | Install this library in the user area
cabal_install :: PackageSpec -> IO Result
cabal_install spec = do
buildResult <- doCabalBuild spec
cabal_install :: PackageSpec -> FilePath -> IO Result
cabal_install spec ghcPath = do
buildResult <- doCabalBuild spec ghcPath
res <- if successful buildResult
then do
res <- cabal spec ["install"]
res <- cabal spec ["install"] ghcPath
return $ recordRun res InstallSuccess buildResult
else
return buildResult
record spec res
return res
cabal_test :: PackageSpec -> [String] -> IO Result
cabal_test spec extraArgs = do
res <- cabal spec $ "test" : extraArgs
cabal_test :: PackageSpec -> [String] -> FilePath -> IO Result
cabal_test spec extraArgs ghcPath = do
res <- cabal spec ("test" : extraArgs) ghcPath
let r = recordRun res TestSuccess nullResult
record spec r
return r
cabal_bench :: PackageSpec -> [String] -> IO Result
cabal_bench spec extraArgs = do
res <- cabal spec $ "bench" : extraArgs
cabal_bench :: PackageSpec -> [String] -> FilePath -> IO Result
cabal_bench spec extraArgs ghcPath = do
res <- cabal spec ("bench" : extraArgs) ghcPath
let r = recordRun res BenchSuccess nullResult
record spec r
return r
compileSetup :: FilePath -> IO ()
compileSetup packageDir = do
compileSetup :: FilePath -> FilePath -> IO ()
compileSetup packageDir ghcPath = do
wd <- getCurrentDirectory
ghc <- getGHC
r <- run (Just $ packageDir) ghc
r <- run (Just $ packageDir) ghcPath
[ "--make"
-- HPC causes trouble -- see #1012
-- , "-fhpc"
......@@ -159,12 +158,12 @@ compileSetup packageDir = do
requireSuccess r
-- | Returns the command that was issued, the return code, and the output text.
cabal :: PackageSpec -> [String] -> IO (String, ExitCode, String)
cabal spec cabalArgs = do
cabal :: PackageSpec -> [String] -> FilePath -> IO (String, ExitCode, String)
cabal spec cabalArgs ghcPath = do
customSetup <- doesFileExist (directory spec </> "Setup.hs")
if customSetup
then do