From 928850dd39ad7f83c7fc34de2c6801766d4cb7d5 Mon Sep 17 00:00:00 2001 From: Andres Loeh Date: Mon, 20 Jul 2015 09:31:09 +0200 Subject: [PATCH 1/7] Properly extract build conditions from condition trees. When doing the index conversion prior to dependency solving, we now consider the "Buildable" flag for package components. In particular, if the "Buildable" flag of a component is "True" only under certain conditions, then all build dependencies of that component will be placed under the same conditions. --- .../Dependency/Modular/IndexConversion.hs | 69 ++++++++++++++++--- 1 file changed, 59 insertions(+), 10 deletions(-) diff --git a/cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs b/cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs index 8e036238253..c85328996cd 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs +++ b/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 From 53d85bb0621a9153de49923bd26312a6e52a8691 Mon Sep 17 00:00:00 2001 From: Andres Loeh Date: Thu, 23 Jul 2015 13:55:14 +0200 Subject: [PATCH 2/7] Do not consider dependencies of non-buildable components. When configuring a package, the condition trees in the package descriptions are evaluated according to the known configuration and flag assignment. During this process, it becomes also known whether a component has its "Buildable" flag set to True or False. We now disregard all dependencies of non-buildable components. --- .../PackageDescription/Configuration.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/Cabal/Distribution/PackageDescription/Configuration.hs b/Cabal/Distribution/PackageDescription/Configuration.hs index 1c7cb3edd8e..9215175bf6e 100644 --- a/Cabal/Distribution/PackageDescription/Configuration.hs +++ b/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 ) From d33ad535b400361187447860d156a5e90c716c87 Mon Sep 17 00:00:00 2001 From: Kristen Kozak Date: Tue, 12 Jan 2016 16:08:03 -0800 Subject: [PATCH 3/7] Add Cabal package test for Buildable field. --- Cabal/Cabal.cabal | 2 ++ .../BuildableField/BuildableField.cabal | 16 ++++++++++++++++ Cabal/tests/PackageTests/BuildableField/Main.hs | 4 ++++ Cabal/tests/PackageTests/Tests.hs | 8 ++++++++ 4 files changed, 30 insertions(+) create mode 100644 Cabal/tests/PackageTests/BuildableField/BuildableField.cabal create mode 100644 Cabal/tests/PackageTests/BuildableField/Main.hs diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 13e58a273fa..5141d197826 100644 --- a/Cabal/Cabal.cabal +++ b/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 diff --git a/Cabal/tests/PackageTests/BuildableField/BuildableField.cabal b/Cabal/tests/PackageTests/BuildableField/BuildableField.cabal new file mode 100644 index 00000000000..db39bbc0bff --- /dev/null +++ b/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 diff --git a/Cabal/tests/PackageTests/BuildableField/Main.hs b/Cabal/tests/PackageTests/BuildableField/Main.hs new file mode 100644 index 00000000000..f56c45f0228 --- /dev/null +++ b/Cabal/tests/PackageTests/BuildableField/Main.hs @@ -0,0 +1,4 @@ +import UnavailableModule + +main :: IO () +main = putStrLn "Hello" diff --git a/Cabal/tests/PackageTests/Tests.hs b/Cabal/tests/PackageTests/Tests.hs index 285a1619e80..aa27dee8ae3 100644 --- a/Cabal/tests/PackageTests/Tests.hs +++ b/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. From dc4901d47651e9fbd6ad27d12751ff11a0738f08 Mon Sep 17 00:00:00 2001 From: Kristen Kozak Date: Tue, 12 Jan 2016 16:09:36 -0800 Subject: [PATCH 4/7] Allow a flag to be used multiple times in the solver DSL. --- .../UnitTests/Distribution/Client/Dependency/Modular/DSL.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs index 3c6ce7d2aa8..c6f6f868c70 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs @@ -16,6 +16,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 @@ -163,7 +164,7 @@ 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.condExecutables = [] From f0ccd6c32ec2805424016f8204e2d31a20ddad56 Mon Sep 17 00:00:00 2001 From: Kristen Kozak Date: Tue, 12 Jan 2016 16:12:54 -0800 Subject: [PATCH 5/7] Represent Buildable field in the solver DSL. --- .../Client/Dependency/Modular/DSL.hs | 57 ++++++++++++++----- .../Client/Dependency/Modular/Solver.hs | 4 +- 2 files changed, 45 insertions(+), 16 deletions(-) diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs index c6f6f868c70..fe3716ac668 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs +++ b/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 @@ -89,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 @@ -98,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] @@ -109,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 { @@ -166,10 +173,13 @@ exAvSrcPkg ex = } , 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 = [] } } @@ -208,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 @@ -229,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 @@ -246,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 [] = ([], []) @@ -277,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) diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs index be94ea74739..cff1d875f80 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs @@ -209,7 +209,7 @@ db3 :: ExampleDb db3 = [ Right $ exAv "A" 1 [] , Right $ exAv "A" 2 [] - , Right $ exAv "B" 1 [ExFlag "flagB" [ExFix "A" 1] [ExFix "A" 2]] + , Right $ exAv "B" 1 [exFlag "flagB" [ExFix "A" 1] [ExFix "A" 2]] , Right $ exAv "C" 1 [ExFix "A" 1, ExAny "B"] , Right $ exAv "D" 1 [ExFix "A" 2, ExAny "B"] ] @@ -252,7 +252,7 @@ db4 = [ , Right $ exAv "Ax" 2 [] , Right $ exAv "Ay" 1 [] , Right $ exAv "Ay" 2 [] - , Right $ exAv "B" 1 [ExFlag "flagB" [ExFix "Ax" 1] [ExFix "Ay" 1]] + , Right $ exAv "B" 1 [exFlag "flagB" [ExFix "Ax" 1] [ExFix "Ay" 1]] , Right $ exAv "C" 1 [ExFix "Ax" 2, ExAny "B"] , Right $ exAv "D" 1 [ExFix "Ay" 2, ExAny "B"] ] From 7811f78f41f7794885c7179fa8cb06037894d949 Mon Sep 17 00:00:00 2001 From: Kristen Kozak Date: Tue, 12 Jan 2016 21:29:48 -0800 Subject: [PATCH 6/7] Allow a compiler to support zero languages or extensions in the solver DSL. 'DSL.exResolve' now takes a 'Maybe [Extension]' for supported extensions and a 'Maybe [Language]' for supported languages. 'Nothing' means that extensions/languages are not checked by the solver, and 'Just []' means that no extensions/languages are allowed. --- .../Client/Dependency/Modular/DSL.hs | 16 ++++++---------- .../Client/Dependency/Modular/Solver.hs | 14 +++++++------- 2 files changed, 13 insertions(+), 17 deletions(-) diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs index fe3716ac668..9c2eb0adcd1 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs @@ -333,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] @@ -348,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 diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs index cff1d875f80..48fa662756c 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs @@ -120,8 +120,8 @@ data SolverTest = SolverTest { , testIndepGoals :: Bool , testSoftConstraints :: [ExPreference] , testDb :: ExampleDb - , testSupportedExts :: [Extension] - , testSupportedLangs :: [Language] + , testSupportedExts :: Maybe [Extension] + , testSupportedLangs :: Maybe [Language] } mkTest :: ExampleDb @@ -129,7 +129,7 @@ mkTest :: ExampleDb -> [String] -> Maybe [(String, Int)] -> SolverTest -mkTest = mkTestExtLang [] [] +mkTest = mkTestExtLang Nothing Nothing mkTestExts :: [Extension] -> ExampleDb @@ -137,7 +137,7 @@ mkTestExts :: [Extension] -> [String] -> Maybe [(String, Int)] -> SolverTest -mkTestExts exts = mkTestExtLang exts [] +mkTestExts exts = mkTestExtLang (Just exts) Nothing mkTestLangs :: [Language] -> ExampleDb @@ -145,10 +145,10 @@ mkTestLangs :: [Language] -> [String] -> Maybe [(String, Int)] -> SolverTest -mkTestLangs = mkTestExtLang [] +mkTestLangs = mkTestExtLang Nothing . Just -mkTestExtLang :: [Extension] - -> [Language] +mkTestExtLang :: Maybe [Extension] + -> Maybe [Language] -> ExampleDb -> String -> [String] From 1727f43a23c046525d1438ff9f60bb9cb56f3ee5 Mon Sep 17 00:00:00 2001 From: Kristen Kozak Date: Wed, 13 Jan 2016 11:21:44 -0800 Subject: [PATCH 7/7] Test the solver's use of the Buildable field. --- .../Client/Dependency/Modular/Solver.hs | 61 +++++++++++++++++++ 1 file changed, 61 insertions(+) diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs index 48fa662756c..82febe45d62 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs @@ -101,6 +101,13 @@ tests = [ , runTest $ soft [ ExPref "A" $ mkvrThis 1 , ExPref "A" $ mkvrOrEarlier 2] $ mkTest db13 "selectPreferredVersionMultiple4" ["A"] (Just [("A", 1)]) ] + , testGroup "Buildable Field" [ + testBuildable "avoid building component with unknown dependency" (ExAny "unknown") + , testBuildable "avoid building component with unknown extension" (ExExt (UnknownExtension "unknown")) + , testBuildable "avoid building component with unknown language" (ExLang (UnknownLanguage "unknown")) + , runTest $ mkTest dbBuildable1 "choose flags that set buildable to false" ["pkg"] (Just [("flag1-true", 1), ("flag2-false", 1), ("pkg", 1)]) + , runTest $ mkTest dbBuildable2 "choose version that sets buildable to false" ["A"] (Just [("A", 1), ("B", 2)]) + ] ] where indep test = test { testIndepGoals = True } @@ -433,6 +440,60 @@ dbLangs1 = [ , Right $ exAv "C" 1 [ExLang (UnknownLanguage "Haskell3000"), ExAny "B"] ] +-- | cabal must choose +disable-lib for "pkg" in order to avoid the unavailable +-- dependency. False is the default. The flag choice causes "pkg" to depend on +-- "true-dep". +testBuildable :: String -> ExampleDependency -> TestTree +testBuildable testName unavailableDep = + runTest $ mkTestExtLang (Just []) (Just []) db testName ["pkg"] expected + where + expected = (Just [("pkg", 1), ("true-dep", 1)]) + db = [ + Right $ exAv "pkg" 1 [ + unavailableDep + , ExFlag "disable-lib" NotBuildable (Buildable []) + , ExTest "test" [exFlag "disable-lib" + [ExAny "true-dep"] + [ExAny "false-dep"]] + ] + , Right $ exAv "true-dep" 1 [] + , Right $ exAv "false-dep" 1 [] + ] + +-- | cabal must choose +flag1 -flag2 for "pkg", which requires packages +-- "flag1-true" and "flag2-false". +dbBuildable1 :: ExampleDb +dbBuildable1 = [ + Right $ exAv "pkg" 1 + [ ExAny "unknown" + , ExFlag "flag1" NotBuildable (Buildable []) + , ExFlag "flag2" NotBuildable (Buildable []) + , ExTest "optional-test" + [ ExAny "unknown" + , ExFlag "flag1" + (Buildable [ExFlag "flag2" (Buildable []) NotBuildable]) + (Buildable [])] + , ExTest "test" [ exFlag "flag1" [ExAny "flag1-true"] [ExAny "flag1-false"] + , exFlag "flag2" [ExAny "flag2-true"] [ExAny "flag2-false"]] + ] + , Right $ exAv "flag1-true" 1 [] + , Right $ exAv "flag1-false" 1 [] + , Right $ exAv "flag2-true" 1 [] + , Right $ exAv "flag2-false" 1 [] + ] + +-- | cabal must pick B-2 to avoid the unknown dependency. +dbBuildable2 :: ExampleDb +dbBuildable2 = [ + Right $ exAv "A" 1 [ExAny "B"] + , Right $ exAv "B" 1 [ExAny "unknown"] + , Right $ exAv "B" 2 + [ ExAny "unknown" + , ExFlag "disable-lib" NotBuildable (Buildable []) + ] + , Right $ exAv "B" 3 [ExAny "unknown"] + ] + {------------------------------------------------------------------------------- Test options -------------------------------------------------------------------------------}