summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/backpack/DriverBkp.hs1
-rw-r--r--compiler/ghc.cabal.in2
-rw-r--r--compiler/main/Packages.hs324
-rw-r--r--ghc/ghc-bin.cabal.in2
m---------libraries/Cabal0
-rw-r--r--libraries/ghc-boot/GHC/PackageDb.hs12
m---------libraries/hpc0
m---------libraries/time0
-rw-r--r--testsuite/driver/extra_files.py1
-rw-r--r--testsuite/tests/cabal/Makefile41
-rw-r--r--testsuite/tests/cabal/T12485/Makefile4
-rw-r--r--testsuite/tests/cabal/T12485/all.T3
-rw-r--r--testsuite/tests/cabal/T12485a.stdout3
-rw-r--r--testsuite/tests/cabal/T1750.stderr2
-rw-r--r--testsuite/tests/cabal/all.T7
-rw-r--r--testsuite/tests/cabal/shadow1.pkg1
-rw-r--r--testsuite/tests/cabal/shadow2.pkg2
-rw-r--r--testsuite/tests/cabal/shadow3.pkg1
-rw-r--r--testsuite/tests/perf/haddock/all.T3
-rw-r--r--utils/ghc-cabal/Main.hs2
-rw-r--r--utils/ghc-pkg/Main.hs1
21 files changed, 279 insertions, 133 deletions
diff --git a/compiler/backpack/DriverBkp.hs b/compiler/backpack/DriverBkp.hs
index cdbe06d51f..fc46ce1752 100644
--- a/compiler/backpack/DriverBkp.hs
+++ b/compiler/backpack/DriverBkp.hs
@@ -302,6 +302,7 @@ buildUnit session cid insts lunit = do
$ deps ++ [ moduleUnitId mod
| (_, mod) <- insts
, not (isHoleModule mod) ],
+ abiDepends = [],
ldOptions = case session of
TcSession -> []
_ -> obj_files,
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 99bb463f54..a7d380afb6 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -55,7 +55,7 @@ Library
process >= 1 && < 1.5,
bytestring >= 0.9 && < 0.11,
binary == 0.8.*,
- time >= 1.4 && < 1.7,
+ time >= 1.4 && < 1.8,
containers >= 0.5 && < 0.6,
array >= 0.1 && < 0.6,
filepath >= 1 && < 1.5,
diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs
index b6b5e3c0a1..5f1a7d5d30 100644
--- a/compiler/main/Packages.hs
+++ b/compiler/main/Packages.hs
@@ -83,6 +83,7 @@ import System.Directory
import System.FilePath as FilePath
import qualified System.FilePath.Posix as FilePath.Posix
import Control.Monad
+import Data.Graph (stronglyConnComp, SCC(..))
import Data.Char ( toUpper )
import Data.List as List
import Data.Map (Map)
@@ -95,7 +96,6 @@ import qualified Data.Semigroup as Semigroup
#endif
import qualified Data.Map as Map
import qualified Data.Map.Strict as MapStrict
-import qualified FiniteMap as Map
import qualified Data.Set as Set
-- ---------------------------------------------------------------------------
@@ -1024,14 +1024,30 @@ updateVisibilityMap wiredInMap vis_map = foldl' f vis_map (Map.toList wiredInMap
-- ----------------------------------------------------------------------------
-type IsShadowed = Bool
+-- | The reason why a package is unusable.
data UnusablePackageReason
- = IgnoredWithFlag
- | MissingDependencies IsShadowed [InstalledUnitId]
+ = -- | We ignored it explicitly using @-ignore-package@.
+ IgnoredWithFlag
+ -- | This package transitively depends on a package that was never present
+ -- in any of the provided databases.
+ | BrokenDependencies [InstalledUnitId]
+ -- | This package transitively depends on a package involved in a cycle.
+ -- Note that the list of 'InstalledUnitId' reports the direct dependencies
+ -- of this package that (transitively) depended on the cycle, and not
+ -- the actual cycle itself (which we report separately at high verbosity.)
+ | CyclicDependencies [InstalledUnitId]
+ -- | This package transitively depends on a package which was ignored.
+ | IgnoredDependencies [InstalledUnitId]
+ -- | This package transitively depends on a package which was
+ -- shadowed by an ABI-incompatible package.
+ | ShadowedDependencies [InstalledUnitId]
+
instance Outputable UnusablePackageReason where
ppr IgnoredWithFlag = text "[ignored with flag]"
- ppr (MissingDependencies b uids) =
- brackets (if b then text "shadowed" else empty <+> ppr uids)
+ ppr (BrokenDependencies uids) = brackets (text "broken" <+> ppr uids)
+ ppr (CyclicDependencies uids) = brackets (text "cyclic" <+> ppr uids)
+ ppr (IgnoredDependencies uids) = brackets (text "ignored" <+> ppr uids)
+ ppr (ShadowedDependencies uids) = brackets (text "shadowed" <+> ppr uids)
type UnusablePackages = Map InstalledUnitId
(PackageConfig, UnusablePackageReason)
@@ -1040,13 +1056,28 @@ 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:" $$
+ BrokenDependencies deps ->
+ pref <+> text "unusable due to missing dependencies:" $$
+ nest 2 (hsep (map ppr deps))
+ CyclicDependencies deps ->
+ pref <+> text "unusable due to cyclic dependencies:" $$
+ nest 2 (hsep (map ppr deps))
+ IgnoredDependencies deps ->
+ pref <+> text "unusable due to ignored dependencies:" $$
+ nest 2 (hsep (map ppr deps))
+ ShadowedDependencies deps ->
+ pref <+> text "unusable due to shadowed dependencies:" $$
nest 2 (hsep (map ppr deps))
+reportCycles :: DynFlags -> [SCC PackageConfig] -> IO ()
+reportCycles dflags sccs = mapM_ report sccs
+ where
+ report (AcyclicSCC _) = return ()
+ report (CyclicSCC vs) =
+ debugTraceMsg dflags 2 $
+ text "these packages are involved in a cycle:" $$
+ nest 2 (hsep (map (ppr . unitId) vs))
+
reportUnusable :: DynFlags -> UnusablePackages -> IO ()
reportUnusable dflags pkgs = mapM_ report (Map.toList pkgs)
where
@@ -1057,36 +1088,60 @@ reportUnusable dflags pkgs = mapM_ report (Map.toList pkgs)
-- ----------------------------------------------------------------------------
--
--- Detect any packages that have missing dependencies, and also any
--- mutually-recursive groups of packages (loops in the package graph
--- are not allowed). We do this by taking the least fixpoint of the
--- dependency graph, repeatedly adding packages whose dependencies are
--- satisfied until no more can be added.
+-- Utilities on the database
--
-findBroken :: IsShadowed
- -> [PackageConfig]
- -> Map InstalledUnitId PackageConfig
- -> UnusablePackages
-findBroken is_shadowed 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))
- | (p,deps) <- not_avail ]
- (new_avail, not_avail) ->
- go (new_avail ++ avail) pkg_map' (map fst not_avail)
- where pkg_map' = Map.insertList
- [ (unitId p, p) | p <- new_avail ]
- pkg_map
-
- depsAvailable :: InstalledPackageIndex
+
+-- | A reverse dependency index, mapping an 'InstalledUnitId' to
+-- the 'InstalledUnitId's which have a dependency on it.
+type RevIndex = Map InstalledUnitId [InstalledUnitId]
+
+-- | Compute the reverse dependency index of a package database.
+reverseDeps :: InstalledPackageIndex -> RevIndex
+reverseDeps db = Map.foldl' go Map.empty db
+ where
+ go r pkg = foldl' (go' (unitId pkg)) r (depends pkg)
+ go' from r to = Map.insertWith (++) to [from] r
+
+-- | Given a list of 'InstalledUnitId's to remove, a database,
+-- and a reverse dependency index (as computed by 'reverseDeps'),
+-- remove those packages, plus any packages which depend on them.
+-- Returns the pruned database, as well as a list of 'PackageConfig's
+-- that was removed.
+removePackages :: [InstalledUnitId] -> RevIndex
+ -> InstalledPackageIndex
+ -> (InstalledPackageIndex, [PackageConfig])
+removePackages uids index m = go uids (m,[])
+ where
+ go [] (m,pkgs) = (m,pkgs)
+ go (uid:uids) (m,pkgs)
+ | Just pkg <- Map.lookup uid m
+ = case Map.lookup uid index of
+ Nothing -> go uids (Map.delete uid m, pkg:pkgs)
+ Just rdeps -> go (rdeps ++ uids) (Map.delete uid m, pkg:pkgs)
+ | otherwise
+ = go uids (m,pkgs)
+
+-- | Given a 'PackageConfig' from some 'InstalledPackageIndex',
+-- return all entries in 'depends' which correspond to packages
+-- that do not exist in the index.
+depsNotAvailable :: InstalledPackageIndex
-> PackageConfig
- -> Either PackageConfig (PackageConfig, [InstalledUnitId])
- depsAvailable pkg_map pkg
- | null dangling = Left pkg
- | otherwise = Right (pkg, dangling)
- where dangling = filter (not . (`Map.member` pkg_map)) (depends pkg)
+ -> [InstalledUnitId]
+depsNotAvailable pkg_map pkg = filter (not . (`Map.member` pkg_map)) (depends pkg)
+
+-- | Given a 'PackageConfig' from some 'InstalledPackageIndex'
+-- return all entries in 'abiDepends' which correspond to packages
+-- that do not exist, OR have mismatching ABIs.
+depsAbiMismatch :: InstalledPackageIndex
+ -> PackageConfig
+ -> [InstalledUnitId]
+depsAbiMismatch pkg_map pkg = map fst . filter (not . abiMatch) $ abiDepends pkg
+ where
+ abiMatch (dep_uid, abi)
+ | Just dep_pkg <- Map.lookup dep_uid pkg_map
+ = abiHash dep_pkg == abi
+ | otherwise
+ = False
-- -----------------------------------------------------------------------------
-- Ignore packages
@@ -1102,6 +1157,98 @@ ignorePackages flags pkgs = Map.fromList (concatMap doit flags)
-- because a common usage is to -ignore-package P as
-- a preventative measure just in case P exists.
+-- ----------------------------------------------------------------------------
+--
+-- Merging databases
+--
+
+-- | Given a list of databases, merge them together, where
+-- packages with the same unit id in later databases override
+-- earlier ones. This does NOT check if the resulting database
+-- makes sense (that's done by 'validateDatabase').
+mergeDatabases :: DynFlags -> [(FilePath, [PackageConfig])]
+ -> IO InstalledPackageIndex
+mergeDatabases dflags = foldM merge Map.empty
+ where
+ 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 "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 InstalledUnitId
+ 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' :: InstalledPackageIndex
+ pkg_map' = Map.union db_map pkg_map
+
+-- | Validates a database, removing unusable packages from it
+-- (this includes removing packages that the user has explicitly
+-- ignored.) Our general strategy:
+--
+-- 1. Remove all broken packages (dangling dependencies)
+-- 2. Remove all packages that are cyclic
+-- 3. Apply ignore flags
+-- 4. Remove all packages which have deps with mismatching ABIs
+--
+validateDatabase :: DynFlags -> InstalledPackageIndex
+ -> (InstalledPackageIndex, UnusablePackages, [SCC PackageConfig])
+validateDatabase dflags pkg_map1 =
+ (pkg_map5, unusable, sccs)
+ where
+ ignore_flags = reverse (ignorePackageFlags dflags)
+
+ -- Compute the reverse dependency index
+ index = reverseDeps pkg_map1
+
+ -- Helper function
+ mk_unusable mk_err dep_matcher m uids =
+ Map.fromList [ (unitId pkg, (pkg, mk_err (dep_matcher m pkg)))
+ | pkg <- uids ]
+
+ -- Find broken packages
+ directly_broken = filter (not . null . depsNotAvailable pkg_map1)
+ (Map.elems pkg_map1)
+ (pkg_map2, broken) = removePackages (map unitId directly_broken) index pkg_map1
+ unusable_broken = mk_unusable BrokenDependencies depsNotAvailable pkg_map2 broken
+
+ -- Find recursive packages
+ sccs = stronglyConnComp [ (pkg, unitId pkg, depends pkg)
+ | pkg <- Map.elems pkg_map2 ]
+ getCyclicSCC (CyclicSCC vs) = map unitId vs
+ getCyclicSCC (AcyclicSCC _) = []
+ (pkg_map3, cyclic) = removePackages (concatMap getCyclicSCC sccs) index pkg_map2
+ unusable_cyclic = mk_unusable CyclicDependencies depsNotAvailable pkg_map3 cyclic
+
+ -- Apply ignore flags
+ directly_ignored = ignorePackages ignore_flags (Map.elems pkg_map3)
+ (pkg_map4, ignored) = removePackages (Map.keys directly_ignored) index pkg_map3
+ unusable_ignored = mk_unusable IgnoredDependencies depsNotAvailable pkg_map4 ignored
+
+ -- Knock out packages whose dependencies don't agree with ABI
+ -- (i.e., got invalidated due to shadowing)
+ directly_shadowed = filter (not . null . depsAbiMismatch pkg_map4)
+ (Map.elems pkg_map4)
+ (pkg_map5, shadowed) = removePackages (map unitId directly_shadowed) index pkg_map4
+ unusable_shadowed = mk_unusable ShadowedDependencies depsAbiMismatch pkg_map5 shadowed
+
+ unusable = directly_ignored `Map.union` unusable_ignored
+ `Map.union` unusable_broken
+ `Map.union` unusable_cyclic
+ `Map.union` unusable_shadowed
+
-- -----------------------------------------------------------------------------
-- When all the command-line options are in, we can process our package
-- settings and populate the package state.
@@ -1124,25 +1271,24 @@ mkPackageState dflags dbs preload0 = do
1. We want to build a single, unified package database based
on all of the input databases, which upholds the invariant that
- there is only one package per any UnitId, and that there are no
- dangling dependencies. We'll do this by successively merging each
- input database into this unified database:
+ there is only one package per any UnitId and there are no
+ dangling dependencies. We'll do this by merging, and
+ then successively filtering out bad dependencies.
- a) if an input database defines unit ID that is already in
+ a) Merge all the databases together.
+ If an input database defines unit ID that is already in
the unified database, that package SHADOWS the existing
- package in the current unified database
- * for every such shadowed package, we remove it and any
- packages which transitively depend on it from the
- unified datbase
+ package in the current unified database.
- b) remove packages selected by -ignore-package from input database
+ b) Remove all packages with missing dependencies, or
+ mutually recursive dependencies.
- c) remove any packages with missing dependencies or mutually recursive
- dependencies from the input database
+ b) Remove packages selected by -ignore-package from input database
- d) report (with -v) any packages that were removed by steps 1-3
+ c) Remove all packages which depended on packages that are now
+ shadowed by an ABI-incompatible package
- e) merge the input database into the unified database
+ d) report (with -v) any packages that were removed by steps 1-3
2. We want to look at the flags controlling package visibility,
and build a mapping of what module names are in scope and
@@ -1170,75 +1316,23 @@ mkPackageState dflags dbs preload0 = do
-}
let other_flags = reverse (packageFlags dflags)
- ignore_flags = reverse (ignorePackageFlags dflags)
debugTraceMsg dflags 2 $
text "package flags" <+> ppr other_flags
- let merge (pkg_map, prev_unusable) (db_path, db) = do
- 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 InstalledUnitId
- 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 InstalledUnitId PackageConfig
- pkg_map' = mk_pkg_map (shadowed_pkgs ++ db3)
-
- (pkg_map1, unusable) <- foldM merge (Map.empty, Map.empty) dbs
+ -- Merge databases together, without checking validity
+ pkg_map1 <- mergeDatabases dflags dbs
+
+ -- Now that we've merged everything together, prune out unusable
+ -- packages.
+ let (pkg_map2, unusable, sccs) = validateDatabase dflags pkg_map1
+
+ reportCycles dflags sccs
+ 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))
+ (Map.elems pkg_map2) (reverse (trustFlags dflags))
let prelim_pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs1
--
diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in
index b9babfec76..dce6142dce 100644
--- a/ghc/ghc-bin.cabal.in
+++ b/ghc/ghc-bin.cabal.in
@@ -52,7 +52,7 @@ Executable ghc
deepseq == 1.4.*,
ghci == @ProjectVersionMunged@,
haskeline == 0.7.*,
- time == 1.6.*,
+ time == 1.7.*,
transformers == 0.5.*
CPP-Options: -DGHCI
GHC-Options: -fno-warn-name-shadowing
diff --git a/libraries/Cabal b/libraries/Cabal
-Subproject 034b44191740214c9e691439b604a8ac95ee994
+Subproject 09865f60caa55a7b02880f2a779c9dd8e1be5ac
diff --git a/libraries/ghc-boot/GHC/PackageDb.hs b/libraries/ghc-boot/GHC/PackageDb.hs
index 09991092ee..9b2889f4cf 100644
--- a/libraries/ghc-boot/GHC/PackageDb.hs
+++ b/libraries/ghc-boot/GHC/PackageDb.hs
@@ -66,7 +66,8 @@ import System.Directory
-- | This is a subset of Cabal's 'InstalledPackageInfo', with just the bits
--- that GHC is interested in.
+-- that GHC is interested in. See Cabal's documentation for a more detailed
+-- description of all of the fields.
--
data InstalledPackageInfo compid srcpkgid srcpkgname instunitid unitid modulename mod
= InstalledPackageInfo {
@@ -78,6 +79,9 @@ data InstalledPackageInfo compid srcpkgid srcpkgname instunitid unitid modulenam
packageVersion :: Version,
abiHash :: String,
depends :: [instunitid],
+ -- | Like 'depends', but each dependency is annotated with the
+ -- ABI hash we expect the dependency to respect.
+ abiDepends :: [(instunitid, String)],
importDirs :: [FilePath],
hsLibraries :: [String],
extraLibraries :: [String],
@@ -159,6 +163,7 @@ emptyInstalledPackageInfo =
packageVersion = Version [] [],
abiHash = "",
depends = [],
+ abiDepends = [],
importDirs = [],
hsLibraries = [],
extraLibraries = [],
@@ -307,7 +312,7 @@ instance (RepInstalledPackageInfo a b c d e f g) =>
put (InstalledPackageInfo
unitId componentId instantiatedWith sourcePackageId
packageName packageVersion
- abiHash depends importDirs
+ abiHash depends abiDepends importDirs
hsLibraries extraLibraries extraGHCiLibraries
libraryDirs libraryDynDirs
frameworks frameworkDirs
@@ -325,6 +330,7 @@ instance (RepInstalledPackageInfo a b c d e f g) =>
instantiatedWith)
put abiHash
put (map toStringRep depends)
+ put (map (\(k,v) -> (toStringRep k, v)) abiDepends)
put importDirs
put hsLibraries
put extraLibraries
@@ -355,6 +361,7 @@ instance (RepInstalledPackageInfo a b c d e f g) =>
instantiatedWith <- get
abiHash <- get
depends <- get
+ abiDepends <- get
importDirs <- get
hsLibraries <- get
extraLibraries <- get
@@ -383,6 +390,7 @@ instance (RepInstalledPackageInfo a b c d e f g) =>
(fromStringRep packageName) packageVersion
abiHash
(map fromStringRep depends)
+ (map (\(k,v) -> (fromStringRep k, v)) abiDepends)
importDirs
hsLibraries extraLibraries extraGHCiLibraries
libraryDirs libraryDynDirs
diff --git a/libraries/hpc b/libraries/hpc
-Subproject 8625c1c0550719437acad89d49401cf04899008
+Subproject 92673292ab7ce7878e982d0a02df3e548ef15b5
diff --git a/libraries/time b/libraries/time
-Subproject 52e0f5e85ffbaab77b155d48720fb216021c8a7
+Subproject b6098be8a4facfa854c633f2a3a82ab8e72962e
diff --git a/testsuite/driver/extra_files.py b/testsuite/driver/extra_files.py
index c2cb401d1f..8b0f99b768 100644
--- a/testsuite/driver/extra_files.py
+++ b/testsuite/driver/extra_files.py
@@ -88,6 +88,7 @@ extra_src_files = {
'T12035j': ['T12035.hs', 'T12035a.hs', 'T12035.hs-boot'],
'T12042': ['T12042.hs', 'T12042a.hs', 'T12042.hs-boot'],
'T12485': ['a.pkg', 'b.pkg', 'Main.hs'],
+ 'T12485a': ['shadow1.pkg', 'shadow2.pkg', 'shadow3.pkg'],
'T12733': ['p/', 'q/', 'Setup.hs'],
'T1372': ['p1/', 'p2/'],
'T1407': ['A.c'],
diff --git a/testsuite/tests/cabal/Makefile b/testsuite/tests/cabal/Makefile
index 45fb6ebb25..64034d4ac4 100644
--- a/testsuite/tests/cabal/Makefile
+++ b/testsuite/tests/cabal/Makefile
@@ -136,12 +136,14 @@ LOCAL_GHC_PKGSHADOW13 = '$(GHC_PKG)' --no-user-package-db -f $(PKGCONFSHADOW1) -
# Test package shadowing behaviour.
#
-# localshadow1.package.conf: shadowdep-1-XXX <- shadow-1-XXX
-# localshadow2.package.conf: shadow-1-XXX
+# The general principle is that we shadow in order of declarations,
+# but we determine what gets overridden based on ABI dependencies.
#
-# 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!
+# Here is the structure of our databases (unitid=abi):
+#
+# localshadow1.package.conf: shadowdep-1-XXX=ddd -> shadow-1-XXX=aaa
+# localshadow2.package.conf: shadow-1-XXX=bbb
+# localshadow3.package.conf: shadow-1-XXX=aaa
shadow:
rm -rf $(PKGCONFSHADOW1) $(PKGCONFSHADOW2) $(PKGCONFSHADOW3) shadow.hs shadow.o shadow.hi shadow.out shadow.hs shadow.hi
$(LOCAL_GHC_PKGSHADOW1) init $(PKGCONFSHADOW1)
@@ -164,8 +166,8 @@ shadow:
if '$(TEST_HC)' $(TEST_HC_OPTS) -package-db $(PKGCONFSHADOW1) -package-db $(PKGCONFSHADOW2) -package shadowdep -c shadow.hs -fno-code; then false; else true; fi
#
# 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
+# we prefer the shadow-1 from the first database, which has the correct
+# ABI hash for shadowdep-1.
#
@echo "should SUCCEED:"
'$(TEST_HC)' $(TEST_HC_OPTS) -package-db $(PKGCONFSHADOW2) -package-db $(PKGCONFSHADOW1) -package shadowdep -c shadow.hs -fno-code
@@ -175,6 +177,31 @@ shadow:
@echo "should SUCCEED:"
'$(TEST_HC)' $(TEST_HC_OPTS) -package-db $(PKGCONFSHADOW3) -package-db $(PKGCONFSHADOW1) -package shadowdep -c shadow.hs -fno-code
+# Test that order we pass databases doesn't matter
+#
+# 1. shadow-1-XXX=aaa
+# 2. shadowdep-1-XXX=ddd (shadow-1-XXX=aaa)
+# 3. shadow-1-XXX=bbb
+.PHONY: T12485a
+T12485a:
+ rm -rf T12485a.package.conf T12485b.package.conf T12485c.package.conf
+ '$(GHC_PKG)' --no-user-package-db init T12485a.package.conf
+ '$(GHC_PKG)' --no-user-package-db init T12485b.package.conf
+ '$(GHC_PKG)' --no-user-package-db init T12485c.package.conf
+ '$(GHC_PKG)' --no-user-package-db -f T12485a.package.conf register -v0 --force shadow1.pkg
+ '$(GHC_PKG)' --no-user-package-db -f T12485b.package.conf register -v0 --force shadow2.pkg
+ '$(GHC_PKG)' --no-user-package-db -f T12485c.package.conf register -v0 --force shadow3.pkg
+ echo "main = return ()" > T12485a.hs
+ # Normal test
+ @echo "should SUCCEED"
+ '$(TEST_HC)' $(TEST_HC_OPTS) -package-db T12485a.package.conf -package-db T12485b.package.conf -package shadowdep -c T12485a.hs -fno-code
+ # Reversed test
+ @echo "should SUCCEED"
+ '$(TEST_HC)' $(TEST_HC_OPTS) -package-db T12485b.package.conf -package-db T12485a.package.conf -package shadowdep -c T12485a.hs -fno-code
+ # Shadow OK, as long as correct one is chosen eventually, even when reversed
+ @echo "should SUCCEED"
+ '$(TEST_HC)' $(TEST_HC_OPTS) -package-db T12485b.package.conf -package-db T12485c.package.conf -package-db T12485a.package.conf -package shadowdep -c T12485a.hs -fno-code
+
# If we pass --global, we should ignore instances in the user database
T5442a:
@rm -rf package.conf.T5442a.global package.conf.T5442a.user
diff --git a/testsuite/tests/cabal/T12485/Makefile b/testsuite/tests/cabal/T12485/Makefile
index fc8e9929e6..2ff0c3c0d0 100644
--- a/testsuite/tests/cabal/T12485/Makefile
+++ b/testsuite/tests/cabal/T12485/Makefile
@@ -9,6 +9,6 @@ T12485 :
'$(GHC_PKG)' init b.db
'$(GHC_PKG)' -f a.db/ -f b.db/ register b.pkg # register b.pkg in b.db
# -package-db in dependency order
- '$(TEST_HC)' -XNoImplicitPrelude -fforce-recomp -hide-all-packages -no-user-package-db -package-db a.db -package-db b.db -package-id a-1-XXX -package-id b-1-XXX Main.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) -XNoImplicitPrelude -fforce-recomp -hide-all-packages -no-user-package-db -package-db a.db -package-db b.db -package-id a-1-XXX -package-id b-1-XXX Main.hs
# -package-db in reverse dependency order
- '$(TEST_HC)' -XNoImplicitPrelude -fforce-recomp -hide-all-packages -no-user-package-db -package-db b.db -package-db a.db -package-id a-1-XXX -package-id b-1-XXX Main.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) -XNoImplicitPrelude -fforce-recomp -hide-all-packages -no-user-package-db -package-db b.db -package-db a.db -package-id a-1-XXX -package-id b-1-XXX Main.hs
diff --git a/testsuite/tests/cabal/T12485/all.T b/testsuite/tests/cabal/T12485/all.T
index 63f6d6a1ef..be817eb274 100644
--- a/testsuite/tests/cabal/T12485/all.T
+++ b/testsuite/tests/cabal/T12485/all.T
@@ -1,5 +1,4 @@
test('T12485',
- [extra_clean(['a.db', 'b.db', 'Main.o', 'Main', 'Main.hi']),
- expect_broken(12485)],
+ [extra_clean(['a.db', 'b.db', 'Main.o', 'Main', 'Main.hi'])],
run_command,
['$MAKE -s --no-print-directory T12485'])
diff --git a/testsuite/tests/cabal/T12485a.stdout b/testsuite/tests/cabal/T12485a.stdout
new file mode 100644
index 0000000000..ee83ab293c
--- /dev/null
+++ b/testsuite/tests/cabal/T12485a.stdout
@@ -0,0 +1,3 @@
+should SUCCEED
+should SUCCEED
+should SUCCEED
diff --git a/testsuite/tests/cabal/T1750.stderr b/testsuite/tests/cabal/T1750.stderr
index 1809d5b050..53c56714c3 100644
--- a/testsuite/tests/cabal/T1750.stderr
+++ b/testsuite/tests/cabal/T1750.stderr
@@ -1,5 +1,5 @@
WARNING: there are broken packages. Run 'ghc-pkg check' for more details.
<command line>: cannot satisfy -package T1750A:
- T1750A-1-XXX is unusable due to missing or recursive dependencies:
+ T1750A-1-XXX is unusable due to cyclic dependencies:
T1750B-1-XXX
(use -v for more information)
diff --git a/testsuite/tests/cabal/all.T b/testsuite/tests/cabal/all.T
index cc874c78c2..64f26396c4 100644
--- a/testsuite/tests/cabal/all.T
+++ b/testsuite/tests/cabal/all.T
@@ -101,3 +101,10 @@ test('shadow',
'local1shadow2.package.conf',
'local1shadow2.package.conf.old']),
run_command, ['$MAKE -s --no-print-directory shadow'])
+
+test('T12485a',
+ extra_clean(['T12485a.hi', 'T1750.out',
+ 'T12485a.package.conf',
+ 'T12485b.package.conf',
+ 'T12485c.package.conf']),
+ run_command, ['$MAKE -s --no-print-directory T12485a'])
diff --git a/testsuite/tests/cabal/shadow1.pkg b/testsuite/tests/cabal/shadow1.pkg
index 1e3960202c..246d62b2d8 100644
--- a/testsuite/tests/cabal/shadow1.pkg
+++ b/testsuite/tests/cabal/shadow1.pkg
@@ -4,3 +4,4 @@ id: shadow-1-XXX
key: shadow-1-XXX
abi: aaa
depends:
+abi-depends:
diff --git a/testsuite/tests/cabal/shadow2.pkg b/testsuite/tests/cabal/shadow2.pkg
index 5cd54cca02..9f6410bc10 100644
--- a/testsuite/tests/cabal/shadow2.pkg
+++ b/testsuite/tests/cabal/shadow2.pkg
@@ -1,5 +1,7 @@
name: shadowdep
version: 1
+abi: ddd
id: shadowdep-1-XXX
key: shadowdep-1-XXX
depends: shadow-1-XXX
+abi-depends: shadow-1-XXX=aaa
diff --git a/testsuite/tests/cabal/shadow3.pkg b/testsuite/tests/cabal/shadow3.pkg
index 6640e9da10..04cfb41ee1 100644
--- a/testsuite/tests/cabal/shadow3.pkg
+++ b/testsuite/tests/cabal/shadow3.pkg
@@ -4,3 +4,4 @@ id: shadow-1-XXX
key: shadow-1-XXX
abi: bbb
depends:
+abi-depends:
diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T
index dee39fc77b..8ec02cefcc 100644
--- a/testsuite/tests/perf/haddock/all.T
+++ b/testsuite/tests/perf/haddock/all.T
@@ -52,7 +52,7 @@ test('haddock.base',
test('haddock.Cabal',
[unless(in_tree_compiler(), skip), req_haddock
,stats_num_field('bytes allocated',
- [(wordsize(64), 23706190072, 5)
+ [(wordsize(64), 25478853176 , 5)
# 2012-08-14: 3255435248 (amd64/Linux)
# 2012-08-29: 3324606664 (amd64/Linux, new codegen)
# 2012-10-08: 3373401360 (amd64/Linux)
@@ -91,6 +91,7 @@ test('haddock.Cabal',
# 2016-10-01: 20619433656 (amd64/Linux) - Cabal update
# 2016-10-03: 21554874976 (amd64/Linux) - Cabal update
# 2016-10-06: 23706190072 (amd64/Linux) - Cabal update
+ # 2016-12-20: 25478853176 (amd64/Linux) - Cabal update
,(platform('i386-unknown-mingw32'), 3293415576, 5)
# 2012-10-30: 1733638168 (x86/Windows)
diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs
index 3b55fe7b0a..12699a7f2d 100644
--- a/utils/ghc-cabal/Main.hs
+++ b/utils/ghc-cabal/Main.hs
@@ -316,7 +316,7 @@ generate directory distdir dll0Modules config_args
do cwd <- getCurrentDirectory
let ipid = mkUnitId (display (packageId pd))
let installedPkgInfo = inplaceInstalledPackageInfo cwd distdir
- pd (mkAbiHash "") lib lbi clbi
+ pd (mkAbiHash "inplace") lib lbi clbi
final_ipi = mangleIPI directory distdir lbi $ installedPkgInfo {
Installed.installedUnitId = ipid,
Installed.compatPackageKey = display (packageId pd),
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 290993f4a5..53f5f9dce6 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -1107,6 +1107,7 @@ convertPackageInfoToCacheFormat pkg =
GhcPkg.packageName = packageName pkg,
GhcPkg.packageVersion = Version.Version (versionNumbers (packageVersion pkg)) [],
GhcPkg.depends = depends pkg,
+ GhcPkg.abiDepends = map (\(AbiDependency k v) -> (k,unAbiHash v)) (abiDepends pkg),
GhcPkg.abiHash = unAbiHash (abiHash pkg),
GhcPkg.importDirs = importDirs pkg,
GhcPkg.hsLibraries = hsLibraries pkg,
View Lorry Controller Status