Commit 8f32ab44 authored by Mikhail Glushenkov's avatar Mikhail Glushenkov Committed by GitHub
Browse files

Merge pull request #3510 from grayjay/issue-3489

Add a goal order parameter to the dependency solver
parents efe23a9a bfdcd7ee
......@@ -54,6 +54,7 @@ module Distribution.Client.Dependency (
setStrongFlags,
setMaxBackjumps,
setEnableBackjumping,
setGoalOrder,
addSourcePackages,
hideInstalledPackagesSpecificByUnitId,
hideInstalledPackagesSpecificBySourcePackageId,
......@@ -119,6 +120,7 @@ import Distribution.Solver.Types.InstalledPreference
import Distribution.Solver.Types.LabeledPackageConstraint
import Distribution.Solver.Types.OptionalStanza
import Distribution.Solver.Types.PackageConstraint
import Distribution.Solver.Types.PackagePath
import Distribution.Solver.Types.PackagePreferences
import qualified Distribution.Solver.Types.PackageIndex as PackageIndex
import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb)
......@@ -128,6 +130,7 @@ import Distribution.Solver.Types.Settings
import Distribution.Solver.Types.SolverId
import Distribution.Solver.Types.SolverPackage
import Distribution.Solver.Types.SourcePackage
import Distribution.Solver.Types.Variable
import Data.List
( foldl', sort, sortBy, nubBy, maximumBy, intercalate, nub )
......@@ -161,7 +164,10 @@ data DepResolverParams = DepResolverParams {
depResolverShadowPkgs :: ShadowPkgs,
depResolverStrongFlags :: StrongFlags,
depResolverMaxBackjumps :: Maybe Int,
depResolverEnableBackjumping :: EnableBackjumping
depResolverEnableBackjumping :: EnableBackjumping,
-- | Function to override the solver's goal-ordering heuristics.
depResolverGoalOrder :: Maybe (Variable QPN -> Variable QPN -> Ordering)
}
showDepResolverParams :: DepResolverParams -> String
......@@ -233,7 +239,8 @@ basicDepResolverParams installedPkgIndex sourcePkgIndex =
depResolverShadowPkgs = ShadowPkgs False,
depResolverStrongFlags = StrongFlags False,
depResolverMaxBackjumps = Nothing,
depResolverEnableBackjumping = EnableBackjumping True
depResolverEnableBackjumping = EnableBackjumping True,
depResolverGoalOrder = Nothing
}
addTargets :: [PackageName]
......@@ -308,6 +315,14 @@ setEnableBackjumping b params =
depResolverEnableBackjumping = b
}
setGoalOrder :: Maybe (Variable QPN -> Variable QPN -> Ordering)
-> DepResolverParams
-> DepResolverParams
setGoalOrder order params =
params {
depResolverGoalOrder = order
}
-- | Some packages are specific to a given compiler version and should never be
-- upgraded.
dontUpgradeNonUpgradeablePackages :: DepResolverParams -> DepResolverParams
......@@ -607,7 +622,7 @@ resolveDependencies platform comp pkgConfigDB solver params =
Step (showDepResolverParams finalparams)
$ fmap (validateSolverResult platform comp indGoals)
$ runSolver solver (SolverConfig reorderGoals indGoals noReinstalls
shadowing strFlags maxBkjumps enableBj)
shadowing strFlags maxBkjumps enableBj order)
platform comp installedPkgIndex sourcePkgIndex
pkgConfigDB preferences constraints targets
where
......@@ -623,7 +638,8 @@ resolveDependencies platform comp pkgConfigDB solver params =
shadowing
strFlags
maxBkjumps
enableBj) = dontUpgradeNonUpgradeablePackages
enableBj
order) = dontUpgradeNonUpgradeablePackages
-- TODO:
-- The modular solver can properly deal with broken
-- packages and won't select them. So the
......@@ -858,7 +874,7 @@ resolveWithoutDependencies :: DepResolverParams
resolveWithoutDependencies (DepResolverParams targets constraints
prefs defpref installedPkgIndex sourcePkgIndex
_reorderGoals _indGoals _avoidReinstalls
_shadowing _strFlags _maxBjumps _enableBj) =
_shadowing _strFlags _maxBjumps _enableBj _order) =
collectEithers (map selectPackage targets)
where
selectPackage :: PackageName -> Either ResolveNoDepsError UnresolvedSourcePackage
......
......@@ -35,6 +35,7 @@ module Distribution.Solver.Modular.Dependency (
, GoalReason(..)
, QGoalReason
, ResetVar(..)
, goalToVar
, goalVarToConflictSet
, varToConflictSet
, goalReasonToVars
......@@ -361,6 +362,9 @@ instance ResetVar Dep where
instance ResetVar Var where
resetVar = const
goalToVar :: Goal a -> Var a
goalToVar (Goal v _) = v
-- | Compute a singleton conflict set from a goal, containing just
-- the goal variable.
--
......
......@@ -13,10 +13,12 @@ module Distribution.Solver.Modular.Preference
, preferPackagePreferences
, preferReallyEasyGoalChoices
, requireInstalled
, sortGoals
) where
-- Reordering or pruning the tree in order to prefer or make certain choices.
import Data.Function (on)
import qualified Data.List as L
import qualified Data.Map as M
#if !MIN_VERSION_base(4,8,0)
......@@ -35,6 +37,7 @@ import Distribution.Solver.Types.OptionalStanza
import Distribution.Solver.Types.PackageConstraint
import Distribution.Solver.Types.PackagePath
import Distribution.Solver.Types.PackagePreferences
import Distribution.Solver.Types.Variable
import Distribution.Solver.Modular.Dependency
import Distribution.Solver.Modular.Flag
......@@ -191,8 +194,8 @@ processPackageConstraintS s c b' (LabeledPackageConstraint pc src) r = go pc
-- by selectively disabling choices that have been ruled out by global user
-- constraints.
enforcePackageConstraints :: M.Map PN [LabeledPackageConstraint]
-> Tree QGoalReason
-> Tree QGoalReason
-> Tree a
-> Tree a
enforcePackageConstraints pcs = trav go
where
go (PChoiceF qpn@(Q pp pn) gr ts) =
......@@ -220,7 +223,7 @@ enforcePackageConstraints pcs = trav go
-- be run after user preferences have been enforced. For manual flags,
-- it checks if a user choice has been made. If not, it disables all but
-- the first choice.
enforceManualFlags :: Tree QGoalReason -> Tree QGoalReason
enforceManualFlags :: Tree a -> Tree a
enforceManualFlags = trav go
where
go (FChoiceF qfn gr tr True ts) = FChoiceF qfn gr tr True $
......@@ -234,7 +237,7 @@ enforceManualFlags = trav go
go x = x
-- | Require installed packages.
requireInstalled :: (PN -> Bool) -> Tree QGoalReason -> Tree QGoalReason
requireInstalled :: (PN -> Bool) -> Tree a -> Tree a
requireInstalled p = trav go
where
go (PChoiceF v@(Q _ pn) gr cs)
......@@ -258,7 +261,7 @@ requireInstalled p = trav go
-- they are, perhaps this should just result in trying to reinstall those other
-- packages as well. However, doing this all neatly in one pass would require to
-- change the builder, or at least to change the goal set after building.
avoidReinstalls :: (PN -> Bool) -> Tree QGoalReason -> Tree QGoalReason
avoidReinstalls :: (PN -> Bool) -> Tree a -> Tree a
avoidReinstalls p = trav go
where
go (PChoiceF qpn@(Q _ pn) gr cs)
......@@ -275,6 +278,21 @@ avoidReinstalls p = trav go
x
go x = x
-- | Sort all goals using the provided function.
sortGoals :: (Variable QPN -> Variable QPN -> Ordering) -> Tree a -> Tree a
sortGoals variableOrder = trav go
where
go (GoalChoiceF xs) = GoalChoiceF (P.sortByKeys goalOrder xs)
go x = x
goalOrder :: Goal QPN -> Goal QPN -> Ordering
goalOrder = variableOrder `on` (varToVariable . goalToVar)
varToVariable :: Var QPN -> Variable QPN
varToVariable (P qpn) = PackageVar qpn
varToVariable (F (FN (PI qpn _) fn)) = FlagVar qpn fn
varToVariable (S (SN (PI qpn _) stanza)) = StanzaVar qpn stanza
-- | Always choose the first goal in the list next, abandoning all
-- other choices.
--
......@@ -371,10 +389,10 @@ type EnforceSIR = Reader (Map (PI PN) QPN)
-- (that is, package name + package version) there can be at most one qualified
-- goal resolving to that instance (there may be other goals _linking_ to that
-- instance however).
enforceSingleInstanceRestriction :: Tree QGoalReason -> Tree QGoalReason
enforceSingleInstanceRestriction :: Tree a -> Tree a
enforceSingleInstanceRestriction = (`runReader` M.empty) . cata go
where
go :: TreeF QGoalReason (EnforceSIR (Tree QGoalReason)) -> EnforceSIR (Tree QGoalReason)
go :: TreeF a (EnforceSIR (Tree a)) -> EnforceSIR (Tree a)
-- We just verify package choices.
go (PChoiceF qpn gr cs) =
......@@ -383,7 +401,7 @@ enforceSingleInstanceRestriction = (`runReader` M.empty) . cata go
innM _otherwise
-- The check proper
goP :: QPN -> POption -> EnforceSIR (Tree QGoalReason) -> EnforceSIR (Tree QGoalReason)
goP :: QPN -> POption -> EnforceSIR (Tree a) -> EnforceSIR (Tree a)
goP qpn@(Q _ pn) (POption i linkedTo) r = do
let inst = PI pn i
env <- ask
......
......@@ -19,6 +19,7 @@ import Distribution.Solver.Types.PackagePreferences
import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb)
import Distribution.Solver.Types.LabeledPackageConstraint
import Distribution.Solver.Types.Settings
import Distribution.Solver.Types.Variable
import Distribution.Solver.Modular.Assignment
import Distribution.Solver.Modular.Builder
......@@ -56,7 +57,8 @@ data SolverConfig = SolverConfig {
shadowPkgs :: ShadowPkgs,
strongFlags :: StrongFlags,
maxBackjumps :: Maybe Int,
enableBackjumping :: EnableBackjumping
enableBackjumping :: EnableBackjumping,
goalOrder :: Maybe (Variable QPN -> Variable QPN -> Ordering)
}
-- | Run all solver phases.
......@@ -103,15 +105,22 @@ solve sc cinfo idx pkgConfigDB userPrefs userConstraints userGoals =
where
explorePhase = backjumpAndExplore (enableBackjumping sc)
detectCycles = traceTree "cycles.json" id . detectCyclesPhase
heuristicsPhase = (if asBool (preferEasyGoalChoices sc)
then P.preferEasyGoalChoices -- also leaves just one choice
else P.firstGoal) . -- after doing goal-choice heuristics, commit to the first choice (saves space)
traceTree "heuristics.json" id .
P.deferWeakFlagChoices .
P.deferSetupChoices .
P.preferBaseGoalChoice .
P.preferLinked
preferencesPhase = P.preferPackagePreferences userPrefs
heuristicsPhase =
let heuristicsTree = traceTree "heuristics.json" id
in case goalOrder sc of
Nothing -> (if asBool (preferEasyGoalChoices sc)
then P.preferEasyGoalChoices -- also leaves just one choice
else P.firstGoal) . -- after doing goal-choice heuristics,
-- commit to the first choice (saves space)
heuristicsTree .
P.deferWeakFlagChoices .
P.deferSetupChoices .
P.preferBaseGoalChoice
Just order -> P.firstGoal .
heuristicsTree .
P.sortGoals order
preferencesPhase = P.preferLinked .
P.preferPackagePreferences userPrefs
validationPhase = traceTree "validated.json" id .
P.enforceManualFlags . -- can only be done after user constraints
P.enforcePackageConstraints userConstraints .
......
module Distribution.Solver.Types.Variable where
import Distribution.Solver.Types.OptionalStanza
import Distribution.PackageDescription (FlagName)
-- | Variables used by the dependency solver. This type is similar to the
-- internal 'Var' type, except that flags and stanzas are associated with
-- package names instead of package instances.
data Variable qpn =
PackageVar qpn
| FlagVar qpn FlagName
| StanzaVar qpn OptionalStanza
deriving Eq
......@@ -281,6 +281,7 @@ executable cabal
Distribution.Solver.Types.SolverId
Distribution.Solver.Types.SolverPackage
Distribution.Solver.Types.SourcePackage
Distribution.Solver.Types.Variable
Distribution.Solver.Modular
Distribution.Solver.Modular.Assignment
Distribution.Solver.Modular.Builder
......
......@@ -11,6 +11,8 @@ module UnitTests.Distribution.Solver.Modular.DSL (
, ExamplePkgName
, ExampleAvailable(..)
, ExampleInstalled(..)
, ExampleQualifier(..)
, ExampleVar(..)
, exAv
, exInst
, exFlag
......@@ -23,9 +25,10 @@ module UnitTests.Distribution.Solver.Modular.DSL (
-- base
import Data.Either (partitionEithers)
import Data.Maybe (catMaybes)
import Data.List (nub)
import Data.Maybe (catMaybes, isNothing)
import Data.List (elemIndex, nub)
import Data.Monoid
import Data.Ord (comparing)
import Data.Version
import qualified Data.Map as Map
......@@ -52,10 +55,12 @@ import Distribution.Solver.Types.ConstraintSource
import Distribution.Solver.Types.LabeledPackageConstraint
import Distribution.Solver.Types.OptionalStanza
import qualified Distribution.Solver.Types.PackageIndex as CI.PackageIndex
import qualified Distribution.Solver.Types.PackagePath as P
import qualified Distribution.Solver.Types.PkgConfigDb as PC
import Distribution.Solver.Types.Settings
import Distribution.Solver.Types.SolverPackage
import Distribution.Solver.Types.SourcePackage
import Distribution.Solver.Types.Variable
{-------------------------------------------------------------------------------
Example package database DSL
......@@ -143,6 +148,17 @@ data ExampleAvailable = ExAv {
, exAvDeps :: ComponentDeps [ExampleDependency]
} deriving Show
data ExampleVar =
P ExampleQualifier ExamplePkgName
| F ExampleQualifier ExamplePkgName ExampleFlagName
| S ExampleQualifier ExamplePkgName OptionalStanza
data ExampleQualifier =
None
| Indep Int
| Setup ExamplePkgName
| IndepSetup Int ExamplePkgName
-- | Constructs an 'ExampleAvailable' package for the 'ExampleDb',
-- given:
--
......@@ -398,10 +414,11 @@ exResolve :: ExampleDb
-> IndependentGoals
-> ReorderGoals
-> EnableBackjumping
-> Maybe [ExampleVar]
-> [ExPreference]
-> ([String], Either String CI.InstallPlan.SolverInstallPlan)
exResolve db exts langs pkgConfigDb targets solver mbj indepGoals reorder
enableBj prefs
enableBj vars prefs
= runProgress $ resolveDependencies C.buildPlatform
compiler pkgConfigDb
solver
......@@ -427,10 +444,34 @@ exResolve db exts langs pkgConfigDb targets solver mbj indepGoals reorder
$ setReorderGoals reorder
$ setMaxBackjumps mbj
$ setEnableBackjumping enableBj
$ setGoalOrder goalOrder
$ standardInstallPolicy instIdx avaiIdx targets'
toLpc pc = LabeledPackageConstraint pc ConstraintSourceUnknown
toPref (ExPref n v) = PackageVersionPreference (C.PackageName n) v
goalOrder :: Maybe (Variable P.QPN -> Variable P.QPN -> Ordering)
goalOrder = (orderFromList . map toVariable) `fmap` vars
-- Sort elements in the list ahead of elements not in the list. Otherwise,
-- follow the order in the list.
orderFromList :: Eq a => [a] -> a -> a -> Ordering
orderFromList xs =
comparing $ \x -> let i = elemIndex x xs in (isNothing i, i)
toVariable :: ExampleVar -> Variable P.QPN
toVariable (P q pn) = PackageVar (toQPN q pn)
toVariable (F q pn fn) = FlagVar (toQPN q pn) (C.FlagName fn)
toVariable (S q pn stanza) = StanzaVar (toQPN q pn) stanza
toQPN :: ExampleQualifier -> ExamplePkgName -> P.QPN
toQPN q pn = P.Q pp (C.PackageName pn)
where
pp = case q of
None -> P.PackagePath P.DefaultNamespace P.Unqualified
Indep x -> P.PackagePath (P.Independent x) P.Unqualified
Setup p -> P.PackagePath P.DefaultNamespace (P.Setup (C.PackageName p))
IndepSetup x p -> P.PackagePath (P.Independent x) (P.Setup (C.PackageName p))
extractInstallPlan :: CI.InstallPlan.SolverInstallPlan
-> [(ExamplePkgName, ExamplePkgVersion)]
extractInstallPlan = catMaybes . map confPkg . CI.InstallPlan.toList
......
......@@ -102,7 +102,7 @@ solve enableBj reorder indep solver targets (TestDb db) =
-- The backjump limit prevents individual tests from using
-- too much time and memory.
(Just defaultMaxBackjumps)
indep reorder enableBj []
indep reorder enableBj Nothing []
failure :: String -> Failure
failure msg
......@@ -223,12 +223,12 @@ arbitraryComponentDep :: TestDb -> Gen (ComponentDep [ExampleDependency])
arbitraryComponentDep db = do
comp <- arbitrary
deps <- case comp of
ComponentSetup -> smallListOf (arbitraryExDep db Setup)
_ -> boundedListOf 5 (arbitraryExDep db NonSetup)
ComponentSetup -> smallListOf (arbitraryExDep db SetupDep)
_ -> boundedListOf 5 (arbitraryExDep db NonSetupDep)
return (comp, deps)
-- | Location of an 'ExampleDependency'. It determines which values are valid.
data ExDepLocation = Setup | NonSetup
data ExDepLocation = SetupDep | NonSetupDep
arbitraryExDep :: TestDb -> ExDepLocation -> Gen ExampleDependency
arbitraryExDep db@(TestDb pkgs) level =
......@@ -247,13 +247,13 @@ arbitraryExDep db@(TestDb pkgs) level =
]
in oneof $
case level of
NonSetup -> flag : other
Setup -> other
NonSetupDep -> flag : other
SetupDep -> other
arbitraryDeps :: TestDb -> Gen Dependencies
arbitraryDeps db = frequency
[ (1, return NotBuildable)
, (20, Buildable <$> smallListOf (arbitraryExDep db NonSetup))
, (20, Buildable <$> smallListOf (arbitraryExDep db NonSetupDep))
]
arbitraryFlagName :: Gen String
......
......@@ -18,6 +18,7 @@ import Language.Haskell.Extension ( Extension(..)
, KnownExtension(..), Language(..))
-- cabal-install
import Distribution.Solver.Types.OptionalStanza
import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb, pkgConfigDbFromList)
import Distribution.Solver.Types.Settings
import Distribution.Client.Dependency.Types
......@@ -133,9 +134,9 @@ tests = [
]
, testGroup "Independent goals" [
runTest $ indep $ mkTest db16 "indepGoals1" ["A", "B"] (SolverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2), ("E", 1)])
, runTest $ indep $ mkTest db17 "indepGoals2" ["A", "B"] (SolverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1)])
, runTest $ indep $ mkTest db19 "indepGoals3" ["D", "E", "F"] anySolverFailure -- The target order is important.
, runTest $ indep $ mkTest db20 "indepGoals4" ["C", "A", "B"] (SolverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2)])
, runTest $ testIndepGoals2 "indepGoals2"
, runTest $ testIndepGoals3 "indepGoals3"
, runTest $ testIndepGoals4 "indepGoals4"
, runTest $ indep $ mkTest db23 "indepGoals5" ["X", "Y"] (SolverSuccess [("A", 1), ("A", 2), ("B", 1), ("C", 1), ("C", 2), ("X", 1), ("Y", 1)])
, runTest $ indep $ mkTest db24 "indepGoals6" ["X", "Y"] (SolverSuccess [("A", 1), ("A", 2), ("B", 1), ("B", 2), ("X", 1), ("Y", 1)])
]
......@@ -154,15 +155,20 @@ tests = [
]
]
where
-- | Combinator to turn on --independent-goals behavior, i.e. solve
-- for the goals as if we were solving for each goal independently.
-- (This doesn't really work well at the moment, see #2842)
indep test = test { testIndepGoals = IndependentGoals True }
soft prefs test = test { testSoftConstraints = prefs }
mkvrThis = V.thisVersion . makeV
mkvrOrEarlier = V.orEarlierVersion . makeV
makeV v = V.Version [v,0,0] []
-- | Combinator to turn on --independent-goals behavior, i.e. solve
-- for the goals as if we were solving for each goal independently.
-- (This doesn't really work well at the moment, see #2842)
indep :: SolverTest -> SolverTest
indep test = test { testIndepGoals = IndependentGoals True }
goalOrder :: [ExampleVar] -> SolverTest -> SolverTest
goalOrder order test = test { testGoalOrder = Just order }
{-------------------------------------------------------------------------------
Solver tests
-------------------------------------------------------------------------------}
......@@ -172,6 +178,7 @@ data SolverTest = SolverTest {
, testTargets :: [String]
, testResult :: SolverResult
, testIndepGoals :: IndependentGoals
, testGoalOrder :: Maybe [ExampleVar]
, testSoftConstraints :: [ExPreference]
, testDb :: ExampleDb
, testSupportedExts :: Maybe [Extension]
......@@ -246,6 +253,7 @@ mkTestExtLangPC exts langs pkgConfigDb db label targets result = SolverTest {
, testTargets = targets
, testResult = result
, testIndepGoals = IndependentGoals False
, testGoalOrder = Nothing
, testSoftConstraints = []
, testDb = db
, testSupportedExts = exts
......@@ -259,7 +267,7 @@ runTest SolverTest{..} = askOption $ \(OptionShowSolverLog showSolverLog) ->
let (_msgs, result) = exResolve testDb testSupportedExts
testSupportedLangs testPkgConfigDb testTargets
Modular Nothing testIndepGoals (ReorderGoals False)
(EnableBackjumping True) testSoftConstraints
(EnableBackjumping True) testGoalOrder testSoftConstraints
when showSolverLog $ mapM_ putStrLn _msgs
case result of
Left err -> assertBool ("Unexpected error:\n" ++ err) (check testResult err)
......@@ -602,23 +610,41 @@ db16 = [
, Right $ exAv "E" 1 []
]
-- | This database checks that when the solver discovers a constraint on a
-- | This test checks that when the solver discovers a constraint on a
-- package's version after choosing to link that package, it can backtrack to
-- try alternative versions for the linked-to package. See pull request #3327.
--
-- When A and B are installed as independent goals, their dependencies on C
-- must be linked. Since C depends on D, A and B's dependencies on D must also
-- be linked. This test relies on the fact that the solver chooses D-2 for both
-- 0.D and 1.D before it encounters the test suites' constraints. The solver
-- must backtrack to try D-1 for both 0.D and 1.D.
db17 :: ExampleDb
db17 = [
Right $ exAv "A" 1 [ExAny "C"] `withTest` ExTest "test" [ExFix "D" 1]
, Right $ exAv "B" 1 [ExAny "C"] `withTest` ExTest "test" [ExFix "D" 1]
, Right $ exAv "C" 1 [ExAny "D"]
, Right $ exAv "D" 1 []
, Right $ exAv "D" 2 []
]
-- be linked. This test fixes the goal order so that the solver chooses D-2 for
-- both 0.D and 1.D before it encounters the test suites' constraints. The
-- solver must backtrack to try D-1 for both 0.D and 1.D.
testIndepGoals2 :: String -> SolverTest
testIndepGoals2 name =
goalOrder goals $ indep $
mkTest db name ["A", "B"] $
SolverSuccess [("A", 1), ("B", 1), ("C", 1), ("D", 1)]
where
db :: ExampleDb
db = [
Right $ exAv "A" 1 [ExAny "C"] `withTest` ExTest "test" [ExFix "D" 1]
, Right $ exAv "B" 1 [ExAny "C"] `withTest` ExTest "test" [ExFix "D" 1]
, Right $ exAv "C" 1 [ExAny "D"]
, Right $ exAv "D" 1 []
, Right $ exAv "D" 2 []
]
goals :: [ExampleVar]
goals = [
P (Indep 0) "A"
, P (Indep 0) "C"
, P (Indep 0) "D"
, P (Indep 1) "B"
, P (Indep 1) "C"
, P (Indep 1) "D"
, S (Indep 1) "B" TestStanzas
, S (Indep 0) "A" TestStanzas
]
-- | Issue #2834
-- When both A and B are installed as independent goals, their dependencies on
......@@ -676,34 +702,76 @@ db18 = [
-- > \ | \ / | /
-- > \| V |/
-- > D F E
db19 :: ExampleDb
db19 = [
Right $ exAv "A" 1 [ExAny "C"]
, Right $ exAv "B" 1 [ExAny "C"]
, Right $ exAv "C" 1 []
, Right $ exAv "C" 2 []
, Right $ exAv "D" 1 [ExAny "A", ExFix "C" 1]
, Right $ exAv "E" 1 [ExAny "B", ExFix "C" 2]
, Right $ exAv "F" 1 [ExAny "A", ExAny "B"]
]
testIndepGoals3 :: String -> SolverTest
testIndepGoals3 name =
goalOrder goals $ indep $
mkTest db name ["D", "E", "F"] anySolverFailure
where
db :: ExampleDb
db = [
Right $ exAv "A" 1 [ExAny "C"]
, Right $ exAv "B" 1 [ExAny "C"]
, Right $ exAv "C" 1 []
, Right $ exAv "C" 2 []
, Right $ exAv "D" 1 [ExAny "A", ExFix "C" 1]
, Right $ exAv "E" 1 [ExAny "B", ExFix "C" 2]
, Right $ exAv "F" 1 [ExAny "A", ExAny "B"]
]
goals :: [ExampleVar]
goals = [
P (Indep 0) "D"
, P (Indep 0) "C"
, P (Indep 0) "A"
, P (Indep 1) "E"
, P (Indep 1) "C"
, P (Indep 1) "B"
, P (Indep 2) "F"
, P (Indep 2) "B"
, P (Indep 2) "C"
, P (Indep 2) "A"
]
-- | This database tests that the solver correctly backjumps when dependencies
-- | This test checks that the solver correctly backjumps when dependencies
-- of linked packages are not linked. It is an example where the conflict set
-- from enforcing the single instance restriction is not sufficient. See pull
-- request #3327.