From 636c2750c90e540ed3d4fb66c8dd4dae876945e7 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Wed, 19 May 2010 10:46:17 +0000 Subject: [PATCH] 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. --- compiler/main/Packages.lhs | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index f6ba7c1..06cd573 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -60,6 +60,7 @@ import System.Directory import System.FilePath import Control.Monad import Data.List as List +import qualified Data.Set as Set -- --------------------------------------------------------------------------- -- The Package state @@ -193,7 +194,7 @@ readPackageConfigs dflags = do -- 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. @@ -219,7 +220,7 @@ getSystemPackageConfigs dflags = do 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 @@ -656,15 +657,23 @@ mkPackageState dflags pkgs0 preload0 this_package = do let flags = reverse (packageFlags dflags) - ipid_map = listToFM [ (installedPackageId p, p) | p <- pkgs0 ] - -- 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. - 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 ] -- 1.7.10.4