From 37978a6c61ffaf09d424e4d6ac73b333eb978b77 Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Wed, 9 Mar 2016 10:24:12 +0800 Subject: [PATCH 1/2] Introduce unit tests that illustrate the problem In #3170 we introduced a cycle check to the solver. This check is necessary to reject cycling solutions (which would previously have resulted in an internal error when we verify the install plan). However, this by itself is not sufficient. If we have a cycle through setup dependencies, the solver loops because it starts building an infinite tree. This is explained in detail in In this commit we just add some unit tests that provide a minimal example that exposes the bug. --- .../Client/Dependency/Modular/Solver.hs | 34 +++++++++++++++++-- 1 file changed, 31 insertions(+), 3 deletions(-) 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 c3c3f999137..4277295bc18 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs @@ -74,9 +74,14 @@ tests = [ , runTest $ mkTest db12 "baseShim6" ["E"] (Just [("E", 1), ("syb", 2)]) ] , testGroup "Cycles" [ - runTest $ mkTest db14 "simpleCycle1" ["A"] Nothing - , runTest $ mkTest db14 "simpleCycle2" ["A", "B"] Nothing - , runTest $ mkTest db14 "cycleWithFlagChoice1" ["C"] (Just [("C", 1), ("E", 1)]) + runTest $ mkTest db14 "simpleCycle1" ["A"] Nothing + , runTest $ mkTest db14 "simpleCycle2" ["A", "B"] Nothing + , runTest $ mkTest db14 "cycleWithFlagChoice1" ["C"] (Just [("C", 1), ("E", 1)]) + , runTest $ mkTest db15 "cycleThroughSetupDep1" ["A"] Nothing + , runTest $ mkTest db15 "cycleThroughSetupDep2" ["B"] Nothing +-- , runTest $ mkTest db15 "cycleThroughSetupDep3" ["C"] Nothing -- TODO +-- , runTest $ mkTest db15 "cycleThroughSetupDep4" ["D"] Nothing -- TODO + , runTest $ mkTest db15 "cycleThroughSetupDep5" ["E"] (Just [("C", 2), ("D", 1), ("E", 1)]) ] , testGroup "Extensions" [ runTest $ mkTestExts [EnableExtension CPP] dbExts1 "unsupported" ["A"] Nothing @@ -460,6 +465,29 @@ db14 = [ , Right $ exAv "E" 1 [] ] +-- | Cycles through setup dependencies +-- +-- The first cycle is unsolvable: package A has a setup dependency on B, +-- B has a regular dependency on A, and we only have a single version available +-- for both. +-- +-- The second cycle can be broken by picking different versions: package C-2.0 +-- has a setup dependency on D, and D has a regular dependency on C-*. However, +-- version C-1.0 is already available (perhaps it didn't have this setup dep). +-- Thus, we should be able to break this cycle even if we are installing package +-- E, which explictly depends on C-2.0. +db15 :: ExampleDb +db15 = [ + -- First example (real cycle, no solution) + Right $ exAv "A" 1 [] `withSetupDeps` [ExAny "B"] + , Right $ exAv "B" 1 [ExAny "A"] + -- Second example (cycle can be broken by picking versions carefully) + , Left $ exInst "C" 1 "C-1-inst" [] + , Right $ exAv "C" 2 [] `withSetupDeps` [ExAny "D"] + , Right $ exAv "D" 1 [ExAny "C" ] + , Right $ exAv "E" 1 [ExFix "C" 2] + ] + dbExts1 :: ExampleDb dbExts1 = [ Right $ exAv "A" 1 [ExExt (EnableExtension RankNTypes)] From 3d2ad8e0a9ffc4db40719e046583a9da0fe5316b Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Thu, 10 Mar 2016 14:50:54 +0800 Subject: [PATCH 2/2] Change structure of package paths A package path now consists of a namespace and a qualifier. The namespace is either DefaultNamespace or Independent _i_, for some _i_; this is used for independent top-level goals. Then the qualifier is either Unqualified (default), Setup _pn_ for the setup dependencies of package _pn_, or Base _pn_, for a dependency on base by package _pn_ (used only when we detect the presence of a base shim). Qualifiers are not tested anymore. This avoids non-termination in the solver. The unit tests now pass. --- .../Client/Dependency/Modular/Builder.hs | 2 +- .../Client/Dependency/Modular/Dependency.hs | 25 +++-- .../Client/Dependency/Modular/Package.hs | 93 ++++++++++++------- .../Client/Dependency/Modular/Preference.hs | 4 +- .../Client/Dependency/Modular/Solver.hs | 4 +- 5 files changed, 83 insertions(+), 45 deletions(-) diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Builder.hs b/cabal-install/Distribution/Client/Dependency/Modular/Builder.hs index 2bea5b80afe..9f356a6d097 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/Builder.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/Builder.hs @@ -180,4 +180,4 @@ buildTree idx ind igs = topLevelGoal qpn = OpenGoal (Simple (Dep qpn (Constrained [])) ()) [UserGoal] qpns | ind = makeIndependent igs - | otherwise = L.map (Q None) igs + | otherwise = L.map (Q (PP DefaultNamespace Unqualified)) igs diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs b/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs index b352d1e1a34..11b5235588a 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs @@ -232,12 +232,8 @@ data QualifyOptions = QO { -- NOTE: It's the _dependencies_ of a package that may or may not be independent -- from the package itself. Package flag choices must of course be consistent. qualifyDeps :: QualifyOptions -> QPN -> FlaggedDeps Component PN -> FlaggedDeps Component QPN -qualifyDeps QO{..} (Q pp' pn) = go +qualifyDeps QO{..} (Q pp@(PP ns q) pn) = go where - -- The Base qualifier does not get inherited - pp :: PP - pp = (if qoBaseShim then stripBase else id) pp' - go :: FlaggedDeps Component PN -> FlaggedDeps Component QPN go = map go1 @@ -259,9 +255,22 @@ qualifyDeps QO{..} (Q pp' pn) = go goD (Lang lang) _ = Lang lang goD (Pkg pkn vr) _ = Pkg pkn vr goD (Dep dep ci) comp - | qBase dep = Dep (Q (Base pn pp) dep) (fmap (Q pp) ci) - | qSetup comp = Dep (Q (Setup pn pp) dep) (fmap (Q pp) ci) - | otherwise = Dep (Q pp dep) (fmap (Q pp) ci) + | qBase dep = Dep (Q (PP ns (Base pn)) dep) (fmap (Q pp) ci) + | qSetup comp = Dep (Q (PP ns (Setup pn)) dep) (fmap (Q pp) ci) + | otherwise = Dep (Q (PP ns inheritedQ) dep) (fmap (Q pp) ci) + + -- If P has a setup dependency on Q, and Q has a regular dependency on R, then + -- we say that the 'Setup' qualifier is inherited: P has an (indirect) setup + -- dependency on R. We do not do this for the base qualifier however. + -- + -- The inherited qualifier is only used for regular dependencies; for setup + -- and base deppendencies we override the existing qualifier. See #3160 for + -- a detailed discussion. + inheritedQ :: Qualifier + inheritedQ = case q of + Setup _ -> q + Unqualified -> q + Base _ -> Unqualified -- Should we qualify this goal with the 'Base' package path? qBase :: PN -> Bool diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Package.hs b/cabal-install/Distribution/Client/Dependency/Modular/Package.hs index 4fc8f7abeb9..ef903f19d15 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/Package.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/Package.hs @@ -8,6 +8,8 @@ module Distribution.Client.Dependency.Modular.Package , PI(..) , PN , PP(..) + , Namespace(..) + , Qualifier(..) , QPN , QPV , Q(..) @@ -17,7 +19,6 @@ module Distribution.Client.Dependency.Modular.Package , showI , showPI , showQPN - , stripBase , unPN ) where @@ -81,46 +82,75 @@ instI :: I -> Bool instI (I _ (Inst _)) = True instI _ = False --- | Package path. --- --- Stored in reverse order -data PP = - -- User-specified independent goal - Independent Int PP - -- Setup dependencies are always considered independent from their package - | Setup PN PP - -- Any dependency on base is considered independent (allows for base shims) - | Base PN PP - -- Unqualified - | None +-- | A package path consists of a namespace and a package path inside that +-- namespace. +data PP = PP Namespace Qualifier deriving (Eq, Ord, Show) --- | Strip any 'Base' qualifiers from a PP +-- | Top-level namespace -- --- (the Base qualifier does not get inherited) -stripBase :: PP -> PP -stripBase (Independent i pp) = Independent i (stripBase pp) -stripBase (Setup pn pp) = Setup pn (stripBase pp) -stripBase (Base _pn pp) = stripBase pp -stripBase None = None +-- Package choices in different namespaces are considered completely independent +-- by the solver. +data Namespace = + -- | The default namespace + DefaultNamespace + + -- | Independent namespace + -- + -- For now we just number these (rather than giving them more structure). + | Independent Int + deriving (Eq, Ord, Show) + +-- | Qualifier of a package within a namespace (see 'PP') +data Qualifier = + -- | Top-level dependency in this namespace + Unqualified + + -- | Any dependency on base is considered independent + -- + -- This makes it possible to have base shims. + | Base PN + + -- | Setup dependency + -- + -- By rights setup dependencies ought to be nestable; after all, the setup + -- dependencies of a package might themselves have setup dependencies, which + -- are independent from everything else. However, this very quickly leads to + -- infinite search trees in the solver. Therefore we limit ourselves to + -- a single qualifier (within a given namespace). + | Setup PN + deriving (Eq, Ord, Show) -- | Is the package in the primary group of packages. In particular this -- does not include packages pulled in as setup deps. -- primaryPP :: PP -> Bool -primaryPP (Independent _ pp) = primaryPP pp -primaryPP (Setup _ _ ) = False -primaryPP (Base _ pp) = primaryPP pp -primaryPP None = True +primaryPP (PP _ns q) = go q + where + go Unqualified = True + go (Base _) = True + go (Setup _) = False -- | String representation of a package path. -- --- NOTE: This always ends in a period +-- NOTE: The result of 'showPP' is either empty or results in a period, so that +-- it can be prepended to a package name. showPP :: PP -> String -showPP (Independent i pp) = show i ++ "." ++ showPP pp -showPP (Setup pn pp) = display pn ++ "-setup" ++ "." ++ showPP pp -showPP (Base pn pp) = display pn ++ "." ++ showPP pp -showPP None = "" +showPP (PP ns q) = + case ns of + DefaultNamespace -> go q + Independent i -> show i ++ "." ++ go q + where + -- Print the qualifier + -- + -- NOTE: the base qualifier is for a dependency _on_ base; the qualifier is + -- there to make sure different dependencies on base are all independent. + -- So we want to print something like @"A.base"@, where the @"A."@ part + -- is the qualifier and @"base"@ is the actual dependency (which, for the + -- 'Base' qualifier, will always be @base@). + go Unqualified = "" + go (Setup pn) = display pn ++ "-setup." + go (Base pn) = display pn ++ "." -- | A qualified entity. Pairs a package path with the entity. data Q a = Q PP a @@ -128,8 +158,7 @@ data Q a = Q PP a -- | Standard string representation of a qualified entity. showQ :: (a -> String) -> (Q a -> String) -showQ showa (Q None x) = showa x -showQ showa (Q pp x) = showPP pp ++ showa x +showQ showa (Q pp x) = showPP pp ++ showa x -- | Qualified package name. type QPN = Q PN @@ -142,5 +171,5 @@ showQPN = showQ display -- them all independent. makeIndependent :: [PN] -> [QPN] makeIndependent ps = [ Q pp pn | (pn, i) <- zip ps [0::Int ..] - , let pp = Independent i None + , let pp = PP (Independent i) Unqualified ] diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Preference.hs b/cabal-install/Distribution/Client/Dependency/Modular/Preference.hs index 63dfbec1f46..c441724200d 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/Preference.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/Preference.hs @@ -308,8 +308,8 @@ deferSetupChoices = trav go go x = x noSetup :: OpenGoal comp -> Bool - noSetup (OpenGoal (Simple (Dep (Q (Setup _ _) _) _) _) _) = False - noSetup _ = True + noSetup (OpenGoal (Simple (Dep (Q (PP _ns (Setup _)) _) _) _) _) = False + noSetup _ = True -- | Transformation that tries to avoid making weak flag choices early. -- Weak flags are trivial flags (not influencing dependencies) or such 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 4277295bc18..92ad0679b13 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs @@ -79,8 +79,8 @@ tests = [ , runTest $ mkTest db14 "cycleWithFlagChoice1" ["C"] (Just [("C", 1), ("E", 1)]) , runTest $ mkTest db15 "cycleThroughSetupDep1" ["A"] Nothing , runTest $ mkTest db15 "cycleThroughSetupDep2" ["B"] Nothing --- , runTest $ mkTest db15 "cycleThroughSetupDep3" ["C"] Nothing -- TODO --- , runTest $ mkTest db15 "cycleThroughSetupDep4" ["D"] Nothing -- TODO + , runTest $ mkTest db15 "cycleThroughSetupDep3" ["C"] (Just [("C", 2), ("D", 1)]) + , runTest $ mkTest db15 "cycleThroughSetupDep4" ["D"] (Just [("D", 1)]) , runTest $ mkTest db15 "cycleThroughSetupDep5" ["E"] (Just [("C", 2), ("D", 1), ("E", 1)]) ] , testGroup "Extensions" [