From 66b9936efaae4d9cbe34f00ee8e41e5e21860576 Mon Sep 17 00:00:00 2001 From: Herbert Valerio Riedel Date: Wed, 6 Mar 2019 21:40:21 +0100 Subject: [PATCH] Decouple lib:Cabal version used by custom-setup from the lib component This might require more refinement in future and is a first iteration trying to address #5916 --- cabal-testsuite/Setup.hs | 84 ++++++++++++++++++-- cabal-testsuite/Setup.simple.hs | 6 ++ cabal-testsuite/Test/Cabal/Monad.hs | 18 ++--- cabal-testsuite/Test/Cabal/Script.hs | 37 ++++----- cabal-testsuite/cabal-testsuite.cabal | 107 +++++++++++++++----------- cabal-testsuite/main/cabal-tests.hs | 5 +- 6 files changed, 170 insertions(+), 87 deletions(-) create mode 100644 cabal-testsuite/Setup.simple.hs diff --git a/cabal-testsuite/Setup.hs b/cabal-testsuite/Setup.hs index 590d1336d2c..e43a9cd7f36 100644 --- a/cabal-testsuite/Setup.hs +++ b/cabal-testsuite/Setup.hs @@ -1,10 +1,78 @@ +{-# LANGUAGE Haskell2010 #-} +module Main (main) where + +import Distribution.Backpack import Distribution.Simple +import Distribution.Simple.BuildPaths +import Distribution.Simple.LocalBuildInfo +import Distribution.Simple.Setup +import Distribution.Simple.Utils +import Distribution.Types.LocalBuildInfo +import Distribution.Types.ModuleRenaming +import Distribution.Types.UnqualComponentName + +import System.Directory +import System.FilePath + main :: IO () -main = defaultMain - --- Although this looks like the Simple build type, it is in fact vital that --- we use this Setup.hs because we need to compile against the very same --- version of the Cabal library that the test suite will be compiled --- against. When this happens, it will mean that we'll be able to --- read the LocalBuildInfo of our build environment, which we will --- subsequently use to make decisions about PATHs etc. Important! +main = defaultMainWithHooks simpleUserHooks + { buildHook = \pkg lbi hooks flags -> do + generateScriptEnvModule lbi flags + buildHook simpleUserHooks pkg lbi hooks flags + } + +generateScriptEnvModule :: LocalBuildInfo -> BuildFlags -> IO () +generateScriptEnvModule lbi flags = do + lbiPackageDbStack <- mapM canonicalizePackageDB (withPackageDB lbi) + + createDirectoryIfMissing True moduledir + rewriteFileEx verbosity (moduledir "ScriptEnv0.hs") $ unlines + [ "module Test.Cabal.ScriptEnv0 where" + , "" + , "import Distribution.Simple" + , "import Distribution.System (Platform(..), Arch(..), OS(..))" + , "import Distribution.Types.ModuleRenaming" + , "import Distribution.Simple.Program.Db" + , "import Distribution.Backpack (OpenUnitId)" + , "import Data.Map (fromList)" + , "" + , "lbiPackageDbStack :: PackageDBStack" + , "lbiPackageDbStack = " ++ show lbiPackageDbStack + , "" + , "lbiPlatform :: Platform" + , "lbiPlatform = " ++ show (hostPlatform lbi) + , "" + , "lbiCompiler :: Compiler" + , "lbiCompiler = " ++ show (compiler lbi) + , "" + , "lbiPackages :: [(OpenUnitId, ModuleRenaming)]" + , "lbiPackages = read " ++ show (show (cabalTestsPackages lbi)) + , "" + , "lbiProgramDb :: ProgramDb" + , "lbiProgramDb = read " ++ show (show (withPrograms lbi)) + , "" + , "lbiWithSharedLib :: Bool" + , "lbiWithSharedLib = " ++ show (withSharedLib lbi) + ] + where + verbosity = fromFlagOrDefault minBound (buildVerbosity flags) + moduledir = libAutogenDir "Test" "Cabal" + -- fixme: use component-specific folder + libAutogenDir = autogenPackageModulesDir lbi + +-- | Convert package database into absolute path, so that +-- if we change working directories in a subprocess we get the correct database. +canonicalizePackageDB :: PackageDB -> IO PackageDB +canonicalizePackageDB (SpecificPackageDB path) + = SpecificPackageDB `fmap` canonicalizePath path +canonicalizePackageDB x = return x + +-- | Compute the set of @-package-id@ flags which would be passed when +-- building the public library. Assumes that the public library is +-- non-Backpack. +cabalTestsPackages :: LocalBuildInfo -> [(OpenUnitId, ModuleRenaming)] +cabalTestsPackages lbi = + case componentNameCLBIs lbi (CExeName (mkUnqualComponentName "cabal-tests")) of + [clbi] -> -- [ (unUnitId $ unDefUnitId duid,rn) | (DefiniteUnitId duid, rn) <- componentIncludes clbi ] + componentIncludes clbi + _ -> error "cabalTestsPackages" diff --git a/cabal-testsuite/Setup.simple.hs b/cabal-testsuite/Setup.simple.hs new file mode 100644 index 00000000000..6fa548caf71 --- /dev/null +++ b/cabal-testsuite/Setup.simple.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/cabal-testsuite/Test/Cabal/Monad.hs b/cabal-testsuite/Test/Cabal/Monad.hs index 07e070a1c45..d57dda559d7 100644 --- a/cabal-testsuite/Test/Cabal/Monad.hs +++ b/cabal-testsuite/Test/Cabal/Monad.hs @@ -66,8 +66,7 @@ import Distribution.System import Distribution.Simple.Program.Db import Distribution.Simple.Program import Distribution.Simple.Configure - ( getPersistBuildConfig, configCompilerEx ) -import Distribution.Types.LocalBuildInfo + ( configCompilerEx ) import Distribution.Version import Distribution.Text import Distribution.Package @@ -240,20 +239,19 @@ runTestM mode m = withSystemTempDirectory "cabal-testsuite" $ \tmp_dir -> do script_base = dropExtensions script_filename -- Canonicalize this so that it is stable across working directory changes script_dir <- canonicalizePath script_dir0 - lbi <- getPersistBuildConfig dist_dir let verbosity = normal -- TODO: configurable - senv <- mkScriptEnv verbosity lbi + senv <- mkScriptEnv verbosity -- Add test suite specific programs let program_db0 = addKnownPrograms ([gitProgram, hackageRepoToolProgram, cabalProgram, diffProgram] ++ builtinPrograms) - (withPrograms lbi) + (runnerProgramDb senv) -- Reconfigure according to user flags let cargs = testCommonArgs args -- Reconfigure GHC (comp, platform, program_db2) <- case argGhcPath cargs of - Nothing -> return (compiler lbi, hostPlatform lbi, program_db0) + Nothing -> return (runnerCompiler senv, runnerPlatform senv, program_db0) Just ghc_path -> do -- All the things that get updated paths from -- configCompilerEx. The point is to make sure @@ -274,7 +272,7 @@ runTestM mode m = withSystemTempDirectory "cabal-testsuite" $ \tmp_dir -> do -- we don't pay for things we don't need. A bit difficult -- to do in the current design. configCompilerEx - (Just (compilerFlavor (compiler lbi))) + (Just (compilerFlavor (runnerCompiler senv))) (Just ghc_path) Nothing program_db1 @@ -294,7 +292,7 @@ runTestM mode m = withSystemTempDirectory "cabal-testsuite" $ \tmp_dir -> do let db_stack = case argGhcPath (testCommonArgs args) of - Nothing -> withPackageDB lbi + Nothing -> runnerPackageDbStack senv -- NB: canonicalized -- Can't use the build package db stack since they -- are all for the wrong versions! TODO: Make -- this configurable @@ -311,9 +309,9 @@ runTestM mode m = withSystemTempDirectory "cabal-testsuite" $ \tmp_dir -> do testVerbosity = verbosity, testMtimeChangeDelay = Nothing, testScriptEnv = senv, - testSetupPath = dist_dir "setup" "setup", + testSetupPath = dist_dir "build" "setup" "setup", testSkipSetupTests = argSkipSetupTests (testCommonArgs args), - testHaveCabalShared = withSharedLib lbi, + testHaveCabalShared = runnerWithSharedLib senv, testEnvironment = -- Try to avoid Unicode output [ ("LC_ALL", Just "C") diff --git a/cabal-testsuite/Test/Cabal/Script.hs b/cabal-testsuite/Test/Cabal/Script.hs index 7305527e0eb..7cbf68afc53 100644 --- a/cabal-testsuite/Test/Cabal/Script.hs +++ b/cabal-testsuite/Test/Cabal/Script.hs @@ -9,13 +9,10 @@ module Test.Cabal.Script ( ) where import Test.Cabal.Run +import Test.Cabal.ScriptEnv0 import Distribution.Backpack import Distribution.Types.ModuleRenaming -import Distribution.Types.LocalBuildInfo -import Distribution.Types.ComponentLocalBuildInfo -import Distribution.Types.ComponentName -import Distribution.Types.UnqualComponentName import Distribution.Utils.NubList import Distribution.Simple.Program.Db import Distribution.Simple.Program.Builtin @@ -26,9 +23,9 @@ import Distribution.Verbosity import Distribution.System import Distribution.Simple.Setup (Flag(..)) -import System.Directory import qualified Data.Monoid as M + -- | The runner environment, which contains all of the important -- parameters for invoking GHC. Mostly subset of 'LocalBuildInfo'. data ScriptEnv = ScriptEnv @@ -38,8 +35,11 @@ data ScriptEnv = ScriptEnv , runnerPlatform :: Platform , runnerCompiler :: Compiler , runnerPackages :: [(OpenUnitId, ModuleRenaming)] + , runnerWithSharedLib :: Bool } +{- + -- | Convert package database into absolute path, so that -- if we change working directories in a subprocess we get the correct database. canonicalizePackageDB :: PackageDB -> IO PackageDB @@ -47,31 +47,24 @@ canonicalizePackageDB (SpecificPackageDB path) = SpecificPackageDB `fmap` canonicalizePath path canonicalizePackageDB x = return x +-} + -- | Create a 'ScriptEnv' from a 'LocalBuildInfo' configured with -- the GHC that we want to use. -mkScriptEnv :: Verbosity -> LocalBuildInfo -> IO ScriptEnv -mkScriptEnv verbosity lbi = do - package_db <- mapM canonicalizePackageDB (withPackageDB lbi) +mkScriptEnv :: Verbosity -> IO ScriptEnv +mkScriptEnv verbosity = return $ ScriptEnv { runnerVerbosity = verbosity - , runnerProgramDb = withPrograms lbi - , runnerPackageDbStack = package_db - , runnerPlatform = hostPlatform lbi - , runnerCompiler = compiler lbi + , runnerProgramDb = lbiProgramDb + , runnerPackageDbStack = lbiPackageDbStack + , runnerPlatform = lbiPlatform + , runnerCompiler = lbiCompiler -- NB: the set of packages available to test.hs scripts will COINCIDE -- with the dependencies on the cabal-testsuite library - , runnerPackages = cabalTestsPackages lbi + , runnerPackages = lbiPackages + , runnerWithSharedLib = lbiWithSharedLib } --- | Compute the set of @-package-id@ flags which would be passed when --- building the public library. Assumes that the public library is --- non-Backpack. -cabalTestsPackages :: LocalBuildInfo -> [(OpenUnitId, ModuleRenaming)] -cabalTestsPackages lbi = - case componentNameCLBIs lbi (CExeName (mkUnqualComponentName "cabal-tests")) of - [clbi] -> componentIncludes clbi - _ -> error "cabalTestsPackages" - -- | Run a script with 'runghc', under the 'ScriptEnv'. runghc :: ScriptEnv -> Maybe FilePath -> [(String, Maybe String)] -> FilePath -> [String] -> IO Result diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index 223c0c697ec..166abd2f3da 100644 --- a/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal-testsuite/cabal-testsuite.cabal @@ -1,7 +1,8 @@ +cabal-version: 2.2 name: cabal-testsuite version: 3.0.0.0 copyright: 2003-2019, Cabal Development Team (see AUTHORS file) -license: BSD3 +license: BSD-3-Clause license-file: LICENSE author: Cabal Development Team maintainer: cabal-devel@haskell.org @@ -11,7 +12,6 @@ synopsis: Test suite for Cabal and cabal-install description: This package defines a shared test suite for Cabal and cabal-install. category: Distribution -cabal-version: >=1.10 build-type: Custom extra-source-files: @@ -22,7 +22,19 @@ source-repository head location: https://github.com/haskell/cabal/ subdir: cabal-testsuite +common shared + default-language: Haskell2010 + + build-depends: + , base >= 4.6 && <4.13 + -- this needs to match the in-tree lib:Cabal version + , Cabal == 3.0.0.0 + + ghc-options: -Wall -fwarn-tabs + library + import: shared + exposed-modules: Test.Cabal.Workdir Test.Cabal.Script @@ -32,54 +44,63 @@ library Test.Cabal.Server Test.Cabal.Monad Test.Cabal.CheckArMetadata + + other-modules: + Test.Cabal.ScriptEnv0 + autogen-modules: + Test.Cabal.ScriptEnv0 + build-depends: - aeson ==1.4.*, - attoparsec, - async, - base, - bytestring, - transformers, - optparse-applicative >=0.14 && <0.15, - process, - directory, - filepath, - regex-compat-tdfa, - regex-tdfa, - temporary, - text, - cryptohash-sha256, - base16-bytestring, - Cabal >= 2.3 - ghc-options: -Wall -fwarn-tabs + , aeson ^>= 1.4.2.0 + , async ^>= 2.2.1 + , attoparsec ^>= 0.13.2.2 + , base16-bytestring ^>= 0.1.1.6 + , bytestring ^>= 0.10.0.2 + , containers ^>= 0.5.0.0 || ^>= 0.6.0.1 + , cryptohash-sha256 ^>= 0.11.101.0 + , directory ^>= 1.2.0.1 || ^>= 1.3.0.0 + , exceptions ^>= 0.10.0 + , filepath ^>= 1.3.0.1 || ^>= 1.4.0.0 + , optparse-applicative ^>= 0.14.3.0 + , process ^>= 1.1.0.2 || ^>= 1.2.0.0 || ^>= 1.4.2.0 || ^>= 1.6.1.0 + , regex-compat-tdfa ^>= 0.95.1.4 + , regex-tdfa ^>= 1.2.3.1 + , temporary ^>= 1.3 + , text ^>= 1.2.3.1 + , transformers ^>= 0.3.0.0 || ^>= 0.4.2.0 || ^>= 0.5.2.0 + if !os(windows) - build-depends: unix, exceptions + build-depends: + , unix ^>= 2.6.0.0 || ^>= 2.7.0.0 else - build-depends: Win32 - default-language: Haskell2010 + build-depends: + , Win32 executable cabal-tests + import: shared main-is: cabal-tests.hs hs-source-dirs: main - ghc-options: -threaded -Wall -fwarn-tabs + ghc-options: -threaded build-depends: - async, - base, - Cabal == 3.0.0.0, - clock, - filepath, - process, - optparse-applicative, - cabal-testsuite, - transformers, - exceptions - default-language: Haskell2010 + , cabal-testsuite + -- cosntraints inherited via lib:cabal-testsuite component + , async + , exceptions + , filepath + , optparse-applicative + , process + , transformers + -- dependencies specific to exe:cabal-tests + , clock ^>= 0.7.2 + + build-tool-depends: cabal-testsuite:setup + +-- this executable is needed by lib:cabal-testsuite +executable setup + import: shared + main-is: Setup.simple.hs custom-setup - -- It's important that we pick the exact same version of lib:Cabal - -- both here and for cabal-tests itself. Without this constraint, - -- the solver would pick the in-tree Cabal for cabal-tests's - -- lib:Cabal dependency, and some stable lib:Cabal version for its - -- custom-setup's one (due to 'setupMaxCabalVersionConstraint' in - -- 'D.C.ProjectPlanning'). - setup-depends: Cabal == 3.0.0.0, - base + -- we only depend on even stable releases of lib:Cabal + setup-depends: Cabal == 2.2.* || == 2.4.* || == 3.0.*, + base, filepath, directory diff --git a/cabal-testsuite/main/cabal-tests.hs b/cabal-testsuite/main/cabal-tests.hs index e3424f542a1..3a779d13530 100644 --- a/cabal-testsuite/main/cabal-tests.hs +++ b/cabal-testsuite/main/cabal-tests.hs @@ -9,7 +9,6 @@ import Test.Cabal.Server import Test.Cabal.Monad import Distribution.Verbosity (normal, verbose, Verbosity) -import Distribution.Simple.Configure (getPersistBuildConfig) import Distribution.Simple.Utils (getDirectoryContentsRecursive) import Options.Applicative @@ -110,10 +109,8 @@ main = do Nothing -> guessDistDir when (verbosity >= verbose) $ hPutStrLn stderr $ "Using dist dir: " ++ dist_dir - lbi <- getPersistBuildConfig dist_dir - -- Get ready to go! - senv <- mkScriptEnv verbosity lbi + senv <- mkScriptEnv verbosity let runTest runner path = runner Nothing [] path $ ["--builddir", dist_dir, path] ++ renderCommonArgs (mainCommonArgs args)