Commit 2f5c8617 authored by Edward Z. Yang's avatar Edward Z. Yang Committed by Edward Z. Yang
Browse files

Check that internal dependencies are supplied on --exact-configuration



Previously, the code would unconditionally report that internal
dependencies were satisfiable, even if --exact-configuration was
provided, we're in per-component mode, and the internal lib was
NOT supplied via a --dependency parameter.  Now ./Setup configure
correctly fails at the right stage.

There is a bit of wibbling to do with compatibility package names.
I think I've gotten it right.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 384ab7e9
......@@ -468,8 +468,9 @@ configure (pkg_descr0', pbi) cfg = do
<- configureFinalizedPackage verbosity cfg enabled
allConstraints
(dependencySatisfiable
use_external_internal_deps
(fromFlagOrDefault False (configExactConfiguration cfg))
(packageVersion pkg_descr0)
(packageName pkg_descr0)
installedPackageSet
internalPackageSet
requiredDepsMap)
......@@ -820,53 +821,71 @@ getInternalPackages pkg_descr0 =
Just n' -> (unqualComponentNameToPackageName n', CSubLibName n')
in Map.fromList (map f (allLibraries pkg_descr))
-- | Returns true if a dependency is satisfiable. This function
-- may report a dependency satisfiable even when it is not,
-- but not vice versa. This is to be passed
-- to finalizePD.
-- | Returns true if a dependency is satisfiable. This function may
-- report a dependency satisfiable even when it is not, but not vice
-- versa. This is to be passed to finalizePD.
dependencySatisfiable
:: Bool
-> Version
:: Bool -- ^ use external internal deps?
-> Bool -- ^ exact configuration?
-> PackageName
-> InstalledPackageIndex -- ^ installed set
-> Map PackageName ComponentName -- ^ internal set
-> Map PackageName InstalledPackageInfo -- ^ required dependencies
-> (Dependency -> Bool)
dependencySatisfiable
exact_config _ installedPackageSet internalPackageSet requiredDepsMap
d@(Dependency depName _)
| exact_config =
-- When we're given '--exact-configuration', we assume that all
-- dependencies and flags are exactly specified on the command
-- line. Thus we only consult the 'requiredDepsMap'. Note that
-- we're not doing the version range check, so if there's some
-- dependency that wasn't specified on the command line,
-- 'finalizePD' will fail.
--
-- TODO: mention '--exact-configuration' in the error message
-- when this fails?
--
-- (However, note that internal deps don't have to be
-- specified!)
--
-- NB: Just like the case below, we might incorrectly
-- determine an external internal dep is satisfiable
-- when it actually isn't.
(depName `Map.member` requiredDepsMap) || isInternalDep
| isInternalDep =
-- If a 'PackageName' is defined by an internal component, the
-- dep is satisfiable (and we are going to use the internal
-- dependency.) Note that this doesn't mean we are actually
-- going to SUCCEED when we configure the package, if
-- UseExternalInternalDeps is True.
True
use_external_internal_deps
exact_config pn installedPackageSet internalPackageSet requiredDepsMap
(Dependency depName0 vr)
-- When we are doing per-component configure, the behavior is very
-- uniform: if an exact configuration is requested, check for the
-- dep in requiredDepsMap; otherwise, check if the dep is in
-- the index
| use_external_internal_deps
= depSatisfiable
-- If we are not per-component, internal dependencies need to
-- be treated specially
| otherwise
= if isInternalDep
-- If a 'PackageName' is defined by an internal component, the dep is
-- satisfiable (we're going to build it ourselves)
then True
-- Otherwise, handle as before
else depSatisfiable
| otherwise =
-- Normal operation: just look up dependency in the
-- package index.
not . null . PackageIndex.lookupDependency installedPackageSet $ d
where
isInternalDep = Map.member depName internalPackageSet
where
isInternalDep = Map.member depName0 internalPackageSet
-- When we're given '--exact-configuration', we assume that all
-- dependencies and flags are exactly specified on the command
-- line. Thus we only consult the 'requiredDepsMap'. Note that
-- we're not doing the version range check, so if there's some
-- dependency that wasn't specified on the command line,
-- 'finalizePD' will fail.
--
-- TODO: mention '--exact-configuration' in the error message
-- when this fails?
depSatisfiable =
if exact_config
-- NB: required deps map is indexed by *compat* package name.
then depName `Map.member` requiredDepsMap
else not . null . PackageIndex.lookupDependency installedPackageSet $ d
-- When it's an internal library, we have to lookup the *compat*
-- package name in the database; the real one won't match anything
d = Dependency depName vr
depName
| isInternalDep && pn /= depName0
= computeCompatPackageName pn
-- TODO: Don't go through String
-- TODO: Hard-coding this to be a sub-library is a
-- bit grotty, but currently it seems that this
-- function is only called on build-depends
-- dependencies, which must be libraries. If
-- pn /= depName0, then it must be a sub library!
(CSubLibName (mkUnqualComponentName (unPackageName depName0)))
| otherwise = depName0
-- | Relax the dependencies of this package if needed.
relaxPackageDeps :: (VersionRange -> VersionRange)
......
......@@ -476,10 +476,22 @@ tests config = do
tcs "ConfigureComponent/SubLib" "sublib-explicit" $ do
withPackageDb $ do
base_id <- getIPID "base"
cabal_install ["sublib", "--cid", "sublib-0.1-abc"]
cabal_install ["exe", "--dependency", "sublib=sublib-0.1-abc"]
cabal_install ["exe", "--exact-configuration"
, "--dependency", "sublib=sublib-0.1-abc"
, "--dependency", "base=" ++ base_id
]
runExe' "exe" [] >>= assertOutputContains "OK"
tcs "ConfigureComponent/SubLib" "sublib-explicit-fail" $ do
withPackageDb $ do
base_id <- getIPID "base"
cabal_install ["sublib", "--cid", "sublib-0.1-abc"]
r <- shouldFail $ cabal' "configure" ["exe", "--exact-configuration"
, "--dependency", "base=" ++ base_id]
assertOutputContains "sublib" r
tcs "ConfigureComponent/SubLib" "sublib" $ do
withPackageDb $ do
cabal_install ["sublib"]
......@@ -641,10 +653,7 @@ tests config = do
tcs "Backpack/Includes3" "external-ok" . whenGhcVersion (>= mkVersion [8,1]) $ do
withPackageDb $ do
containers_result <- ghcPkg' "field" ["--global", "containers", "id"]
containers_id <- case stripPrefix "id: " (resultOutput containers_result) of
Just x -> return (takeWhile (not . Char.isSpace) x)
Nothing -> error "could not determine id of containers"
containers_id <- getIPID "containers"
withPackage "sigs" $ cabal_install_with_docs ["--ipid", "sigs-0.1.0.0"]
withPackage "indef" $ cabal_install_with_docs ["--ipid", "indef-0.1.0.0"]
withPackage "sigs" $ do
......@@ -747,3 +756,10 @@ tests config = do
tcs :: FilePath -> FilePath -> TestM a -> TestTreeM ()
tcs name sub_name m
= testTreeSub config name sub_name m
getIPID :: String -> TestM String
getIPID pn = do
r <- ghcPkg' "field" ["--global", pn, "id"]
case stripPrefix "id: " (resultOutput r) of
Just x -> return (takeWhile (not . Char.isSpace) x)
Nothing -> error $ "could not determine id of " ++ pn
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment