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

Fixes #3199.

(cherry picked from commit 2f97657)

Author: 23Skidoo

Cabal/Distribution/PackageDescription.hs

@@ -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

Cabal/Distribution/PackageDescription/Configuration.hs

@@ -1,3 +1,4 @@
+{-# 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 }

cabal-install/Distribution/Client/Configure.hs

@@ -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)
              ]

cabal-install/Distribution/Client/Dependency.hs

@@ -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

cabal-install/Distribution/Client/ProjectPlanning.hs

@@ -1629,14 +1629,15 @@ 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
 
       -- For packages with build type custom that do not specify explicit
       -- 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 "