Commit 58b4a651 authored by Mikhail Glushenkov's avatar Mikhail Glushenkov

Force Cabal >= 1.24 dep when there's no custom-setup stanza.

Fixes #3199.

(cherry picked from commit 2f976576)
parent 3784e1f5
......@@ -100,7 +100,7 @@ module Distribution.PackageDescription (
GenericPackageDescription(..),
Flag(..), FlagName(..), FlagAssignment,
CondTree(..), ConfVar(..), Condition(..),
cNot,
cNot, cAnd, cOr,
-- * Source repositories
SourceRepo(..),
......@@ -114,7 +114,7 @@ module Distribution.PackageDescription (
import Distribution.Compat.Binary
import qualified Distribution.Compat.Semigroup as Semi ((<>))
import Distribution.Compat.Semigroup as Semi (Monoid(..), Semigroup, gmempty, gmappend)
import Distribution.Compat.Semigroup as Semi (Monoid(..), Semigroup, gmempty)
import qualified Distribution.Compat.ReadP as Parse
import Distribution.Compat.ReadP ((<++))
import Distribution.Package
......@@ -310,18 +310,24 @@ instance Text BuildType where
-- options authors can specify to just Haskell package dependencies.
data SetupBuildInfo = SetupBuildInfo {
setupDepends :: [Dependency]
setupDepends :: [Dependency],
defaultSetupDepends :: Bool
-- ^ Is this a default 'custom-setup' section added by the cabal-install
-- code (as opposed to user-provided)? This field is only used
-- internally, and doesn't correspond to anything in the .cabal
-- file. See #3199.
}
deriving (Generic, Show, Eq, Read, Typeable, Data)
instance Binary SetupBuildInfo
instance Semi.Monoid SetupBuildInfo where
mempty = gmempty
mempty = SetupBuildInfo [] False
mappend = (Semi.<>)
instance Semigroup SetupBuildInfo where
(<>) = gmappend
a <> b = SetupBuildInfo (setupDepends a Semi.<> setupDepends b)
(defaultSetupDepends a || defaultSetupDepends b)
-- ---------------------------------------------------------------------------
-- Module renaming
......@@ -1225,11 +1231,32 @@ data Condition c = Var c
| CAnd (Condition c) (Condition c)
deriving (Show, Eq, Typeable, Data, Generic)
-- | Boolean negation of a 'Condition' value.
cNot :: Condition a -> Condition a
cNot (Lit b) = Lit (not b)
cNot (CNot c) = c
cNot c = CNot c
-- | Boolean AND of two 'Condtion' values.
cAnd :: Condition a -> Condition a -> Condition a
cAnd (Lit False) _ = Lit False
cAnd _ (Lit False) = Lit False
cAnd (Lit True) x = x
cAnd x (Lit True) = x
cAnd x y = CAnd x y
-- | Boolean OR of two 'Condition' values.
cOr :: Eq v => Condition v -> Condition v -> Condition v
cOr (Lit True) _ = Lit True
cOr _ (Lit True) = Lit True
cOr (Lit False) x = x
cOr x (Lit False) = x
cOr c (CNot d)
| c == d = Lit True
cOr (CNot c) d
| c == d = Lit True
cOr x y = COr x y
instance Functor Condition where
f `fmap` Var c = Var (f c)
_ `fmap` Lit c = Lit c
......
{-# LANGUAGE CPP #-}
-- -fno-warn-deprecations for use of Map.foldWithKey
{-# OPTIONS_GHC -fno-warn-deprecations #-}
-----------------------------------------------------------------------------
......@@ -23,6 +24,7 @@ module Distribution.PackageDescription.Configuration (
parseCondition,
freeVars,
extractCondition,
extractConditions,
addBuildableCondition,
mapCondTree,
mapTreeData,
......@@ -32,6 +34,9 @@ module Distribution.PackageDescription.Configuration (
transformAllBuildDepends,
) where
import Control.Applicative -- 7.10 -Werror workaround.
import Prelude
import Distribution.Package
import Distribution.PackageDescription
import Distribution.PackageDescription.Utils
......@@ -293,17 +298,24 @@ addBuildableCondition getInfo t =
Lit False -> CondNode mempty mempty []
c -> CondNode mempty mempty [(c, t, Nothing)]
-- | Extract buildable condition from a cond tree.
-- Note: extracting buildable conditions.
-- --------------------------------------
--
-- Background: If the conditions in a cond tree lead to Buildable being set to False,
-- then none of the dependencies for this cond tree should actually be taken into
-- account. On the other hand, some of the flags may only be decided in the solver,
-- so we cannot necessarily make the decision whether a component is Buildable or not
-- prior to solving.
-- If the conditions in a cond tree lead to Buildable being set to False, then
-- none of the dependencies for this cond tree should actually be taken into
-- account. On the other hand, some of the flags may only be decided in the
-- solver, so we cannot necessarily make the decision whether a component is
-- Buildable or not prior to solving.
--
-- What we are doing here is to partially evaluate a condition tree in order to extract
-- the condition under which Buildable is True. The predicate determines whether data
-- under a 'CondTree' is buildable.
-- What we are doing here is to partially evaluate a condition tree in order to
-- extract the condition under which Buildable is True. The predicate determines
-- whether data under a 'CondTree' is buildable.
-- | Extract the condition matched by the given predicate from a cond tree.
--
-- We use this mainly for extracting buildable conditions (see the Note above),
-- but the function is in fact more general.
extractCondition :: Eq v => (a -> Bool) -> CondTree v c a -> Condition v
extractCondition p = go
where
......@@ -316,21 +328,20 @@ extractCondition p = go
ct = go t
ce = maybe (Lit True) go e
in
((c `cand` ct) `cor` (CNot c `cand` ce)) `cand` goList cs
cand (Lit False) _ = Lit False
cand _ (Lit False) = Lit False
cand (Lit True) x = x
cand x (Lit True) = x
cand x y = CAnd x y
cor (Lit True) _ = Lit True
cor _ (Lit True) = Lit True
cor (Lit False) x = x
cor x (Lit False) = x
cor c (CNot d)
| c == d = Lit True
cor x y = COr x y
((c `cAnd` ct) `cOr` (CNot c `cAnd` ce)) `cAnd` goList cs
-- | Extract conditions matched by the given predicate from all cond trees in a
-- 'GenericPackageDescription'.
extractConditions :: (BuildInfo -> Bool) -> GenericPackageDescription
-> [Condition ConfVar]
extractConditions f gpkg =
concat [
extractCondition (f . libBuildInfo) . snd <$> condLibraries gpkg
, extractCondition (f . buildInfo) . snd <$> condExecutables gpkg
, extractCondition (f . testBuildInfo) . snd <$> condTestSuites gpkg
, extractCondition (f . benchmarkBuildInfo) . snd <$> condBenchmarks gpkg
]
-- | A map of dependencies that combines version ranges using 'unionVersionRanges'.
newtype DepMapUnion = DepMapUnion { unDepMapUnion :: Map PackageName VersionRange }
......
......@@ -187,18 +187,18 @@ configureSetupScript packageDBs
index
mpkg
= SetupScriptOptions {
useCabalVersion = cabalVersion
, useCabalSpecVersion = Nothing
, useCompiler = Just comp
, usePlatform = Just platform
, usePackageDB = packageDBs'
, usePackageIndex = index'
, useProgramConfig = conf
, useDistPref = distPref
, useLoggingHandle = Nothing
, useWorkingDir = Nothing
, setupCacheLock = lock
, useWin32CleanHack = False
useCabalVersion = cabalVersion
, useCabalSpecVersion = Nothing
, useCompiler = Just comp
, usePlatform = Just platform
, usePackageDB = packageDBs'
, usePackageIndex = index'
, useProgramConfig = conf
, useDistPref = distPref
, useLoggingHandle = Nothing
, useWorkingDir = Nothing
, setupCacheLock = lock
, useWin32CleanHack = False
, forceExternalSetupMethod = forceExternal
-- If we have explicit setup dependencies, list them; otherwise, we give
-- the empty list of dependencies; ideally, we would fix the version of
......@@ -207,8 +207,8 @@ configureSetupScript packageDBs
-- know the version of Cabal at this point, but only find this there.
-- Therefore, for now, we just leave this blank.
, useDependencies = fromMaybe [] explicitSetupDeps
, useDependenciesExclusive = isJust explicitSetupDeps
, useVersionMacros = isJust explicitSetupDeps
, useDependenciesExclusive = not defaultSetupDeps && isJust explicitSetupDeps
, useVersionMacros = not defaultSetupDeps && isJust explicitSetupDeps
}
where
-- When we are compiling a legacy setup script without an explicit
......@@ -226,13 +226,24 @@ configureSetupScript packageDBs
-- but if the user is using an odd db stack, don't touch it
_otherwise -> (packageDBs, Just index)
explicitSetupDeps :: Maybe [(UnitId, PackageId)]
explicitSetupDeps = do
maybeSetupBuildInfo :: Maybe PkgDesc.SetupBuildInfo
maybeSetupBuildInfo = do
ReadyPackage cpkg <- mpkg
let gpkg = packageDescription (confPkgSource cpkg)
-- Check if there is an explicit setup stanza
_buildInfo <- PkgDesc.setupBuildInfo (PkgDesc.packageDescription gpkg)
PkgDesc.setupBuildInfo (PkgDesc.packageDescription gpkg)
-- Was a default 'custom-setup' stanza added by 'cabal-install' itself? If
-- so, 'setup-depends' must not be exclusive. See #3199.
defaultSetupDeps :: Bool
defaultSetupDeps = maybe False PkgDesc.defaultSetupDepends
maybeSetupBuildInfo
explicitSetupDeps :: Maybe [(UnitId, PackageId)]
explicitSetupDeps = do
-- Check if there is an explicit setup stanza.
_buildInfo <- maybeSetupBuildInfo
-- Return the setup dependencies computed by the solver
ReadyPackage cpkg <- mpkg
return [ ( uid, srcid )
| ConfiguredId srcid uid <- CD.setupDeps (confPkgDeps cpkg)
]
......
......@@ -94,16 +94,14 @@ import Distribution.Package
, Package(..), packageName, packageVersion
, UnitId, Dependency(Dependency))
import qualified Distribution.PackageDescription as PD
( PackageDescription(..), SetupBuildInfo(..)
, GenericPackageDescription(..)
, Flag(flagName), FlagName(..) )
import qualified Distribution.PackageDescription.Configuration as PD
import Distribution.PackageDescription.Configuration
( finalizePackageDescription )
import Distribution.Client.PackageUtils
( externalBuildDepends )
import Distribution.Version
( VersionRange, anyVersion, thisVersion, withinRange
, simplifyVersionRange )
( Version(..), VersionRange, anyVersion, thisVersion, orLaterVersion
, withinRange, simplifyVersionRange )
import Distribution.Compiler
( CompilerInfo(..) )
import Distribution.System
......@@ -394,7 +392,7 @@ removeUpperBounds allowNewer params =
-- 'addSourcePackages'. Otherwise, the packages inserted by
-- 'addSourcePackages' won't have upper bounds in dependencies relaxed.
--
addDefaultSetupDependencies :: (UnresolvedSourcePackage -> [Dependency])
addDefaultSetupDependencies :: (UnresolvedSourcePackage -> Maybe [Dependency])
-> DepResolverParams -> DepResolverParams
addDefaultSetupDependencies defaultSetupDeps params =
params {
......@@ -410,9 +408,12 @@ addDefaultSetupDependencies defaultSetupDeps params =
PD.setupBuildInfo =
case PD.setupBuildInfo pkgdesc of
Just sbi -> Just sbi
Nothing -> Just PD.SetupBuildInfo {
PD.setupDepends = defaultSetupDeps srcpkg
}
Nothing -> case defaultSetupDeps srcpkg of
Nothing -> Nothing
Just deps -> Just PD.SetupBuildInfo {
PD.defaultSetupDepends = True,
PD.setupDepends = deps
}
}
}
}
......@@ -451,12 +452,41 @@ standardInstallPolicy
. hideInstalledPackagesSpecificBySourcePackageId
[ packageId pkg | SpecificSourcePackage pkg <- pkgSpecifiers ]
. addDefaultSetupDependencies mkDefaultSetupDeps
. addSourcePackages
[ pkg | SpecificSourcePackage pkg <- pkgSpecifiers ]
$ basicDepResolverParams
installedPkgIndex sourcePkgIndex
where
-- Force Cabal >= 1.24 dep when the package is affected by #3199.
mkDefaultSetupDeps :: UnresolvedSourcePackage -> Maybe [Dependency]
mkDefaultSetupDeps srcpkg | affected =
Just [Dependency (PackageName "Cabal")
(orLaterVersion $ Version [1,24] [])]
| otherwise = Nothing
where
gpkgdesc = packageDescription srcpkg
pkgdesc = PD.packageDescription gpkgdesc
bt = fromMaybe PD.Custom (PD.buildType pkgdesc)
affected = bt == PD.Custom && hasBuildableFalse gpkgdesc
-- Does this package contain any components with non-empty 'build-depends'
-- and a 'buildable' field that could potentially be set to 'False'? False
-- positives are possible.
hasBuildableFalse :: PD.GenericPackageDescription -> Bool
hasBuildableFalse gpkg =
not (all alwaysTrue (zipWith PD.cOr buildableConditions noDepConditions))
where
buildableConditions = PD.extractConditions PD.buildable gpkg
noDepConditions = PD.extractConditions
(null . PD.targetBuildDepends) gpkg
alwaysTrue (PD.Lit True) = True
alwaysTrue _ = False
applySandboxInstallPolicy :: SandboxPackageInfo
-> DepResolverParams
-> DepResolverParams
......
......@@ -1629,7 +1629,7 @@ packageSetupScriptStylePreSolver pkg
-- we still need to distinguish the case of explicit and implict setup deps.
-- See 'rememberImplicitSetupDeps'.
--
defaultSetupDeps :: Platform -> PD.PackageDescription -> [Dependency]
defaultSetupDeps :: Platform -> PD.PackageDescription -> Maybe [Dependency]
defaultSetupDeps platform pkg =
case packageSetupScriptStylePreSolver pkg of
......@@ -1637,6 +1637,7 @@ defaultSetupDeps platform pkg =
-- setup dependencies, we add a dependency on Cabal and a number
-- of other packages.
SetupCustomImplicitDeps ->
Just $
[ Dependency depPkgname anyVersion
| depPkgname <- legacyCustomSetupPkgs platform ] ++
-- The Cabal dep is slightly special:
......@@ -1663,13 +1664,13 @@ defaultSetupDeps platform pkg =
-- external Setup.hs, it'll be one of the simple ones that only depends
-- on Cabal and base.
SetupNonCustomExternalLib ->
[ Dependency cabalPkgname cabalConstraint
, Dependency basePkgname anyVersion ]
Just [ Dependency cabalPkgname cabalConstraint
, Dependency basePkgname anyVersion ]
where
cabalConstraint = orLaterVersion (PD.specVersion pkg)
-- The internal setup wrapper method has no deps at all.
SetupNonCustomInternalLib -> []
SetupNonCustomInternalLib -> Just []
SetupCustomExplicitDeps ->
error $ "defaultSetupDeps: called for a package with explicit "
......
......@@ -161,15 +161,16 @@ data SetupScriptOptions = SetupScriptOptions {
useWorkingDir :: Maybe FilePath,
forceExternalSetupMethod :: Bool,
-- | List of dependencies to use when building Setup.hs
-- | List of dependencies to use when building Setup.hs.
useDependencies :: [(UnitId, PackageId)],
-- | Is the list of setup dependencies exclusive?
--
-- When this is @False@, if we compile the Setup.hs script we do so with
-- the list in 'useDependencies' but all other packages in the environment
-- are also visible. Additionally, a suitable version of @Cabal@ library
-- is added to the list of dependencies (see 'useCabalVersion').
-- When this is @False@, if we compile the Setup.hs script we do so with the
-- list in 'useDependencies' but all other packages in the environment are
-- also visible. A suitable version of @Cabal@ library (see
-- 'useCabalVersion') is also added to the list of dependencies, unless
-- 'useDependencies' already contains a Cabal dependency.
--
-- When @True@, only the 'useDependencies' packages are used, with other
-- packages in the environment hidden.
......@@ -604,16 +605,22 @@ externalSetupMethod verbosity options pkg bt mkargs = do
-- With 'useDependenciesExclusive' we enforce the deps specified,
-- so only the given ones can be used. Otherwise we allow the use
-- of packages in the ambient environment, and add on a dep on the
-- Cabal library.
-- Cabal library (unless 'useDependencies' already contains one).
--
-- With 'useVersionMacros' we use a version CPP macros .h file.
--
-- Both of these options should be enabled for packages that have
-- opted-in and declared a custom-settup stanza.
--
hasCabal (_, PackageIdentifier (PackageName "Cabal") _) = True
hasCabal _ = False
selectedDeps | useDependenciesExclusive options'
= useDependencies options'
| otherwise = useDependencies options' ++ cabalDep
| otherwise = useDependencies options' ++
if any hasCabal (useDependencies options')
then []
else cabalDep
addRenaming (ipid, _) = (ipid, defaultRenaming)
cppMacrosFile = setupDir </> "setup_macros.h"
ghcOptions = mempty {
......
......@@ -221,7 +221,8 @@ exAvSrcPkg ex =
, C.benchmarks = error "not yet configured: benchmarks"
, C.buildDepends = error "not yet configured: buildDepends"
, C.setupBuildInfo = Just C.SetupBuildInfo {
C.setupDepends = mkSetupDeps (CD.setupDeps (exAvDeps ex))
C.setupDepends = mkSetupDeps (CD.setupDeps (exAvDeps ex)),
C.defaultSetupDepends = False
}
}
, C.genPackageFlags = nub $ concatMap extractFlags $
......
Markdown is supported
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