Commit a8290305 authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files

Merge pull request #3437 from dcoutts/issue-3394

Fix handling of default setup deps
parents 9d0c0c03 02464abe
......@@ -30,6 +30,7 @@ module Distribution.Client.Dependency (
InstalledPreference(..),
-- ** Standard policy
basicInstallPolicy,
standardInstallPolicy,
PackageSpecifier(..),
......@@ -448,11 +449,13 @@ reinstallTargets params =
hideInstalledPackagesAllVersions (depResolverTargets params) params
standardInstallPolicy :: InstalledPackageIndex
-> SourcePackageDb
-> [PackageSpecifier UnresolvedSourcePackage]
-> DepResolverParams
standardInstallPolicy
-- | A basic solver policy on which all others are built.
--
basicInstallPolicy :: InstalledPackageIndex
-> SourcePackageDb
-> [PackageSpecifier UnresolvedSourcePackage]
-> DepResolverParams
basicInstallPolicy
installedPkgIndex (SourcePackageDb sourcePkgIndex sourcePkgPrefs)
pkgSpecifiers
......@@ -469,14 +472,29 @@ standardInstallPolicy
. hideInstalledPackagesSpecificBySourcePackageId
[ packageId pkg | SpecificSourcePackage pkg <- pkgSpecifiers ]
. addDefaultSetupDependencies mkDefaultSetupDeps
. addSourcePackages
[ pkg | SpecificSourcePackage pkg <- pkgSpecifiers ]
$ basicDepResolverParams
installedPkgIndex sourcePkgIndex
-- | The policy used by all the standard commands, install, fetch, freeze etc
-- (but not the new-build and related commands).
--
-- It extends the 'basicInstallPolicy' with a policy on setup deps.
--
standardInstallPolicy :: InstalledPackageIndex
-> SourcePackageDb
-> [PackageSpecifier UnresolvedSourcePackage]
-> DepResolverParams
standardInstallPolicy installedPkgIndex sourcePkgDb pkgSpecifiers
= addDefaultSetupDependencies mkDefaultSetupDeps
$ basicInstallPolicy
installedPkgIndex sourcePkgDb pkgSpecifiers
where
-- Force Cabal >= 1.24 dep when the package is affected by #3199.
mkDefaultSetupDeps :: UnresolvedSourcePackage -> Maybe [Dependency]
......
......@@ -82,7 +82,6 @@ import Distribution.Solver.Types.ConstraintSource
import Distribution.Solver.Types.LabeledPackageConstraint
import Distribution.Solver.Types.OptionalStanza
import Distribution.Solver.Types.PackageFixedDeps
import qualified Distribution.Solver.Types.PackageIndex as SourcePackageIndex
import Distribution.Solver.Types.PkgConfigDb
import Distribution.Solver.Types.Settings
import Distribution.Solver.Types.SolverId
......@@ -424,7 +423,7 @@ rebuildInstallPlan verbosity
phaseRunSolver :: ProjectConfig
-> (Compiler, Platform, ProgramDb)
-> [UnresolvedSourcePackage]
-> Rebuild (SolverInstallPlan, PackagesImplicitSetupDeps)
-> Rebuild SolverInstallPlan
phaseRunSolver projectConfig@ProjectConfig {
projectConfigShared,
projectConfigBuildOnly
......@@ -490,7 +489,7 @@ rebuildInstallPlan verbosity
--
phaseElaboratePlan :: ProjectConfig
-> (Compiler, Platform, ProgramDb)
-> (SolverInstallPlan, PackagesImplicitSetupDeps)
-> SolverInstallPlan
-> [SourcePackage loc]
-> Rebuild ( ElaboratedInstallPlan
, ElaboratedSharedConfig )
......@@ -501,8 +500,7 @@ rebuildInstallPlan verbosity
projectConfigBuildOnly
}
(compiler, platform, progdb)
(solverPlan, pkgsImplicitSetupDeps)
localPackages = do
solverPlan localPackages = do
liftIO $ debug verbosity "Elaborating the install plan..."
......@@ -518,7 +516,6 @@ rebuildInstallPlan verbosity
distDirLayout
cabalDirLayout
solverPlan
pkgsImplicitSetupDeps
localPackages
sourcePackageHashes
defaultInstallDirs
......@@ -827,14 +824,11 @@ planPackages :: Compiler
-> PkgConfigDb
-> [UnresolvedSourcePackage]
-> Map PackageName (Map OptionalStanza Bool)
-> Progress String String
(SolverInstallPlan, PackagesImplicitSetupDeps)
-> Progress String String SolverInstallPlan
planPackages comp platform solver SolverSettings{..}
installedPkgIndex sourcePkgDb pkgConfigDB
localPackages pkgStanzasEnable =
rememberImplicitSetupDeps (depResolverSourcePkgIndex stdResolverParams) <$>
resolveDependencies
platform (compilerInfo comp)
pkgConfigDB solver
......@@ -933,7 +927,9 @@ planPackages comp platform solver SolverSettings{..}
$ stdResolverParams
stdResolverParams =
standardInstallPolicy
-- Note: we don't use the standardInstallPolicy here, since that uses
-- its own addDefaultSetupDependencies that is not appropriate for us.
basicInstallPolicy
installedPkgIndex sourcePkgDb
(map SpecificSourcePackage localPackages)
......@@ -973,7 +969,6 @@ elaborateInstallPlan
-> DistDirLayout
-> CabalDirLayout
-> SolverInstallPlan
-> PackagesImplicitSetupDeps
-> [SourcePackage loc]
-> Map PackageId PackageSourceHash
-> InstallDirs.InstallDirTemplates
......@@ -984,7 +979,7 @@ elaborateInstallPlan
elaborateInstallPlan platform compiler compilerprogdb
DistDirLayout{..}
cabalDirLayout@CabalDirLayout{cabalStorePackageDB}
solverPlan pkgsImplicitSetupDeps localPackages
solverPlan localPackages
sourcePackageHashes
defaultInstallDirs
_sharedPackageConfig
......@@ -1101,8 +1096,7 @@ elaborateInstallPlan platform compiler compilerprogdb
pkgRegisterPackageDBStack = buildAndRegisterDbs
pkgRequiresRegistration = PD.hasPublicLib pkgDescription
pkgSetupScriptStyle = packageSetupScriptStylePostSolver
pkgsImplicitSetupDeps pkg pkgDescription
pkgSetupScriptStyle = packageSetupScriptStyle pkgDescription
pkgSetupScriptCliVersion = packageSetupScriptSpecVersion
pkgSetupScriptStyle pkgDescription deps
pkgSetupPackageDBStack = buildAndRegisterDbs
......@@ -1689,18 +1683,20 @@ dependencyGraph pkgid deps pkgs =
-- | Work out the 'SetupScriptStyle' given the package description.
--
-- This only works on original packages before we give them to the solver,
-- since after the solver some implicit setup deps are made explicit.
--
-- See 'rememberImplicitSetupDeps' and 'packageSetupScriptStylePostSolver'.
--
packageSetupScriptStylePreSolver :: PD.PackageDescription -> SetupScriptStyle
packageSetupScriptStylePreSolver pkg
packageSetupScriptStyle :: PD.PackageDescription -> SetupScriptStyle
packageSetupScriptStyle pkg
| buildType == PD.Custom
, isJust (PD.setupBuildInfo pkg)
, Just setupbi <- PD.setupBuildInfo pkg -- does have a custom-setup stanza
, not (PD.defaultSetupDepends setupbi) -- but not one we added internally
= SetupCustomExplicitDeps
| buildType == PD.Custom
, Just setupbi <- PD.setupBuildInfo pkg -- we get this case post-solver as
, PD.defaultSetupDepends setupbi -- the solver fills in the deps
= SetupCustomImplicitDeps
| buildType == PD.Custom
, Nothing <- PD.setupBuildInfo pkg -- we get this case pre-solver
= SetupCustomImplicitDeps
| PD.specVersion pkg > cabalVersion -- one cabal-install is built against
......@@ -1731,7 +1727,7 @@ defaultSetupDeps :: Compiler -> Platform
-> PD.PackageDescription
-> Maybe [Dependency]
defaultSetupDeps compiler platform pkg =
case packageSetupScriptStylePreSolver pkg of
case packageSetupScriptStyle pkg of
-- For packages with build type custom that do not specify explicit
-- setup dependencies, we add a dependency on Cabal and a number
......@@ -1783,60 +1779,6 @@ defaultSetupDeps compiler platform pkg =
++ "setup deps: " ++ display (packageId pkg)
-- | See 'rememberImplicitSetupDeps' for details.
type PackagesImplicitSetupDeps = Set InstalledPackageId
-- | A consequence of using 'defaultSetupDeps' in 'planPackages' is that by
-- making implicit setup deps explicit we loose track of which packages
-- originally had implicit setup deps. That's important because we do still
-- have different behaviour based on the setup style (in particular whether to
-- compile a Setup.hs script with version macros).
--
-- So we remember the necessary information in an auxilliary set and use it
-- in 'packageSetupScriptStylePreSolver' to recover the full info.
--
rememberImplicitSetupDeps :: SourcePackageIndex.PackageIndex (SourcePackage loc)
-> SolverInstallPlan
-> (SolverInstallPlan, PackagesImplicitSetupDeps)
rememberImplicitSetupDeps sourcePkgIndex plan =
(plan, pkgsImplicitSetupDeps)
where
pkgsImplicitSetupDeps =
Set.fromList
[ installedPackageId pkg
| InstallPlan.Configured
pkg@(SolverPackage newpkg _ _ _) <- InstallPlan.toList plan
-- has explicit setup deps now
, hasExplicitSetupDeps newpkg
-- but originally had no setup deps
, let Just origpkg = SourcePackageIndex.lookupPackageId
sourcePkgIndex (packageId pkg)
, not (hasExplicitSetupDeps origpkg)
]
hasExplicitSetupDeps =
(SetupCustomExplicitDeps==)
. packageSetupScriptStylePreSolver
. PD.packageDescription . packageDescription
-- | Use the extra info saved by 'rememberImplicitSetupDeps' to let us work
-- out the correct 'SetupScriptStyle'. This should give the same result as
-- 'packageSetupScriptStylePreSolver' gave prior to munging the package info
-- through the solver.
--
packageSetupScriptStylePostSolver :: Set InstalledPackageId
-> SolverPackage loc
-> PD.PackageDescription
-> SetupScriptStyle
packageSetupScriptStylePostSolver pkgsImplicitSetupDeps pkg pkgDescription =
case packageSetupScriptStylePreSolver pkgDescription of
SetupCustomExplicitDeps
| Set.member (installedPackageId pkg) pkgsImplicitSetupDeps
-> SetupCustomImplicitDeps
other -> other
-- | Work out which version of the Cabal spec we will be using to talk to the
-- Setup.hs interface for this package.
--
......
......@@ -114,6 +114,15 @@ Extra-Source-Files:
tests/IntegrationTests/user-config/uses_CABAL_CONFIG.out
tests/IntegrationTests/user-config/uses_CABAL_CONFIG.sh
tests/IntegrationTests2.hs
tests/IntegrationTests2/build/setup-custom1/A.hs
tests/IntegrationTests2/build/setup-custom1/Setup.hs
tests/IntegrationTests2/build/setup-custom1/a.cabal
tests/IntegrationTests2/build/setup-custom2/A.hs
tests/IntegrationTests2/build/setup-custom2/Setup.hs
tests/IntegrationTests2/build/setup-custom2/a.cabal
tests/IntegrationTests2/build/setup-simple/A.hs
tests/IntegrationTests2/build/setup-simple/Setup.hs
tests/IntegrationTests2/build/setup-simple/a.cabal
tests/IntegrationTests2/exception/build/Main.hs
tests/IntegrationTests2/exception/build/a.cabal
tests/IntegrationTests2/exception/configure/a.cabal
......@@ -547,7 +556,8 @@ test-suite integration-tests2
time,
zlib,
tasty,
tasty-hunit
tasty-hunit,
tagged
if flag(old-bytestring)
build-depends: bytestring-builder
......
{-# LANGUAGE CPP #-}
{-# LANGUAGE CPP, DeriveDataTypeable #-}
module Main where
import Distribution.Client.DistDirLayout
import Distribution.Client.ProjectConfig
import Distribution.Client.Config (defaultCabalDir)
import Distribution.Client.ProjectPlanning
import Distribution.Client.ProjectPlanning.Types
import Distribution.Client.ProjectBuilding
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.Types (GenericReadyPackage(..), installedPackageId)
import Distribution.Package hiding (installedPackageId)
import Distribution.PackageDescription
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import Distribution.Simple.Setup (toFlag)
import Distribution.Version
import Distribution.Verbosity
import Distribution.Text
......@@ -26,34 +29,47 @@ import System.Directory
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.Options
import Data.Tagged (Tagged(..))
import Data.Proxy (Proxy(..))
import Data.Typeable (Typeable)
main :: IO ()
main = defaultMain (testGroup "Integration tests (internal)" tests)
tests :: [TestTree]
tests =
main =
defaultMainWithIngredients
(defaultIngredients ++ [includingOptions projectConfigOptionDescriptions])
(withProjectConfig $ \config ->
testGroup "Integration tests (internal)"
(tests config))
tests :: ProjectConfig -> [TestTree]
tests config =
--TODO: tests for:
-- * normal success
-- * dry-run tests with changes
[ testGroup "Exceptions during discovey and planning" $
[ testCase "no package" testExceptionInFindingPackage
, testCase "no package2" testExceptionInFindingPackage2
[ testCase "no package" (testExceptionInFindingPackage config)
, testCase "no package2" (testExceptionInFindingPackage2 config)
]
, testGroup "Exceptions during building (local inplace)" $
[ testCase "configure" testExceptionInConfigureStep
, testCase "build" testExceptionInBuildStep
[ testCase "configure" (testExceptionInConfigureStep config)
, testCase "build" (testExceptionInBuildStep config)
-- , testCase "register" testExceptionInRegisterStep
]
--TODO: need to repeat for packages for the store
, testGroup "Successful builds" $
[ testCaseSteps "Setup script styles" (testSetupScriptStyles config)
]
, testGroup "Regression tests" $
[ testCase "issue #3324" testRegressionIssue3324
[ testCase "issue #3324" (testRegressionIssue3324 config)
]
]
testExceptionInFindingPackage :: Assertion
testExceptionInFindingPackage = do
testExceptionInFindingPackage :: ProjectConfig -> Assertion
testExceptionInFindingPackage config = do
BadPackageLocations locs <- expectException "BadPackageLocations" $
void $ planProject testdir config
case locs of
......@@ -62,11 +78,10 @@ testExceptionInFindingPackage = do
cleanProject testdir
where
testdir = "exception/no-pkg"
config = mempty
testExceptionInFindingPackage2 :: Assertion
testExceptionInFindingPackage2 = do
testExceptionInFindingPackage2 :: ProjectConfig -> Assertion
testExceptionInFindingPackage2 config = do
BadPackageLocations locs <- expectException "BadPackageLocations" $
void $ planProject testdir config
case locs of
......@@ -75,11 +90,10 @@ testExceptionInFindingPackage2 = do
cleanProject testdir
where
testdir = "exception/no-pkg2"
config = mempty
testExceptionInConfigureStep :: Assertion
testExceptionInConfigureStep = do
testExceptionInConfigureStep :: ProjectConfig -> Assertion
testExceptionInConfigureStep config = do
plan <- planProject testdir config
plan' <- executePlan plan
(_pkga1, failure) <- expectPackageFailed plan' pkgidA1
......@@ -89,25 +103,68 @@ testExceptionInConfigureStep = do
cleanProject testdir
where
testdir = "exception/configure"
config = mempty
pkgidA1 = PackageIdentifier (PackageName "a") (Version [1] [])
testExceptionInBuildStep :: Assertion
testExceptionInBuildStep = do
testExceptionInBuildStep :: ProjectConfig -> Assertion
testExceptionInBuildStep config = do
plan <- planProject testdir config
plan' <- executePlan plan
(_pkga1, failure) <- expectPackageFailed plan' pkgidA1
expectBuildFailed failure
where
testdir = "exception/build"
config = mempty
pkgidA1 = PackageIdentifier (PackageName "a") (Version [1] [])
testSetupScriptStyles :: ProjectConfig -> (String -> IO ()) -> Assertion
testSetupScriptStyles config reportSubCase = do
reportSubCase (show SetupCustomExplicitDeps)
plan1 <- executePlan =<< planProject testdir1 config
(pkg1, _, _) <- expectPackageInstalled plan1 pkgidA
pkgSetupScriptStyle pkg1 @?= SetupCustomExplicitDeps
hasDefaultSetupDeps pkg1 @?= Just False
marker1 <- readFile (basedir </> testdir1 </> "marker")
marker1 @?= "ok"
removeFile (basedir </> testdir1 </> "marker")
reportSubCase (show SetupCustomImplicitDeps)
plan2 <- executePlan =<< planProject testdir2 config
(pkg2, _, _) <- expectPackageInstalled plan2 pkgidA
pkgSetupScriptStyle pkg2 @?= SetupCustomImplicitDeps
hasDefaultSetupDeps pkg2 @?= Just True
marker2 <- readFile (basedir </> testdir2 </> "marker")
marker2 @?= "ok"
removeFile (basedir </> testdir2 </> "marker")
reportSubCase (show SetupNonCustomInternalLib)
plan3 <- executePlan =<< planProject testdir3 config
(pkg3, _, _) <- expectPackageInstalled plan3 pkgidA
pkgSetupScriptStyle pkg3 @?= SetupNonCustomInternalLib
{-
--TODO: the SetupNonCustomExternalLib case is hard to test since it
-- requires a version of Cabal that's later than the one we're testing
-- e.g. needs a .cabal file that specifies cabal-version: >= 2.0
-- and a corresponding Cabal package that we can use to try and build a
-- default Setup.hs.
reportSubCase (show SetupNonCustomExternalLib)
plan4 <- executePlan =<< planProject testdir4 config
(pkg4, _, _) <- expectPackageInstalled plan4 pkgidA
pkgSetupScriptStyle pkg4 @?= SetupNonCustomExternalLib
-}
where
testdir1 = "build/setup-custom1"
testdir2 = "build/setup-custom2"
testdir3 = "build/setup-simple"
pkgidA = PackageIdentifier (PackageName "a") (Version [0,1] [])
-- The solver fills in default setup deps explicitly, but marks them as such
hasDefaultSetupDeps = fmap defaultSetupDepends
. setupBuildInfo . pkgDescription
-- | See <https://github.com/haskell/cabal/issues/3324>
--
testRegressionIssue3324 :: Assertion
testRegressionIssue3324 = do
testRegressionIssue3324 :: ProjectConfig -> Assertion
testRegressionIssue3324 config = do
-- expected failure first time due to missing dep
plan1 <- executePlan =<< planProject testdir config
(_pkgq, failure) <- expectPackageFailed plan1 pkgidQ
......@@ -123,7 +180,6 @@ testRegressionIssue3324 = do
return ()
where
testdir = "regression/3324"
config = mempty
pkgidP = PackageIdentifier (PackageName "p") (Version [0,1] [])
pkgidQ = PackageIdentifier (PackageName "q") (Version [0,1] [])
......@@ -209,6 +265,44 @@ cleanProject testdir = do
verbosity :: Verbosity
verbosity = minBound --normal --verbose --maxBound --minBound
-------------------------------------------
-- Tasty integration to adjust the config
--
withProjectConfig :: (ProjectConfig -> TestTree) -> TestTree
withProjectConfig testtree =
askOption $ \ghcPath ->
testtree (mkProjectConfig ghcPath)
mkProjectConfig :: GhcPath -> ProjectConfig
mkProjectConfig (GhcPath ghcPath) =
mempty {
projectConfigShared = mempty {
projectConfigHcPath = maybeToFlag ghcPath
},
projectConfigBuildOnly = mempty {
projectConfigNumJobs = toFlag (Just 1)
}
}
where
maybeToFlag = maybe mempty toFlag
data GhcPath = GhcPath (Maybe FilePath)
deriving Typeable
instance IsOption GhcPath where
defaultValue = GhcPath Nothing
optionName = Tagged "with-ghc"
optionHelp = Tagged "The ghc compiler to use"
parseValue = Just . GhcPath . Just
projectConfigOptionDescriptions :: [OptionDescription]
projectConfigOptionDescriptions = [Option (Proxy :: Proxy GhcPath)]
---------------------------------------
-- HUint style utils for this context
--
......
import Distribution.Simple
main = defaultMain >> writeFile "marker" "ok"
name: a
version: 0.1
build-type: Custom
cabal-version: >= 1.10
-- explicit setup deps:
custom-setup
setup-depends: base, Cabal >= 1.18
library
exposed-modules: A
build-depends: base
default-language: Haskell2010
import Distribution.Simple
main = defaultMain >> writeFile "marker" "ok"
name: a
version: 0.1
build-type: Custom
cabal-version: >= 1.10
-- no explicit setup deps
library
exposed-modules: A
build-depends: base
default-language: Haskell2010
import Distribution.Simple
main = defaultMain
name: a
version: 0.1
build-type: Simple
cabal-version: >= 1.10
library
exposed-modules: A
build-depends: base
default-language: Haskell2010
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment