Support for abi-depends for computing shadowing.

Summary:
This is a complete fix based off of
ed7af26606b3a605a4511065ca1a43b1c0f3b51d for handling
shadowing and out-of-order -package-db flags simultaneously.

The general strategy is we first put all databases together,
overriding packages as necessary.  Once this is done, we successfully
prune out broken packages, including packages which depend on a package
whose ABI differs from the ABI we need.

Our check gracefully degrades in the absence of abi-depends, as
we only check deps which are recorded in abi-depends.

Contains time and Cabal submodule update.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: niteria, austin, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2846

GHC Trac Issues: #12485

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,