From 3838247c6ceefdfa3aeed99addf3efb9bb49332a Mon Sep 17 00:00:00 2001 From: Kristen Kozak Date: Thu, 21 Nov 2019 01:06:32 -0800 Subject: [PATCH 1/5] Update comment about extractCondition. --- Cabal/Distribution/Types/CondTree.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/Cabal/Distribution/Types/CondTree.hs b/Cabal/Distribution/Types/CondTree.hs index df8aa02875e..974ec77a655 100644 --- a/Cabal/Distribution/Types/CondTree.hs +++ b/Cabal/Distribution/Types/CondTree.hs @@ -140,8 +140,9 @@ traverseCondBranchC f (CondBranch cnd t me) = CondBranch cnd -- | Extract the condition matched by the given predicate from a cond tree. -- --- We use this mainly for extracting buildable conditions (see the Note above), --- but the function is in fact more general. +-- We use this mainly for extracting buildable conditions (see the Note in +-- Distribution.PackageDescription.Configuration), but the function is in fact +-- more general. extractCondition :: Eq v => (a -> Bool) -> CondTree v c a -> Condition v extractCondition p = go where From a3dbcacf20658609396e5e136d12cbc5fff13dbf Mon Sep 17 00:00:00 2001 From: Kristen Kozak Date: Thu, 21 Nov 2019 01:06:32 -0800 Subject: [PATCH 2/5] Solver: Support dependencies on sub-libraries (issue #6039). This commit tracks dependencies on sub-libraries by extending the functionality for tracking executables that was added in e86f83890d93068f7c27faea5bf07146b5452c23. It also starts adding support for library visibility, though it currently only works for source packages. There is a TODO for handling installed packages. This commit handles visibility similarly to the way that the buildable field is handled currently. It only checks whether a component is made private by the current environment and flag constraints at the start of dependency solving. This means that the solver can treat a component as visible when the visibility is controlled by an automatic flag, and the build can fail later, depending on the value that is chosen for the flag. Fixes #6038. --- .../Distribution/Solver/Modular/Dependency.hs | 9 +- .../Distribution/Solver/Modular/Index.hs | 18 +++- .../Solver/Modular/IndexConversion.hs | 99 ++++++++++++------- .../Distribution/Solver/Modular/Message.hs | 13 ++- .../Distribution/Solver/Modular/Tree.hs | 2 + .../Distribution/Solver/Modular/Validate.hs | 65 +++++++----- 6 files changed, 139 insertions(+), 67 deletions(-) diff --git a/cabal-install/Distribution/Solver/Modular/Dependency.hs b/cabal-install/Distribution/Solver/Modular/Dependency.hs index 8fc55f5724d..6b2fdba447b 100644 --- a/cabal-install/Distribution/Solver/Modular/Dependency.hs +++ b/cabal-install/Distribution/Solver/Modular/Dependency.hs @@ -55,6 +55,7 @@ import qualified Distribution.Solver.Modular.ConflictSet as CS import Distribution.Solver.Types.ComponentDeps (Component(..)) import Distribution.Solver.Types.PackagePath +import Distribution.Types.LibraryName import Distribution.Types.PkgconfigVersionRange import Distribution.Types.UnqualComponentName @@ -131,7 +132,9 @@ data PkgComponent qpn = PkgComponent qpn ExposedComponent -- | A component that can be depended upon by another package, i.e., a library -- or an executable. -data ExposedComponent = ExposedLib | ExposedExe UnqualComponentName +data ExposedComponent = + ExposedLib LibraryName + | ExposedExe UnqualComponentName deriving (Eq, Ord, Show) -- | The reason that a dependency is active. It identifies the package and any @@ -185,7 +188,7 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go -- Suppose package B has a setup dependency on package A. -- This will be recorded as something like -- - -- > LDep (DependencyReason "B") (Dep (PkgComponent "A" ExposedLib) (Constrained AnyVersion)) + -- > LDep (DependencyReason "B") (Dep (PkgComponent "A" (ExposedLib LMainLibName)) (Constrained AnyVersion)) -- -- Observe that when we qualify this dependency, we need to turn that -- @"A"@ into @"B-setup.A"@, but we should not apply that same qualifier @@ -199,7 +202,7 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go goD (Pkg pkn vr) _ = Pkg pkn vr goD (Dep dep@(PkgComponent qpn (ExposedExe _)) ci) _ = Dep (Q (PackagePath ns (QualExe pn qpn)) <$> dep) ci - goD (Dep dep@(PkgComponent qpn ExposedLib) ci) comp + goD (Dep dep@(PkgComponent qpn (ExposedLib _)) ci) comp | qBase qpn = Dep (Q (PackagePath ns (QualBase pn)) <$> dep) ci | qSetup comp = Dep (Q (PackagePath ns (QualSetup pn)) <$> dep) ci | otherwise = Dep (Q (PackagePath ns inheritedQ ) <$> dep) ci diff --git a/cabal-install/Distribution/Solver/Modular/Index.hs b/cabal-install/Distribution/Solver/Modular/Index.hs index ac60fec7d65..c1a8c0be412 100644 --- a/cabal-install/Distribution/Solver/Modular/Index.hs +++ b/cabal-install/Distribution/Solver/Modular/Index.hs @@ -1,6 +1,8 @@ module Distribution.Solver.Modular.Index ( Index , PInfo(..) + , ComponentInfo(..) + , IsVisible(..) , IsBuildable(..) , defaultQualifyOptions , mkIndex @@ -30,10 +32,24 @@ type Index = Map PN (Map I PInfo) -- globally, for reasons external to the solver. We currently use this -- for shadowing which essentially is a GHC limitation, and for -- installed packages that are broken. -data PInfo = PInfo (FlaggedDeps PN) (Map ExposedComponent IsBuildable) FlagInfo (Maybe FailReason) +data PInfo = PInfo (FlaggedDeps PN) + (Map ExposedComponent ComponentInfo) + FlagInfo + (Maybe FailReason) + +-- | Info associated with each library and executable in a package instance. +data ComponentInfo = ComponentInfo { + compIsVisible :: IsVisible + , compIsBuildable :: IsBuildable + } + +-- | Whether a component is visible in the current environment. +newtype IsVisible = IsVisible Bool + deriving Eq -- | Whether a component is made unbuildable by a "buildable: False" field. newtype IsBuildable = IsBuildable Bool + deriving Eq mkIndex :: [(PN, I, PInfo)] -> Index mkIndex xs = M.map M.fromList (groupMap (L.map (\ (pn, i, pi) -> (pn, (i, pi))) xs)) diff --git a/cabal-install/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install/Distribution/Solver/Modular/IndexConversion.hs index bc84228ce7e..0d519a17484 100644 --- a/cabal-install/Distribution/Solver/Modular/IndexConversion.hs +++ b/cabal-install/Distribution/Solver/Modular/IndexConversion.hs @@ -25,6 +25,7 @@ import Distribution.PackageDescription.Configuration import qualified Distribution.Simple.PackageIndex as SI import Distribution.System import Distribution.Types.ForeignLib +import Distribution.Types.LibraryVisibility import Distribution.Solver.Types.ComponentDeps ( Component(..), componentNameToComponent ) @@ -92,11 +93,18 @@ convIP :: SI.InstalledPackageIndex -> IPI.InstalledPackageInfo -> (PN, I, PInfo) convIP idx ipi = case mapM (convIPId (DependencyReason pn M.empty S.empty) comp idx) (IPI.depends ipi) of Nothing -> (pn, i, PInfo [] M.empty M.empty (Just Broken)) - Just fds -> ( pn - , i - , PInfo fds (M.singleton ExposedLib (IsBuildable True)) M.empty Nothing) + Just fds -> ( pn, i, PInfo fds components M.empty Nothing) where + -- TODO: Handle sub-libraries and visibility. + components = + M.singleton (ExposedLib LMainLibName) + ComponentInfo { + compIsVisible = IsVisible True + , compIsBuildable = IsBuildable True + } + (pn, i) = convId ipi + -- 'sourceLibName' is unreliable, but for now we only really use this for -- primary libs anyways comp = componentNameToComponent $ CLibName $ IPI.sourceLibName ipi @@ -140,7 +148,8 @@ convIPId dr comp idx ipid = case SI.lookupUnitId idx ipid of Nothing -> Nothing Just ipi -> let (pn, i) = convId ipi - in Just (D.Simple (LDep dr (Dep (PkgComponent pn ExposedLib) (Fixed i))) comp) + name = ExposedLib LMainLibName -- TODO: Handle sub-libraries. + in Just (D.Simple (LDep dr (Dep (PkgComponent pn name) (Fixed i))) comp) -- NB: something we pick up from the -- InstalledPackageIndex is NEVER an executable @@ -213,34 +222,52 @@ convGPD os arch cinfo constraints strfl solveExes pn Just ver -> Just (UnsupportedSpecVer ver) Nothing -> Nothing - components :: Map ExposedComponent IsBuildable - components = M.fromList $ libComps ++ exeComps + components :: Map ExposedComponent ComponentInfo + components = M.fromList $ libComps ++ subLibComps ++ exeComps where - libComps = [ (ExposedLib, IsBuildable $ isBuildable libBuildInfo lib) + libComps = [ (ExposedLib LMainLibName, libToComponentInfo lib) | lib <- maybeToList mlib ] - exeComps = [ (ExposedExe name, IsBuildable $ isBuildable buildInfo exe) + subLibComps = [ (ExposedLib (LSubLibName name), libToComponentInfo lib) + | (name, lib) <- sub_libs ] + exeComps = [ ( ExposedExe name + , ComponentInfo { + compIsVisible = IsVisible True + , compIsBuildable = IsBuildable $ testCondition (buildable . buildInfo) exe /= Just False + } + ) | (name, exe) <- exes ] - isBuildable = isBuildableComponent os arch cinfo constraints + + libToComponentInfo lib = + ComponentInfo { + compIsVisible = IsVisible $ testCondition (isPrivate . libVisibility) lib /= Just True + , compIsBuildable = IsBuildable $ testCondition (buildable . libBuildInfo) lib /= Just False + } + + testCondition = testConditionForComponent os arch cinfo constraints + + isPrivate LibraryVisibilityPrivate = True + isPrivate LibraryVisibilityPublic = False in PInfo flagged_deps components fds fr --- | Returns true if the component is buildable in the given environment. --- This function can give false-positives. For example, it only considers flags --- that are set by unqualified flag constraints, and it doesn't check whether --- the intra-package dependencies of a component are buildable. It is also --- possible for the solver to later assign a value to an automatic flag that --- makes the component unbuildable. -isBuildableComponent :: OS - -> Arch - -> CompilerInfo - -> [LabeledPackageConstraint] - -> (a -> BuildInfo) - -> CondTree ConfVar [Dependency] a - -> Bool -isBuildableComponent os arch cinfo constraints getInfo tree = - case simplifyCondition $ extractCondition (buildable . getInfo) tree of - Lit False -> False - _ -> True +-- | Applies the given predicate (for example, testing buildability or +-- visibility) to the given component and environment. Values are combined with +-- AND. This function returns 'Nothing' when the result cannot be determined +-- before dependency solving. Additionally, this function only considers flags +-- that are set by unqualified flag constraints, and it doesn't check the +-- intra-package dependencies of a component. +testConditionForComponent :: OS + -> Arch + -> CompilerInfo + -> [LabeledPackageConstraint] + -> (a -> Bool) + -> CondTree ConfVar [Dependency] a + -> Maybe Bool +testConditionForComponent os arch cinfo constraints p tree = + case simplifyCondition $ extractCondition p tree of + Lit True -> Just True + Lit False -> Just False + _ -> Nothing where flagAssignment :: [(FlagName, Bool)] flagAssignment = @@ -332,8 +359,10 @@ convCondTree flags dr pkg os arch cinfo pn fds comp getInfo ipns solveExes@(Solv -- duplicates could grow exponentially from the leaves to the root -- of the tree. mergeSimpleDeps $ - L.map (\d -> D.Simple (convLibDep dr d) comp) - (mapMaybe (filterIPNs ipns) ds) -- unconditional package dependencies + [ D.Simple singleDep comp + | dep <- mapMaybe (filterIPNs ipns) ds + , singleDep <- convLibDeps dr dep ] -- unconditional package dependencies + ++ L.map (\e -> D.Simple (LDep dr (Ext e)) comp) (allExtensions bi) -- unconditional extension dependencies ++ L.map (\l -> D.Simple (LDep dr (Lang l)) comp) (allLanguages bi) -- unconditional language dependencies ++ L.map (\(PkgconfigDependency pkn vr) -> D.Simple (LDep dr (Pkg pkn vr)) comp) (pkgconfigDepends bi) -- unconditional pkg-config dependencies @@ -537,9 +566,12 @@ unionDRs :: DependencyReason pn -> DependencyReason pn -> DependencyReason pn unionDRs (DependencyReason pn' fs1 ss1) (DependencyReason _ fs2 ss2) = DependencyReason pn' (M.union fs1 fs2) (S.union ss1 ss2) --- | Convert a Cabal dependency on a library to a solver-specific dependency. -convLibDep :: DependencyReason PN -> Dependency -> LDep PN -convLibDep dr (Dependency pn vr _) = LDep dr $ Dep (PkgComponent pn ExposedLib) (Constrained vr) +-- | Convert a Cabal dependency on a set of library components (from a single +-- package) to solver-specific dependencies. +convLibDeps :: DependencyReason PN -> Dependency -> [LDep PN] +convLibDeps dr (Dependency pn vr libs) = + [ LDep dr $ Dep (PkgComponent pn (ExposedLib lib)) (Constrained vr) + | lib <- S.toList libs ] -- | Convert a Cabal dependency on an executable (build-tools) to a solver-specific dependency. convExeDep :: DependencyReason PN -> ExeDependency -> LDep PN @@ -548,5 +580,6 @@ convExeDep dr (ExeDependency pn exe vr) = LDep dr $ Dep (PkgComponent pn (Expose -- | Convert setup dependencies convSetupBuildInfo :: PN -> SetupBuildInfo -> FlaggedDeps PN convSetupBuildInfo pn nfo = - L.map (\d -> D.Simple (convLibDep (DependencyReason pn M.empty S.empty) d) ComponentSetup) - (setupDepends nfo) + [ D.Simple singleDep ComponentSetup + | dep <- setupDepends nfo + , singleDep <- convLibDeps (DependencyReason pn M.empty S.empty) dep ] diff --git a/cabal-install/Distribution/Solver/Modular/Message.hs b/cabal-install/Distribution/Solver/Modular/Message.hs index 5d642d32c14..9624f76e02e 100644 --- a/cabal-install/Distribution/Solver/Modular/Message.hs +++ b/cabal-install/Distribution/Solver/Modular/Message.hs @@ -25,6 +25,7 @@ import Distribution.Solver.Modular.Version import Distribution.Solver.Types.ConstraintSource import Distribution.Solver.Types.PackagePath import Distribution.Solver.Types.Progress +import Distribution.Types.LibraryName import Distribution.Types.UnqualComponentName data Message = @@ -220,8 +221,10 @@ showFR _ (MissingPkgconfigPackage pn vr) = " (conflict: pkg-config package " ++ showFR _ (NewPackageDoesNotMatchExistingConstraint d) = " (conflict: " ++ showConflictingDep d ++ ")" showFR _ (ConflictingConstraints d1 d2) = " (conflict: " ++ L.intercalate ", " (L.map showConflictingDep [d1, d2]) ++ ")" showFR _ (NewPackageIsMissingRequiredComponent comp dr) = " (does not contain " ++ showExposedComponent comp ++ ", which is required by " ++ showDependencyReason dr ++ ")" +showFR _ (NewPackageHasPrivateRequiredComponent comp dr) = " (" ++ showExposedComponent comp ++ " is private, but it is required by " ++ showDependencyReason dr ++ ")" showFR _ (NewPackageHasUnbuildableRequiredComponent comp dr) = " (" ++ showExposedComponent comp ++ " is not buildable in the current environment, but it is required by " ++ showDependencyReason dr ++ ")" showFR _ (PackageRequiresMissingComponent qpn comp) = " (requires " ++ showExposedComponent comp ++ " from " ++ showQPN qpn ++ ", but the component does not exist)" +showFR _ (PackageRequiresPrivateComponent qpn comp) = " (requires " ++ showExposedComponent comp ++ " from " ++ showQPN qpn ++ ", but the component is private)" showFR _ (PackageRequiresUnbuildableComponent qpn comp) = " (requires " ++ showExposedComponent comp ++ " from " ++ showQPN qpn ++ ", but the component is not buildable in the current environment)" showFR _ CannotInstall = " (only already installed instances can be used)" showFR _ CannotReinstall = " (avoiding to reinstall a package with same version but new dependencies)" @@ -247,8 +250,9 @@ showFR _ (MalformedStanzaChoice qsn) = " (INTERNAL ERROR: MALFORMED STANZA showFR _ EmptyGoalChoice = " (INTERNAL ERROR: EMPTY GOAL CHOICE)" showExposedComponent :: ExposedComponent -> String -showExposedComponent ExposedLib = "library" -showExposedComponent (ExposedExe name) = "executable '" ++ unUnqualComponentName name ++ "'" +showExposedComponent (ExposedLib LMainLibName) = "library" +showExposedComponent (ExposedLib (LSubLibName name)) = "library '" ++ unUnqualComponentName name ++ "'" +showExposedComponent (ExposedExe name) = "executable '" ++ unUnqualComponentName name ++ "'" constraintSource :: ConstraintSource -> String constraintSource src = "constraint from " ++ showConstraintSource src @@ -257,8 +261,9 @@ showConflictingDep :: ConflictingDep -> String showConflictingDep (ConflictingDep dr (PkgComponent qpn comp) ci) = let DependencyReason qpn' _ _ = dr componentStr = case comp of - ExposedExe exe -> " (exe " ++ unUnqualComponentName exe ++ ")" - ExposedLib -> "" + ExposedExe exe -> " (exe " ++ unUnqualComponentName exe ++ ")" + ExposedLib LMainLibName -> "" + ExposedLib (LSubLibName lib) -> " (lib " ++ unUnqualComponentName lib ++ ")" in case ci of Fixed i -> (if qpn /= qpn' then showDependencyReason dr ++ " => " else "") ++ showQPN qpn ++ componentStr ++ "==" ++ showI i diff --git a/cabal-install/Distribution/Solver/Modular/Tree.hs b/cabal-install/Distribution/Solver/Modular/Tree.hs index e2d7c091031..ca7099278c7 100644 --- a/cabal-install/Distribution/Solver/Modular/Tree.hs +++ b/cabal-install/Distribution/Solver/Modular/Tree.hs @@ -102,8 +102,10 @@ data FailReason = UnsupportedExtension Extension | NewPackageDoesNotMatchExistingConstraint ConflictingDep | ConflictingConstraints ConflictingDep ConflictingDep | NewPackageIsMissingRequiredComponent ExposedComponent (DependencyReason QPN) + | NewPackageHasPrivateRequiredComponent ExposedComponent (DependencyReason QPN) | NewPackageHasUnbuildableRequiredComponent ExposedComponent (DependencyReason QPN) | PackageRequiresMissingComponent QPN ExposedComponent + | PackageRequiresPrivateComponent QPN ExposedComponent | PackageRequiresUnbuildableComponent QPN ExposedComponent | CannotInstall | CannotReinstall diff --git a/cabal-install/Distribution/Solver/Modular/Validate.hs b/cabal-install/Distribution/Solver/Modular/Validate.hs index a3dec6e1f67..0410ffe8a39 100644 --- a/cabal-install/Distribution/Solver/Modular/Validate.hs +++ b/cabal-install/Distribution/Solver/Modular/Validate.hs @@ -14,6 +14,7 @@ module Distribution.Solver.Modular.Validate (validateTree) where import Control.Applicative import Control.Monad.Reader hiding (sequence) +import Data.Either (lefts) import Data.Function (on) import Data.Traversable import Prelude hiding (sequence) @@ -38,6 +39,7 @@ import qualified Distribution.Solver.Modular.WeightedPSQ as W import Distribution.Solver.Types.PackagePath import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb, pkgConfigPkgIsPresent) +import Distribution.Types.LibraryName import Distribution.Types.PkgconfigVersionRange #ifdef DEBUG_CONFLICT_SETS @@ -110,8 +112,9 @@ data ValidateState = VS { pa :: PreAssignment, -- Map from package name to the components that are provided by the chosen - -- instance of that package, and whether those components are buildable. - availableComponents :: Map QPN (Map ExposedComponent IsBuildable), + -- instance of that package, and whether those components are visible and + -- buildable. + availableComponents :: Map QPN (Map ExposedComponent ComponentInfo), -- Map from package name to the components that are required from that -- package. @@ -301,20 +304,29 @@ validate = cata go local (\ s -> s { pa = PA nppa pfa npsa, requiredComponents = rComps' }) r -- | Check that a newly chosen package instance contains all components that --- are required from that package so far. The components must also be buildable. +-- are required from that package so far. The components must also be visible +-- and buildable. checkComponentsInNewPackage :: ComponentDependencyReasons -> QPN - -> Map ExposedComponent IsBuildable + -> Map ExposedComponent ComponentInfo -> Either Conflict () checkComponentsInNewPackage required qpn providedComps = case M.toList $ deleteKeys (M.keys providedComps) required of (missingComp, dr) : _ -> Left $ mkConflict missingComp dr NewPackageIsMissingRequiredComponent [] -> - case M.toList $ deleteKeys buildableProvidedComps required of - (unbuildableComp, dr) : _ -> - Left $ mkConflict unbuildableComp dr NewPackageHasUnbuildableRequiredComponent - [] -> Right () + let failures = lefts + [ case () of + _ | compIsVisible compInfo == IsVisible False -> + Left $ mkConflict comp dr NewPackageHasPrivateRequiredComponent + | compIsBuildable compInfo == IsBuildable False -> + Left $ mkConflict comp dr NewPackageHasUnbuildableRequiredComponent + | otherwise -> Right () + | let merged = M.intersectionWith (,) required providedComps + , (comp, (dr, compInfo)) <- M.toList merged ] + in case failures of + failure : _ -> Left failure + [] -> Right () where mkConflict :: ExposedComponent -> DependencyReason QPN @@ -323,9 +335,6 @@ checkComponentsInNewPackage required qpn providedComps = mkConflict comp dr mkFailure = (CS.insert (P qpn) (dependencyReasonToConflictSet dr), mkFailure comp dr) - buildableProvidedComps :: [ExposedComponent] - buildableProvidedComps = [comp | (comp, IsBuildable True) <- M.toList providedComps] - deleteKeys :: Ord k => [k] -> Map k v -> Map k v deleteKeys ks m = L.foldr M.delete m ks @@ -411,13 +420,15 @@ extend extSupported langSupported pkgPresent newactives ppa = foldM extendSingle -- the solver chooses foo-2.0, it tries to add the constraint foo==2.0. -- -- TODO: The new constraint is implemented as a dependency from foo to foo's --- library. That isn't correct, because foo might only be needed as a build +-- main library. That isn't correct, because foo might only be needed as a build -- tool dependency. The implemention may need to change when we support -- component-based dependency solving. extendWithPackageChoice :: PI QPN -> PPreAssignment -> Either Conflict PPreAssignment extendWithPackageChoice (PI qpn i) ppa = let mergedDep = M.findWithDefault (MergedDepConstrained []) qpn ppa - newChoice = PkgDep (DependencyReason qpn M.empty S.empty) (PkgComponent qpn ExposedLib) (Fixed i) + newChoice = PkgDep (DependencyReason qpn M.empty S.empty) + (PkgComponent qpn (ExposedLib LMainLibName)) + (Fixed i) in case (\ x -> M.insert qpn x ppa) <$> merge mergedDep newChoice of Left (c, (d, _d')) -> -- Don't include the package choice in the -- FailReason, because it is redundant. @@ -521,9 +532,9 @@ createConflictSetForVersionConflict pkg -- | Takes a list of new dependencies and uses it to try to update the map of -- known component dependencies. It returns a failure when a new dependency --- requires a component that is missing or unbuildable in a previously chosen --- packages. -extendRequiredComponents :: Map QPN (Map ExposedComponent IsBuildable) +-- requires a component that is missing, private, or unbuildable in a previously +-- chosen package. +extendRequiredComponents :: Map QPN (Map ExposedComponent ComponentInfo) -> Map QPN ComponentDependencyReasons -> [LDep QPN] -> Either Conflict (Map QPN ComponentDependencyReasons) @@ -534,16 +545,21 @@ extendRequiredComponents available = foldM extendSingle -> Either Conflict (Map QPN ComponentDependencyReasons) extendSingle required (LDep dr (Dep (PkgComponent qpn comp) _)) = let compDeps = M.findWithDefault M.empty qpn required + success = Right $ M.insertWith M.union qpn (M.insert comp dr compDeps) required in -- Only check for the existence of the component if its package has -- already been chosen. case M.lookup qpn available of - Just comps - | M.notMember comp comps -> - Left $ mkConflict qpn comp dr PackageRequiresMissingComponent - | L.notElem comp (buildableComps comps) -> - Left $ mkConflict qpn comp dr PackageRequiresUnbuildableComponent - _ -> - Right $ M.insertWith M.union qpn (M.insert comp dr compDeps) required + Just comps -> + case M.lookup comp comps of + Nothing -> + Left $ mkConflict qpn comp dr PackageRequiresMissingComponent + Just compInfo + | compIsVisible compInfo == IsVisible False -> + Left $ mkConflict qpn comp dr PackageRequiresPrivateComponent + | compIsBuildable compInfo == IsBuildable False -> + Left $ mkConflict qpn comp dr PackageRequiresUnbuildableComponent + | otherwise -> success + Nothing -> success extendSingle required _ = Right required mkConflict :: QPN @@ -554,9 +570,6 @@ extendRequiredComponents available = foldM extendSingle mkConflict qpn comp dr mkFailure = (CS.insert (P qpn) (dependencyReasonToConflictSet dr), mkFailure qpn comp) - buildableComps :: Map comp IsBuildable -> [comp] - buildableComps comps = [comp | (comp, IsBuildable True) <- M.toList comps] - -- | Interface. validateTree :: CompilerInfo -> Index -> PkgConfigDb -> Tree d c -> Tree d c From 7ef6a8f64a4735551f38d9061f1c8a81a426f4f8 Mon Sep 17 00:00:00 2001 From: Kristen Kozak Date: Thu, 21 Nov 2019 01:06:32 -0800 Subject: [PATCH 3/5] Solver DSL: Support sub-libraries and library visibility field. This commit also refactors the Dependencies type so that it can represent any combination of dependencies, buildability, and visibility. --- .../Solver/Modular/IndexConversion.hs | 3 +- .../Distribution/Solver/Modular/DSL.hs | 242 ++++++++++++------ .../Solver/Modular/MemoryUsage.hs | 4 +- .../Distribution/Solver/Modular/QuickCheck.hs | 39 ++- .../Distribution/Solver/Modular/Solver.hs | 98 +++---- 5 files changed, 237 insertions(+), 149 deletions(-) diff --git a/cabal-install/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install/Distribution/Solver/Modular/IndexConversion.hs index 0d519a17484..f5c5203b2d9 100644 --- a/cabal-install/Distribution/Solver/Modular/IndexConversion.hs +++ b/cabal-install/Distribution/Solver/Modular/IndexConversion.hs @@ -7,6 +7,7 @@ import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe (mapMaybe, fromMaybe, maybeToList) import Data.Monoid as Mon +import qualified Distribution.Compat.NonEmptySet as NonEmptySet import qualified Data.Set as S import qualified Distribution.InstalledPackageInfo as IPI @@ -571,7 +572,7 @@ unionDRs (DependencyReason pn' fs1 ss1) (DependencyReason _ fs2 ss2) = convLibDeps :: DependencyReason PN -> Dependency -> [LDep PN] convLibDeps dr (Dependency pn vr libs) = [ LDep dr $ Dep (PkgComponent pn (ExposedLib lib)) (Constrained vr) - | lib <- S.toList libs ] + | lib <- NonEmptySet.toList libs ] -- | Convert a Cabal dependency on an executable (build-tools) to a solver-specific dependency. convExeDep :: DependencyReason PN -> ExeDependency -> LDep PN diff --git a/cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs index ed1e7ec10bd..a6c66ef92a7 100644 --- a/cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs +++ b/cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs @@ -6,6 +6,7 @@ module UnitTests.Distribution.Solver.Modular.DSL ( ExampleDependency(..) , Dependencies(..) + , ExSubLib(..) , ExTest(..) , ExExe(..) , ExConstraint(..) @@ -21,13 +22,21 @@ module UnitTests.Distribution.Solver.Modular.DSL ( , ExampleQualifier(..) , ExampleVar(..) , EnableAllTests(..) + , dependencies + , publicDependencies + , unbuildableDependencies , exAv , exAvNoLibrary , exInst + , exSubLib + , exTest + , exExe , exFlagged , exResolve , extractInstallPlan , declareFlags + , withSubLibrary + , withSubLibraries , withSetupDeps , withTest , withTests @@ -46,6 +55,7 @@ import Distribution.Utils.Generic import Control.Arrow (second) import Data.Either (partitionEithers) import qualified Data.Map as Map +import qualified Distribution.Compat.NonEmptySet as NonEmptySet -- Cabal import qualified Distribution.CabalSpecVersion as C @@ -58,6 +68,7 @@ import qualified Distribution.Package as C import qualified Distribution.Types.ExeDependency as C import qualified Distribution.Types.ForeignLib as C import qualified Distribution.Types.LegacyExeDependency as C +import qualified Distribution.Types.LibraryVisibility as C import qualified Distribution.Types.PkgconfigDependency as C import qualified Distribution.Types.PkgconfigVersion as C import qualified Distribution.Types.PkgconfigVersionRange as C @@ -140,12 +151,40 @@ type ExamplePkgName = String type ExamplePkgVersion = Int type ExamplePkgHash = String -- for example "installed" packages type ExampleFlagName = String +type ExampleSubLibName = String type ExampleTestName = String type ExampleExeName = String type ExampleVersionRange = C.VersionRange -data Dependencies = NotBuildable | Buildable [ExampleDependency] - deriving Show +data Dependencies = Dependencies { + depsVisibility :: C.LibraryVisibility + , depsIsBuildable :: Bool + , depsExampleDependencies :: [ExampleDependency] + } deriving Show + +instance Semigroup Dependencies where + deps1 <> deps2 = Dependencies { + depsVisibility = depsVisibility deps1 <> depsVisibility deps2 + , depsIsBuildable = depsIsBuildable deps1 && depsIsBuildable deps2 + , depsExampleDependencies = depsExampleDependencies deps1 ++ depsExampleDependencies deps2 + } + +instance Monoid Dependencies where + mempty = Dependencies { + depsVisibility = mempty + , depsIsBuildable = True + , depsExampleDependencies = [] + } + mappend = (<>) + +dependencies :: [ExampleDependency] -> Dependencies +dependencies deps = mempty { depsExampleDependencies = deps } + +publicDependencies :: Dependencies +publicDependencies = mempty { depsVisibility = C.LibraryVisibilityPublic } + +unbuildableDependencies :: Dependencies +unbuildableDependencies = mempty { depsIsBuildable = False } data ExampleDependency = -- | Simple dependency on any version @@ -158,6 +197,12 @@ data ExampleDependency = -- and an exclusive upper bound. | ExRange ExamplePkgName ExamplePkgVersion ExamplePkgVersion + -- | Sub-library dependency + | ExSubLibAny ExamplePkgName ExampleSubLibName + + -- | Sub-library dependency on a fixed version + | ExSubLibFix ExamplePkgName ExampleSubLibName ExamplePkgVersion + -- | Build-tool-depends dependency | ExBuildToolAny ExamplePkgName ExampleExeName @@ -191,13 +236,24 @@ data ExFlag = ExFlag { , exFlagType :: FlagType } deriving Show -data ExTest = ExTest ExampleTestName [ExampleDependency] +data ExSubLib = ExSubLib ExampleSubLibName Dependencies + +data ExTest = ExTest ExampleTestName Dependencies + +data ExExe = ExExe ExampleExeName Dependencies -data ExExe = ExExe ExampleExeName [ExampleDependency] +exSubLib :: ExampleSubLibName -> [ExampleDependency] -> ExSubLib +exSubLib name deps = ExSubLib name (dependencies deps) + +exTest :: ExampleTestName -> [ExampleDependency] -> ExTest +exTest name deps = ExTest name (dependencies deps) + +exExe :: ExampleExeName -> [ExampleDependency] -> ExExe +exExe name deps = ExExe name (dependencies deps) exFlagged :: ExampleFlagName -> [ExampleDependency] -> [ExampleDependency] -> ExampleDependency -exFlagged n t e = ExFlagged n (Buildable t) (Buildable e) +exFlagged n t e = ExFlagged n (dependencies t) (dependencies e) data ExConstraint = ExVersionConstraint ConstraintScope ExampleVersionRange @@ -213,7 +269,7 @@ data ExPreference = data ExampleAvailable = ExAv { exAvName :: ExamplePkgName , exAvVersion :: ExamplePkgVersion - , exAvDeps :: ComponentDeps [ExampleDependency] + , exAvDeps :: ComponentDeps Dependencies -- Setting flags here is only necessary to override the default values of -- the fields in C.Flag. @@ -253,7 +309,7 @@ newtype EnableAllTests = EnableAllTests Bool -- exAv :: ExamplePkgName -> ExamplePkgVersion -> [ExampleDependency] -> ExampleAvailable -exAv n v ds = (exAvNoLibrary n v) { exAvDeps = CD.fromLibraryDeps ds } +exAv n v ds = (exAvNoLibrary n v) { exAvDeps = CD.fromLibraryDeps (dependencies ds) } -- | Constructs an 'ExampleAvailable' package without a default library -- component. @@ -270,9 +326,18 @@ declareFlags flags ex = ex { exAvFlags = flags } +withSubLibrary :: ExampleAvailable -> ExSubLib -> ExampleAvailable +withSubLibrary ex lib = withSubLibraries ex [lib] + +withSubLibraries :: ExampleAvailable -> [ExSubLib] -> ExampleAvailable +withSubLibraries ex libs = + let subLibCDs = CD.fromList [(CD.ComponentSubLib $ C.mkUnqualComponentName name, deps) + | ExSubLib name deps <- libs] + in ex { exAvDeps = exAvDeps ex <> subLibCDs } + withSetupDeps :: ExampleAvailable -> [ExampleDependency] -> ExampleAvailable withSetupDeps ex setupDeps = ex { - exAvDeps = exAvDeps ex <> CD.fromSetupDeps setupDeps + exAvDeps = exAvDeps ex <> CD.fromSetupDeps (dependencies setupDeps) } withTest :: ExampleAvailable -> ExTest -> ExampleAvailable @@ -342,7 +407,7 @@ exAvSrcPkg ex = usedFlags :: Map ExampleFlagName C.PackageFlag usedFlags = Map.fromList [(fn, mkDefaultFlag fn) | fn <- names] where - names = concatMap extractFlags $ CD.flatDeps (exAvDeps ex) + names = extractFlags $ CD.flatDeps (exAvDeps ex) in -- 'declaredFlags' overrides 'usedFlags' to give flags non-default settings: Map.elems $ declaredFlags `Map.union` usedFlags @@ -351,7 +416,7 @@ exAvSrcPkg ex = testSuites = [(name, deps) | (CD.ComponentTest name, deps) <- CD.toList (exAvDeps ex)] benchmarks = [(name, deps) | (CD.ComponentBench name, deps) <- CD.toList (exAvDeps ex)] executables = [(name, deps) | (CD.ComponentExe name, deps) <- CD.toList (exAvDeps ex)] - setup = case CD.setupDeps (exAvDeps ex) of + setup = case depsExampleDependencies $ CD.setupDeps (exAvDeps ex) of [] -> Nothing deps -> Just C.SetupBuildInfo { C.setupDepends = mkSetupDeps deps, @@ -380,30 +445,30 @@ exAvSrcPkg ex = , C.gpdScannedVersion = Nothing , C.genPackageFlags = flags , C.condLibrary = - let mkLib bi = mempty { C.libBuildInfo = bi } + let mkLib v bi = mempty { C.libVisibility = v, C.libBuildInfo = bi } -- Avoid using the Monoid instance for [a] when getting -- the library dependencies, to allow for the possibility -- that the package doesn't have a library: libDeps = lookup CD.ComponentLib (CD.toList (exAvDeps ex)) - in mkCondTree defaultLib mkLib . mkBuildInfoTree . Buildable <$> libDeps + in mkTopLevelCondTree defaultLib mkLib <$> libDeps , C.condSubLibraries = - let mkTree = mkCondTree defaultLib mkLib . mkBuildInfoTree . Buildable - mkLib bi = mempty { C.libBuildInfo = bi } + let mkTree = mkTopLevelCondTree defaultSubLib mkLib + mkLib v bi = mempty { C.libVisibility = v, C.libBuildInfo = bi } in map (second mkTree) subLibraries , C.condForeignLibs = - let mkTree = mkCondTree mempty mkLib . mkBuildInfoTree . Buildable + let mkTree = mkTopLevelCondTree (mkLib defaultTopLevelBuildInfo) (const mkLib) mkLib bi = mempty { C.foreignLibBuildInfo = bi } in map (second mkTree) foreignLibraries , C.condExecutables = - let mkTree = mkCondTree defaultExe mkExe . mkBuildInfoTree . Buildable + let mkTree = mkTopLevelCondTree defaultExe (const mkExe) mkExe bi = mempty { C.buildInfo = bi } in map (second mkTree) executables , C.condTestSuites = - let mkTree = mkCondTree defaultTest mkTest . mkBuildInfoTree . Buildable + let mkTree = mkTopLevelCondTree defaultTest (const mkTest) mkTest bi = mempty { C.testBuildInfo = bi } in map (second mkTree) testSuites , C.condBenchmarks = - let mkTree = mkCondTree defaultBenchmark mkBench . mkBuildInfoTree . Buildable + let mkTree = mkTopLevelCondTree defaultBenchmark (const mkBench) mkBench bi = mempty { C.benchmarkBuildInfo = bi } in map (second mkTree) benchmarks } @@ -424,19 +489,34 @@ exAvSrcPkg ex = defaultTopLevelBuildInfo = mempty { C.defaultLanguage = Just Haskell98 } defaultLib :: C.Library - defaultLib = mempty { C.exposedModules = [Module.fromString "Module"] } + defaultLib = mempty { + C.libBuildInfo = defaultTopLevelBuildInfo + , C.exposedModules = [Module.fromString "Module"] + , C.libVisibility = C.LibraryVisibilityPublic + } + + defaultSubLib :: C.Library + defaultSubLib = mempty { + C.libBuildInfo = defaultTopLevelBuildInfo + , C.exposedModules = [Module.fromString "Module"] + } defaultExe :: C.Executable - defaultExe = mempty { C.modulePath = "Main.hs" } + defaultExe = mempty { + C.buildInfo = defaultTopLevelBuildInfo + , C.modulePath = "Main.hs" + } defaultTest :: C.TestSuite defaultTest = mempty { - C.testInterface = C.TestSuiteExeV10 (C.mkVersion [1,0]) "Test.hs" + C.testBuildInfo = defaultTopLevelBuildInfo + , C.testInterface = C.TestSuiteExeV10 (C.mkVersion [1,0]) "Test.hs" } defaultBenchmark :: C.Benchmark defaultBenchmark = mempty { - C.benchmarkInterface = C.BenchmarkExeV10 (C.mkVersion [1,0]) "Benchmark.hs" + C.benchmarkBuildInfo = defaultTopLevelBuildInfo + , C.benchmarkInterface = C.BenchmarkExeV10 (C.mkVersion [1,0]) "Benchmark.hs" } -- Split the set of dependencies into the set of dependencies of the library, @@ -478,57 +558,43 @@ exAvSrcPkg ex = in (dep:other, exts, lang, pcpkgs, exes, legacyExes) -- Extract the total set of flags used - extractFlags :: ExampleDependency -> [ExampleFlagName] - extractFlags (ExAny _) = [] - extractFlags (ExFix _ _) = [] - extractFlags (ExRange _ _ _) = [] - extractFlags (ExBuildToolAny _ _) = [] - extractFlags (ExBuildToolFix _ _ _) = [] - extractFlags (ExLegacyBuildToolAny _) = [] - extractFlags (ExLegacyBuildToolFix _ _) = [] - extractFlags (ExFlagged f a b) = - f : concatMap extractFlags (deps a ++ deps b) - where - deps :: Dependencies -> [ExampleDependency] - deps NotBuildable = [] - deps (Buildable ds) = ds - extractFlags (ExExt _) = [] - extractFlags (ExLang _) = [] - extractFlags (ExPkg _) = [] - - -- Convert a tree of BuildInfos into a tree of a specific component type. - -- 'defaultTopLevel' contains the default values for the component, and - -- 'mkComponent' creates a component from a 'BuildInfo'. - mkCondTree :: forall a. Semigroup a => - a -> (C.BuildInfo -> a) - -> DependencyTree C.BuildInfo - -> DependencyTree a - mkCondTree defaultTopLevel mkComponent (C.CondNode topData topConstraints topComps) = - C.CondNode { - C.condTreeData = - defaultTopLevel <> mkComponent (defaultTopLevelBuildInfo <> topData) - , C.condTreeConstraints = topConstraints - , C.condTreeComponents = goComponents topComps - } + extractFlags :: Dependencies -> [ExampleFlagName] + extractFlags deps = concatMap go (depsExampleDependencies deps) where - go :: DependencyTree C.BuildInfo -> DependencyTree a - go (C.CondNode ctData constraints comps) = - C.CondNode (mkComponent ctData) constraints (goComponents comps) - - goComponents :: [DependencyComponent C.BuildInfo] - -> [DependencyComponent a] - goComponents comps = [C.CondBranch cond (go t) (go <$> me) | C.CondBranch cond t me <- comps] - - mkBuildInfoTree :: Dependencies -> DependencyTree C.BuildInfo - mkBuildInfoTree NotBuildable = - C.CondNode { - C.condTreeData = mempty { C.buildable = False } - , C.condTreeConstraints = [] - , C.condTreeComponents = [] - } - mkBuildInfoTree (Buildable deps) = - let (libraryDeps, exts, mlang, pcpkgs, buildTools, legacyBuildTools) = splitTopLevel deps + go :: ExampleDependency -> [ExampleFlagName] + go (ExAny _) = [] + go (ExFix _ _) = [] + go (ExRange _ _ _) = [] + go (ExSubLibAny _ _) = [] + go (ExSubLibFix _ _ _) = [] + go (ExBuildToolAny _ _) = [] + go (ExBuildToolFix _ _ _) = [] + go (ExLegacyBuildToolAny _) = [] + go (ExLegacyBuildToolFix _ _) = [] + go (ExFlagged f a b) = f : extractFlags a ++ extractFlags b + go (ExExt _) = [] + go (ExLang _) = [] + go (ExPkg _) = [] + + -- Convert 'Dependencies' into a tree of a specific component type, using + -- the given top level component and function for creating a component at + -- any level. + mkTopLevelCondTree :: forall a. Semigroup a => + a + -> (C.LibraryVisibility -> C.BuildInfo -> a) + -> Dependencies + -> DependencyTree a + mkTopLevelCondTree defaultTopLevel mkComponent deps = + let condNode = mkCondTree mkComponent deps + in condNode { C.condTreeData = defaultTopLevel <> C.condTreeData condNode } + + -- Convert 'Dependencies' into a tree of a specific component type, using + -- the given function to generate each component. + mkCondTree :: (C.LibraryVisibility -> C.BuildInfo -> a) -> Dependencies -> DependencyTree a + mkCondTree mkComponent deps = + let (libraryDeps, exts, mlang, pcpkgs, buildTools, legacyBuildTools) = splitTopLevel (depsExampleDependencies deps) (directDeps, flaggedDeps) = splitDeps libraryDeps + component = mkComponent (depsVisibility deps) bi bi = mempty { C.otherExtensions = exts , C.defaultLanguage = mlang @@ -540,25 +606,27 @@ exAvSrcPkg ex = | (n,v) <- pcpkgs , let n' = C.mkPkgconfigName n , let v' = C.PcThisVersion (mkSimplePkgconfigVersion v) ] + , C.buildable = depsIsBuildable deps } in C.CondNode { - C.condTreeData = bi -- Necessary for language extensions + C.condTreeData = component -- TODO: Arguably, build-tools dependencies should also -- effect constraints on conditional tree. But no way to -- distinguish between them , C.condTreeConstraints = map mkDirect directDeps - , C.condTreeComponents = map mkFlagged flaggedDeps + , C.condTreeComponents = map (mkFlagged mkComponent) flaggedDeps } - mkDirect :: (ExamplePkgName, C.VersionRange) -> C.Dependency - mkDirect (dep, vr) = C.Dependency (C.mkPackageName dep) vr C.mainLibSet + mkDirect :: (ExamplePkgName, C.LibraryName, C.VersionRange) -> C.Dependency + mkDirect (dep, name, vr) = C.Dependency (C.mkPackageName dep) vr (NonEmptySet.singleton name) - mkFlagged :: (ExampleFlagName, Dependencies, Dependencies) - -> DependencyComponent C.BuildInfo - mkFlagged (f, a, b) = + mkFlagged :: (C.LibraryVisibility -> C.BuildInfo -> a) + -> (ExampleFlagName, Dependencies, Dependencies) + -> DependencyComponent a + mkFlagged mkComponent (f, a, b) = C.CondBranch (C.Var (C.PackageFlag (C.mkFlagName f))) - (mkBuildInfoTree a) - (Just (mkBuildInfoTree b)) + (mkCondTree mkComponent a) + (Just (mkCondTree mkComponent b)) -- Split a set of dependencies into direct dependencies and flagged -- dependencies. A direct dependency is a tuple of the name of package and @@ -566,20 +634,26 @@ exAvSrcPkg ex = -- 'mkDirect' for example. A flagged dependency is the set of dependencies -- guarded by a flag. splitDeps :: [ExampleDependency] - -> ( [(ExamplePkgName, C.VersionRange)] + -> ( [(ExamplePkgName, C.LibraryName, C.VersionRange)] , [(ExampleFlagName, Dependencies, Dependencies)] ) splitDeps [] = ([], []) splitDeps (ExAny p:deps) = let (directDeps, flaggedDeps) = splitDeps deps - in ((p, C.anyVersion):directDeps, flaggedDeps) + in ((p, C.LMainLibName, C.anyVersion):directDeps, flaggedDeps) splitDeps (ExFix p v:deps) = let (directDeps, flaggedDeps) = splitDeps deps - in ((p, C.thisVersion $ mkSimpleVersion v):directDeps, flaggedDeps) + in ((p, C.LMainLibName, C.thisVersion $ mkSimpleVersion v):directDeps, flaggedDeps) splitDeps (ExRange p v1 v2:deps) = let (directDeps, flaggedDeps) = splitDeps deps - in ((p, mkVersionRange v1 v2):directDeps, flaggedDeps) + in ((p, C.LMainLibName, mkVersionRange v1 v2):directDeps, flaggedDeps) + splitDeps (ExSubLibAny p lib:deps) = + let (directDeps, flaggedDeps) = splitDeps deps + in ((p, C.LSubLibName (C.mkUnqualComponentName lib), C.anyVersion):directDeps, flaggedDeps) + splitDeps (ExSubLibFix p lib v:deps) = + let (directDeps, flaggedDeps) = splitDeps deps + in ((p, C.LSubLibName (C.mkUnqualComponentName lib), C.thisVersion $ mkSimpleVersion v):directDeps, flaggedDeps) splitDeps (ExFlagged f a b:deps) = let (directDeps, flaggedDeps) = splitDeps deps in (directDeps, (f, a, b):flaggedDeps) diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/MemoryUsage.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/MemoryUsage.hs index 93f7c5a5d20..463e56bd7e6 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/MemoryUsage.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/MemoryUsage.hs @@ -150,7 +150,7 @@ duplicateDependencies name = pkgs :: ExampleDb pkgs = [ Right $ exAv "A" 1 (dependencyTree 1) - , Right $ exAv "B" 1 [] `withExe` ExExe "exe" [] + , Right $ exAv "B" 1 [] `withExe` exExe "exe" [] ] dependencyTree :: Int -> [ExampleDependency] @@ -178,7 +178,7 @@ duplicateFlaggedDependencies name = pkgs :: ExampleDb pkgs = [ Right $ exAv "A" 1 (dependencyTree 1) - , Right $ exAv "B" 1 [] `withExe` ExExe "exe" [] + , Right $ exAv "B" 1 [] `withExe` exExe "exe" [] ] dependencyTree :: Int -> [ExampleDependency] diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs index a1a6412d014..46b2fdfaf3c 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs @@ -26,6 +26,7 @@ import Distribution.Utils.ShortText (ShortText) import Distribution.Client.Setup (defaultMaxBackjumps) +import Distribution.Types.LibraryVisibility import Distribution.Types.PackageName import Distribution.Types.UnqualComponentName @@ -310,8 +311,8 @@ arbitraryExInst pn v pkgs = do deps <- randomSubset numDeps pkgs return $ ExInst (unPN pn) (unPV v) pkgHash (map exInstHash deps) -arbitraryComponentDeps :: PN -> TestDb -> Gen (ComponentDeps [ExampleDependency]) -arbitraryComponentDeps _ (TestDb []) = return $ CD.fromLibraryDeps [] +arbitraryComponentDeps :: PN -> TestDb -> Gen (ComponentDeps Dependencies) +arbitraryComponentDeps _ (TestDb []) = return $ CD.fromLibraryDeps (dependencies []) arbitraryComponentDeps pn db = do -- dedupComponentNames removes components with duplicate names, for example, -- 'ComponentExe x' and 'ComponentTest x', and then CD.fromList combines @@ -321,7 +322,7 @@ arbitraryComponentDeps pn db = do return $ if isCompleteComponentDeps cds then cds else -- Add a library if the ComponentDeps isn't complete. - CD.fromLibraryDeps [] <> cds + CD.fromLibraryDeps (dependencies []) <> cds where isValid :: Component -> Bool isValid (ComponentSubLib name) = name /= mkUnqualComponentName (unPN pn) @@ -352,13 +353,20 @@ isCompleteComponentDeps = any (completesPkg . fst) . CD.toList completesPkg (ComponentFLib _) = False completesPkg ComponentSetup = False -arbitraryComponentDep :: TestDb -> Gen (ComponentDep [ExampleDependency]) +arbitraryComponentDep :: TestDb -> Gen (ComponentDep Dependencies) arbitraryComponentDep db = do comp <- arbitrary deps <- case comp of ComponentSetup -> smallListOf (arbitraryExDep db SetupDep) _ -> boundedListOf 5 (arbitraryExDep db NonSetupDep) - return (comp, deps) + return ( comp + , Dependencies { + depsExampleDependencies = deps + + -- TODO: Test different values for visibility and buildability. + , depsVisibility = LibraryVisibilityPublic + , depsIsBuildable = True + } ) -- | Location of an 'ExampleDependency'. It determines which values are valid. data ExDepLocation = SetupDep | NonSetupDep @@ -387,8 +395,8 @@ arbitraryExDep db@(TestDb pkgs) level = arbitraryDeps :: TestDb -> Gen Dependencies arbitraryDeps db = frequency - [ (1, return NotBuildable) - , (20, Buildable <$> smallListOf (arbitraryExDep db NonSetupDep)) + [ (1, return unbuildableDependencies) + , (20, dependencies <$> smallListOf (arbitraryExDep db NonSetupDep)) ] arbitraryFlagName :: Gen String @@ -432,6 +440,12 @@ instance Arbitrary IndependentGoals where shrink (IndependentGoals indep) = [IndependentGoals False | indep] +instance Arbitrary LibraryVisibility where + arbitrary = elements [LibraryVisibilityPrivate, LibraryVisibilityPublic] + + shrink LibraryVisibilityPublic = [LibraryVisibilityPrivate] + shrink LibraryVisibilityPrivate = [] + instance Arbitrary UnqualComponentName where -- The "component-" prefix prevents component names and build-depends -- dependency names from overlapping. @@ -476,19 +490,18 @@ instance Arbitrary ExampleDependency where shrink (ExFix "base" _) = [] -- preserve bounds on base shrink (ExFix pn _) = [ExAny pn] shrink (ExFlagged flag th el) = - deps th ++ deps el + depsExampleDependencies th ++ depsExampleDependencies el ++ [ExFlagged flag th' el | th' <- shrink th] ++ [ExFlagged flag th el' | el' <- shrink el] - where - deps NotBuildable = [] - deps (Buildable ds) = ds shrink dep = error $ "Dependency not handled: " ++ show dep instance Arbitrary Dependencies where arbitrary = error "arbitrary not implemented: Dependencies" - shrink NotBuildable = [Buildable []] - shrink (Buildable deps) = map Buildable (shrink deps) + shrink deps = + [ deps { depsVisibility = v } | v <- shrink $ depsVisibility deps ] + ++ [ deps { depsIsBuildable = b } | b <- shrink $ depsIsBuildable deps ] + ++ [ deps { depsExampleDependencies = ds } | ds <- shrink $ depsExampleDependencies deps ] instance Arbitrary ExConstraint where arbitrary = error "arbitrary not implemented: ExConstraint" diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs index a7edbeaacf4..65a7d6114bf 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs @@ -282,16 +282,16 @@ tests = [ , runTest $ indep $ mkTest dbBJ8 "bj8" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)]) ] , testGroup "library dependencies" [ - let db = [Right $ exAvNoLibrary "A" 1 `withExe` ExExe "exe" []] + let db = [Right $ exAvNoLibrary "A" 1 `withExe` exExe "exe" []] in runTest $ mkTest db "install build target without a library" ["A"] $ solverSuccess [("A", 1)] , let db = [ Right $ exAv "A" 1 [ExAny "B"] - , Right $ exAvNoLibrary "B" 1 `withExe` ExExe "exe" [] ] + , Right $ exAvNoLibrary "B" 1 `withExe` exExe "exe" [] ] in runTest $ mkTest db "reject build-depends dependency with no library" ["A"] $ solverFailure (isInfixOf "rejecting: B-1.0.0 (does not contain library, which is required by A)") - , let exe = ExExe "exe" [] + , let exe = exExe "exe" [] db = [ Right $ exAv "A" 1 [ExAny "B"] , Right $ exAvNoLibrary "B" 2 `withExe` exe , Right $ exAv "B" 1 [] `withExe` exe ] @@ -370,19 +370,19 @@ tests = [ , testGroup "Components that are unbuildable in the current environment" $ let flagConstraint = ExFlagConstraint . ScopeAnyQualifier in [ - let db = [ Right $ exAv "A" 1 [ExFlagged "build-lib" (Buildable []) NotBuildable] ] + let db = [ Right $ exAv "A" 1 [ExFlagged "build-lib" (dependencies []) unbuildableDependencies] ] in runTest $ constraints [flagConstraint "A" "build-lib" False] $ mkTest db "install unbuildable library" ["A"] $ solverSuccess [("A", 1)] , let db = [ Right $ exAvNoLibrary "A" 1 - `withExe` ExExe "exe" [ExFlagged "build-exe" (Buildable []) NotBuildable] ] + `withExe` exExe "exe" [ExFlagged "build-exe" (dependencies []) unbuildableDependencies] ] in runTest $ constraints [flagConstraint "A" "build-exe" False] $ mkTest db "install unbuildable exe" ["A"] $ solverSuccess [("A", 1)] , let db = [ Right $ exAv "A" 1 [ExAny "B"] - , Right $ exAv "B" 1 [ExFlagged "build-lib" (Buildable []) NotBuildable] ] + , Right $ exAv "B" 1 [ExFlagged "build-lib" (dependencies []) unbuildableDependencies] ] in runTest $ constraints [flagConstraint "B" "build-lib" False] $ mkTest db "reject library dependency with unbuildable library" ["A"] $ solverFailure $ isInfixOf $ @@ -390,15 +390,15 @@ tests = [ ++ "current environment, but it is required by A)" , let db = [ Right $ exAv "A" 1 [ExBuildToolAny "B" "bt"] - , Right $ exAv "B" 1 [ExFlagged "build-lib" (Buildable []) NotBuildable] - `withExe` ExExe "bt" [] ] + , Right $ exAv "B" 1 [ExFlagged "build-lib" (dependencies []) unbuildableDependencies] + `withExe` exExe "bt" [] ] in runTest $ constraints [flagConstraint "B" "build-lib" False] $ mkTest db "allow build-tool dependency with unbuildable library" ["A"] $ solverSuccess [("A", 1), ("B", 1)] , let db = [ Right $ exAv "A" 1 [ExBuildToolAny "B" "bt"] , Right $ exAv "B" 1 [] - `withExe` ExExe "bt" [ExFlagged "build-exe" (Buildable []) NotBuildable] ] + `withExe` exExe "bt" [ExFlagged "build-exe" (dependencies []) unbuildableDependencies] ] in runTest $ constraints [flagConstraint "B" "build-exe" False] $ mkTest db "reject build-tool dependency with unbuildable exe" ["A"] $ solverFailure $ isInfixOf $ @@ -874,11 +874,11 @@ db5 = [ Right $ exAv "A" 1 [] , Right $ exAv "A" 2 [] , Right $ exAv "B" 1 [] - , Right $ exAv "C" 1 [] `withTest` ExTest "testC" [ExAny "A"] - , Right $ exAv "D" 1 [] `withTest` ExTest "testD" [ExFix "B" 2] - , Right $ exAv "E" 1 [ExFix "A" 1] `withTest` ExTest "testE" [ExAny "A"] - , Right $ exAv "F" 1 [ExFix "A" 1] `withTest` ExTest "testF" [ExFix "A" 2] - , Right $ exAv "G" 1 [ExFix "A" 2] `withTest` ExTest "testG" [ExAny "A"] + , Right $ exAv "C" 1 [] `withTest` exTest "testC" [ExAny "A"] + , Right $ exAv "D" 1 [] `withTest` exTest "testD" [ExFix "B" 2] + , Right $ exAv "E" 1 [ExFix "A" 1] `withTest` exTest "testE" [ExAny "A"] + , Right $ exAv "F" 1 [ExFix "A" 1] `withTest` exTest "testF" [ExFix "A" 2] + , Right $ exAv "G" 1 [ExFix "A" 2] `withTest` exTest "testG" [ExAny "A"] ] -- Now the _dependencies_ have test suites @@ -893,7 +893,7 @@ db6 :: ExampleDb db6 = [ Right $ exAv "A" 1 [] , Right $ exAv "A" 2 [] - , Right $ exAv "B" 1 [] `withTest` ExTest "testA" [ExAny "A"] + , Right $ exAv "B" 1 [] `withTest` exTest "testA" [ExAny "A"] , Right $ exAv "C" 1 [ExFix "A" 1, ExAny "B"] , Right $ exAv "D" 1 [ExAny "B"] ] @@ -915,7 +915,7 @@ testTestSuiteWithFlag name = db = [ Right $ exAv "A" 1 [] `withTest` - ExTest "test" [exFlagged "flag" [ExFix "B" 2] []] + exTest "test" [exFlagged "flag" [ExFix "B" 2] []] , Right $ exAv "B" 1 [] ] @@ -1086,13 +1086,13 @@ dbConstraints = dbStanzaPreferences1 :: ExampleDb dbStanzaPreferences1 = [ - Right $ exAv "pkg" 1 [] `withTest` ExTest "test" [ExAny "test-dep"] + Right $ exAv "pkg" 1 [] `withTest` exTest "test" [ExAny "test-dep"] , Right $ exAv "test-dep" 1 [] ] dbStanzaPreferences2 :: ExampleDb dbStanzaPreferences2 = [ - Right $ exAv "pkg" 1 [] `withTest` ExTest "test" [ExAny "unknown"] + Right $ exAv "pkg" 1 [] `withTest` exTest "test" [ExAny "unknown"] ] -- | This is a test case for a bug in stanza preferences (#3930). The solver @@ -1108,7 +1108,7 @@ testStanzaPreference name = [] [ExAny "unknown-pkg1"]] `withTest` - ExTest "test" [exFlagged "flag" + exTest "test" [exFlagged "flag" [ExAny "unknown-pkg2"] []] goals = [ @@ -1278,8 +1278,8 @@ testIndepGoals2 name = 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 "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 [] @@ -1460,7 +1460,7 @@ testIndepGoals4 name = db = [ Right $ exAv "A" 1 [ExFix "E" 2] , Right $ exAv "B" 1 [ExAny "D"] - , Right $ exAv "C" 1 [ExAny "D"] `withTest` ExTest "test" [ExFix "E" 1] + , Right $ exAv "C" 1 [ExAny "D"] `withTest` exTest "test" [ExFix "E" 1] , Right $ exAv "D" 1 [ExAny "E"] , Right $ exAv "E" 1 [] , Right $ exAv "E" 2 [] @@ -1617,8 +1617,8 @@ testBuildable testName unavailableDep = [ExAny "true-dep"] [ExAny "false-dep"]] `withExe` - ExExe "exe" [ unavailableDep - , ExFlagged "enable-exe" (Buildable []) NotBuildable ] + exExe "exe" [ unavailableDep + , ExFlagged "enable-exe" (dependencies []) unbuildableDependencies ] , Right $ exAv "true-dep" 1 [] , Right $ exAv "false-dep" 1 [] ] @@ -1631,15 +1631,15 @@ dbBuildable1 = [ [ exFlagged "flag1" [ExAny "flag1-true"] [ExAny "flag1-false"] , exFlagged "flag2" [ExAny "flag2-true"] [ExAny "flag2-false"]] `withExes` - [ ExExe "exe1" + [ exExe "exe1" [ ExAny "unknown" - , ExFlagged "flag1" (Buildable []) NotBuildable - , ExFlagged "flag2" (Buildable []) NotBuildable] - , ExExe "exe2" + , ExFlagged "flag1" (dependencies []) unbuildableDependencies + , ExFlagged "flag2" (dependencies []) unbuildableDependencies] + , exExe "exe2" [ ExAny "unknown" , ExFlagged "flag1" - (Buildable []) - (Buildable [ExFlagged "flag2" NotBuildable (Buildable [])])] + (dependencies []) + (dependencies [ExFlagged "flag2" unbuildableDependencies (dependencies [])])] ] , Right $ exAv "flag1-true" 1 [] , Right $ exAv "flag1-false" 1 [] @@ -1654,9 +1654,9 @@ dbBuildable2 = [ , Right $ exAv "B" 1 [ExAny "unknown"] , Right $ exAv "B" 2 [] `withExe` - ExExe "exe" + exExe "exe" [ ExAny "unknown" - , ExFlagged "disable-exe" NotBuildable (Buildable []) + , ExFlagged "disable-exe" unbuildableDependencies (dependencies []) ] , Right $ exAv "B" 3 [ExAny "unknown"] ] @@ -1870,17 +1870,17 @@ dbBuildTools = [ Right $ exAv "A" 1 [ExBuildToolAny "bt-pkg" "exe1"] , Right $ exAv "B" 1 [exFlagged "flagB" [ExAny "unknown"] [ExBuildToolAny "bt-pkg" "exe1"]] - , Right $ exAv "C" 1 [] `withTest` ExTest "testC" [ExBuildToolAny "bt-pkg" "exe1"] + , Right $ exAv "C" 1 [] `withTest` exTest "testC" [ExBuildToolAny "bt-pkg" "exe1"] , Right $ exAv "D" 1 [ExBuildToolAny "bt-pkg" "unknown-exe"] , Right $ exAv "E" 1 [ExBuildToolAny "unknown-pkg" "exe1"] , Right $ exAv "F" 1 [exFlagged "flagF" [ExBuildToolAny "bt-pkg" "unknown-exe"] [ExAny "unknown"]] - , Right $ exAv "G" 1 [] `withTest` ExTest "testG" [ExBuildToolAny "bt-pkg" "unknown-exe"] + , Right $ exAv "G" 1 [] `withTest` exTest "testG" [ExBuildToolAny "bt-pkg" "unknown-exe"] , Right $ exAv "H" 1 [ExBuildToolFix "bt-pkg" "exe1" 3] , Right $ exAv "bt-pkg" 4 [] - , Right $ exAv "bt-pkg" 3 [] `withExe` ExExe "exe2" [] - , Right $ exAv "bt-pkg" 2 [] `withExe` ExExe "exe1" [] + , Right $ exAv "bt-pkg" 3 [] `withExe` exExe "exe2" [] + , Right $ exAv "bt-pkg" 2 [] `withExe` exExe "exe1" [] , Right $ exAv "bt-pkg" 1 [] ] @@ -1924,7 +1924,7 @@ chooseExeAfterBuildToolsPackage shouldSucceed name = [ExAny "unknown"]] , Right $ exAv "B" 1 [] `withExes` - [ExExe exe [] | exe <- if shouldSucceed then ["exe1", "exe2"] else ["exe1"]] + [exExe exe [] | exe <- if shouldSucceed then ["exe1", "exe2"] else ["exe1"]] ] goals :: [ExampleVar] @@ -1952,7 +1952,7 @@ requireConsistentBuildToolVersions name = , Right $ exAv "B" 1 [] `withExes` exes ] - exes = [ExExe "exe1" [], ExExe "exe2" []] + exes = [exExe "exe1" [], exExe "exe2" []] -- | This test is similar to the failure case for -- chooseExeAfterBuildToolsPackage, except that the build tool is unbuildable @@ -1972,8 +1972,8 @@ chooseUnbuildableExeAfterBuildToolsPackage name = [ExAny "unknown"]] , Right $ exAvNoLibrary "B" 1 `withExes` - [ ExExe "bt1" [] - , ExExe "bt2" [ExFlagged "build-bt2" (Buildable []) NotBuildable] + [ exExe "bt1" [] + , exExe "bt2" [ExFlagged "build-bt2" (dependencies []) unbuildableDependencies] ] ] @@ -1989,7 +1989,7 @@ chooseUnbuildableExeAfterBuildToolsPackage name = -------------------------------------------------------------------------------} dbLegacyBuildTools1 :: ExampleDb dbLegacyBuildTools1 = [ - Right $ exAv "alex" 1 [] `withExe` ExExe "alex" [], + Right $ exAv "alex" 1 [] `withExe` exExe "alex" [], Right $ exAv "A" 1 [ExLegacyBuildToolAny "alex"] ] @@ -1997,8 +1997,8 @@ dbLegacyBuildTools1 = [ -- package and the executable. This db has no solution. dbLegacyBuildTools2 :: ExampleDb dbLegacyBuildTools2 = [ - Right $ exAv "alex" 1 [] `withExe` ExExe "other-exe" [], - Right $ exAv "other-package" 1 [] `withExe` ExExe "alex" [], + Right $ exAv "alex" 1 [] `withExe` exExe "other-exe" [], + Right $ exAv "other-package" 1 [] `withExe` exExe "alex" [], Right $ exAv "A" 1 [ExLegacyBuildToolAny "alex"] ] @@ -2012,8 +2012,8 @@ dbLegacyBuildTools3 = [ -- Test that we can solve for different versions of executables dbLegacyBuildTools4 :: ExampleDb dbLegacyBuildTools4 = [ - Right $ exAv "alex" 1 [] `withExe` ExExe "alex" [], - Right $ exAv "alex" 2 [] `withExe` ExExe "alex" [], + Right $ exAv "alex" 1 [] `withExe` exExe "alex" [], + Right $ exAv "alex" 2 [] `withExe` exExe "alex" [], Right $ exAv "A" 1 [ExLegacyBuildToolFix "alex" 1], Right $ exAv "B" 1 [ExLegacyBuildToolFix "alex" 2], Right $ exAv "C" 1 [ExAny "A", ExAny "B"] @@ -2022,7 +2022,7 @@ dbLegacyBuildTools4 = [ -- Test that exe is not related to library choices dbLegacyBuildTools5 :: ExampleDb dbLegacyBuildTools5 = [ - Right $ exAv "alex" 1 [ExFix "A" 1] `withExe` ExExe "alex" [], + Right $ exAv "alex" 1 [ExFix "A" 1] `withExe` exExe "alex" [], Right $ exAv "A" 1 [], Right $ exAv "A" 2 [], Right $ exAv "B" 1 [ExLegacyBuildToolFix "alex" 1, ExFix "A" 2] @@ -2031,8 +2031,8 @@ dbLegacyBuildTools5 = [ -- Test that build-tools on build-tools works dbLegacyBuildTools6 :: ExampleDb dbLegacyBuildTools6 = [ - Right $ exAv "alex" 1 [] `withExe` ExExe "alex" [], - Right $ exAv "happy" 1 [ExLegacyBuildToolAny "alex"] `withExe` ExExe "happy" [], + Right $ exAv "alex" 1 [] `withExe` exExe "alex" [], + Right $ exAv "happy" 1 [ExLegacyBuildToolAny "alex"] `withExe` exExe "happy" [], Right $ exAv "A" 1 [ExLegacyBuildToolAny "happy"] ] @@ -2043,7 +2043,7 @@ dbIssue3775 = [ Right $ exAv "warp" 1 [], -- NB: the warp build-depends refers to the package, not the internal -- executable! - Right $ exAv "A" 2 [ExFix "warp" 1] `withExe` ExExe "warp" [ExAny "A"], + Right $ exAv "A" 2 [ExFix "warp" 1] `withExe` exExe "warp" [ExAny "A"], Right $ exAv "B" 2 [ExAny "A", ExAny "warp"] ] From 91f8b300977039b1ada7c2566009d73cefc88556 Mon Sep 17 00:00:00 2001 From: Kristen Kozak Date: Thu, 21 Nov 2019 01:06:32 -0800 Subject: [PATCH 4/5] Add solver unit tests for sub-library dependencies (issue #6039). --- .../Distribution/Solver/Modular/Solver.hs | 58 ++++++++++++++++++- 1 file changed, 57 insertions(+), 1 deletion(-) diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs index 65a7d6114bf..3abd45f5047 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs @@ -281,7 +281,7 @@ tests = [ , runTest $ mkTest dbBJ7 "bj7" ["A"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)]) , runTest $ indep $ mkTest dbBJ8 "bj8" ["A", "B"] (solverSuccess [("A", 1), ("B", 1), ("C", 1)]) ] - , testGroup "library dependencies" [ + , testGroup "main library dependencies" [ let db = [Right $ exAvNoLibrary "A" 1 `withExe` exExe "exe" []] in runTest $ mkTest db "install build target without a library" ["A"] $ solverSuccess [("A", 1)] @@ -298,6 +298,62 @@ tests = [ in runTest $ mkTest db "choose version of build-depends dependency that has a library" ["A"] $ solverSuccess [("A", 1), ("B", 1)] ] + , testGroup "sub-library dependencies" [ + let db = [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib"] + , Right $ exAv "B" 1 [] ] + in runTest $ + mkTest db "reject package that is missing required sub-library" ["A"] $ + solverFailure $ isInfixOf $ + "rejecting: B-1.0.0 (does not contain library 'sub-lib', which is required by A)" + + , let db = [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib"] + , Right $ exAvNoLibrary "B" 1 `withSubLibrary` exSubLib "sub-lib" [] ] + in runTest $ + mkTest db "reject package with private but required sub-library" ["A"] $ + solverFailure $ isInfixOf $ + "rejecting: B-1.0.0 (library 'sub-lib' is private, but it is required by A)" + + , let db = [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib"] + , Right $ exAvNoLibrary "B" 1 + `withSubLibrary` exSubLib "sub-lib" [ExFlagged "make-lib-private" (dependencies []) publicDependencies] ] + in runTest $ constraints [ExFlagConstraint (ScopeAnyQualifier "B") "make-lib-private" True] $ + mkTest db "reject package with sub-library made private by flag constraint" ["A"] $ + solverFailure $ isInfixOf $ + "rejecting: B-1.0.0 (library 'sub-lib' is private, but it is required by A)" + + , let db = [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib"] + , Right $ exAvNoLibrary "B" 1 + `withSubLibrary` exSubLib "sub-lib" [ExFlagged "make-lib-private" (dependencies []) publicDependencies] ] + in runTest $ + mkTest db "treat sub-library as visible even though flag choice could make it private" ["A"] $ + solverSuccess [("A", 1), ("B", 1)] + + , let db = [ Right $ exAv "A" 1 [ExAny "B"] + , Right $ exAv "B" 1 [] `withSubLibrary` exSubLib "sub-lib" [] + , Right $ exAv "C" 1 [ExSubLibAny "B" "sub-lib"] ] + goals :: [ExampleVar] + goals = [ + P QualNone "A" + , P QualNone "B" + , P QualNone "C" + ] + in runTest $ goalOrder goals $ + mkTest db "reject package that requires a private sub-library" ["A", "C"] $ + solverFailure $ isInfixOf $ + "rejecting: C-1.0.0 (requires library 'sub-lib' from B, but the component is private)" + + , let db = [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib-v1"] + , Right $ exAv "B" 2 [] `withSubLibrary` ExSubLib "sub-lib-v2" publicDependencies + , Right $ exAv "B" 1 [] `withSubLibrary` ExSubLib "sub-lib-v1" publicDependencies ] + in runTest $ mkTest db "choose version of package containing correct sub-library" ["A"] $ + solverSuccess [("A", 1), ("B", 1)] + + , let db = [ Right $ exAv "A" 1 [ExSubLibAny "B" "sub-lib"] + , Right $ exAv "B" 2 [] `withSubLibrary` ExSubLib "sub-lib" (dependencies []) + , Right $ exAv "B" 1 [] `withSubLibrary` ExSubLib "sub-lib" publicDependencies ] + in runTest $ mkTest db "choose version of package with public sub-library" ["A"] $ + solverSuccess [("A", 1), ("B", 1)] + ] -- build-tool-depends dependencies , testGroup "build-tool-depends" [ runTest $ mkTest dbBuildTools "simple exe dependency" ["A"] (solverSuccess [("A", 1), ("bt-pkg", 2)]) From 60324d6d1616f95abe91a19fb6b650730c4db0bf Mon Sep 17 00:00:00 2001 From: Kristen Kozak Date: Fri, 22 Nov 2019 00:28:27 -0800 Subject: [PATCH 5/5] Update test output with solver error for private dependencies. --- .../MultipleLibraries/Failing/cabal.out | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/cabal-testsuite/PackageTests/MultipleLibraries/Failing/cabal.out b/cabal-testsuite/PackageTests/MultipleLibraries/Failing/cabal.out index 1cb30898b58..ed846531e57 100644 --- a/cabal-testsuite/PackageTests/MultipleLibraries/Failing/cabal.out +++ b/cabal-testsuite/PackageTests/MultipleLibraries/Failing/cabal.out @@ -1,14 +1,8 @@ # cabal v2-build Resolving dependencies... -Build profile: -w ghc- -O1 -In order, the following will be built: - - d-0.1.0.0 (lib:privatelib) (first run) - - p-0.1.0.0 (lib) (first run) -Warning: d.cabal:10:22: visibility is experimental feature (issue #5660) -Configuring library 'privatelib' for d-0.1.0.0.. -Preprocessing library 'privatelib' for d-0.1.0.0.. -Building library 'privatelib' for d-0.1.0.0.. -Warning: p.cabal:6:20: colon specifier is experimental feature (issue #5660) -Configuring library for p-0.1.0.0.. -cabal: Encountered missing or private dependencies: - d:{privatelib} ==0.1.0.0 +cabal: Could not resolve dependencies: +[__0] trying: d-0.1.0.0 (user goal) +[__1] next goal: p (user goal) +[__1] rejecting: p-0.1.0.0 (requires library 'privatelib' from d, but the component is private) +[__1] fail (backjumping, conflict set: d, p) +After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: d (2), p (2)