diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs
index b44106bde67f1fe7cf80019f4e6e8eabfa45cfdd..4de9b46a9a31c7b6d3e25e989c14e9de6295130b 100644
--- a/compiler/main/Packages.hs
+++ b/compiler/main/Packages.hs
@@ -816,10 +816,9 @@ updateVisibilityMap wiredInMap vis_map = foldl' f vis_map (Map.toList wiredInMap
-- ----------------------------------------------------------------------------
-type IsShadowed = Bool
data UnusablePackageReason
= IgnoredWithFlag
- | MissingDependencies IsShadowed [UnitId]
+ | MissingDependencies [UnitId]
type UnusablePackages = Map UnitId
(PackageConfig, UnusablePackageReason)
@@ -828,11 +827,8 @@ pprReason :: SDoc -> UnusablePackageReason -> SDoc
pprReason pref reason = case reason of
IgnoredWithFlag ->
pref <+> text "ignored due to an -ignore-package flag"
- MissingDependencies is_shadowed deps ->
- pref <+> text "unusable due to"
- <+> (if is_shadowed then text "shadowed"
- else text "missing or recursive")
- <+> text "dependencies:" $$
+ MissingDependencies deps ->
+ pref <+> text "unusable due to missing or recursive dependencies:" $$
nest 2 (hsep (map ppr deps))
reportUnusable :: DynFlags -> UnusablePackages -> IO ()
@@ -851,16 +847,15 @@ reportUnusable dflags pkgs = mapM_ report (Map.toList pkgs)
-- dependency graph, repeatedly adding packages whose dependencies are
-- satisfied until no more can be added.
--
-findBroken :: IsShadowed
- -> [PackageConfig]
+findBroken :: [PackageConfig]
-> Map UnitId PackageConfig
-> UnusablePackages
-findBroken is_shadowed pkgs pkg_map0 = go [] pkg_map0 pkgs
+findBroken pkgs pkg_map0 = go [] pkg_map0 pkgs
where
go avail pkg_map not_avail =
case partitionWith (depsAvailable pkg_map) not_avail of
([], not_avail) ->
- Map.fromList [ (unitId p, (p, MissingDependencies is_shadowed deps))
+ Map.fromList [ (unitId p, (p, MissingDependencies deps))
| (p,deps) <- not_avail ]
(new_avail, not_avail) ->
go (new_avail ++ avail) pkg_map' (map fst not_avail)
@@ -962,71 +957,53 @@ mkPackageState dflags dbs preload0 = do
let other_flags = reverse (packageFlags dflags)
ignore_flags = reverse (ignorePackageFlags dflags)
- let merge (pkg_map, prev_unusable) (db_path, db) = do
+ let merge pkg_map (db_path, db) = do
+ debugTraceMsg dflags 2 $
+ text "loading package database" <+> text db_path
+ forM_ (Set.toList override_set) $ \pkg ->
debugTraceMsg dflags 2 $
- text "loading package database" <+> text db_path
- forM_ (Set.toList shadow_set) $ \pkg ->
- debugTraceMsg dflags 2 $
- text "package" <+> ppr pkg <+>
- text "shadows a previously defined package"
- reportUnusable dflags unusable
- -- NB: an unusable unit ID can become usable again
- -- if it's validly specified in a later package stack.
- -- Keep unusable up-to-date!
- return (pkg_map', (prev_unusable `Map.difference` pkg_map')
- `Map.union` unusable)
- where -- The set of UnitIds which appear in both
- -- db and pkgs (to be shadowed from pkgs)
- shadow_set :: Set UnitId
- shadow_set = foldr ins Set.empty db
- where ins pkg s
- -- If the package from the upper database is
- -- in the lower database, and the ABIs don't
- -- match...
- | Just old_pkg <- Map.lookup (unitId pkg) pkg_map
- , abiHash old_pkg /= abiHash pkg
- -- ...add this unit ID to the set of unit IDs
- -- which (transitively) should be shadowed from
- -- the lower database.
- = Set.insert (unitId pkg) s
- | otherwise
- = s
- -- Remove shadow_set from pkg_map...
- shadowed_pkgs0 :: [PackageConfig]
- shadowed_pkgs0 = filter (not . (`Set.member` shadow_set) . unitId)
- (Map.elems pkg_map)
- -- ...and then remove anything transitively broken
- -- this way.
- shadowed = findBroken True shadowed_pkgs0 Map.empty
- shadowed_pkgs :: [PackageConfig]
- shadowed_pkgs = filter (not . (`Map.member` shadowed) . unitId)
- shadowed_pkgs0
-
- -- Apply ignore flags to db (TODO: could extend command line
- -- flag format to support per-database ignore now! More useful
- -- than what we have now.)
- ignored = ignorePackages ignore_flags db
- db2 = filter (not . (`Map.member` ignored) . unitId) db
-
- -- Look for broken packages (either from ignore, or possibly
- -- because the db was broken to begin with)
- mk_pkg_map = Map.fromList . map (\p -> (unitId p, p))
- broken = findBroken False db2 (mk_pkg_map shadowed_pkgs)
- db3 = filter (not . (`Map.member` broken) . unitId) db2
-
- unusable = shadowed `Map.union` ignored
- `Map.union` broken
-
- -- Now merge the sets together (NB: later overrides
- -- earlier!)
- pkg_map' :: Map UnitId PackageConfig
- pkg_map' = mk_pkg_map (shadowed_pkgs ++ db3)
-
- (pkg_map1, unusable) <- foldM merge (Map.empty, Map.empty) dbs
+ text "package" <+> ppr pkg <+>
+ text "overrides a previously defined package"
+ return pkg_map'
+ where
+ db_map = mk_pkg_map db
+ mk_pkg_map = Map.fromList . map (\p -> (unitId p, p))
+
+ -- The set of UnitIds which appear in both db and pkgs. These are the
+ -- ones that get overridden. Compute this just to give some
+ -- helpful debug messages at -v2
+ override_set :: Set UnitId
+ override_set = Set.intersection (Map.keysSet db_map)
+ (Map.keysSet pkg_map)
+
+ -- Now merge the sets together (NB: in case of duplicate,
+ -- first argument preferred)
+ pkg_map' :: Map UnitId PackageConfig
+ pkg_map' = Map.union db_map pkg_map
+
+ pkg_map1 <- foldM merge Map.empty dbs
+
+ -- Now that we've merged everything together, prune out unusable
+ -- packages.
+ let pkgs01 = Map.elems pkg_map1
+
+ -- First, apply ignore flags to db
+ ignored = ignorePackages ignore_flags pkgs01
+ pkgs02 = filter (not . (`Map.member` ignored) . unitId) pkgs01
+
+ -- Look for broken packages (either from ignore, or possibly
+ -- because the db was broken to begin with)
+ broken = findBroken pkgs02 Map.empty
+ pkgs03 = filter (not . (`Map.member` broken) . unitId) pkgs02
+
+ unusable = ignored `Map.union` broken
+
+ reportUnusable dflags unusable
+
-- Apply trust flags (these flags apply regardless of whether
-- or not packages are visible or not)
pkgs1 <- foldM (applyTrustFlag dflags unusable)
- (Map.elems pkg_map1) (reverse (trustFlags dflags))
+ pkgs03 (reverse (trustFlags dflags))
--
-- Calculate the initial set of packages, prior to any package flags.
diff --git a/docs/users_guide/packages.rst b/docs/users_guide/packages.rst
index d3da125d587a6bba3e69e28a900bd29d1febb464..9c577fbfaa6743436ffd28392b77e0bc5796fe46 100644
--- a/docs/users_guide/packages.rst
+++ b/docs/users_guide/packages.rst
@@ -392,10 +392,10 @@ to packages below, but not vice versa).
*Package shadowing:* When multiple package databases are in use it
is possible, though rarely, that the same installed package id is present in
more than one database. In that case, packages closer to the top of the stack
-will override (*shadow*) those below them. If the conflicting packages are
-found to be equivalent (by ABI hash comparison) then one of them replaces all
-references to the other, otherwise the overridden package and all those
-depending on it will be removed.
+will *override* those below them. Shadowing is an *unsafe* operation:
+if a package overrides another package it is not ABI compatible with,
+it is possible that GHC will end up with an inconsistent view of the
+package database that could induce it to build segfaulting executables.
*Package version selection:* When selecting a package, GHC will search for
packages in all available databases. If multiple versions of the same package
diff --git a/testsuite/tests/cabal/Makefile b/testsuite/tests/cabal/Makefile
index cbf8cbb7ed0b2ca34ce94d321a14b4d3715da847..4115a6df726eea6b8d6b04ed5dba497614a4b5e8 100644
--- a/testsuite/tests/cabal/Makefile
+++ b/testsuite/tests/cabal/Makefile
@@ -134,14 +134,11 @@ LOCAL_GHC_PKGSHADOW3 = '$(GHC_PKG)' --no-user-package-db -f $(PKGCONFSHADOW3)
LOCAL_GHC_PKGSHADOW12 = '$(GHC_PKG)' --no-user-package-db -f $(PKGCONFSHADOW1) -f $(PKGCONFSHADOW2)
LOCAL_GHC_PKGSHADOW13 = '$(GHC_PKG)' --no-user-package-db -f $(PKGCONFSHADOW1) -f $(PKGCONFSHADOW3)
-# Test package shadowing behaviour.
+# Test package overriding behaviour.
#
# localshadow1.package.conf: shadowdep-1-XXX <- shadow-1-XXX
# localshadow2.package.conf: shadow-1-XXX
#
-# If the ABI hash of boths shadow-1s are the same, we'll just accept
-# the later shadow version. However, if the ABIs are different, we
-# should complain!
shadow:
rm -rf $(PKGCONFSHADOW1) $(PKGCONFSHADOW2) $(PKGCONFSHADOW3) shadow.hs shadow.o shadow.hi shadow.out shadow.hs shadow.hi
$(LOCAL_GHC_PKGSHADOW1) init $(PKGCONFSHADOW1)
@@ -150,7 +147,7 @@ shadow:
$(LOCAL_GHC_PKGSHADOW1) register -v0 --force shadow1.pkg
$(LOCAL_GHC_PKGSHADOW1) register -v0 --force shadow2.pkg
$(LOCAL_GHC_PKGSHADOW2) register -v0 --force shadow3.pkg
- $(LOCAL_GHC_PKGSHADOW3) register -v0 --force shadow1.pkg
+ $(LOCAL_GHC_PKGSHADOW3) register -v0 --force shadow2.pkg
@echo "databases 1 and 2:"
$(LOCAL_GHC_PKGSHADOW12) list
@echo "databases 1 and 3:"
@@ -158,22 +155,21 @@ shadow:
echo "main = return ()" >shadow.hs
#
# In this test, the later database defines a new shadow-1-XXX which
-# shadows the old one, making shadowdep unsatisfiable.
+# overrides the old one.
#
- @echo "should FAIL:"
- if '$(TEST_HC)' $(TEST_HC_OPTS) -package-db $(PKGCONFSHADOW1) -package-db $(PKGCONFSHADOW2) -package shadowdep -c shadow.hs -fno-code; then false; else true; fi
+ @echo "should SUCCEED:"
+ '$(TEST_HC)' $(TEST_HC_OPTS) -package-db $(PKGCONFSHADOW1) -package-db $(PKGCONFSHADOW2) -package shadowdep -c shadow.hs -fno-code
#
-# Reversing the orders of the configs fixes the problem, because now
-# the shadow-1-XXX defined in the same DB as shadowdep shadows
-# shadow-1-XXX in localshadow2.package.conf
+# Reversing the orders of the configs also works; this time the copy from
+# db1 wins out.
#
@echo "should SUCCEED:"
'$(TEST_HC)' $(TEST_HC_OPTS) -package-db $(PKGCONFSHADOW2) -package-db $(PKGCONFSHADOW1) -package shadowdep -c shadow.hs -fno-code
#
-# When the ABIs are the same, dependencies don't break, we just swap it in
+# We can pass DBs out of order
#
@echo "should SUCCEED:"
- '$(TEST_HC)' $(TEST_HC_OPTS) -package-db $(PKGCONFSHADOW3) -package-db $(PKGCONFSHADOW1) -package shadowdep -c shadow.hs -fno-code
+ '$(TEST_HC)' $(TEST_HC_OPTS) -package-db $(PKGCONFSHADOW3) -package-db $(PKGCONFSHADOW2) -package shadowdep -c shadow.hs -fno-code
# If we pass --global, we should ignore instances in the user database
T5442a:
diff --git a/testsuite/tests/cabal/cabal08/all.T b/testsuite/tests/cabal/cabal08/all.T
index fc4221a769a9efa9829aceb4313a21368e60c69f..a0ca1d855beddc4d0e1342928dd6cdbf873ee3a4 100644
--- a/testsuite/tests/cabal/cabal08/all.T
+++ b/testsuite/tests/cabal/cabal08/all.T
@@ -3,7 +3,9 @@ if default_testopts.cleanup != '':
else:
cleanup = ''
+# This test is broken since we eliminated the fancy shadowing logic; skip it for
+# now. See #12485.
test('cabal08',
- normal,
+ skip,
run_command,
['$MAKE -s --no-print-directory cabal08 ' + cleanup])
diff --git a/testsuite/tests/cabal/shadow.stderr b/testsuite/tests/cabal/shadow.stderr
index 601e33714f2895d5945d31eed541b6b07f8fb47e..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 100644
--- a/testsuite/tests/cabal/shadow.stderr
+++ b/testsuite/tests/cabal/shadow.stderr
@@ -1,4 +0,0 @@
-<command line>: cannot satisfy -package shadowdep:
- shadowdep-1-XXX is unusable due to shadowed dependencies:
- shadow-1-XXX
- (use -v for more information)
diff --git a/testsuite/tests/cabal/shadow.stdout b/testsuite/tests/cabal/shadow.stdout
index a47ce15795d070131f5239c8687b073ab84d62ee..1f3a5468472920d9113b737863786036bedea8a0 100644
--- a/testsuite/tests/cabal/shadow.stdout
+++ b/testsuite/tests/cabal/shadow.stdout
@@ -12,8 +12,8 @@ localshadow1.package.conf
(shadowdep-1)
localshadow3.package.conf
- (shadow-1)
+ (shadowdep-1)
-should FAIL:
+should SUCCEED:
should SUCCEED:
should SUCCEED: