Commit 636c2750 authored by Simon Marlow's avatar Simon Marlow

Fix package shadowing order (#4072)

Later packages are supposed to shadow earlier ones in the stack,
unless the ordering is overriden with -package-id flags.
Unfortunately an earlier fix for something else had sorted the list of
packages so that it was in lexicographic order by installedPackageId,
and sadly our test (cabal/shadow) didn't pick this up because the
lexicographic ordering happened to work for the test.  I've now fixed
the test so it tries both orderings.
parent 9318157b
...@@ -60,6 +60,7 @@ import System.Directory ...@@ -60,6 +60,7 @@ import System.Directory
import System.FilePath import System.FilePath
import Control.Monad import Control.Monad
import Data.List as List import Data.List as List
import qualified Data.Set as Set
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- The Package state -- The Package state
...@@ -193,7 +194,7 @@ readPackageConfigs dflags = do ...@@ -193,7 +194,7 @@ readPackageConfigs dflags = do
-- the we tack on the system paths. -- the we tack on the system paths.
pkgs <- mapM (readPackageConfig dflags) pkgs <- mapM (readPackageConfig dflags)
(reverse pkgconfs ++ reverse (extraPkgConfs dflags)) (pkgconfs ++ reverse (extraPkgConfs dflags))
-- later packages shadow earlier ones. extraPkgConfs -- later packages shadow earlier ones. extraPkgConfs
-- is in the opposite order to the flags on the -- is in the opposite order to the flags on the
-- command line. -- command line.
...@@ -219,7 +220,7 @@ getSystemPackageConfigs dflags = do ...@@ -219,7 +220,7 @@ getSystemPackageConfigs dflags = do
if exist then return [pkgconf] else return [] if exist then return [pkgconf] else return []
`catchIO` (\_ -> return []) `catchIO` (\_ -> return [])
return (user_pkgconf ++ [system_pkgconf]) return (system_pkgconf : user_pkgconf)
readPackageConfig :: DynFlags -> FilePath -> IO [PackageConfig] readPackageConfig :: DynFlags -> FilePath -> IO [PackageConfig]
readPackageConfig dflags conf_file = do readPackageConfig dflags conf_file = do
...@@ -656,15 +657,23 @@ mkPackageState dflags pkgs0 preload0 this_package = do ...@@ -656,15 +657,23 @@ mkPackageState dflags pkgs0 preload0 this_package = do
let let
flags = reverse (packageFlags dflags) flags = reverse (packageFlags dflags)
ipid_map = listToFM [ (installedPackageId p, p) | p <- pkgs0 ]
-- pkgs0 with duplicate packages filtered out. This is -- pkgs0 with duplicate packages filtered out. This is
-- important: it is possible for a package in the user package -- important: it is possible for a package in the global package
-- DB to have the same IPID as a package in the global DB, and -- DB to have the same IPID as a package in the user DB, and
-- we want the former to take precedence. This is not the same -- we want the latter to take precedence. This is not the same
-- as shadowing (below), since in this case the two packages -- as shadowing (below), since in this case the two packages
-- have the same ABI and are interchangeable. -- have the same ABI and are interchangeable.
pkgs0_unique = eltsFM ipid_map --
-- #4072: note that we must retain the ordering of the list here
-- so that shadowing behaves as expected when we apply it later.
pkgs0_unique = snd $ foldr del (Set.empty,[]) pkgs0
where del p (s,ps)
| pid `Set.member` s = (s,ps)
| otherwise = (Set.insert pid s, p:ps)
where pid = installedPackageId p
-- XXX this is just a variant of nub
ipid_map = listToFM [ (installedPackageId p, p) | p <- pkgs0 ]
ipid_selected = depClosure ipid_map [ InstalledPackageId i ipid_selected = depClosure ipid_map [ InstalledPackageId i
| ExposePackageId i <- flags ] | ExposePackageId i <- flags ]
......
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