Merge pull request #3039 from grayjay/buildable-tests

Tests for #2731 (Ignore dependencies that are not Buildable)

Cabal/Cabal.cabal

@@ -77,6 +77,8 @@ extra-source-files:
   tests/PackageTests/BuildDeps/TargetSpecificDeps3/lemon.hs
   tests/PackageTests/BuildDeps/TargetSpecificDeps3/my.cabal
   tests/PackageTests/BuildTestSuiteDetailedV09/Dummy2.hs
+  tests/PackageTests/BuildableField/BuildableField.cabal
+  tests/PackageTests/BuildableField/Main.hs
   tests/PackageTests/CMain/Bar.hs
   tests/PackageTests/CMain/foo.c
   tests/PackageTests/CMain/my.cabal

Cabal/Distribution/PackageDescription/Configuration.hs

@@ -220,6 +220,7 @@ resolveWithFlags dom os arch impl constrs trees checkDeps =
 
     -- simplify trees by (partially) evaluating all conditions and converting
     -- dependencies to dependency maps.
+    simplifiedTrees :: [CondTree FlagName DependencyMap PDTagged]
     simplifiedTrees = map ( mapTreeConstrs toDepMap  -- convert to maps
                           . mapTreeConds (fst . simplifyWithSysParams os arch impl))
                           trees
@@ -228,6 +229,9 @@ resolveWithFlags dom os arch impl constrs trees checkDeps =
     -- either succeeds or returns a binary tree with the missing dependencies
     -- encountered in each run.  Since the tree is constructed lazily, we
     -- avoid some computation overhead in the successful case.
+    try :: [(FlagName, [Bool])]
+        -> [(FlagName, Bool)]
+        -> Either (BT [Dependency]) (TargetSet PDTagged, FlagAssignment)
     try [] flags =
         let targetSet = TargetSet $ flip map simplifiedTrees $
                 -- apply additional constraints to all dependencies
@@ -337,11 +341,11 @@ overallDependencies (TargetSet targets) = mconcat depss
   where
     (depss, _) = unzip $ filter (removeDisabledSections . snd) targets
     removeDisabledSections :: PDTagged -> Bool
-    removeDisabledSections (Lib _) = True
-    removeDisabledSections (Exe _ _) = True
-    removeDisabledSections (Test _ t) = testEnabled t
-    removeDisabledSections (Bench _ b) = benchmarkEnabled b
-    removeDisabledSections PDNull = True
+    removeDisabledSections (Lib l)     = buildable (libBuildInfo l)
+    removeDisabledSections (Exe _ e)   = buildable (buildInfo e)
+    removeDisabledSections (Test _ t)  = testEnabled t && buildable (testBuildInfo t)
+    removeDisabledSections (Bench _ b) = benchmarkEnabled b && buildable (benchmarkBuildInfo b)
+    removeDisabledSections PDNull      = True
 
 -- Apply extra constraints to a dependency map.
 -- Combines dependencies where the result will only contain keys from the left
@@ -482,10 +486,6 @@ finalizePackageDescription userflags satisfyDep
                     , testSuites = tests'
                     , benchmarks = bms'
                     , buildDepends = fromDepMap (overallDependencies targetSet)
-                      --TODO: we need to find a way to avoid pulling in deps
-                      -- for non-buildable components. However cannot simply
-                      -- filter at this stage, since if the package were not
-                      -- available we would have failed already.
                     }
               , flagVals )
 

Cabal/tests/PackageTests/BuildableField/BuildableField.cabal

@@ -0,0 +1,16 @@
+name: BuildableField
+version: 0.1.0.0
+cabal-version: >=1.2
+build-type: Simple
+license: BSD3
+
+flag build-exe
+  default: True
+
+library
+
+executable my-executable
+  build-depends: base, unavailable-package
+  main-is: Main.hs
+  if !flag(build-exe)
+    buildable: False

Cabal/tests/PackageTests/BuildableField/Main.hs

@@ -0,0 +1,4 @@
+import UnavailableModule
+
+main :: IO ()
+main = putStrLn "Hello"

Cabal/tests/PackageTests/Tests.hs

@@ -223,6 +223,14 @@ tests config =
             cabal_build ["--enable-tests"]
             cabal "test" []
 
