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.
import System.FilePath
import Control.Monad
import Data.List as List
import System.FilePath
import Control.Monad
import Data.List as List
+import qualified Data.Set as Set
-- ---------------------------------------------------------------------------
-- The Package state
-- ---------------------------------------------------------------------------
-- The Package state
-- the we tack on the system paths.
pkgs <- mapM (readPackageConfig dflags)
-- the we tack on the system paths.
pkgs <- mapM (readPackageConfig dflags)
- (reverse pkgconfs ++ reverse (extraPkgConfs dflags))
+ (pkgconfs ++ reverse (extraPkgConfs dflags))
-- later packages shadow earlier ones. extraPkgConfs
-- is in the opposite order to the flags on the
-- command line.
-- later packages shadow earlier ones. extraPkgConfs
-- is in the opposite order to the flags on the
-- command line.
if exist then return [pkgconf] else return []
`catchIO` (\_ -> return [])
if exist then return [pkgconf] else return []
`catchIO` (\_ -> return [])
- return (user_pkgconf ++ [system_pkgconf])
+ return (system_pkgconf : user_pkgconf)
readPackageConfig :: DynFlags -> FilePath -> IO [PackageConfig]
readPackageConfig dflags conf_file = do
readPackageConfig :: DynFlags -> FilePath -> IO [PackageConfig]
readPackageConfig dflags conf_file = do
let
flags = reverse (packageFlags dflags)
let
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
- -- DB to have the same IPID as a package in the global DB, and
- -- we want the former to take precedence. This is not the same
+ -- important: it is possible for a package in the global package
+ -- DB to have the same IPID as a package in the user DB, and
+ -- we want the latter to take precedence. This is not the same
-- as shadowing (below), since in this case the two packages
-- have the same ABI and are interchangeable.
-- as shadowing (below), since in this case the two packages
-- 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
| ExposePackageId i <- flags ]
ipid_selected = depClosure ipid_map [ InstalledPackageId i
| ExposePackageId i <- flags ]