Commit e496b09e authored by Edward Z. Yang's avatar Edward Z. Yang Committed by GitHub

Rewrite the test suite, AGAIN. (#4095)

See cabal-testsuite/ for a detailed description
of the new architecture.
Signed-off-by: default avatarEdward Z. Yang <>
parent 2f5c8617
......@@ -82,6 +82,7 @@ import Distribution.Package
import qualified Distribution.ModuleName as ModuleName
import Distribution.ModuleName (ModuleName)
import Distribution.Simple.Program
import Distribution.Simple.Program.Builtin (runghcProgram)
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import qualified Distribution.Simple.Program.Ar as Ar
import qualified Distribution.Simple.Program.Ld as Ld
......@@ -148,9 +149,13 @@ configure verbosity hcPath hcPkgPath conf0 = do
hpcProgram' = hpcProgram {
programFindLocation = guessHpcFromGhcPath ghcProg
runghcProgram' = runghcProgram {
programFindLocation = guessRunghcFromGhcPath ghcProg
progdb3 = addKnownProgram haddockProgram' $
addKnownProgram hsc2hsProgram' $
addKnownProgram hpcProgram' progdb2
addKnownProgram hpcProgram' $
addKnownProgram runghcProgram' progdb2
languages <- Internal.getLanguages verbosity implInfo ghcProg
extensions0 <- Internal.getExtensions verbosity implInfo ghcProg
......@@ -283,6 +288,11 @@ guessHpcFromGhcPath :: ConfiguredProgram
-> IO (Maybe (FilePath, [FilePath]))
guessHpcFromGhcPath = guessToolFromGhcPath hpcProgram
guessRunghcFromGhcPath :: ConfiguredProgram
-> Verbosity -> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessRunghcFromGhcPath = guessToolFromGhcPath runghcProgram
getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)]
getGhcInfo verbosity ghcProg = Internal.getGhcInfo verbosity implInfo ghcProg
......@@ -18,6 +18,7 @@ module Distribution.Simple.Program.Builtin (
-- * Programs that Cabal knows about
......@@ -70,6 +71,7 @@ builtinPrograms =
-- compilers and related progs
, runghcProgram
, ghcPkgProgram
, ghcjsProgram
, ghcjsPkgProgram
......@@ -121,6 +123,15 @@ ghcProgram = (simpleProgram "ghc") {
(programVersion ghcProg)
runghcProgram :: Program
runghcProgram = (simpleProgram "runghc") {
programFindVersion = findProgramVersion "--version" $ \str ->
case words str of
-- "runghc 7.10.3"
(_:ver:_) -> ver
_ -> ""
ghcPkgProgram :: Program
ghcPkgProgram = (simpleProgram "ghc-pkg") {
programFindVersion = findProgramVersion "--version" $ \str ->
......@@ -28,8 +28,8 @@ main' fp = do
let testModuleFiles = getOtherModulesFiles cabal
let skipPredicates' = skipPredicates ++ map (==) testModuleFiles
-- Read all files git knows about under "tests" and "PackageTests" (cabal-testsuite)
files0 <- lines <$> readProcess "git" ["ls-files", "tests", "PackageTests"] ""
-- Read all files git knows about under "tests"
files0 <- lines <$> readProcess "git" ["ls-files", "tests"] ""
-- Filter
let files1 = filter (\f -> takeExtension f `elem` whitelistedExtensionss ||
......@@ -21,11 +21,17 @@ build_script:
- Setup test --show-details=streaming --test-option=--hide-successes
- Setup install
- cd ..\cabal-testsuite
- ghc --make -threaded -i Setup.hs -package Cabal-
- echo "" | ..\cabal install --only-dependencies --enable-tests
- ghc --make -threaded -i -i. Setup.hs -Wall -Werror
- Setup configure --user --ghc-option=-Werror --enable-tests
- Setup build
- Setup test --show-details=streaming --test-option=--hide-successes
# Must install the test suite, so that our GHCi invocation picks it up
- Setup install
# Copy the setup script into the spot cabal-tests expects it
- mkdir dist\setup
- cp Setup.exe dist\setup
- dist\build\cabal-tests\cabal-tests.exe -j3
# - Setup test --show-details=streaming --test-option=--hide-successes
- cd ..\cabal-install
- ghc --make -threaded -i -i. Setup.hs -Wall -Werror
- echo "" | ..\cabal install happy
......@@ -296,7 +296,10 @@ planLocalPackage :: Verbosity -> Compiler
-> IO (Progress String String SolverInstallPlan)
planLocalPackage verbosity comp platform configFlags configExFlags
installedPkgIndex (SourcePackageDb _ packagePrefs) pkgConfigDb = do
pkg <- readPackageDescription verbosity =<< defaultPackageDesc verbosity
pkg <- readPackageDescription verbosity =<<
case flagToMaybe (configCabalFilePath configFlags) of
Nothing -> defaultPackageDesc verbosity
Just fp -> return fp
solver <- chooseSolver verbosity (fromFlag $ configSolver configExFlags)
(compilerInfo comp)
......@@ -387,7 +390,10 @@ configurePackage verbosity platform comp scriptOptions configFlags
gpkg = packageDescription spkg
configureFlags = filterConfigureFlags configFlags {
configIPID = toFlag (display ipid),
configIPID = if isJust (flagToMaybe (configIPID configFlags))
-- Make sure cabal configure --ipid works.
then configIPID configFlags
else toFlag (display ipid),
configConfigurationsFlags = flags,
-- We generate the legacy constraints as well as the new style precise
-- deps. In the end only one set gets passed to Setup.hs configure,
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PatternGuards #-}
-- This is the runner for the package-tests suite. The actual
-- tests are in in PackageTests.Tests
module Main where
import PackageTests.Options
import PackageTests.PackageTester
import PackageTests.Tests
import Distribution.Backpack
import Distribution.Simple.Configure
( ConfigStateFileError(..), findDistPrefOrDefault, getConfigStateFile
, interpretPackageDbFlags, configCompilerEx )
import Distribution.Simple.Compiler (PackageDB(..), PackageDBStack
import Distribution.Types.LocalBuildInfo (componentNameCLBIs)
import Distribution.Types.ModuleRenaming
import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Types.ComponentName
import Distribution.Types.UnqualComponentName
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
import Distribution.Simple.Program (defaultProgramDb)
import Distribution.Simple.Setup (Flag(..), readPackageDbList, showPackageDbList)
import Distribution.Simple.Utils (cabalVersion)
import Distribution.Text (display)
import Distribution.Verbosity (normal, flagToVerbosity, lessVerbose)
import Distribution.ReadE (readEOrFail)
import Distribution.Compat.Time (calibrateMtimeChangeDelay)
import Control.Exception
import Data.Proxy ( Proxy(..) )
import Distribution.Compat.Environment ( lookupEnv )
import System.Directory
import Test.Tasty
import Test.Tasty.Options
import Test.Tasty.Ingredients
#if MIN_VERSION_base(4,6,0)
import System.Environment ( getExecutablePath )
main :: IO ()
main = do
-- In abstract, the Cabal test suite makes calls to the "Setup"
-- executable and tests the output of Cabal. However, we have to
-- responsible for building this executable in the first place,
-- since (1) Cabal doesn't support a test-suite depending on an
-- executable, so we can't put a "Setup" executable in the Cabal
-- file and then depend on it, (2) we don't want to call the Cabal
-- functions *directly* because we need to capture and save the
-- stdout and stderr, and (3) even if we could do all that, we will
-- want to test some Custom setup scripts, which will be specific to
-- the test at hand and need to be compiled against Cabal.
-- To be able to build the executable, there is some information
-- we need:
-- 1. We need to know what ghc to use,
-- 2. We need to know what package databases (plural!) contain
-- all of the necessary dependencies to make our Cabal package
-- well-formed.
-- We could have the user pass these all in as arguments, but
-- there's a more convenient way to get this information: the *build
-- configuration* that was used to build the Cabal library (and this
-- test suite) in the first place. To do this, we need to find the
-- 'dist' directory that was set as the build directory for Cabal.
-- First, figure out the dist directory associated with this Cabal.
dist_dir :: FilePath <- guessDistDir
-- Next, read out the LBI. Now that package-tests is in a separate
-- package with a Custom setup, this MUST succeed; we will freak
-- out if it does not
lbi <- getPersistBuildConfig dist_dir
-- You need to run the test suite in the right directory, sorry.
-- This variable is modestly misnamed: this refers to the base
-- directory of Cabal (so, CHECKOUT_DIR/Cabal, not
-- CHECKOUT_DIR/Cabal/test).
cabal_dir <- getCurrentDirectory
-- TODO: make this controllable by a flag. We do have a flag
-- parser but it's not called early enough for this verbosity...
verbosity <- maybe normal (readEOrFail flagToVerbosity)
`fmap` lookupEnv "VERBOSE"
-- NOTE: There are TWO configurations of GHC we have to manage
-- when running the test suite.
-- 1. The primary GHC is the one that was used to build the
-- copy of Cabal that we are testing. This configuration
-- can be pulled out of the LBI.
-- 2. The "with" GHC is the version of GHC we ask the Cabal
-- we are testing to use (i.e., using --with-compiler). Notice
-- that this does NOT have to match the version we compiled
-- the library with! (Not all tests will work in this situation,
-- however, since some need to link against the Cabal library.)
-- By default we use the same configuration as the one from the
-- LBI, but a user can override it to test against a different
-- version of GHC.
let boot_programs = withPrograms lbi
mb_with_ghc_path <- lookupEnv "CABAL_PACKAGETESTS_WITH_GHC"
mb_with_ghc_pkg_path <- lookupEnv "CABAL_PACKAGETESTS_WITH_GHC_PKG"
with_programs <-
case (mb_with_ghc_path, mb_with_ghc_path) of
(Nothing, Nothing) -> return boot_programs
_ -> do
putStrLn "Configuring test suite for --with-compiler"
(_comp, _compPlatform, with_programs)
<- configCompilerEx
(Just GHC) mb_with_ghc_path mb_with_ghc_pkg_path
(lessVerbose verbosity)
return with_programs
-- TODO: maybe have to configure gcc?
-- Figure out what database stack to use. (This is the tricky bit,
-- because we need to have enough databases to make the just-built
-- Cabal package well-formed).
let packageDBStack0 = withPackageDB lbi
-- Package DBs are not guaranteed to be absolute, so make them so in
-- case a subprocess using the package DB needs a different CWD.
packageDBStack1 <- mapM canonicalizePackageDB packageDBStack0
-- The LBI's database stack does *not* contain the inplace installed
-- Cabal package. So we need to add that to the stack.
let package_db_stack
= packageDBStack1 ++
(dist_dir </> "package.conf.inplace")]
-- NB: It's possible that our database stack is broken (e.g.,
-- it's got a database for the wrong version of GHC, or it
-- doesn't have enough to let us build Cabal.) We'll notice
-- when we attempt to compile setup.
-- There is also is a parameter for the stack for --with-compiler,
-- since if GHC is a different version we need a different set of
-- databases. The default should actually be quite reasonable
-- as, unlike in the case of the GHC used to build Cabal, we don't
-- expect htere to be a Cabal available.
with_ghc_db_stack_env :: Maybe String
let withGhcDBStack0 :: PackageDBStack
withGhcDBStack0 =
interpretPackageDbFlags True
$ case with_ghc_db_stack_env of
Nothing -> []
Just str -> concatMap readPackageDbList (splitSearchPath str)
with_ghc_db_stack :: PackageDBStack
<- mapM canonicalizePackageDB withGhcDBStack0
-- THIS ISN'T EVEN MY FINAL FORM. The package database stack
-- controls where we install a package; specifically, the package is
-- installed to the top-most package on the stack (this makes the
-- most sense, since it could depend on any of the packages below
-- it.) If the test wants to register anything (as opposed to just
-- working in place), then we need to have another temporary
-- database we can install into (and not accidentally clobber any of
-- the other stacks.) This is done on a per-test basis.
-- ONE MORE THING. On the subject of installing the package (with
-- copy/register) it is EXTREMELY important that we also overload
-- the install directories, so we don't clobber anything in the
-- default install paths. VERY IMPORTANT.
-- Figure out how long we need to delay for recompilation tests
(mtimeChange, mtimeChange') <- calibrateMtimeChangeDelay
let suite = SuiteConfig
{ cabalDistPref = dist_dir
, bootProgramDb = boot_programs
, withProgramDb = with_programs
, packageDBStack = package_db_stack
, withGhcDBStack = with_ghc_db_stack
, suiteVerbosity = verbosity
, absoluteCWD = cabal_dir
, bootCompiler = compiler lbi
, bootPlatform = hostPlatform lbi
, bootPackages = cabalTestsuitePackages lbi
, mtimeChangeDelay = mtimeChange'
let toMillis :: Int -> Double
toMillis x = fromIntegral x / 1000.0
putStrLn $ "Cabal test suite - testing cabal version "
++ display cabalVersion
putStrLn $ "Cabal build directory: " ++ dist_dir
putStrLn $ "Cabal source directory: " ++ cabal_dir
putStrLn $ "File modtime calibration: " ++ show (toMillis mtimeChange')
++ " (maximum observed: " ++ show (toMillis mtimeChange) ++ ")"
-- TODO: it might be useful to factor this out so that ./Setup
-- configure dumps this file, so we can read it without in a version
-- stable way.
putStrLn $ "Environment:"
putStrLn $ "CABAL_PACKAGETESTS_GHC=" ++ show (ghcPath suite) ++ " \\"
putStrLn $ "CABAL_PACKAGETESTS_GHC_PKG=" ++ show (ghcPkgPath suite) ++ " \\"
putStrLn $ "CABAL_PACKAGETESTS_WITH_GHC=" ++ show (withGhcPath suite) ++ " \\"
putStrLn $ "CABAL_PACKAGETESTS_WITH_GHC_PKG=" ++ show (withGhcPkgPath suite) ++ " \\"
-- For brevity, we use the pre-canonicalized values
let showDBStack = show
. intercalate [searchPathSeparator]
. showPackageDbList
. uninterpretPackageDBFlags
putStrLn $ "CABAL_PACKAGETESTS_DB_STACK=" ++ showDBStack packageDBStack0
putStrLn $ "CABAL_PACKAGETESTS_WITH_DB_STACK=" ++ showDBStack withGhcDBStack0
-- Create a shared Setup executable to speed up Simple tests
putStrLn $ "Building shared ./Setup executable"
rawCompileSetup verbosity suite [] "."
defaultMainWithIngredients options $
runTestTree "Package Tests" (tests suite)
-- | Compute the set of @-package-id@ flags which would be passed when
-- building the public library. Assumes that the public library is
-- non-Backpack.
cabalTestsuitePackages :: LocalBuildInfo -> [(OpenUnitId, ModuleRenaming)]
cabalTestsuitePackages lbi =
case componentNameCLBIs lbi (CTestName (mkUnqualComponentName "package-tests")) of
[clbi] -> componentIncludes clbi
_ -> error "cabalTestsuitePackages"
-- Reverse of 'interpretPackageDbFlags'.
-- prop_idem stk b
-- = interpretPackageDbFlags b (uninterpretPackageDBFlags stk) == stk
uninterpretPackageDBFlags :: PackageDBStack -> [Maybe PackageDB]
uninterpretPackageDBFlags stk = Nothing : map (\x -> Just x) stk
-- | Guess what the 'dist' directory Cabal was installed in is. There's
-- no 100% reliable way to find this, but there are a few good shots:
-- 1. Test programs are ~always built in-place, in a directory
-- that looks like dist/build/package-tests/package-tests;
-- thus the directory can be determined by looking at $0.
-- This method is robust against sandboxes, Nix local
-- builds, and Stack, but doesn't work if you're running
-- in an interpreter.
-- 2. We can use the normal input methods (as per Cabal),
-- checking for the CABAL_BUILDDIR environment variable as
-- well as the default location in the current working directory.
-- NB: If you update this, also update its copy in cabal-install's
-- IntegrationTests
guessDistDir :: IO FilePath
guessDistDir = do
#if MIN_VERSION_base(4,6,0)
-- Method (1)
-- TODO: this needs to be BC'ified, probably.
exe_path <- canonicalizePath =<< getExecutablePath
-- exe_path is something like /path/to/dist/build/package-tests/package-tests
let dist0 = dropFileName exe_path </> ".." </> ".."
b <- doesFileExist (dist0 </> "setup-config")
let dist0 = error "no path"
b = False
-- Method (2)
if b then canonicalizePath dist0
else findDistPrefOrDefault NoFlag >>= canonicalizePath
canonicalizePackageDB :: PackageDB -> IO PackageDB
canonicalizePackageDB (SpecificPackageDB path)
= SpecificPackageDB `fmap` canonicalizePath path
canonicalizePackageDB x = return x
-- | 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.
-- Here's the situation:
-- 1. There's some system Cabal-1.0 installed. We use this
-- to build Setup.hs
-- 2. We run ./Setup configure, which uses Cabal-1.0 to
-- write out the LocalBuildInfo
-- 3. We build the Cabal library, whose version is Cabal-2.0
-- 4. We build the package-tests executable, which LINKS AGAINST
-- Cabal-2.0
-- 5. We try to read the LocalBuildInfo that ./Setup configure
-- wrote out, but it's Cabal-1.0 format!
-- It's a bit skeevy that we're trying to read Cabal-1.0 LocalBuildInfo
-- using Cabal-2.0's parser, but this seems to work OK in practice
-- because LocalBuildInfo is a slow-moving data structure. If
-- we ever make a major change, this won't work, and we'll have to
-- take a different approach (either setting "build-type: Custom"
-- so we bootstrap with the most recent Cabal, or by writing the
-- information we need in another format.)
getPersistBuildConfig_ :: FilePath -> IO (Maybe LocalBuildInfo)
getPersistBuildConfig_ filename = do
eLBI <- try $ getConfigStateFile filename
case eLBI of
-- If the version doesn't match but we still got a successful
-- parse, don't complain and just use it!
Left (ConfigStateFileBadVersion _ _ (Right lbi)) -> return (Just lbi)
Left _ -> return Nothing
Right lbi -> return (Just lbi)
options :: [Ingredient]
options = includingOptions
[Option (Proxy :: Proxy OptionEnableAllTests)] :
import Distribution.Simple
main :: IO ()
main = defaultMain
import Test.Cabal.Prelude hiding (cabal)
import qualified Test.Cabal.Prelude as P
main = cabalTest $ do
fails $ cabal "new-build" []
cabal "new-build" ["--allow-newer"]
fails $ cabal "new-build" ["--allow-newer=baz,quux"]
cabal "new-build" ["--allow-newer=base", "--allow-newer=baz,quux"]
cabal "new-build" ["--allow-newer=bar", "--allow-newer=base,baz"
fails $ cabal "new-build" ["--enable-tests"]
cabal "new-build" ["--enable-tests", "--allow-newer"]
fails $ cabal "new-build" ["--enable-benchmarks"]
cabal "new-build" ["--enable-benchmarks", "--allow-newer"]
fails $ cabal "new-build" ["--enable-benchmarks", "--enable-tests"]
cabal "new-build" ["--enable-benchmarks", "--enable-tests"
fails $ cabal "new-build" ["--allow-newer=Foo:base"]
fails $ cabal "new-build" ["--allow-newer=Foo:base"
,"--enable-tests", "--enable-benchmarks"]
cabal "new-build" ["--allow-newer=AllowNewer:base"]
cabal "new-build" ["--allow-newer=AllowNewer:base"
cabal "new-build" ["--allow-newer=AllowNewer:base"
,"--enable-tests", "--enable-benchmarks"]
cabal cmd args = P.cabal cmd ("--dry-run" : args)
import Test.Cabal.Prelude
-- Test Setup.hs understand --allow-newer
main = setupAndCabalTest $ do
fails $ setup "configure" []
setup "configure" ["--allow-newer"]
fails $ setup "configure" ["--allow-newer=baz,quux"]
setup "configure" ["--allow-newer=base", "--allow-newer=baz,quux"]
setup "configure" ["--allow-newer=bar", "--allow-newer=base,baz"
fails $ setup "configure" ["--enable-tests"]
setup "configure" ["--enable-tests", "--allow-newer"]
fails $ setup "configure" ["--enable-benchmarks"]
setup "configure" ["--enable-benchmarks", "--allow-newer"]
fails $ setup "configure" ["--enable-benchmarks", "--enable-tests"]
setup "configure" ["--enable-benchmarks", "--enable-tests"
fails $ setup "configure" ["--allow-newer=Foo:base"]
fails $ setup "configure" ["--allow-newer=Foo:base"
,"--enable-tests", "--enable-benchmarks"]
setup "configure" ["--allow-newer=AllowNewer:base"]
setup "configure" ["--allow-newer=AllowNewer:base"
setup "configure" ["--allow-newer=AllowNewer:base"
,"--enable-tests", "--enable-benchmarks"]
module Main where
main :: IO ()
main = return ()
module Foo where
import Test.Cabal.Prelude
main = setupAndCabalTest $ do
fails $ setup "configure" []
setup "configure" ["--allow-older"]
fails $ setup "configure" ["--allow-older=baz,quux"]
setup "configure" ["--allow-older=base", "--allow-older=baz,quux"]
setup "configure" ["--allow-older=bar", "--allow-older=base,baz"
fails $ setup "configure" ["--enable-tests"]
setup "configure" ["--enable-tests", "--allow-older"]
fails $ setup "configure" ["--enable-benchmarks"]
setup "configure" ["--enable-benchmarks", "--allow-older"]
fails $ setup "configure" ["--enable-benchmarks", "--enable-tests"]
setup "configure" ["--enable-benchmarks", "--enable-tests"
fails $ setup "configure" ["--allow-older=Foo:base"]
fails $ setup "configure" ["--allow-older=Foo:base"
,"--enable-tests", "--enable-benchmarks"]
setup "configure" ["--allow-older=AllowOlder:base"]
setup "configure" ["--allow-older=AllowOlder:base"
setup "configure" ["--allow-older=AllowOlder:base"
,"--enable-tests", "--enable-benchmarks"]
import Test.Cabal.Prelude
-- Test that module name ambiguity can be resolved using package
-- qualified imports. (Paper Backpack doesn't natively support
-- this but we must!)
main = setupAndCabalTest $ do
withPackageDb $ do
withDirectory "p" $ setup_install []