+  -- Test that Cabal can choose flags to disable building a component when that
+  -- component's dependencies are unavailable. The build should succeed without
+  -- requiring the component's dependencies or imports.
+  , tc "BuildableField" $ do
+        r <- cabal' "configure" ["-v"]
+        assertOutputContains "Flags chosen: build-exe=False" r
+        cabal "build" []
+
   ]
   where
     -- Shared test function for BuildDeps/InternalLibrary* tests.

cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs

@@ -106,7 +106,7 @@ convGPD os arch comp strfl pi
         (GenericPackageDescription pkg flags libs exes tests benchs) =
   let
     fds  = flagInfo strfl flags
-    conv = convCondTree os arch comp pi fds (const True)
+    conv = convBuildableCondTree os arch comp pi fds
   in
     PInfo
       (maybe []    (conv ComponentLib                     libBuildInfo         ) libs    ++
@@ -128,18 +128,68 @@ prefix f fds = [f (concat fds)]
 flagInfo :: Bool -> [PD.Flag] -> FlagInfo
 flagInfo strfl = M.fromList . L.map (\ (MkFlag fn _ b m) -> (fn, FInfo b m (not (strfl || m))))
 
+-- | Extract buildable condition from a cond tree.
+--
+-- 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.
+--
+-- What we are doing here is to partially evaluate a condition tree in order to extract
+-- the condition under which Buildable is True.
+extractCondition :: Eq v => (a -> Bool) -> CondTree v [c] a -> Condition v
+extractCondition p = go
+  where
+    go (CondNode x _ cs) | not (p x) = Lit False
+                         | otherwise = goList cs
+
+    goList []               = Lit True
+    goList ((c, t, e) : cs) =
+      let
+        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
+
+-- | Convert a condition tree to flagged dependencies.
+--
+-- In addition, tries to determine under which condition the condition tree
+-- is buildable, and will add an additional condition on top accordingly.
+convBuildableCondTree :: OS -> Arch -> CompilerInfo -> PI PN -> FlagInfo ->
+                         Component ->
+                         (a -> BuildInfo) ->
+                         CondTree ConfVar [Dependency] a -> FlaggedDeps Component PN
+convBuildableCondTree os arch cinfo pi fds comp getInfo t =
+  case extractCondition (buildable . getInfo) t of
+    Lit True  -> convCondTree os arch cinfo pi fds comp getInfo t
+    Lit False -> []
+    c         -> convBranch os arch cinfo pi fds comp getInfo (c, t, Nothing)
+
 -- | Convert condition trees to flagged dependencies.
 convCondTree :: OS -> Arch -> CompilerInfo -> PI PN -> FlagInfo ->
-                (a -> Bool) -> -- how to detect if a branch is active
                 Component ->
                 (a -> BuildInfo) ->
                 CondTree ConfVar [Dependency] a -> FlaggedDeps Component PN
-convCondTree os arch cinfo pi@(PI pn _) fds p comp getInfo (CondNode info ds branches)
-  | p info    =  L.map (\d -> D.Simple (convDep pn d) comp) ds  -- unconditional package dependencies
+convCondTree os arch cinfo pi@(PI pn _) fds comp getInfo (CondNode info ds branches) =
+                 L.map (\d -> D.Simple (convDep pn d) comp) ds  -- unconditional package dependencies
               ++ L.map (\e -> D.Simple (Ext  e) comp) (PD.allExtensions bi) -- unconditional extension dependencies
               ++ L.map (\l -> D.Simple (Lang l) comp) (PD.allLanguages  bi) -- unconditional language dependencies
-              ++ concatMap (convBranch os arch cinfo pi fds p comp getInfo) branches
-  | otherwise = []
+              ++ concatMap (convBranch os arch cinfo pi fds comp getInfo) branches
   where
     bi = getInfo info
 
@@ -153,15 +203,14 @@ convCondTree os arch cinfo pi@(PI pn _) fds p comp getInfo (CondNode info ds bra
 -- simple flag choices.
 convBranch :: OS -> Arch -> CompilerInfo ->
               PI PN -> FlagInfo ->
-              (a -> Bool) -> -- how to detect if a branch is active
               Component ->
               (a -> BuildInfo) ->
               (Condition ConfVar,
                CondTree ConfVar [Dependency] a,
                Maybe (CondTree ConfVar [Dependency] a)) -> FlaggedDeps Component PN
-convBranch os arch cinfo pi@(PI pn _) fds p comp getInfo (c', t', mf') =
-  go c' (          convCondTree os arch cinfo pi fds p comp getInfo   t')
-        (maybe [] (convCondTree os arch cinfo pi fds p comp getInfo) mf')
+convBranch os arch cinfo pi@(PI pn _) fds comp getInfo (c', t', mf') =
+  go c' (          convCondTree os arch cinfo pi fds comp getInfo   t')
+        (maybe [] (convCondTree os arch cinfo pi fds comp getInfo) mf')
   where
     go :: Condition ConfVar ->
           FlaggedDeps Component PN -> FlaggedDeps Component PN -> FlaggedDeps Component PN

cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs

@@ -2,12 +2,14 @@
 -- | DSL for testing the modular solver
 module UnitTests.Distribution.Client.Dependency.Modular.DSL (
     ExampleDependency(..)
+  , Dependencies(..)
   , ExPreference(..)
   , ExampleDb
   , ExampleVersionRange
   , ExamplePkgVersion
   , exAv
   , exInst
+  , exFlag
   , exResolve
   , extractInstallPlan
   , withSetupDeps
@@ -16,6 +18,7 @@ module UnitTests.Distribution.Client.Dependency.Modular.DSL (
 -- base
 import Data.Either (partitionEithers)
 import Data.Maybe (catMaybes)
+import Data.List (nub)
 import Data.Monoid
 import Data.Version
 import qualified Data.Map as Map
@@ -88,6 +91,7 @@ type ExamplePkgHash    = String  -- for example "installed" packages
 type ExampleFlagName   = String
 type ExampleTestName   = String
 type ExampleVersionRange = C.VersionRange
+data Dependencies = NotBuildable | Buildable [ExampleDependency]
 
 data ExampleDependency =
     -- | Simple dependency on any version
@@ -97,7 +101,7 @@ data ExampleDependency =
   | ExFix ExamplePkgName ExamplePkgVersion
 
     -- | Dependencies indexed by a flag
-  | ExFlag ExampleFlagName [ExampleDependency] [ExampleDependency]
+  | ExFlag ExampleFlagName Dependencies Dependencies
 
     -- | Dependency if tests are enabled
   | ExTest ExampleTestName [ExampleDependency]
@@ -108,6 +112,10 @@ data ExampleDependency =
     -- | Dependency on a language version
   | ExLang Language
 
+exFlag :: ExampleFlagName -> [ExampleDependency] -> [ExampleDependency]
+       -> ExampleDependency
+exFlag n t e = ExFlag n (Buildable t) (Buildable e)
+
 data ExPreference = ExPref String ExampleVersionRange
 
 data ExampleAvailable = ExAv {
@@ -163,12 +171,15 @@ exAvSrcPkg ex =
                        C.setupDepends = mkSetupDeps (CD.setupDeps (exAvDeps ex))
                      }
                  }
-             , C.genPackageFlags = concatMap extractFlags
+             , C.genPackageFlags = nub $ concatMap extractFlags
                                    (CD.libraryDeps (exAvDeps ex))
-             , C.condLibrary     = Just $ mkCondTree (extsLib exts <> langLib mlang) libraryDeps
+             , C.condLibrary     = Just $ mkCondTree (extsLib exts <> langLib mlang)
+                                                     disableLib
+                                                     (Buildable libraryDeps)
              , C.condExecutables = []
-             , C.condTestSuites  = map (\(t, deps) -> (t, mkCondTree mempty deps))
-                                   testSuites
+             , C.condTestSuites  =
+                 let mkTree = mkCondTree mempty disableTest . Buildable
+                 in map (\(t, deps) -> (t, mkTree deps)) testSuites
              , C.condBenchmarks  = []
              }
          }
@@ -207,18 +218,28 @@ exAvSrcPkg ex =
                                     , C.flagDefault     = False
                                     , C.flagManual      = False
                                     }
-                                : concatMap extractFlags (a ++ b)
+                                : concatMap extractFlags (deps a ++ deps b)
+      where
+        deps :: Dependencies -> [ExampleDependency]
+        deps NotBuildable = []
+        deps (Buildable ds) = ds
     extractFlags (ExTest _ a)   = concatMap extractFlags a
     extractFlags (ExExt _)      = []
     extractFlags (ExLang _)     = []
 
-    mkCondTree :: Monoid a => a -> [ExampleDependency] -> DependencyTree a
-    mkCondTree x deps =
+    mkCondTree :: Monoid a => a -> (a -> a) -> Dependencies -> DependencyTree a
+    mkCondTree x dontBuild NotBuildable =
+      C.CondNode {
+             C.condTreeData        = dontBuild x
+           , C.condTreeConstraints = []
+           , C.condTreeComponents  = []
+           }
+    mkCondTree x dontBuild (Buildable deps) =
       let (directDeps, flaggedDeps) = splitDeps deps
       in C.CondNode {
              C.condTreeData        = x -- Necessary for language extensions
            , C.condTreeConstraints = map mkDirect directDeps
-           , C.condTreeComponents  = map mkFlagged flaggedDeps
+           , C.condTreeComponents  = map (mkFlagged dontBuild) flaggedDeps
            }
 
     mkDirect :: (ExamplePkgName, Maybe ExamplePkgVersion) -> C.Dependency
@@ -228,13 +249,14 @@ exAvSrcPkg ex =
         v = Version [n, 0, 0] []
 
     mkFlagged :: Monoid a
-              => (ExampleFlagName, [ExampleDependency], [ExampleDependency])
+              => (a -> a)
+              -> (ExampleFlagName, Dependencies, Dependencies)
               -> (C.Condition C.ConfVar
                  , DependencyTree a, Maybe (DependencyTree a))
-    mkFlagged (f, a, b) = ( C.Var (C.Flag (C.FlagName f))
-                          , mkCondTree mempty a
-                          , Just (mkCondTree mempty b)
-                          )
+    mkFlagged dontBuild (f, a, b) = ( C.Var (C.Flag (C.FlagName f))
+                                    , mkCondTree mempty dontBuild a
+                                    , Just (mkCondTree mempty dontBuild b)
+                                    )
 
     -- Split a set of dependencies into direct dependencies and flagged
     -- dependencies. A direct dependency is a tuple of the name of package and
@@ -245,7 +267,7 @@ exAvSrcPkg ex =
     -- TODO: Take care of flagged language extensions and language flavours.
     splitDeps :: [ExampleDependency]
               -> ( [(ExamplePkgName, Maybe Int)]
-                 , [(ExampleFlagName, [ExampleDependency], [ExampleDependency])]
+                 , [(ExampleFlagName, Dependencies, Dependencies)]
                  )
     splitDeps [] =
       ([], [])
@@ -276,6 +298,14 @@ exAvSrcPkg ex =
     langLib (Just lang) = mempty { C.libBuildInfo = mempty { C.defaultLanguage = Just lang } }
     langLib _ = mempty
 
+    disableLib :: C.Library -> C.Library
+    disableLib lib =
+        lib { C.libBuildInfo = (C.libBuildInfo lib) { C.buildable = False }}
+
+    disableTest :: C.TestSuite -> C.TestSuite
+    disableTest test =
+        test { C.testBuildInfo = (C.testBuildInfo test) { C.buildable = False }}
+
 exAvPkgId :: ExampleAvailable -> C.PackageIdentifier
 exAvPkgId ex = C.PackageIdentifier {
       pkgName    = C.PackageName (exAvName ex)
@@ -303,10 +333,10 @@ exInstIdx :: [ExampleInstalled] -> C.PackageIndex.InstalledPackageIndex
 exInstIdx = C.PackageIndex.fromList . map exInstInfo
 
 exResolve :: ExampleDb
-          -- List of extensions supported by the compiler.
-          -> [Extension]
-          -- A compiler can support multiple languages.
-          -> [Language]
+          -- List of extensions supported by the compiler, or Nothing if unknown.
+          -> Maybe [Extension]
+          -- List of languages supported by the compiler, or Nothing if unknown.
+          -> Maybe [Language]
           -> [ExamplePkgName]
           -> Bool
           -> [ExPreference]
@@ -318,12 +348,8 @@ exResolve db exts langs targets indepGoals prefs = runProgress $
                         params
   where
     defaultCompiler = C.unknownCompilerInfo C.buildCompilerId C.NoAbiTag
-    compiler = defaultCompiler { C.compilerInfoExtensions = if null exts
-                                                               then Nothing
-                                                               else Just exts
-                               , C.compilerInfoLanguages  = if null langs
-                                                                then Nothing
-                                                                else Just langs
+    compiler = defaultCompiler { C.compilerInfoExtensions = exts
+                               , C.compilerInfoLanguages  = langs
                                }
     (inst, avai) = partitionEithers db
     instIdx      = exInstIdx inst