Skip to content

Commit f99f91e

Browse files
23Skidoo23Skidoo
committed
Merge pull request #3337 from 23Skidoo/issue-3199
Force Cabal >= 1.24 dep when there's no custom-setup stanza.
2 parents 075cd94 + 9f5caed commit f99f91e

File tree

14 files changed

+229
-83
lines changed

14 files changed

+229
-83
lines changed

‎Cabal/Cabal.cabal‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
name: Cabal
2-
version: 1.24.0.0
2+
version: 1.24.1.0
33
copyright: 2003-2006, Isaac Jones
44
2005-2011, Duncan Coutts
55
license: BSD3

‎Cabal/Distribution/PackageDescription.hs‎

Lines changed: 32 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -97,7 +97,7 @@ module Distribution.PackageDescription (
9797
GenericPackageDescription(..),
9898
Flag(..), FlagName(..), FlagAssignment,
9999
CondTree(..), ConfVar(..), Condition(..),
100-
cNot,
100+
cNot, cAnd, cOr,
101101

102102
-- * Source repositories
103103
SourceRepo(..),
@@ -111,7 +111,7 @@ module Distribution.PackageDescription (
111111

112112
import Distribution.Compat.Binary
113113
import qualified Distribution.Compat.Semigroup as Semi ((<>))
114-
import Distribution.Compat.Semigroup as Semi (Monoid(..), Semigroup, gmempty, gmappend)
114+
import Distribution.Compat.Semigroup as Semi (Monoid(..), Semigroup, gmempty)
115115
import qualified Distribution.Compat.ReadP as Parse
116116
import Distribution.Compat.ReadP ((<++))
117117
import Distribution.Package
@@ -308,18 +308,24 @@ instance Text BuildType where
308308
-- options authors can specify to just Haskell package dependencies.
309309

310310
data SetupBuildInfo = SetupBuildInfo {
311-
setupDepends :: [Dependency]
311+
setupDepends :: [Dependency],
312+
defaultSetupDepends :: Bool
313+
-- ^ Is this a default 'custom-setup' section added by the cabal-install
314+
-- code (as opposed to user-provided)? This field is only used
315+
-- internally, and doesn't correspond to anything in the .cabal
316+
-- file. See #3199.
312317
}
313318
deriving (Generic, Show, Eq, Read, Typeable, Data)
314319

315320
instance Binary SetupBuildInfo
316321

317322
instance Semi.Monoid SetupBuildInfo where
318-
mempty = gmempty
323+
mempty = SetupBuildInfo [] False
319324
mappend = (Semi.<>)
320325

321326
instance Semigroup SetupBuildInfo where
322-
(<>) = gmappend
327+
a <> b = SetupBuildInfo (setupDepends a Semi.<> setupDepends b)
328+
(defaultSetupDepends a || defaultSetupDepends b)
323329

324330
-- ---------------------------------------------------------------------------
325331
-- Module renaming
@@ -1193,11 +1199,32 @@ data Condition c = Var c
11931199
| CAnd (Condition c) (Condition c)
11941200
deriving (Show, Eq, Typeable, Data, Generic)
11951201

1202+
-- | Boolean negation of a 'Condition' value.
11961203
cNot :: Condition a -> Condition a
11971204
cNot (Lit b) = Lit (not b)
11981205
cNot (CNot c) = c
11991206
cNot c = CNot c
12001207

1208+
-- | Boolean AND of two 'Condtion' values.
1209+
cAnd :: Condition a -> Condition a -> Condition a
1210+
cAnd (Lit False) _ = Lit False
1211+
cAnd _ (Lit False) = Lit False
1212+
cAnd (Lit True) x = x
1213+
cAnd x (Lit True) = x
1214+
cAnd x y = CAnd x y
1215+
1216+
-- | Boolean OR of two 'Condition' values.
1217+
cOr :: Eq v => Condition v -> Condition v -> Condition v
1218+
cOr (Lit True) _ = Lit True
1219+
cOr _ (Lit True) = Lit True
1220+
cOr (Lit False) x = x
1221+
cOr x (Lit False) = x
1222+
cOr c (CNot d)
1223+
| c == d = Lit True
1224+
cOr (CNot c) d
1225+
| c == d = Lit True
1226+
cOr x y = COr x y
1227+
12011228
instance Functor Condition where
12021229
f `fmap` Var c = Var (f c)
12031230
_ `fmap` Lit c = Lit c

‎Cabal/Distribution/PackageDescription/Configuration.hs‎

Lines changed: 35 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE CPP #-}
12
-- -fno-warn-deprecations for use of Map.foldWithKey
23
{-# OPTIONS_GHC -fno-warn-deprecations #-}
34
-----------------------------------------------------------------------------
@@ -23,6 +24,7 @@ module Distribution.PackageDescription.Configuration (
2324
parseCondition,
2425
freeVars,
2526
extractCondition,
27+
extractConditions,
2628
addBuildableCondition,
2729
mapCondTree,
2830
mapTreeData,
@@ -32,6 +34,9 @@ module Distribution.PackageDescription.Configuration (
3234
transformAllBuildDepends,
3335
) where
3436

37+
import Control.Applicative -- 7.10 -Werror workaround.
38+
import Prelude
39+
3540
import Distribution.Package
3641
import Distribution.PackageDescription
3742
import Distribution.PackageDescription.Utils
@@ -293,17 +298,24 @@ addBuildableCondition getInfo t =
293298
Lit False -> CondNode mempty mempty []
294299
c -> CondNode mempty mempty [(c, t, Nothing)]
295300

296-
-- | Extract buildable condition from a cond tree.
301+
-- Note: extracting buildable conditions.
302+
-- --------------------------------------
297303
--
298-
-- Background: If the conditions in a cond tree lead to Buildable being set to False,
299-
-- then none of the dependencies for this cond tree should actually be taken into
300-
-- account. On the other hand, some of the flags may only be decided in the solver,
301-
-- so we cannot necessarily make the decision whether a component is Buildable or not
302-
-- prior to solving.
304+
-- If the conditions in a cond tree lead to Buildable being set to False, then
305+
-- none of the dependencies for this cond tree should actually be taken into
306+
-- account. On the other hand, some of the flags may only be decided in the
307+
-- solver, so we cannot necessarily make the decision whether a component is
308+
-- Buildable or not prior to solving.
303309
--
304-
-- What we are doing here is to partially evaluate a condition tree in order to extract
305-
-- the condition under which Buildable is True. The predicate determines whether data
306-
-- under a 'CondTree' is buildable.
310+
-- What we are doing here is to partially evaluate a condition tree in order to
311+
-- extract the condition under which Buildable is True. The predicate determines
312+
-- whether data under a 'CondTree' is buildable.
313+
314+
315+
-- | Extract the condition matched by the given predicate from a cond tree.
316+
--
317+
-- We use this mainly for extracting buildable conditions (see the Note above),
318+
-- but the function is in fact more general.
307319
extractCondition :: Eq v => (a -> Bool) -> CondTree v c a -> Condition v
308320
extractCondition p = go
309321
where
@@ -316,21 +328,20 @@ extractCondition p = go
316328
ct = go t
317329
ce = maybe (Lit True) go e
318330
in
319-
((c `cand` ct) `cor` (CNot c `cand` ce)) `cand` goList cs
320-
321-
cand (Lit False) _ = Lit False
322-
cand _ (Lit False) = Lit False
323-
cand (Lit True) x = x
324-
cand x (Lit True) = x
325-
cand x y = CAnd x y
326-
327-
cor (Lit True) _ = Lit True
328-
cor _ (Lit True) = Lit True
329-
cor (Lit False) x = x
330-
cor x (Lit False) = x
331-
cor c (CNot d)
332-
| c == d = Lit True
333-
cor x y = COr x y
331+
((c `cAnd` ct) `cOr` (CNot c `cAnd` ce)) `cAnd` goList cs
332+
333+
-- | Extract conditions matched by the given predicate from all cond trees in a
334+
-- 'GenericPackageDescription'.
335+
extractConditions :: (BuildInfo -> Bool) -> GenericPackageDescription
336+
-> [Condition ConfVar]
337+
extractConditions f gpkg =
338+
concat [
339+
maybeToList $ extractCondition (f . libBuildInfo) <$> condLibrary gpkg
340+
, extractCondition (f . buildInfo) . snd <$> condExecutables gpkg
341+
, extractCondition (f . testBuildInfo) . snd <$> condTestSuites gpkg
342+
, extractCondition (f . benchmarkBuildInfo) . snd <$> condBenchmarks gpkg
343+
]
344+
334345

335346
-- | A map of dependencies that combines version ranges using 'unionVersionRanges'.
336347
newtype DepMapUnion = DepMapUnion { unDepMapUnion :: Map PackageName VersionRange }

‎cabal-install/Distribution/Client/Configure.hs‎

Lines changed: 29 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -184,18 +184,18 @@ configureSetupScript packageDBs
184184
index
185185
mpkg
186186
= SetupScriptOptions {
187-
useCabalVersion = cabalVersion
188-
, useCabalSpecVersion = Nothing
189-
, useCompiler = Just comp
190-
, usePlatform = Just platform
191-
, usePackageDB = packageDBs'
192-
, usePackageIndex = index'
193-
, useProgramConfig = conf
194-
, useDistPref = distPref
195-
, useLoggingHandle = Nothing
196-
, useWorkingDir = Nothing
197-
, setupCacheLock = lock
198-
, useWin32CleanHack = False
187+
useCabalVersion = cabalVersion
188+
, useCabalSpecVersion = Nothing
189+
, useCompiler = Just comp
190+
, usePlatform = Just platform
191+
, usePackageDB = packageDBs'
192+
, usePackageIndex = index'
193+
, useProgramConfig = conf
194+
, useDistPref = distPref
195+
, useLoggingHandle = Nothing
196+
, useWorkingDir = Nothing
197+
, setupCacheLock = lock
198+
, useWin32CleanHack = False
199199
, forceExternalSetupMethod = forceExternal
200200
-- If we have explicit setup dependencies, list them; otherwise, we give
201201
-- the empty list of dependencies; ideally, we would fix the version of
@@ -204,8 +204,8 @@ configureSetupScript packageDBs
204204
-- know the version of Cabal at this point, but only find this there.
205205
-- Therefore, for now, we just leave this blank.
206206
, useDependencies = fromMaybe [] explicitSetupDeps
207-
, useDependenciesExclusive = isJust explicitSetupDeps
208-
, useVersionMacros = isJust explicitSetupDeps
207+
, useDependenciesExclusive = not defaultSetupDeps && isJust explicitSetupDeps
208+
, useVersionMacros = not defaultSetupDeps && isJust explicitSetupDeps
209209
}
210210
where
211211
-- When we are compiling a legacy setup script without an explicit
@@ -223,13 +223,24 @@ configureSetupScript packageDBs
223223
-- but if the user is using an odd db stack, don't touch it
224224
_otherwise -> (packageDBs, Just index)
225225

226+
maybeSetupBuildInfo :: Maybe PkgDesc.SetupBuildInfo
227+
maybeSetupBuildInfo = do
228+
ReadyPackage (ConfiguredPackage (SourcePackage _ gpkg _ _) _ _ _) _
229+
<- mpkg
230+
PkgDesc.setupBuildInfo (PkgDesc.packageDescription gpkg)
231+
232+
-- Was a default 'custom-setup' stanza added by 'cabal-install' itself? If
233+
-- so, 'setup-depends' must not be exclusive. See #3199.
234+
defaultSetupDeps :: Bool
235+
defaultSetupDeps = maybe False PkgDesc.defaultSetupDepends
236+
maybeSetupBuildInfo
237+
226238
explicitSetupDeps :: Maybe [(UnitId, PackageId)]
227239
explicitSetupDeps = do
228-
ReadyPackage (ConfiguredPackage (SourcePackage _ gpkg _ _) _ _ _) deps
229-
<- mpkg
230-
-- Check if there is an explicit setup stanza
231-
_buildInfo <- PkgDesc.setupBuildInfo (PkgDesc.packageDescription gpkg)
240+
-- Check if there is an explicit setup stanza.
241+
_buildInfo <- maybeSetupBuildInfo
232242
-- Return the setup dependencies computed by the solver
243+
ReadyPackage _ deps <- mpkg
233244
return [ ( Installed.installedUnitId deppkg
234245
, Installed.sourcePackageId deppkg
235246
)

‎cabal-install/Distribution/Client/Dependency.hs‎

Lines changed: 40 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -92,16 +92,14 @@ import Distribution.Package
9292
, Package(..), packageName, packageVersion
9393
, UnitId, Dependency(Dependency))
9494
import qualified Distribution.PackageDescription as PD
95-
( PackageDescription(..), SetupBuildInfo(..)
96-
, GenericPackageDescription(..)
97-
, Flag(flagName), FlagName(..) )
95+
import qualified Distribution.PackageDescription.Configuration as PD
9896
import Distribution.PackageDescription.Configuration
9997
( finalizePackageDescription )
10098
import Distribution.Client.PackageUtils
10199
( externalBuildDepends )
102100
import Distribution.Version
103-
( VersionRange, anyVersion, thisVersion, withinRange
104-
, simplifyVersionRange )
101+
( VersionRange, Version(..), anyVersion, orLaterVersion, thisVersion
102+
, withinRange, simplifyVersionRange )
105103
import Distribution.Compiler
106104
( CompilerInfo(..) )
107105
import Distribution.System
@@ -122,7 +120,7 @@ import Distribution.Verbosity
122120
import Data.List
123121
( foldl', sort, sortBy, nubBy, maximumBy, intercalate, nub )
124122
import Data.Function (on)
125-
import Data.Maybe (fromMaybe)
123+
import Data.Maybe (fromMaybe)
126124
import qualified Data.Map as Map
127125
import qualified Data.Set as Set
128126
import Data.Set (Set)
@@ -392,7 +390,7 @@ removeUpperBounds allowNewer params =
392390
-- 'addSourcePackages'. Otherwise, the packages inserted by
393391
-- 'addSourcePackages' won't have upper bounds in dependencies relaxed.
394392
--
395-
addDefaultSetupDependencies :: (SourcePackage -> [Dependency])
393+
addDefaultSetupDependencies :: (SourcePackage -> Maybe [Dependency])
396394
-> DepResolverParams -> DepResolverParams
397395
addDefaultSetupDependencies defaultSetupDeps params =
398396
params {
@@ -408,9 +406,12 @@ addDefaultSetupDependencies defaultSetupDeps params =
408406
PD.setupBuildInfo =
409407
case PD.setupBuildInfo pkgdesc of
410408
Just sbi -> Just sbi
411-
Nothing -> Just PD.SetupBuildInfo {
412-
PD.setupDepends = defaultSetupDeps srcpkg
413-
}
409+
Nothing -> case defaultSetupDeps srcpkg of
410+
Nothing -> Nothing
411+
Just deps -> Just PD.SetupBuildInfo {
412+
PD.defaultSetupDepends = True,
413+
PD.setupDepends = deps
414+
}
414415
}
415416
}
416417
}
@@ -449,12 +450,41 @@ standardInstallPolicy
449450
. hideInstalledPackagesSpecificBySourcePackageId
450451
[ packageId pkg | SpecificSourcePackage pkg <- pkgSpecifiers ]
451452

453+
. addDefaultSetupDependencies mkDefaultSetupDeps
454+
452455
. addSourcePackages
453456
[ pkg | SpecificSourcePackage pkg <- pkgSpecifiers ]
454457

455458
$ basicDepResolverParams
456459
installedPkgIndex sourcePkgIndex
457460

461+
where
462+
-- Force Cabal >= 1.24 dep when the package is affected by #3199.
463+
mkDefaultSetupDeps :: SourcePackage -> Maybe [Dependency]
464+
mkDefaultSetupDeps srcpkg | affected =
465+
Just [Dependency (PackageName "Cabal")
466+
(orLaterVersion $ Version [1,24] [])]
467+
| otherwise = Nothing
468+
where
469+
gpkgdesc = packageDescription srcpkg
470+
pkgdesc = PD.packageDescription gpkgdesc
471+
bt = fromMaybe PD.Custom (PD.buildType pkgdesc)
472+
affected = bt == PD.Custom && hasBuildableFalse gpkgdesc
473+
474+
-- Does this package contain any components with non-empty 'build-depends'
475+
-- and a 'buildable' field that could potentially be set to 'False'? False
476+
-- positives are possible.
477+
hasBuildableFalse :: PD.GenericPackageDescription -> Bool
478+
hasBuildableFalse gpkg =
479+
not (all alwaysTrue (zipWith PD.cOr buildableConditions noDepConditions))
480+
where
481+
buildableConditions = PD.extractConditions PD.buildable gpkg
482+
noDepConditions = PD.extractConditions
483+
(null . PD.targetBuildDepends) gpkg
484+
alwaysTrue (PD.Lit True) = True
485+
alwaysTrue _ = False
486+
487+
458488
applySandboxInstallPolicy :: SandboxPackageInfo
459489
-> DepResolverParams
460490
-> DepResolverParams

0 commit comments

Comments
 (0)