X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FPackages.lhs;h=06cd573bc96f27b31e8403dc0950e30ca7ee07e6;hb=3c4c513daad3d83e9f4cb6870c1f1162c0028388;hp=e9108e7bb8ac5c97ff466cf0537bb0f03165eabd;hpb=f3795c06370ed317957028027e4d18682bfeb447;p=ghc-hetmet.git

diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index e9108e7..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
@@ -556,12 +557,12 @@ shadowPackages pkgs preferred
    in  listToFM shadowed
  where
  check (shadowed,pkgmap) pkg
-      | Just oldpkg <- lookupUFM pkgmap (packageConfigId pkg),
-        let
+      | Just oldpkg <- lookupUFM pkgmap (packageConfigId pkg)
+      , let
             ipid_new = installedPackageId pkg
-            ipid_old = installedPackageId oldpkg,
+            ipid_old = installedPackageId oldpkg
         --
-        ipid_old /= ipid_new
+      , ipid_old /= ipid_new
       = if ipid_old `elem` preferred
            then ( (ipid_new, ShadowedBy ipid_old) : shadowed, pkgmap )
            else ( (ipid_old, ShadowedBy ipid_new) : shadowed, pkgmap' )
@@ -656,6 +657,22 @@ mkPackageState dflags pkgs0 preload0 this_package = do
   let
       flags = reverse (packageFlags dflags)
 
+      -- pkgs0 with duplicate packages filtered out.  This is
+      -- 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.
+      --
+      -- #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
@@ -665,11 +682,11 @@ mkPackageState dflags pkgs0 preload0 this_package = do
       is_ignore IgnorePackage{} = True
       is_ignore _ = False
 
-      shadowed = shadowPackages pkgs0 ipid_selected
+      shadowed = shadowPackages pkgs0_unique ipid_selected
 
-      ignored  = ignorePackages ignore_flags pkgs0
+      ignored  = ignorePackages ignore_flags pkgs0_unique
 
-      pkgs0' = filter (not . (`elemFM` (plusFM shadowed ignored)) . installedPackageId) pkgs0
+      pkgs0' = filter (not . (`elemFM` (plusFM shadowed ignored)) . installedPackageId) pkgs0_unique
       broken   = findBroken pkgs0'
       unusable = shadowed `plusFM` ignored `plusFM` broken
 
@@ -679,7 +696,7 @@ mkPackageState dflags pkgs0 preload0 this_package = do
   -- Modify the package database according to the command-line flags
   -- (-package, -hide-package, -ignore-package, -hide-all-packages).
   --
-  pkgs1 <- foldM (applyPackageFlag unusable) pkgs0 other_flags
+  pkgs1 <- foldM (applyPackageFlag unusable) pkgs0_unique other_flags
   let pkgs2 = filter (not . (`elemFM` unusable) . installedPackageId) pkgs1
 
   -- Here we build up a set of the packages mentioned in -package