Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

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

Merged
merged 7 commits into from
Jan 15, 2016
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions Cabal/Cabal.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
18 changes: 9 additions & 9 deletions Cabal/Distribution/PackageDescription/Configuration.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 )

Expand Down
16 changes: 16 additions & 0 deletions Cabal/tests/PackageTests/BuildableField/BuildableField.cabal
Original file line number Diff line number Diff line change
@@ -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
4 changes: 4 additions & 0 deletions Cabal/tests/PackageTests/BuildableField/Main.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
import UnavailableModule

main :: IO ()
main = putStrLn "Hello"
8 changes: 8 additions & 0 deletions Cabal/tests/PackageTests/Tests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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 ++
Expand All @@ -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

Expand All @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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]
Expand All @@ -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 {
Expand Down Expand Up @@ -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 = []
}
}
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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 [] =
([], [])
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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]
Expand All @@ -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
Expand Down
Loading