Package keys (for linking/type equality) separated from package IDs.
authorEdward Z. Yang <ezyang@cs.stanford.edu>
Fri, 18 Jul 2014 13:48:47 +0000 (14:48 +0100)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Tue, 5 Aug 2014 09:08:02 +0000 (10:08 +0100)
This patch set makes us no longer assume that a package key is a human
readable string, leaving Cabal free to "do whatever it wants" to allocate
keys; we'll look up the PackageId in the database to display to the user.
This also means we have a new level of qualifier decisions to make at the
package level, and rewriting some Safe Haskell error reporting code to DTRT.

Additionally, we adjust the build system to use a new ghc-cabal output
Make variable PACKAGE_KEY to determine library names and other things,
rather than concatenating PACKAGE/VERSION as before.

Adds a new `-this-package-key` flag to subsume the old, erroneously named
`-package-name` flag, and `-package-key` to select packages by package key.

RFC: The md5 hashes are pretty tough on the eye, as far as the file
system is concerned :(

ToDo: safePkg01 test had its output updated, but the fix is not really right:
the rest of the dependencies are truncated due to the fact the we're only
grepping a single line, but ghc-pkg is wrapping its output.

ToDo: In a later commit, update all submodules to stop using -package-name
and use -this-package-key.  For now, we don't do it to avoid submodule
explosion.

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

Reviewers: simonpj, simonmar, hvr, austin

Subscribers: simonmar, relrod, carter

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

74 files changed:
compiler/basicTypes/Module.lhs
compiler/ghc.cabal.in
compiler/ghc.mk
compiler/ghci/Linker.lhs
compiler/iface/LoadIface.lhs
compiler/llvmGen/LlvmCodeGen/Base.hs
compiler/main/DynFlags.hs
compiler/main/Finder.lhs
compiler/main/HscMain.hs
compiler/main/HscTypes.lhs
compiler/main/PackageConfig.hs
compiler/main/Packages.lhs
compiler/main/Packages.lhs-boot
compiler/utils/Outputable.lhs
docs/users_guide/flags.xml
docs/users_guide/packages.xml
ghc.mk
ghc/InteractiveUI.hs
libraries/Cabal
libraries/base/base.cabal
libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs
libraries/ghc-prim/ghc-prim.cabal
libraries/integer-gmp/integer-gmp.cabal
libraries/integer-simple/integer-simple.cabal
libraries/template-haskell/template-haskell.cabal
rts/ghc.mk
rts/package.conf.in
rules/build-package-way.mk
rules/build-prog.mk
rules/distdir-way-opts.mk
testsuite/.gitignore
testsuite/tests/cabal/T1750A.pkg
testsuite/tests/cabal/T1750B.pkg
testsuite/tests/cabal/cabal06/Makefile [new file with mode: 0644]
testsuite/tests/cabal/cabal06/Setup.hs [new file with mode: 0644]
testsuite/tests/cabal/cabal06/all.T [new file with mode: 0644]
testsuite/tests/cabal/cabal06/cabal06.stderr [new file with mode: 0644]
testsuite/tests/cabal/cabal06/cabal06.stdout [new file with mode: 0644]
testsuite/tests/cabal/cabal06/p-1.0/LICENSE [new file with mode: 0644]
testsuite/tests/cabal/cabal06/p-1.0/P.hs [new file with mode: 0644]
testsuite/tests/cabal/cabal06/p-1.0/p.cabal [new file with mode: 0644]
testsuite/tests/cabal/cabal06/p-1.1/LICENSE [new file with mode: 0644]
testsuite/tests/cabal/cabal06/p-1.1/P.hs [new file with mode: 0644]
testsuite/tests/cabal/cabal06/p-1.1/p.cabal [new file with mode: 0644]
testsuite/tests/cabal/cabal06/q/LICENSE [new file with mode: 0644]
testsuite/tests/cabal/cabal06/q/Q.hs [new file with mode: 0644]
testsuite/tests/cabal/cabal06/q/q-1.0.conf [new file with mode: 0644]
testsuite/tests/cabal/cabal06/q/q.cabal [new file with mode: 0644]
testsuite/tests/cabal/cabal06/r/LICENSE [new file with mode: 0644]
testsuite/tests/cabal/cabal06/r/Main.hs [new file with mode: 0644]
testsuite/tests/cabal/cabal06/r/r.cabal [new file with mode: 0644]
testsuite/tests/cabal/ghcpkg01.stdout
testsuite/tests/cabal/shadow1.pkg
testsuite/tests/cabal/shadow2.pkg
testsuite/tests/cabal/shadow3.pkg
testsuite/tests/cabal/test.pkg
testsuite/tests/cabal/test2.pkg
testsuite/tests/cabal/test3.pkg
testsuite/tests/cabal/test4.pkg
testsuite/tests/cabal/test5.pkg
testsuite/tests/cabal/test7a.pkg
testsuite/tests/cabal/test7b.pkg
testsuite/tests/cabal/testdup.pkg
testsuite/tests/ghc-api/T7478/T7478.hs
testsuite/tests/ghci/linking/Makefile
testsuite/tests/module/base01/Makefile
testsuite/tests/module/mod73.stderr
testsuite/tests/rename/prog006/Makefile
testsuite/tests/rename/should_compile/T3103/test.T
testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly07.stderr
testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly08.stderr
testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
utils/ghc-cabal/Main.hs
utils/ghc-pkg/Main.hs

index 3ec9f6a..8f21d66 100644 (file)
@@ -43,6 +43,7 @@ module Module
         mainPackageKey,
         thisGhcPackageKey,
         interactivePackageKey, isInteractiveModule,
+        wiredInPackageKeys,
 
         -- * The Module type
         Module,
@@ -82,6 +83,7 @@ import UniqFM
 import FastString
 import Binary
 import Util
+import {-# SOURCE #-} Packages
 
 import Data.Data
 import Data.Map (Map)
@@ -274,7 +276,7 @@ pprPackagePrefix p mod = getPprStyle doc
           if p == mainPackageKey
                 then empty -- never qualify the main package in code
                 else ztext (zEncodeFS (packageKeyFS p)) <> char '_'
-       | qualModule sty mod = ftext (packageKeyFS (modulePackageKey mod)) <> char ':'
+       | qualModule sty mod = ppr (modulePackageKey mod) <> char ':'
                 -- the PrintUnqualified tells us which modules have to
                 -- be qualified with package names
        | otherwise = empty
@@ -293,7 +295,10 @@ class HasModule m where
 %************************************************************************
 
 \begin{code}
--- | Essentially just a string identifying a package, including the version: e.g. parsec-1.0
+-- | A string which uniquely identifies a package.  For wired-in packages,
+-- it is just the package name, but for user compiled packages, it is a hash.
+-- ToDo: when the key is a hash, we can do more clever things than store
+-- the hex representation and hash-cons those strings.
 newtype PackageKey = PId FastString deriving( Eq, Typeable )
     -- here to avoid module loops with PackageConfig
 
@@ -316,7 +321,12 @@ stablePackageKeyCmp :: PackageKey -> PackageKey -> Ordering
 stablePackageKeyCmp p1 p2 = packageKeyFS p1 `compare` packageKeyFS p2
 
 instance Outputable PackageKey where
-   ppr pid = text (packageKeyString pid)
+   ppr pk = getPprStyle $ \sty -> sdocWithDynFlags $ \dflags ->
+    text (packageKeyPackageIdString dflags pk)
+    -- Don't bother qualifying if it's wired in!
+       <> (if qualPackage sty pk && not (pk `elem` wiredInPackageKeys)
+            then char '@' <> ftext (packageKeyFS pk)
+            else empty)
 
 instance Binary PackageKey where
   put_ bh pid = put_ bh (packageKeyFS pid)
@@ -377,6 +387,16 @@ mainPackageKey      = fsToPackageKey (fsLit "main")
 
 isInteractiveModule :: Module -> Bool
 isInteractiveModule mod = modulePackageKey mod == interactivePackageKey
+
+wiredInPackageKeys :: [PackageKey]
+wiredInPackageKeys = [ primPackageKey,
+                       integerPackageKey,
+                       basePackageKey,
+                       rtsPackageKey,
+                       thPackageKey,
+                       thisGhcPackageKey,
+                       dphSeqPackageKey,
+                       dphParPackageKey ]
 \end{code}
 
 %************************************************************************
index 838a908..d449ada 100644 (file)
@@ -105,11 +105,11 @@ Library
     Include-Dirs: . parser utils
 
     if impl( ghc >= 7.9 )
-        -- We need to set the package name to ghc (without a version number)
+        -- We need to set the package key to ghc (without a version number)
         -- as it's magic.  But we can't set it for old versions of GHC (e.g.
         -- when bootstrapping) because those versions of GHC don't understand
         -- that GHC is wired-in.
-        GHC-Options: -package-name ghc
+        GHC-Options: -this-package-key ghc
 
     if flag(stage1)
         Include-Dirs: stage1
index c236bcf..d23d1fe 100644 (file)
@@ -437,8 +437,14 @@ ifeq "$(compiler_stage1_VERSION_MUNGED)" "YES"
 compiler_stage1_MUNGED_VERSION = $(subst .$(ProjectPatchLevel),,$(ProjectVersion))
 define compiler_PACKAGE_MAGIC
 compiler_stage1_VERSION = $(compiler_stage1_MUNGED_VERSION)
+compiler_stage1_PACKAGE_KEY = $(subst .$(ProjectPatchLevel),,$(compiler_stage1_PACKAGE_KEY))
 endef
 
+# NB: the PACKAGE_KEY munging has no effect for new-style package keys
+# (which indeed, have nothing version like in them, but are important for
+# old-style package keys which do.)  The subst operation is idempotent, so
+# as long as we do it at least once we should be good.
+
 # Don't register the non-munged package
 compiler_stage1_REGISTER_PACKAGE = NO
 
index 74dec19..013918c 100644 (file)
@@ -70,7 +70,7 @@ import System.Directory hiding (findFile)
 import System.Directory
 #endif
 
-import Distribution.Package hiding (depends)
+import Distribution.Package hiding (depends, mkPackageKey, PackageKey)
 
 import Exception
 \end{code}
index 04b0476..2be6e9d 100644 (file)
@@ -876,6 +876,8 @@ badIfaceFile file err
 
 hiModuleNameMismatchWarn :: Module -> Module -> MsgDoc
 hiModuleNameMismatchWarn requested_mod read_mod = 
+  -- ToDo: This will fail to have enough qualification when the package IDs
+  -- are the same
   withPprStyle (mkUserStyle alwaysQualify AllTheWay) $
     -- we want the Modules below to be qualified with package names,
     -- so reset the PrintUnqualified setting.
index 686b352..50cd824 100644 (file)
@@ -406,7 +406,7 @@ strDisplayName_llvm lbl = do
     dflags <- getDynFlags
     let sdoc = pprCLabel platform lbl
         depth = Outp.PartWay 1
-        style = Outp.mkUserStyle (\ _ _ -> Outp.NameNotInScope2, Outp.alwaysQualifyModules) depth
+        style = Outp.mkUserStyle Outp.reallyAlwaysQualify depth
         str = Outp.renderWithStyle dflags sdoc style
     return (fsLit (dropInfoSuffix str))
 
index dfd2e27..8280730 100644 (file)
@@ -90,7 +90,7 @@ module DynFlags (
         getVerbFlags,
         updOptLevel,
         setTmpDir,
-        setPackageName,
+        setPackageKey,
 
         -- ** Parsing DynFlags
         parseDynamicFlagsCmdLine,
@@ -1023,6 +1023,7 @@ isNoLink _      = False
 data PackageFlag
   = ExposePackage   String
   | ExposePackageId String
+  | ExposePackageKey String
   | HidePackage     String
   | IgnorePackage   String
   | TrustPackage    String
@@ -2526,9 +2527,13 @@ package_flags = [
                                     removeUserPkgConf
                                     deprecate "Use -no-user-package-db instead")
 
-  , Flag "package-name"          (hasArg setPackageName)
+  , Flag "package-name"          (HasArg $ \name -> do
+                                    upd (setPackageKey name)
+                                    deprecate "Use -this-package-key instead")
+  , Flag "this-package-key"      (hasArg setPackageKey)
   , Flag "package-id"            (HasArg exposePackageId)
   , Flag "package"               (HasArg exposePackage)
+  , Flag "package-key"           (HasArg exposePackageKey)
   , Flag "hide-package"          (HasArg hidePackage)
   , Flag "hide-all-packages"     (NoArg (setGeneralFlag Opt_HideAllPackages))
   , Flag "ignore-package"        (HasArg ignorePackage)
@@ -3338,11 +3343,13 @@ removeGlobalPkgConf = upd $ \s -> s { extraPkgConfs = filter isNotGlobal . extra
 clearPkgConf :: DynP ()
 clearPkgConf = upd $ \s -> s { extraPkgConfs = const [] }
 
-exposePackage, exposePackageId, hidePackage, ignorePackage,
+exposePackage, exposePackageId, exposePackageKey, hidePackage, ignorePackage,
         trustPackage, distrustPackage :: String -> DynP ()
 exposePackage p = upd (exposePackage' p)
 exposePackageId p =
   upd (\s -> s{ packageFlags = ExposePackageId p : packageFlags s })
+exposePackageKey p =
+  upd (\s -> s{ packageFlags = ExposePackageKey p : packageFlags s })
 hidePackage p =
   upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
 ignorePackage p =
@@ -3356,8 +3363,8 @@ exposePackage' :: String -> DynFlags -> DynFlags
 exposePackage' p dflags
     = dflags { packageFlags = ExposePackage p : packageFlags dflags }
 
-setPackageName :: String -> DynFlags -> DynFlags
-setPackageName p s =  s{ thisPackage = stringToPackageKey p }
+setPackageKey :: String -> DynFlags -> DynFlags
+setPackageKey p s =  s{ thisPackage = stringToPackageKey p }
 
 -- If we're linking a binary, then only targets that produce object
 -- code are allowed (requests for other target types are ignored).
@@ -3600,6 +3607,7 @@ compilerInfo dflags
        ("Support dynamic-too",         if isWindows then "NO" else "YES"),
        ("Support parallel --make",     "YES"),
        ("Support reexported-modules",  "YES"),
+       ("Uses package keys",           "YES"),
        ("Dynamic by default",          if dYNAMIC_BY_DEFAULT dflags
                                        then "YES" else "NO"),
        ("GHC Dynamic",                 if dynamicGhc
index 37395ce..ded8514 100644 (file)
@@ -43,7 +43,7 @@ import Maybes           ( expectJust )
 import Exception        ( evaluate )
 
 import Distribution.Text
-import Distribution.Package
+import Distribution.Package hiding (PackageKey, mkPackageKey)
 import Data.IORef       ( IORef, writeIORef, readIORef, atomicModifyIORef )
 import System.Directory
 import System.FilePath
index f02abe8..8710297 100644 (file)
@@ -891,6 +891,13 @@ hscGetSafe hsc_env m l = runHsc hsc_env $ do
               | otherwise      = pkgs
     return (good, pkgs')
 
+-- | A function which only qualifies package names if necessary; but
+-- qualifies all other identifiers.
+pkgQual :: DynFlags -> PrintUnqualified
+pkgQual dflags = alwaysQualify {
+        queryQualifyPackage = mkQualPackage dflags
+    }
+
 -- | Is a module trusted? If not, throw or log errors depending on the type.
 -- Return (regardless of trusted or not) if the trust type requires the modules
 -- own package be trusted and a list of other packages required to be trusted
@@ -932,13 +939,13 @@ hscCheckSafe' dflags m l = do
                     return (trust == Sf_Trustworthy, pkgRs)
 
                 where
-                    pkgTrustErr = unitBag $ mkPlainErrMsg dflags l $
+                    pkgTrustErr = unitBag $ mkErrMsg dflags l (pkgQual dflags) $
                         sep [ ppr (moduleName m)
                                 <> text ": Can't be safely imported!"
                             , text "The package (" <> ppr (modulePackageKey m)
                                 <> text ") the module resides in isn't trusted."
                             ]
-                    modTrustErr = unitBag $ mkPlainErrMsg dflags l $
+                    modTrustErr = unitBag $ mkErrMsg dflags l (pkgQual dflags) $
                         sep [ ppr (moduleName m)
                                 <> text ": Can't be safely imported!"
                             , text "The module itself isn't safe." ]
@@ -995,7 +1002,7 @@ checkPkgTrust dflags pkgs =
             | trusted $ getPackageDetails (pkgState dflags) pkg
             = Nothing
             | otherwise
-            = Just $ mkPlainErrMsg dflags noSrcSpan
+            = Just $ mkErrMsg dflags noSrcSpan (pkgQual dflags)
                    $ text "The package (" <> ppr pkg <> text ") is required" <>
                      text " to be trusted but it isn't!"
 
index c0794de..e0d11e4 100644 (file)
@@ -54,6 +54,7 @@ module HscTypes (
         setInteractivePrintName, icInteractiveModule,
         InteractiveImport(..), setInteractivePackage,
         mkPrintUnqualified, pprModulePrefix,
+        mkQualPackage, mkQualModule,
 
         -- * Interfaces
         ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,
@@ -443,7 +444,7 @@ instance Outputable TargetId where
 -- | Helps us find information about modules in the home package
 type HomePackageTable  = ModuleNameEnv HomeModInfo
         -- Domain = modules in the home package that have been fully compiled
-        -- "home" package name cached here for convenience
+        -- "home" package key cached here for convenience
 
 -- | Helps us find information about modules in the imported packages
 type PackageIfaceTable = ModuleEnv ModIface
@@ -1138,7 +1139,7 @@ The details are a bit tricky though:
    extend the HPT.
 
  * The 'thisPackage' field of DynFlags is *not* set to 'interactive'.
-   It stays as 'main' (or whatever -package-name says), and is the
+   It stays as 'main' (or whatever -this-package-key says), and is the
    package to which :load'ed modules are added to.
 
  * So how do we arrange that declarations at the command prompt get
@@ -1148,7 +1149,7 @@ The details are a bit tricky though:
    turn get the module from it 'icInteractiveModule' field of the 
    interactive context.
 
-   The 'thisPackage' field stays as 'main' (or whatever -package-name says.
+   The 'thisPackage' field stays as 'main' (or whatever -this-package-key says.
 
  * The main trickiness is that the type environment (tcg_type_env and
    fixity envt (tcg_fix_env), and instances (tcg_insts, tcg_fam_insts)
@@ -1409,11 +1410,28 @@ exposed (say P2), so we use M.T for that, and P1:M.T for the other one.
 This is handled by the qual_mod component of PrintUnqualified, inside
 the (ppr mod) of case (3), in Name.pprModulePrefix
 
+Note [Printing package keys]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In the old days, original names were tied to PackageIds, which directly
+corresponded to the entities that users wrote in Cabal files, and were perfectly
+suitable for printing when we need to disambiguate packages.  However, with
+PackageKey, the situation is different.  First, the key is not a human readable
+at all, so we need to consult the package database to find the appropriate
+PackageId to display.  Second, there may be multiple copies of a library visible
+with the same PackageId, in which case we need to disambiguate.  For now,
+we just emit the actual package key (which the user can go look up); however,
+another scheme is to (recursively) say which dependencies are different.
+
+NB: When we extend package keys to also have holes, we will have to disambiguate
+those as well.
+
 \begin{code}
 -- | Creates some functions that work out the best ways to format
--- names for the user according to a set of heuristics
+-- names for the user according to a set of heuristics.
 mkPrintUnqualified :: DynFlags -> GlobalRdrEnv -> PrintUnqualified
-mkPrintUnqualified dflags env = (qual_name, qual_mod)
+mkPrintUnqualified dflags env = QueryQualify qual_name
+                                             (mkQualModule dflags)
+                                             (mkQualPackage dflags)
   where
   qual_name mod occ
         | [gre] <- unqual_gres
@@ -1446,7 +1464,11 @@ mkPrintUnqualified dflags env = (qual_name, qual_mod)
     -- "import M" would resolve unambiguously to P:M.  (if P is the
     -- current package we can just assume it is unqualified).
 
-  qual_mod mod
+-- | Creates a function for formatting modules based on two heuristics:
+-- (1) if the module is the current module, don't qualify, and (2) if there
+-- is only one exposed package which exports this module, don't qualify.
+mkQualModule :: DynFlags -> QueryQualifyModule
+mkQualModule dflags mod
      | modulePackageKey mod == thisPackage dflags = False
 
      | [pkgconfig] <- [modConfPkg m | m <- lookup
@@ -1458,6 +1480,27 @@ mkPrintUnqualified dflags env = (qual_name, qual_mod)
 
      | otherwise = True
      where lookup = eltsUFM $ lookupModuleInAllPackages dflags (moduleName mod)
+
+-- | Creates a function for formatting packages based on two heuristics:
+-- (1) don't qualify if the package in question is "main", and (2) only qualify
+-- with a package key if the package ID would be ambiguous.
+mkQualPackage :: DynFlags -> QueryQualifyPackage
+mkQualPackage dflags pkg_key
+     | pkg_key == mainPackageKey
+        -- Skip the lookup if it's main, since it won't be in the package
+        -- database!
+     = False
+     | filter ((pkgid ==) . sourcePackageId)
+              (eltsUFM (pkgIdMap (pkgState dflags))) `lengthIs` 1
+        -- this says: we are given a package pkg-0.1@MMM, are there only one
+        -- exposed packages whose package ID is pkg-0.1?
+     = False
+     | otherwise
+     = True
+     where pkg = fromMaybe (pprPanic "qual_pkg" (ftext (packageKeyFS pkg_key)))
+                    (lookupPackage (pkgIdMap (pkgState dflags)) pkg_key)
+           pkgid = sourcePackageId pkg
+
 \end{code}
 
 
index 520b533..864980b 100644 (file)
@@ -26,7 +26,8 @@ module PackageConfig (
 
 import Distribution.InstalledPackageInfo
 import Distribution.ModuleName
-import Distribution.Package
+import Distribution.Package hiding (PackageKey, mkPackageKey)
+import qualified Distribution.Package as Cabal
 import Distribution.Text
 import Distribution.Version
 
@@ -43,23 +44,23 @@ defaultPackageConfig :: PackageConfig
 defaultPackageConfig = emptyInstalledPackageInfo
 
 -- -----------------------------------------------------------------------------
--- PackageKey (package names with versions)
+-- PackageKey (package names, versions and dep hash)
 
 -- $package_naming
 -- #package_naming#
--- Mostly the compiler deals in terms of 'PackageKey's, which have the
--- form @<pkg>-<version>@. You're expected to pass in the version for
--- the @-package-name@ flag. However, for wired-in packages like @base@
--- & @rts@, we don't necessarily know what the version is, so these are
--- handled specially; see #wired_in_packages#.
+-- Mostly the compiler deals in terms of 'PackageKey's, which are md5 hashes
+-- of a package ID, keys of its dependencies, and Cabal flags. You're expected
+-- to pass in the package key in the @-this-package-key@ flag. However, for
+-- wired-in packages like @base@ & @rts@, we don't necessarily know what the
+-- version is, so these are handled specially; see #wired_in_packages#.
 
 -- | Turn a Cabal 'PackageIdentifier' into a GHC 'PackageKey'
-mkPackageKey :: PackageIdentifier -> PackageKey
+mkPackageKey :: Cabal.PackageKey -> PackageKey
 mkPackageKey = stringToPackageKey . display
 
 -- | Get the GHC 'PackageKey' right out of a Cabalish 'PackageConfig'
 packageConfigId :: PackageConfig -> PackageKey
-packageConfigId = mkPackageKey . sourcePackageId
+packageConfigId = mkPackageKey . packageKey
 
 -- | Turn a 'PackageConfig', which contains GHC 'Module.ModuleName's into a Cabal specific
 -- 'InstalledPackageInfo' which contains Cabal 'Distribution.ModuleName.ModuleName's
index 5973bc5..93b566f 100644 (file)
@@ -33,6 +33,7 @@ module Packages (
         ModuleExport(..),
 
         -- * Utils
+        packageKeyPackageIdString,
         isDllName
     )
 where
@@ -53,7 +54,7 @@ import Maybes
 import System.Environment ( getEnv )
 import Distribution.InstalledPackageInfo
 import Distribution.InstalledPackageInfo.Binary
-import Distribution.Package hiding (PackageId,depends)
+import Distribution.Package hiding (depends, PackageKey, mkPackageKey)
 import Distribution.ModuleExport
 import FastString
 import ErrUtils         ( debugTraceMsg, putMsg, MsgDoc )
@@ -383,6 +384,14 @@ applyPackageFlag dflags unusable pkgs flag =
                 ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs)
          _ -> panic "applyPackageFlag"
 
+    ExposePackageKey str ->
+       case selectPackages (matchingKey str) pkgs unusable of
+         Left ps         -> packageFlagErr dflags flag ps
+         Right (p:ps,qs) -> return (p':ps')
+          where p' = p {exposed=True}
+                ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs)
+         _ -> panic "applyPackageFlag"
+
     HidePackage str ->
        case selectPackages (matchingStr str) pkgs unusable of
          Left ps       -> packageFlagErr dflags flag ps
@@ -441,6 +450,9 @@ matchingStr str p
 matchingId :: String -> PackageConfig -> Bool
 matchingId str p =  InstalledPackageId str == installedPackageId p
 
+matchingKey :: String -> PackageConfig -> Bool
+matchingKey str p = str == display (packageKey p)
+
 sortByVersion :: [InstalledPackageInfo_ m] -> [InstalledPackageInfo_ m]
 sortByVersion = sortBy (flip (comparing (pkgVersion.sourcePackageId)))
 
@@ -465,12 +477,14 @@ packageFlagErr dflags flag reasons
   where err = text "cannot satisfy " <> ppr_flag <>
                 (if null reasons then empty else text ": ") $$
               nest 4 (ppr_reasons $$
+                      -- ToDo: this admonition seems a bit dodgy
                       text "(use -v for more information)")
         ppr_flag = case flag of
                      IgnorePackage p -> text "-ignore-package " <> text p
                      HidePackage p   -> text "-hide-package " <> text p
                      ExposePackage p -> text "-package " <> text p
                      ExposePackageId p -> text "-package-id " <> text p
+                     ExposePackageKey p -> text "-package-key " <> text p
                      TrustPackage p    -> text "-trust " <> text p
                      DistrustPackage p -> text "-distrust " <> text p
         ppr_reasons = vcat (map ppr_reason reasons)
@@ -520,15 +534,7 @@ findWiredInPackages dflags pkgs = do
   --
   let
         wired_in_pkgids :: [String]
-        wired_in_pkgids = map packageKeyString
-                          [ primPackageKey,
-                            integerPackageKey,
-                            basePackageKey,
-                            rtsPackageKey,
-                            thPackageKey,
-                            thisGhcPackageKey,
-                            dphSeqPackageKey,
-                            dphParPackageKey ]
+        wired_in_pkgids = map packageKeyString wiredInPackageKeys
 
         matches :: PackageConfig -> String -> Bool
         pc `matches` pid = display (pkgName (sourcePackageId pc)) == pid
@@ -588,7 +594,9 @@ findWiredInPackages dflags pkgs = do
         updateWiredInDependencies pkgs = map upd_pkg pkgs
           where upd_pkg p
                   | installedPackageId p `elem` wired_in_ids
-                  = p { sourcePackageId = (sourcePackageId p){ pkgVersion = Version [] [] } }
+                  = let pid = (sourcePackageId p) { pkgVersion = Version [] [] }
+                    in p { sourcePackageId = pid
+                         , packageKey = OldPackageKey pid }
                   | otherwise
                   = p
 
@@ -666,7 +674,7 @@ shadowPackages pkgs preferred
    in  Map.fromList shadowed
  where
  check (shadowed,pkgmap) pkg
-      | Just oldpkg <- lookupUFM pkgmap (packageConfigId pkg)
+      | Just oldpkg <- lookupUFM pkgmap pkgid
       , let
             ipid_new = installedPackageId pkg
             ipid_old = installedPackageId oldpkg
@@ -678,7 +686,8 @@ shadowPackages pkgs preferred
       | otherwise
       = (shadowed, pkgmap')
       where
-        pkgmap' = addToUFM pkgmap (packageConfigId pkg) pkg
+        pkgid = mkFastString (display (sourcePackageId pkg))
+        pkgmap' = addToUFM pkgmap pkgid pkg
 
 -- -----------------------------------------------------------------------------
 
@@ -730,12 +739,12 @@ mkPackageState dflags pkgs0 preload0 this_package = do
    1. P = transitive closure of packages selected by -package-id
 
    2. Apply shadowing.  When there are multiple packages with the same
-      sourcePackageId,
+      packageKey,
         * if one is in P, use that one
         * otherwise, use the one highest in the package stack
       [
-       rationale: we cannot use two packages with the same sourcePackageId
-       in the same program, because sourcePackageId is the symbol prefix.
+       rationale: we cannot use two packages with the same packageKey
+       in the same program, because packageKey is the symbol prefix.
        Hence we must select a consistent set of packages to use.  We have
        a default algorithm for doing this: packages higher in the stack
        shadow those lower down.  This default algorithm can be overriden
@@ -782,9 +791,15 @@ mkPackageState dflags pkgs0 preload0 this_package = do
           -- XXX this is just a variant of nub
 
       ipid_map = Map.fromList [ (installedPackageId p, p) | p <- pkgs0 ]
+      -- NB: Prefer the last one (i.e. the one highest in the package stack
+      pk_map = Map.fromList [ (packageConfigId p, p) | p <- pkgs0 ]
 
-      ipid_selected = depClosure ipid_map [ InstalledPackageId i
-                                          | ExposePackageId i <- flags ]
+      ipid_selected = depClosure ipid_map ([ InstalledPackageId i
+                                           | ExposePackageId i <- flags ]
+                                        ++ [ installedPackageId pkg
+                                           | ExposePackageKey k <- flags
+                                           , Just pkg <- [Map.lookup
+                                                (stringToPackageKey k) pk_map]])
 
       (ignore_flags, other_flags) = partition is_ignore flags
       is_ignore IgnorePackage{} = True
@@ -819,6 +834,7 @@ mkPackageState dflags pkgs0 preload0 this_package = do
          = take 1 $ sortByVersion (filter (matchingStr s) pkgs2)
          --  -package P means "the latest version of P" (#7030)
       get_exposed (ExposePackageId s) = filter (matchingId  s) pkgs2
+      get_exposed (ExposePackageKey s) = filter (matchingKey s) pkgs2
       get_exposed _                   = []
 
   -- hide packages that are subsumed by later versions
@@ -1113,6 +1129,13 @@ missingDependencyMsg (Just parent)
 
 -- -----------------------------------------------------------------------------
 
+packageKeyPackageIdString :: DynFlags -> PackageKey -> String
+packageKeyPackageIdString dflags pkg_key
+    | pkg_key == mainPackageKey = "main"
+    | otherwise = maybe "(unknown)"
+                      (display . sourcePackageId)
+                      (lookupPackage (pkgIdMap (pkgState dflags)) pkg_key)
+
 -- | Will the 'Name' come from a dynamically linked library?
 isDllName :: DynFlags -> PackageKey -> Module -> Name -> Bool
 -- Despite the "dll", I think this function just means that
index 3a1712e..3fd0fd5 100644 (file)
@@ -1,4 +1,8 @@
 \begin{code}
 module Packages where
+-- Well, this is kind of stupid...
+import {-# SOURCE #-} Module (PackageKey)
+import {-# SOURCE #-} DynFlags (DynFlags)
 data PackageState
+packageKeyPackageIdString :: DynFlags -> PackageKey -> String
 \end{code}
index e32261d..a65607a 100644 (file)
@@ -53,15 +53,17 @@ module Outputable (
         -- * Controlling the style in which output is printed
         BindingSite(..),
 
-        PprStyle, CodeStyle(..), PrintUnqualified,
+        PprStyle, CodeStyle(..), PrintUnqualified(..),
+        QueryQualifyName, QueryQualifyModule, QueryQualifyPackage,
+        reallyAlwaysQualify, reallyAlwaysQualifyNames,
         alwaysQualify, alwaysQualifyNames, alwaysQualifyModules,
         neverQualify, neverQualifyNames, neverQualifyModules,
-        QualifyName(..),
+        QualifyName(..), queryQual,
         sdocWithDynFlags, sdocWithPlatform,
         getPprStyle, withPprStyle, withPprStyleDoc,
         pprDeeper, pprDeeperList, pprSetDepth,
         codeStyle, userStyle, debugStyle, dumpStyle, asmStyle,
-        ifPprDebug, qualName, qualModule,
+        ifPprDebug, qualName, qualModule, qualPackage,
         mkErrStyle, defaultErrStyle, defaultDumpStyle, defaultUserStyle,
         mkUserStyle, cmdlineParserStyle, Depth(..),
 
@@ -76,7 +78,7 @@ import {-# SOURCE #-}   DynFlags( DynFlags,
                                   targetPlatform, pprUserLength, pprCols,
                                   useUnicode, useUnicodeSyntax,
                                   unsafeGlobalDynFlags )
-import {-# SOURCE #-}   Module( Module, ModuleName, moduleName )
+import {-# SOURCE #-}   Module( PackageKey, Module, ModuleName, moduleName )
 import {-# SOURCE #-}   OccName( OccName )
 import {-# SOURCE #-}   StaticFlags( opt_PprStyle_Debug, opt_NoDebugOutput )
 
@@ -142,12 +144,15 @@ data Depth = AllTheWay
 -- -----------------------------------------------------------------------------
 -- Printing original names
 
--- When printing code that contains original names, we need to map the
+-- When printing code that contains original names, we need to map the
 -- original names back to something the user understands.  This is the
--- purpose of the pair of functions that gets passed around
+-- purpose of the triple of functions that gets passed around
 -- when rendering 'SDoc'.
-
-type PrintUnqualified = (QueryQualifyName, QueryQualifyModule)
+data PrintUnqualified = QueryQualify {
+    queryQualifyName    :: QueryQualifyName,
+    queryQualifyModule  :: QueryQualifyModule,
+    queryQualifyPackage :: QueryQualifyPackage
+}
 
 -- | given an /original/ name, this function tells you which module
 -- name it should be qualified with when printing for the user, if
@@ -161,6 +166,9 @@ type QueryQualifyName = Module -> OccName -> QualifyName
 -- a package name to disambiguate it.
 type QueryQualifyModule = Module -> Bool
 
+-- | For a given package, we need to know whether to print it with
+-- the package key to disambiguate it.
+type QueryQualifyPackage = PackageKey -> Bool
 
 -- See Note [Printing original names] in HscTypes
 data QualifyName                        -- given P:M.T
@@ -173,6 +181,10 @@ data QualifyName                        -- given P:M.T
                 -- it is not in scope at all, and M.T is already bound in the
                 -- current scope, so we must refer to it as "P:M.T"
 
+reallyAlwaysQualifyNames :: QueryQualifyName
+reallyAlwaysQualifyNames _ _ = NameNotInScope2
+
+-- | NB: This won't ever show package IDs
 alwaysQualifyNames :: QueryQualifyName
 alwaysQualifyNames m _ = NameQual (moduleName m)
 
@@ -185,9 +197,23 @@ alwaysQualifyModules _ = True
 neverQualifyModules :: QueryQualifyModule
 neverQualifyModules _ = False
 
-alwaysQualify, neverQualify :: PrintUnqualified
-alwaysQualify = (alwaysQualifyNames, alwaysQualifyModules)
-neverQualify  = (neverQualifyNames,  neverQualifyModules)
+alwaysQualifyPackages :: QueryQualifyPackage
+alwaysQualifyPackages _ = True
+
+neverQualifyPackages :: QueryQualifyPackage
+neverQualifyPackages _ = False
+
+reallyAlwaysQualify, alwaysQualify, neverQualify :: PrintUnqualified
+reallyAlwaysQualify
+              = QueryQualify reallyAlwaysQualifyNames
+                             alwaysQualifyModules
+                             alwaysQualifyPackages
+alwaysQualify = QueryQualify alwaysQualifyNames
+                             alwaysQualifyModules
+                             alwaysQualifyPackages
+neverQualify  = QueryQualify neverQualifyNames
+                             neverQualifyModules
+                             neverQualifyPackages
 
 defaultUserStyle, defaultDumpStyle :: PprStyle
 
@@ -297,13 +323,22 @@ sdocWithPlatform f = sdocWithDynFlags (f . targetPlatform)
 
 \begin{code}
 qualName :: PprStyle -> QueryQualifyName
-qualName (PprUser (qual_name,_) _)  mod occ = qual_name mod occ
+qualName (PprUser q _)  mod occ = queryQualifyName q mod occ
 qualName _other                     mod _   = NameQual (moduleName mod)
 
 qualModule :: PprStyle -> QueryQualifyModule
-qualModule (PprUser (_,qual_mod) _)  m = qual_mod m
+qualModule (PprUser q _)  m = queryQualifyModule q m
 qualModule _other                   _m = True
 
+qualPackage :: PprStyle -> QueryQualifyPackage
+qualPackage (PprUser q _)  m = queryQualifyPackage q m
+qualPackage _other                   _m = True
+
+queryQual :: PprStyle -> PrintUnqualified
+queryQual s = QueryQualify (qualName s)
+                           (qualModule s)
+                           (qualPackage s)
+
 codeStyle :: PprStyle -> Bool
 codeStyle (PprCode _)     = True
 codeStyle _               = False
index 1dd224a..8381ca1 100644 (file)
         </thead>
         <tbody>
           <row>
-            <entry><option>-package-name</option> <replaceable>P</replaceable></entry>
+            <entry><option>-this-package-key</option> <replaceable>P</replaceable></entry>
             <entry>Compile to be part of package <replaceable>P</replaceable></entry>
             <entry>static</entry>
             <entry>-</entry>
index 62b4e96..50549b4 100644 (file)
@@ -258,19 +258,15 @@ exposed-modules: Network.BSD,
       </varlistentry>
 
       <varlistentry>
-        <term><option>-package-name</option> <replaceable>foo</replaceable>
-        <indexterm><primary><option>-package-name</option></primary>
+        <term><option>-this-package-key</option> <replaceable>foo</replaceable>
+        <indexterm><primary><option>-this-package-key</option></primary>
           </indexterm></term>
         <listitem>
           <para>Tells GHC the the module being compiled forms part of
-            package <replaceable>foo</replaceable>.
+            package key <replaceable>foo</replaceable>; internally, these
+            keys are used to determine type equality and linker symbols.
             If this flag is omitted (a very common case) then the
             default package <literal>main</literal> is assumed.</para>
-            <para>Note: the argument to <option>-package-name</option>
-              should be the full
-              package <literal>name-version</literal> for the package.
-              For example:
-            <literal>-package mypkg-1.2</literal>.</para>
         </listitem>
       </varlistentry>
 
@@ -328,7 +324,7 @@ exposed-modules: Network.BSD,
 
   <para>Every complete Haskell program must define <literal>main</literal> in
    module <literal>Main</literal>
-   in package <literal>main</literal>.   (Omitting the <option>-package-name</option> flag compiles
+   in package <literal>main</literal>.   (Omitting the <option>-this-package-key</option> flag compiles
    code for package <literal>main</literal>.) Failure to do so leads to a somewhat obscure
    link-time error of the form:
 <programlisting>
@@ -1170,8 +1166,8 @@ ghc-pkg dot | tred | dot -Tpdf >pkgs.pdf
     </itemizedlist>
 
      <para>To compile a module which is to be part of a new package,
-      use the <literal>-package-name</literal> option (<xref linkend="using-packages"/>).
-      Failure to use the <literal>-package-name</literal> option
+      use the <literal>-this-package-key</literal> option (<xref linkend="using-packages"/>).
+      Failure to use the <literal>-this-package-key</literal> option
       when compiling a package will probably result in disaster, but
       you will only discover later when you attempt to import modules
       from the package.  At this point GHC will complain that the
diff --git a/ghc.mk b/ghc.mk
index a1d304e..8ba90fe 100644 (file)
--- a/ghc.mk
+++ b/ghc.mk
@@ -911,10 +911,10 @@ install_packages: rts/dist/package.conf.install
        $(call INSTALL_DIR,"$(DESTDIR)$(topdir)")
        $(call removeTrees,"$(INSTALLED_PACKAGE_CONF)")
        $(call INSTALL_DIR,"$(INSTALLED_PACKAGE_CONF)")
-       $(call INSTALL_DIR,"$(DESTDIR)$(topdir)/rts-1.0")
-       $(call installLibsTo, $(RTS_INSTALL_LIBS), "$(DESTDIR)$(topdir)/rts-1.0")
+       $(call INSTALL_DIR,"$(DESTDIR)$(topdir)/rts")
+       $(call installLibsTo, $(RTS_INSTALL_LIBS), "$(DESTDIR)$(topdir)/rts")
        $(foreach p, $(INSTALL_DYNLIBS), \
-           $(call installLibsTo, $(wildcard $p/dist-install/build/*.so $p/dist-install/build/*.dll $p/dist-install/build/*.dylib), "$(DESTDIR)$(topdir)/$($p_PACKAGE)-$($p_dist-install_VERSION)"))
+           $(call installLibsTo, $(wildcard $p/dist-install/build/*.so $p/dist-install/build/*.dll $p/dist-install/build/*.dylib), "$(DESTDIR)$(topdir)/$($p_dist-install_PACKAGE_KEY)"))
        $(foreach p, $(INSTALL_PACKAGES),                             \
            $(call make-command,                                      \
                   "$(ghc-cabal_INPLACE)" copy                        \
index ab4ea87..96b7880 100644 (file)
@@ -1605,13 +1605,13 @@ isSafeModule m = do
     liftIO $ putStrLn $ "Package Trust: " ++ (if packageTrustOn dflags then "On" else "Off")
     when (not $ null good)
          (liftIO $ putStrLn $ "Trusted package dependencies (trusted): " ++
-                        (intercalate ", " $ map packageKeyString good))
+                        (intercalate ", " $ map (showPpr dflags) good))
     case msafe && null bad of
         True -> liftIO $ putStrLn $ mname ++ " is trusted!"
         False -> do
             when (not $ null bad)
                  (liftIO $ putStrLn $ "Trusted package dependencies (untrusted): "
-                            ++ (intercalate ", " $ map packageKeyString bad))
+                            ++ (intercalate ", " $ map (showPpr dflags) bad))
             liftIO $ putStrLn $ mname ++ " is NOT trusted!"
 
   where
@@ -2341,6 +2341,7 @@ showPackages = do
         showFlag (HidePackage     p) = text $ "  -hide-package " ++ p
         showFlag (IgnorePackage   p) = text $ "  -ignore-package " ++ p
         showFlag (ExposePackageId p) = text $ "  -package-id " ++ p
+        showFlag (ExposePackageKey p) = text $ "  -package-key " ++ p
         showFlag (TrustPackage    p) = text $ "  -trust " ++ p
         showFlag (DistrustPackage p) = text $ "  -distrust " ++ p
 
index 9684769..6cc4699 160000 (submodule)
@@ -1 +1 @@
-Subproject commit 96847693bf8ff48ae94f179d60c1f23411e1365e
+Subproject commit 6cc46998f0778c04b535c805416604995fe153b5
index e56724c..b7828a9 100644 (file)
@@ -328,6 +328,6 @@ Library
             GHC.Event.TimerManager
             GHC.Event.Unique
 
-    -- We need to set the package name to base (without a version number)
+    -- We need to set the package key to base (without a version number)
     -- as it's magic.
-    ghc-options: -package-name base
+    ghc-options: -this-package-key base
index f4d0a4b..baf8a05 100644 (file)
@@ -49,6 +49,7 @@ putInstalledPackageInfo :: Binary m => InstalledPackageInfo_ m -> Put
 putInstalledPackageInfo ipi = do
   put (sourcePackageId ipi)
   put (installedPackageId ipi)
+  put (packageKey ipi)
   put (license ipi)
   put (copyright ipi)
   put (maintainer ipi)
@@ -84,6 +85,7 @@ getInstalledPackageInfo :: Binary m => Get (InstalledPackageInfo_ m)
 getInstalledPackageInfo = do
   sourcePackageId <- get
   installedPackageId <- get
+  packageKey <- get
   license <- get
   copyright <- get
   maintainer <- get
@@ -166,3 +168,12 @@ instance Binary m => Binary (ModuleExport m) where
   put (ModuleExport a b c d) = do put a; put b; put c; put d
   get = do a <- get; b <- get; c <- get; d <- get;
            return (ModuleExport a b c d)
+
+instance Binary PackageKey where
+  put (PackageKey a b c) = do putWord8 0; put a; put b; put c
+  put (OldPackageKey a) = do putWord8 1; put a
+  get = do n <- getWord8
+           case n of
+            0 -> do a <- get; b <- get; c <- get; return (PackageKey a b c)
+            1 -> do a <- get; return (OldPackageKey a)
+            _ -> error ("Binary PackageKey: bad branch " ++ show n)
index bc9f571..9c1801b 100644 (file)
@@ -59,6 +59,6 @@ Library
         cbits/popcnt.c
         cbits/word2float.c
 
-    -- We need to set the package name to ghc-prim (without a version number)
+    -- We need to set the package key to ghc-prim (without a version number)
     -- as it's magic.
-    ghc-options: -package-name ghc-prim
+    ghc-options: -this-package-key ghc-prim
index c0f6b60..376139f 100644 (file)
@@ -75,6 +75,6 @@ Library
 
     build-depends: ghc-prim >= 0.3.1 && < 0.4
 
-    -- We need to set the package name to integer-gmp
+    -- We need to set the package key to integer-gmp
     -- (without a version number) as it's magic.
-    ghc-options: -Wall -package-name integer-gmp
+    ghc-options: -Wall -this-package-key integer-gmp
index 51d3cc7..d18a182 100644 (file)
@@ -28,4 +28,4 @@ Library
                 UnliftedFFITypes, NoImplicitPrelude
     -- We need to set the package name to integer-simple
     -- (without a version number) as it's magic.
-    ghc-options: -package-name integer-simple -Wall
+    ghc-options: -this-package-key integer-simple -Wall
index fb8dbd7..db268be 100644 (file)
@@ -49,6 +49,6 @@ Library
         base       == 4.7.*,
         pretty     == 1.1.*
 
-    -- We need to set the package name to template-haskell (without a
+    -- We need to set the package key to template-haskell (without a
     -- version number) as it's magic.
-    ghc-options: -Wall -package-name template-haskell
+    ghc-options: -Wall -this-package-key template-haskell
index 0d2b341..c5dc06e 100644 (file)
@@ -188,7 +188,7 @@ ifneq "$$(findstring dyn, $1)" ""
 ifeq "$$(HostOS_CPP)" "mingw32" 
 $$(rts_$1_LIB) : $$(rts_$1_OBJS) $$(ALL_RTS_DEF_LIBS) rts/dist/libs.depend rts/dist/build/$$(LIBFFI_DLL)
        "$$(RM)" $$(RM_OPTS) $$@
-       "$$(rts_dist_HC)" -package-name rts -shared -dynamic -dynload deploy \
+       "$$(rts_dist_HC)" -this-package-key rts -shared -dynamic -dynload deploy \
          -no-auto-link-packages -Lrts/dist/build -l$$(LIBFFI_NAME) \
          `cat rts/dist/libs.depend` $$(rts_$1_OBJS) $$(ALL_RTS_DEF_LIBS) \
          $$(rts_dist_$1_GHC_LD_OPTS) \
@@ -209,7 +209,7 @@ LIBFFI_LIBS =
 endif
 $$(rts_$1_LIB) : $$(rts_$1_OBJS) $$(rts_$1_DTRACE_OBJS) rts/dist/libs.depend $$(rts_dist_FFI_SO)
        "$$(RM)" $$(RM_OPTS) $$@
-       "$$(rts_dist_HC)" -package-name rts -shared -dynamic -dynload deploy \
+       "$$(rts_dist_HC)" -this-package-key rts -shared -dynamic -dynload deploy \
          -no-auto-link-packages $$(LIBFFI_LIBS) `cat rts/dist/libs.depend` $$(rts_$1_OBJS) \
           $$(rts_dist_$1_GHC_LD_OPTS) \
          $$(rts_$1_DTRACE_OBJS) -o $$@
@@ -283,7 +283,7 @@ STANDARD_OPTS += -DCOMPILING_RTS
 rts_CC_OPTS += $(WARNING_OPTS)
 rts_CC_OPTS += $(STANDARD_OPTS)
 
-rts_HC_OPTS += $(STANDARD_OPTS) -package-name rts
+rts_HC_OPTS += $(STANDARD_OPTS) -this-package-key rts
 
 ifneq "$(GhcWithSMP)" "YES"
 rts_CC_OPTS += -DNOSMP
index 8250bc2..82d2870 100644 (file)
@@ -6,6 +6,7 @@
 name:           rts
 version:        1.0
 id:             builtin_rts
+key:            rts
 license:        BSD3
 maintainer:     glasgow-haskell-users@haskell.org
 exposed:        True
@@ -16,7 +17,7 @@ hidden-modules:
 import-dirs:
 
 #ifdef INSTALLING
-library-dirs:           LIB_DIR"/rts-1.0" PAPI_LIB_DIR FFI_LIB_DIR
+library-dirs:           LIB_DIR"/rts" PAPI_LIB_DIR FFI_LIB_DIR
 #else /* !INSTALLING */
 library-dirs:           TOP"/rts/dist/build" PAPI_LIB_DIR FFI_LIB_DIR
 #endif
index 294e432..3efe501 100644 (file)
@@ -23,13 +23,13 @@ $(call hs-objs,$1,$2,$3)
 # The .a/.so library file, indexed by two different sets of vars:
 # the first is indexed by the dir, distdir and way
 # the second is indexed by the package id, distdir and way
-$1_$2_$3_LIB_NAME = libHS$$($1_PACKAGE)-$$($1_$2_VERSION)$$($3_libsuf)
+$1_$2_$3_LIB_NAME = libHS$$($1_$2_PACKAGE_KEY)$$($3_libsuf)
 $1_$2_$3_LIB = $1/$2/build/$$($1_$2_$3_LIB_NAME)
-$$($1_PACKAGE)-$$($1_$2_VERSION)_$2_$3_LIB = $$($1_$2_$3_LIB)
+$$($1_$2_PACKAGE_KEY)_$2_$3_LIB = $$($1_$2_$3_LIB)
 
 ifeq "$$(HostOS_CPP)" "mingw32"
 ifneq "$$($1_$2_dll0_HS_OBJS)" ""
-$1_$2_$3_LIB0_ROOT = HS$$($1_PACKAGE)-$$($1_$2_VERSION)-0$$($3_libsuf)
+$1_$2_$3_LIB0_ROOT = HS$$($1_$2_PACKAGE_KEY)-0$$($3_libsuf)
 $1_$2_$3_LIB0_NAME = lib$$($1_$2_$3_LIB0_ROOT)
 $1_$2_$3_LIB0 = $1/$2/build/$$($1_$2_$3_LIB0_NAME)
 endif
@@ -42,14 +42,16 @@ endif
 # Really we should use a consistent scheme for distdirs, but in the
 # meantime we work around it by defining ghc-<ver>_dist-install_way_LIB:
 ifeq "$$($1_PACKAGE) $2" "ghc stage2"
-$$($1_PACKAGE)-$$($1_$2_VERSION)_dist-install_$3_LIB = $$($1_$2_$3_LIB)
+$$($1_$2_PACKAGE_KEY)_dist-install_$3_LIB = $$($1_$2_$3_LIB)
 endif
 
 # All the .a/.so library file dependencies for this library.
 #
 # The $(subst stage2,dist-install,..) is needed due to Note
 # [inconsistent distdirs].
-$1_$2_$3_DEPS_LIBS=$$(foreach dep,$$($1_$2_DEPS),$$($$(dep)_$(subst stage2,dist-install,$2)_$3_LIB))
+#
+# NB: Use DEP_KEYS, since DEPS only contains package IDs
+$1_$2_$3_DEPS_LIBS=$$(foreach dep,$$($1_$2_DEP_KEYS),$$($$(dep)_$(subst stage2,dist-install,$2)_$3_LIB))
 
 $1_$2_$3_NON_HS_OBJS = $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS)  $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS)
 $1_$2_$3_ALL_OBJS = $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_NON_HS_OBJS)
@@ -134,7 +136,7 @@ ifeq "$$(DYNAMIC_GHC_PROGRAMS)" "YES"
 $1_$2_GHCI_LIB = $$($1_$2_dyn_LIB)
 else
 ifeq "$3" "v"
-$1_$2_GHCI_LIB = $1/$2/build/HS$$($1_PACKAGE)-$$($1_$2_VERSION).$$($3_osuf)
+$1_$2_GHCI_LIB = $1/$2/build/HS$$($1_$2_PACKAGE_KEY).$$($3_osuf)
 ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES"
 # Don't put bootstrapping packages in the bindist
 ifneq "$4" "0"
index ba1fa00..f93b99d 100644 (file)
@@ -240,7 +240,7 @@ $1/$2/build/tmp/$$($1_$2_PROG)-wrapper.c: driver/utils/dynwrapper.c | $$$$(dir $
        echo '#include <Windows.h>' >> $$@
        echo '#include "Rts.h"' >> $$@
        echo 'LPTSTR path_dirs[] = {' >> $$@
-       $$(foreach p,$$($1_$2_TRANSITIVE_DEPS),$$(call make-command,echo '    TEXT("/../lib/$$p")$$(comma)' >> $$@))
+       $$(foreach p,$$($1_$2_TRANSITIVE_DEP_KEYS),$$(call make-command,echo '    TEXT("/../lib/$$p")$$(comma)' >> $$@))
        echo '    TEXT("/../lib/"),' >> $$@
        echo '    NULL};' >> $$@
        echo 'LPTSTR progDll = TEXT("../lib/$$($1_$2_PROG).dll");' >> $$@
index 93bc60b..898485c 100644 (file)
@@ -81,6 +81,18 @@ define distdir-way-opts # args: $1 = dir, $2 = distdir, $3 = way, $4 = stage
 # $1_$2_$3_MOST_HC_OPTS is also passed to C compilations when we use
 # GHC as the C compiler.
 
+# ToDo: It would be more accurate to version test this against what version of
+# GHC we're using to see if it understands package-key
+ifeq "$4" "0"
+$1_$2_$4_DEP_OPTS = \
+ $$(foreach pkg,$$($1_$2_DEPS),-package $$(pkg))
+$4_THIS_PACKAGE_KEY = -package-name
+else
+$1_$2_$4_DEP_OPTS = \
+ $$(foreach pkg,$$($1_$2_DEP_KEYS),-package-key $$(pkg))
+$4_THIS_PACKAGE_KEY = -this-package-key
+endif
+
 $1_$2_$3_MOST_HC_OPTS = \
  $$(WAY_$3_HC_OPTS) \
  $$(CONF_HC_OPTS) \
@@ -88,7 +100,7 @@ $1_$2_$3_MOST_HC_OPTS = \
  $$($1_HC_OPTS) \
  $$($1_$2_HC_PKGCONF) \
  $$(if $$($1_$2_PROG),, \
-        $$(if $$($1_PACKAGE),-package-name $$($1_PACKAGE)-$$($1_$2_VERSION))) \
+        $$(if $$($1_PACKAGE),$$($4_THIS_PACKAGE_KEY) $$($1_$2_PACKAGE_KEY))) \
  $$(if $$($1_PACKAGE),-hide-all-packages) \
  -i $$(if $$($1_$2_HS_SRC_DIRS),$$(foreach dir,$$($1_$2_HS_SRC_DIRS),-i$1/$$(dir)),-i$1) \
  -i$1/$2/build -i$1/$2/build/autogen \
@@ -98,7 +110,7 @@ $1_$2_$3_MOST_HC_OPTS = \
  $$(foreach inc,$$($1_$2_INCLUDE),-\#include "$$(inc)") \
  $$(foreach opt,$$($1_$2_CPP_OPTS),-optP$$(opt)) \
  $$(if $$($1_PACKAGE),-optP-include -optP$1/$2/build/autogen/cabal_macros.h) \
- $$(foreach pkg,$$($1_$2_DEPS),-package $$(pkg)) \
+ $$($1_$2_$4_DEP_OPTS) \
  $$($1_$2_HC_OPTS) \
  $$(CONF_HC_OPTS_STAGE$4) \
  $$($1_$2_MORE_HC_OPTS) \
@@ -170,11 +182,11 @@ ifneq "$4" "0"
 ifeq "$$(TargetElf)" "YES"
 $1_$2_$3_GHC_LD_OPTS += \
     -fno-use-rpaths \
-    $$(foreach d,$$($1_$2_TRANSITIVE_DEPS),-optl-Wl$$(comma)-rpath -optl-Wl$$(comma)'$$$$ORIGIN/../$$d') -optl-Wl,-zorigin
+    $$(foreach d,$$($1_$2_TRANSITIVE_DEP_KEYS),-optl-Wl$$(comma)-rpath -optl-Wl$$(comma)'$$$$ORIGIN/../$$d') -optl-Wl,-zorigin
 else ifeq "$$(TargetOS_CPP)" "darwin"
 $1_$2_$3_GHC_LD_OPTS += \
     -fno-use-rpaths \
-    $$(foreach d,$$($1_$2_TRANSITIVE_DEPS),-optl-Wl$$(comma)-rpath -optl-Wl$$(comma)'@loader_path/../$$d')
+    $$(foreach d,$$($1_$2_TRANSITIVE_DEP_KEYS),-optl-Wl$$(comma)-rpath -optl-Wl$$(comma)'@loader_path/../$$d')
 endif
 endif
 endif
index c99aeba..d160143 100644 (file)
@@ -109,6 +109,8 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk
 /tests/cabal/cabal05/p-0.1.0.0/
 /tests/cabal/cabal05/q-0.1.0.0/
 /tests/cabal/cabal05/r-0.1.0.0/
+/tests/cabal/cabal06/inst-*/
+/tests/cabal/cabal06/tmp*
 /tests/cabal/local01.package.conf/
 /tests/cabal/local03.package.conf/
 /tests/cabal/local04.package.conf/
index 9bda51e..3f4a96e 100644 (file)
@@ -1,4 +1,5 @@
 name: T1750A
 version: 1
 id: T1750A-1-XXX
+key: T1750A-1
 depends: T1750B-1-XXX
index 479ce70..caaaefa 100644 (file)
@@ -1,4 +1,5 @@
 name: T1750B
 version: 1
 id: T1750B-1-XXX
+key: T1750B-1
 depends: T1750A-1-XXX
diff --git a/testsuite/tests/cabal/cabal06/Makefile b/testsuite/tests/cabal/cabal06/Makefile
new file mode 100644 (file)
index 0000000..5934b9b
--- /dev/null
@@ -0,0 +1,70 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+SETUP=../Setup -v0
+
+# This test is for packages whose package IDs overlap, but whose package keys
+# do not.
+#
+#   1. install p-1.0
+#   2. install q-1.0 (depending on p-1.0)
+#   3. install p-1.1
+#   4. install q-1.0, asking for p-1.1
+#   5. install r-1.0 (depending on p-1.1, q-1.0)
+#   6. install r-1.0 asking for p-1.0
+#
+# The notable steps are (4), which previously would have required a reinstall,
+# and (6), where the dependency solver picks between two package keys with the
+# same package ID based on their depenencies.
+#
+# ./Setup configure is pretty dumb, so we spoonfeed it precisely the
+# dependencies it needs.
+
+cabal06: clean
+       $(MAKE) clean
+       '$(GHC_PKG)' init tmp.d
+       '$(TEST_HC)' -v0 --make Setup
+       cd p-1.0 && $(SETUP) clean
+       cd p-1.0 && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/inst-a' --ghc-pkg-options='--enable-multi-instance'
+       cd p-1.0 && $(SETUP) build
+       cd p-1.0 && $(SETUP) copy
+       cd p-1.0 && $(SETUP) register
+       cd q && $(SETUP) clean
+       cd q && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/inst-b' --ghc-pkg-options='--enable-multi-instance'
+       cd q && $(SETUP) build
+       cd q && $(SETUP) copy
+       (cd q && $(SETUP) register --print-ipid) > tmp_first_q
+       cd p-1.1 && $(SETUP) clean
+       cd p-1.1 && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/inst-c' --ghc-pkg-options='--enable-multi-instance'
+       cd p-1.1 && $(SETUP) build
+       cd p-1.1 && $(SETUP) copy
+       cd p-1.1 && $(SETUP) register
+       cd q && $(SETUP) clean
+       cd q && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --constraint="p==1.1" --prefix='$(PWD)/inst-d' --ghc-pkg-options='--enable-multi-instance'
+       cd q && $(SETUP) build
+       cd q && $(SETUP) copy
+       (cd q && $(SETUP) register --print-ipid) > tmp_second_q
+       @echo "Does the first instance of q depend on p-1.0?"
+       '$(GHC_PKG)' field --ipid `cat tmp_first_q` depends -f tmp.d | grep p-1.0 | wc -l
+       @echo "Does the second instance of q depend on p-1.0?"
+       '$(GHC_PKG)' field --ipid `cat tmp_second_q` depends -f tmp.d | grep p-1.1 | wc -l
+       cd r && $(SETUP) clean
+       cd r && ../Setup configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --dependency="q=`cat ../tmp_first_q`" --constraint="p==1.0" --prefix='$(PWD)/inst-e' --ghc-pkg-options='--enable-multi-instance'
+       cd r && $(SETUP) build
+       cd r && $(SETUP) copy
+       cd r && $(SETUP) clean
+       cd r && ../Setup configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --dependency="q=`cat ../tmp_second_q`" --constraint="p==1.1" --prefix='$(PWD)/inst-f' --ghc-pkg-options='--enable-multi-instance'
+       cd r && $(SETUP) build
+       cd r && $(SETUP) copy
+       inst-e/bin/cabal06
+       inst-f/bin/cabal06
+ifneq "$(CLEANUP)" ""
+       $(MAKE) clean
+endif
+
+clean :
+       '$(GHC_PKG)' unregister --force p >/dev/null 2>&1 || true
+       '$(GHC_PKG)' unregister --force q >/dev/null 2>&1 || true
+       '$(GHC_PKG)' unregister --force r >/dev/null 2>&1 || true
+       $(RM) -r tmp.d inst-* *.o *.hi */*.o */*.hi */Setup$(exeext) */dist Setup$(exeext)
diff --git a/testsuite/tests/cabal/cabal06/Setup.hs b/testsuite/tests/cabal/cabal06/Setup.hs
new file mode 100644 (file)
index 0000000..9a994af
--- /dev/null
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/testsuite/tests/cabal/cabal06/all.T b/testsuite/tests/cabal/cabal06/all.T
new file mode 100644 (file)
index 0000000..edca288
--- /dev/null
@@ -0,0 +1,9 @@
+if default_testopts.cleanup != '':
+   cleanup = 'CLEANUP=1'
+else:
+   cleanup = ''
+
+test('cabal06',
+     normal,
+     run_command,
+     ['$MAKE -s --no-print-directory cabal06 ' + cleanup])
diff --git a/testsuite/tests/cabal/cabal06/cabal06.stderr b/testsuite/tests/cabal/cabal06/cabal06.stderr
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/testsuite/tests/cabal/cabal06/cabal06.stdout b/testsuite/tests/cabal/cabal06/cabal06.stdout
new file mode 100644 (file)
index 0000000..e5ff042
--- /dev/null
@@ -0,0 +1,8 @@
+Does the first instance of q depend on p-1.0?
+1
+Does the second instance of q depend on p-1.0?
+1
+Configuring r-1.0...
+Configuring r-1.0...
+10
+11
diff --git a/testsuite/tests/cabal/cabal06/p-1.0/LICENSE b/testsuite/tests/cabal/cabal06/p-1.0/LICENSE
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/testsuite/tests/cabal/cabal06/p-1.0/P.hs b/testsuite/tests/cabal/cabal06/p-1.0/P.hs
new file mode 100644 (file)
index 0000000..7d63e39
--- /dev/null
@@ -0,0 +1,3 @@
+module P where
+p :: Int
+p = 0
diff --git a/testsuite/tests/cabal/cabal06/p-1.0/p.cabal b/testsuite/tests/cabal/cabal06/p-1.0/p.cabal
new file mode 100644 (file)
index 0000000..ab7b3eb
--- /dev/null
@@ -0,0 +1,12 @@
+name:                p
+version:             1.0
+license-file:        LICENSE
+author:              Edward Z. Yang
+maintainer:          ezyang@cs.stanford.edu
+build-type:          Simple
+cabal-version:       >=1.20
+
+library
+  exposed-modules:     P
+  build-depends:       base
+  default-language:    Haskell2010
diff --git a/testsuite/tests/cabal/cabal06/p-1.1/LICENSE b/testsuite/tests/cabal/cabal06/p-1.1/LICENSE
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/testsuite/tests/cabal/cabal06/p-1.1/P.hs b/testsuite/tests/cabal/cabal06/p-1.1/P.hs
new file mode 100644 (file)
index 0000000..4464480
--- /dev/null
@@ -0,0 +1,3 @@
+module P where
+p :: Int
+p = 1
diff --git a/testsuite/tests/cabal/cabal06/p-1.1/p.cabal b/testsuite/tests/cabal/cabal06/p-1.1/p.cabal
new file mode 100644 (file)
index 0000000..8a7b7b2
--- /dev/null
@@ -0,0 +1,12 @@
+name:                p
+version:             1.1
+license-file:        LICENSE
+author:              Edward Z. Yang
+maintainer:          ezyang@cs.stanford.edu
+build-type:          Simple
+cabal-version:       >=1.20
+
+library
+  exposed-modules:     P
+  build-depends:       base
+  default-language:    Haskell2010
diff --git a/testsuite/tests/cabal/cabal06/q/LICENSE b/testsuite/tests/cabal/cabal06/q/LICENSE
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/testsuite/tests/cabal/cabal06/q/Q.hs b/testsuite/tests/cabal/cabal06/q/Q.hs
new file mode 100644 (file)
index 0000000..03d0923
--- /dev/null
@@ -0,0 +1,4 @@
+module Q where
+import P
+q :: Int
+q = p + 10
diff --git a/testsuite/tests/cabal/cabal06/q/q-1.0.conf b/testsuite/tests/cabal/cabal06/q/q-1.0.conf
new file mode 100644 (file)
index 0000000..2c25cee
--- /dev/null
@@ -0,0 +1,19 @@
+name: q
+version: 1.0
+id: q-1.0-beaf238a500e9dd4ea74fe12762b72e1
+
+key: d54a904d84001e92dbb7d30e2bede8ce
+license: AllRightsReserved
+maintainer: ezyang@cs.stanford.edu
+author: Edward Z. Yang
+exposed: True
+exposed-modules:
+    Q
+trusted: False
+import-dirs: /5playpen/t-edyang/ghc-backpack/testsuite/tests/cabal/cabal06/inst-d/lib/x86_64-linux-ghc-7.9.20140719/q-1.0
+library-dirs: /5playpen/t-edyang/ghc-backpack/testsuite/tests/cabal/cabal06/inst-d/lib/x86_64-linux-ghc-7.9.20140719/q-1.0
+hs-libraries: HSd54a904d84001e92dbb7d30e2bede8ce
+depends: base-4.7.1.0-inplace
+         p-1.0-168289aa0216a183a2729001bb18e7a8
+haddock-interfaces: /5playpen/t-edyang/ghc-backpack/testsuite/tests/cabal/cabal06/inst-d/share/doc/x86_64-linux-ghc-7.9.20140719/q-1.0/html/q.haddock
+haddock-html: /5playpen/t-edyang/ghc-backpack/testsuite/tests/cabal/cabal06/inst-d/share/doc/x86_64-linux-ghc-7.9.20140719/q-1.0/html
diff --git a/testsuite/tests/cabal/cabal06/q/q.cabal b/testsuite/tests/cabal/cabal06/q/q.cabal
new file mode 100644 (file)
index 0000000..7b3a074
--- /dev/null
@@ -0,0 +1,12 @@
+name:                q
+version:             1.0
+license-file:        LICENSE
+author:              Edward Z. Yang
+maintainer:          ezyang@cs.stanford.edu
+build-type:          Simple
+cabal-version:       >=1.20
+
+library
+  exposed-modules:     Q
+  build-depends:       base, p
+  default-language:    Haskell2010
diff --git a/testsuite/tests/cabal/cabal06/r/LICENSE b/testsuite/tests/cabal/cabal06/r/LICENSE
new file mode 100644 (file)
index 0000000..e69de29
diff --git a/testsuite/tests/cabal/cabal06/r/Main.hs b/testsuite/tests/cabal/cabal06/r/Main.hs
new file mode 100644 (file)
index 0000000..5e62664
--- /dev/null
@@ -0,0 +1,3 @@
+module Main where
+import Q
+main = print q
diff --git a/testsuite/tests/cabal/cabal06/r/r.cabal b/testsuite/tests/cabal/cabal06/r/r.cabal
new file mode 100644 (file)
index 0000000..60e16c1
--- /dev/null
@@ -0,0 +1,12 @@
+name:                r
+version:             1.0
+license-file:        LICENSE
+author:              Edward Z. Yang
+maintainer:          ezyang@cs.stanford.edu
+build-type:          Simple
+cabal-version:       >=1.20
+
+executable cabal06
+  build-depends:       base, p, q
+  main-is:             Main.hs
+  default-language:    Haskell2010
index da50cd9..c8faf7f 100644 (file)
@@ -4,6 +4,7 @@ Reading package info from "test.pkg" ... done.
 name: testpkg
 version: 1.2.3.4
 id: testpkg-1.2.3.4-XXX
+key: testpkg-1.2.3.4
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
@@ -28,6 +29,7 @@ pkgroot:
 name: testpkg
 version: 1.2.3.4
 id: testpkg-1.2.3.4-XXX
+key: testpkg-1.2.3.4
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
@@ -58,6 +60,7 @@ local01.package.conf:
 name: testpkg
 version: 2.0
 id: testpkg-2.0-XXX
+key: testpkg-2.0
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
@@ -82,6 +85,7 @@ pkgroot:
 name: testpkg
 version: 2.0
 id: testpkg-2.0-XXX
+key: testpkg-2.0
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
@@ -106,6 +110,7 @@ pkgroot:
 name: testpkg
 version: 1.2.3.4
 id: testpkg-1.2.3.4-XXX
+key: testpkg-1.2.3.4
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
@@ -137,6 +142,7 @@ Reading package info from "test3.pkg" ... done.
 name: testpkg
 version: 1.2.3.4
 id: testpkg-1.2.3.4-XXX
+key: testpkg-1.2.3.4
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
index 7bf047f..553ebeb 100644 (file)
@@ -1,4 +1,5 @@
 name: shadow
 version: 1
 id: shadow-1-XXX
+key: shadow-1
 depends:
index b720dc9..ae89641 100644 (file)
@@ -1,4 +1,5 @@
 name: shadowdep
 version: 1
 id: shadowdep-1-XXX
+key: shadowdep-1
 depends: shadow-1-XXX
index 933ed3f..62c93f9 100644 (file)
@@ -1,4 +1,5 @@
 name: shadow
 version: 1
 id: shadow-1-YYY
+key: shadow-1
 depends:
index 02a07ab..42c557a 100644 (file)
@@ -1,6 +1,7 @@
 name: testpkg
 version: 1.2.3.4
 id: testpkg-1.2.3.4-XXX
+key: testpkg-1.2.3.4
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
index a6d28d6..c027ed3 100644 (file)
@@ -1,6 +1,7 @@
 name: "testpkg"
 version: 2.0
 id: testpkg-2.0-XXX
+key: testpkg-2.0
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
index 6d32571..8f1ca04 100644 (file)
@@ -1,6 +1,7 @@
 name: "testpkg"
 version: 3.0
 id: testpkg-3.0-XXX
+key: testpkg-3.0
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
index 598559a..c4b1883 100644 (file)
@@ -1,6 +1,7 @@
 name: "testpkg"
 version: 4.0
 id: testpkg-4.0-XXX
+key: testpkg-4.0
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
index fc27bc9..48e198c 100644 (file)
@@ -1,6 +1,7 @@
 name: "newtestpkg"
 version: 2.0
 id: newtestpkg-2.0-XXX
+key: newtestpkg-2.0
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
index c0698d7..f90fa73 100644 (file)
@@ -1,6 +1,7 @@
 name: testpkg7a
 version: 1.0
 id: testpkg7a-1.0-XXX
+key: testpkg7a-1.0
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
index d8bf47e..e89ac44 100644 (file)
@@ -1,6 +1,7 @@
 name: testpkg7b
 version: 1.0
 id: testpkg7b-1.0-XXX
+key: testpkg7b-1.0
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
index 77000ed..0e368e5 100644 (file)
@@ -1,5 +1,6 @@
 name: testdup
 version: 1.0
 id: testdup-1.0-XXX
+key: testdup-1.0
 license: BSD3
 depends: testpkg-1.2.3.4-XXX testpkg-1.2.3.4-XXX
index 15c3559..dc6edb2 100644 (file)
@@ -9,7 +9,7 @@ import GHC
 import qualified Config as GHC
 import qualified Outputable as GHC
 import GhcMonad (liftIO)
-import Outputable (PprStyle, qualName, qualModule)
+import Outputable (PprStyle, queryQual)
 
 compileInGhc :: [FilePath]          -- ^ Targets
              -> (String -> IO ())   -- ^ handler for each SevOutput message
@@ -42,7 +42,7 @@ compileInGhc targets handlerOutput = do
         _ -> error "fileFromTarget: not a known target"
 
     collectSrcError handlerOutput flags SevOutput _srcspan style msg
-      = handlerOutput $ GHC.showSDocForUser flags (qualName style,qualModule style) msg
+      = handlerOutput $ GHC.showSDocForUser flags (queryQual style) msg
     collectSrcError _ _ _ _ _ _
       = return ()
 
index 60cb9cb..08c5158 100644 (file)
@@ -60,6 +60,7 @@ ghcilink004 :
        echo 'name: test' >>$(PKG004)
        echo 'version: 1.0' >>$(PKG004)
        echo 'id: test-XXX' >>$(PKG004)
+       echo 'key: test-1.0' >>$(PKG004)
        echo 'library-dirs: $${pkgroot}' >>$(PKG004)
        echo 'extra-libraries: foo' >>$(PKG004)
        echo '[]' >$(LOCAL_PKGCONF004)
@@ -87,6 +88,7 @@ ghcilink005 :
        echo 'name: test' >>$(PKG005)
        echo 'version: 1.0' >>$(PKG005)
        echo 'id: test-XXX' >>$(PKG005)
+       echo 'key: test-1.0' >>$(PKG005)
        echo 'library-dirs: $${pkgroot}' >>$(PKG005)
        echo 'extra-libraries: foo' >>$(PKG005)
        echo '[]' >$(LOCAL_PKGCONF005)
@@ -111,6 +113,7 @@ ghcilink006 :
        echo "name: test" >>$(PKG006)
        echo "version: 1.0" >>$(PKG006)
        echo "id: test-XXX" >>$(PKG006)
+       echo "key: test-1.0" >>$(PKG006)
        echo "extra-libraries: stdc++" >>$(PKG006)
        echo "[]" >$(LOCAL_PKGCONF006)
        '$(GHC_PKG)' --no-user-package-db -f $(LOCAL_PKGCONF006) register $(PKG006) -v0
index 815fbff..6f77c09 100644 (file)
@@ -9,6 +9,6 @@ clean:
 base01:
        rm -f GHC/*.o
        rm -f GHC/*.hi
-       '$(TEST_HC)' $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) -XNoImplicitPrelude -package-name base -c GHC/Base.hs
-       '$(TEST_HC)' $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) -XNoImplicitPrelude -package-name base --make GHC.Foo
+       '$(TEST_HC)' $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) -XNoImplicitPrelude -this-package-key base -c GHC/Base.hs
+       '$(TEST_HC)' $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) -XNoImplicitPrelude -this-package-key base --make GHC.Foo
 
index 576b0e3..d19a032 100644 (file)
@@ -2,6 +2,6 @@
 mod73.hs:3:7:
     Not in scope: ‘Prelude.g’
     Perhaps you meant one of these:
-      data constructor ‘Prelude.LT’ (imported from Prelude),
+      data constructor ‘Prelude.GT’ (imported from Prelude),
       data constructor ‘Prelude.EQ’ (imported from Prelude),
-      data constructor ‘Prelude.GT’ (imported from Prelude)
+      data constructor ‘Prelude.LT’ (imported from Prelude)
index fec1ce4..4124fec 100644 (file)
@@ -28,11 +28,12 @@ rn.prog006:
        rm -f pkg.conf
        rm -f pwd pwd.exe pwd.exe.manifest pwd.hi pwd.o
        '$(TEST_HC)' $(TEST_HC_OPTS) --make pwd -v0
-       '$(TEST_HC)' $(TEST_HC_OPTS) --make -package-name test-1.0 B.C -fforce-recomp -v0 $(RM_PROG006_EXTRA_FLAGS)
+       '$(TEST_HC)' $(TEST_HC_OPTS) --make -this-package-key test-1.0 B.C -fforce-recomp -v0 $(RM_PROG006_EXTRA_FLAGS)
        rm -f pkg.conf
        echo "name: test" >>pkg.conf
        echo "version: 1.0" >>pkg.conf
        echo "id: test-XXX" >>pkg.conf
+       echo "key: test-1.0" >>pkg.conf
        echo "import-dirs: `./pwd`" >>pkg.conf
        echo "exposed-modules: B.C" >>pkg.conf
        echo "[]" >$(LOCAL_PKGCONF)
index d1e5b64..51ee283 100644 (file)
@@ -11,5 +11,5 @@ test('T3103',
                    'GHC/Unicode.o',  'GHC/Unicode.o-boot',
                    'GHC/Word.hi',    'GHC/Word.o'])],
      multimod_compile,
-     ['Foreign.Ptr', '-v0 -hide-all-packages -package ghc-prim -package integer-gmp -package-name base'])
+     ['Foreign.Ptr', '-v0 -hide-all-packages -package ghc-prim -package integer-gmp -this-package-key base'])
 
index a22386b..43306a9 100644 (file)
@@ -3,4 +3,4 @@
     The package (base) is required to be trusted but it isn't!
 
 <no location info>:
-    The package (bytestring-0.10.1.0) is required to be trusted but it isn't!
+    The package (bytestring-0.10.4.0) is required to be trusted but it isn't!
index a22386b..43306a9 100644 (file)
@@ -3,4 +3,4 @@
     The package (base) is required to be trusted but it isn't!
 
 <no location info>:
-    The package (bytestring-0.10.1.0) is required to be trusted but it isn't!
+    The package (bytestring-0.10.4.0) is required to be trusted but it isn't!
index 17fc482..a37dfa5 100644 (file)
@@ -29,17 +29,17 @@ trusted: safe
 require own pkg trusted: True
 
 M_SafePkg6
-package dependencies: array-0.5.0.0 base* bytestring-0.10.4.0*
+package dependencies: array-0.5.0.0@array_H3W2D8UaI9TKGEhUuQHax2
 trusted: trustworthy
 require own pkg trusted: False
 
 M_SafePkg7
-package dependencies: array-0.5.0.0 base* bytestring-0.10.4.0*
+package dependencies: array-0.5.0.0@array_H3W2D8UaI9TKGEhUuQHax2
 trusted: safe
 require own pkg trusted: False
 
 M_SafePkg8
-package dependencies: array-0.5.0.0 base bytestring-0.10.4.0*
+package dependencies: array-0.5.0.0@array_H3W2D8UaI9TKGEhUuQHax2
 trusted: trustworthy
 require own pkg trusted: False
 
index d33652f..47eb1de 100644 (file)
@@ -260,7 +260,7 @@ updateInstallDirTemplates relocatableBuild myPrefix myLibdir myDocdir idts
                           if relocatableBuild
                           then "$topdir"
                           else myLibdir,
-          libsubdir = toPathTemplate "$pkgid",
+          libsubdir = toPathTemplate "$pkgkey",
           docdir    = toPathTemplate $
                           if relocatableBuild
                           then "$topdir/../doc/html/libraries/$pkgid"
@@ -356,6 +356,7 @@ generate directory distdir dll0Modules config_args
              writeFileAtomic (distdir </> "inplace-pkg-config") (BS.pack $ toUTF8 content)
 
       let
+          comp = compiler lbi
           libBiModules lib = (libBuildInfo lib, libModules lib)
           exeBiModules exe = (buildInfo exe, ModuleName.main : exeModules exe)
           biModuless = (maybeToList $ fmap libBiModules $ library pd)
@@ -398,10 +399,25 @@ generate directory distdir dll0Modules config_args
 
           dep_ids  = map snd (externalPackageDeps lbi)
           deps     = map display dep_ids
+          dep_keys
+            | packageKeySupported comp
+                   = map (display
+                        . Installed.packageKey
+                        . fromMaybe (error "ghc-cabal: dep_keys failed")
+                        . PackageIndex.lookupInstalledPackageId
+                                                           (installedPkgs lbi)
+                        . fst)
+                   . externalPackageDeps
+                   $ lbi
+            | otherwise = deps
           depNames = map (display . packageName) dep_ids
 
           transitive_dep_ids = map Installed.sourcePackageId dep_pkgs
           transitiveDeps = map display transitive_dep_ids
+          transitiveDepKeys
+            | packageKeySupported comp
+                   = map (display . Installed.packageKey) dep_pkgs
+            | otherwise = transitiveDeps
           transitiveDepNames = map (display . packageName) transitive_dep_ids
 
           libraryDirs = forDeps Installed.libraryDirs
@@ -420,13 +436,16 @@ generate directory distdir dll0Modules config_args
           otherMods = map display (otherModules bi)
           allMods = mods ++ otherMods
       let xs = [variablePrefix ++ "_VERSION = " ++ display (pkgVersion (package pd)),
+                variablePrefix ++ "_PACKAGE_KEY = " ++ display (pkgKey lbi),
                 variablePrefix ++ "_MODULES = " ++ unwords mods,
                 variablePrefix ++ "_HIDDEN_MODULES = " ++ unwords otherMods,
                 variablePrefix ++ "_SYNOPSIS =" ++ synopsis pd,
                 variablePrefix ++ "_HS_SRC_DIRS = " ++ unwords (hsSourceDirs bi),
                 variablePrefix ++ "_DEPS = " ++ unwords deps,
+                variablePrefix ++ "_DEP_KEYS = " ++ unwords dep_keys,
                 variablePrefix ++ "_DEP_NAMES = " ++ unwords depNames,
                 variablePrefix ++ "_TRANSITIVE_DEPS = " ++ unwords transitiveDeps,
+                variablePrefix ++ "_TRANSITIVE_DEP_KEYS = " ++ unwords transitiveDepKeys,
                 variablePrefix ++ "_TRANSITIVE_DEP_NAMES = " ++ unwords transitiveDepNames,
                 variablePrefix ++ "_INCLUDE_DIRS = " ++ unwords (includeDirs bi),
                 variablePrefix ++ "_INCLUDES = " ++ unwords (includes bi),
index 072dec0..2679639 100644 (file)
@@ -901,13 +901,13 @@ registerPackage input verbosity my_flags auto_ghci_libs multi_instance
 
   let 
      -- In the normal mode, we only allow one version of each package, so we
-     -- remove all instances with the same source package id as the one we're
+     -- remove all instances with the same source package key as the one we're
      -- adding. In the multi instance mode we don't do that, thus allowing
-     -- multiple instances with the same source package id.
+     -- multiple instances with the same source package key.
      removes = [ RemovePackage p
                | not multi_instance,
                  p <- packages db_to_operate_on,
-                 sourcePackageId p == sourcePackageId pkg ]
+                 packageKey p == packageKey pkg ]
   --
   changeDB verbosity (removes ++ [AddPackage pkg']) db_to_operate_on
 
@@ -1058,21 +1058,28 @@ modifyPackage fn pkgarg verbosity my_flags force = do
       db_name = location db
       pkgs    = packages db
 
-      pids = map sourcePackageId ps
+      pks = map packageKey ps
 
-      cmds = [ fn pkg | pkg <- pkgs, sourcePackageId pkg `elem` pids ]
+      cmds = [ fn pkg | pkg <- pkgs, packageKey pkg `elem` pks ]
       new_db = updateInternalDB db cmds
 
       -- ...but do consistency checks with regards to the full stack
       old_broken = brokenPackages (allPackagesInStack db_stack)
       rest_of_stack = filter ((/= db_name) . location) db_stack
       new_stack = new_db : rest_of_stack
-      new_broken = map sourcePackageId (brokenPackages (allPackagesInStack new_stack))
-      newly_broken = filter (`notElem` map sourcePackageId old_broken) new_broken
+      new_broken = brokenPackages (allPackagesInStack new_stack)
+      newly_broken = filter ((`notElem` map packageKey old_broken)
+                            . packageKey) new_broken
   --
+  let displayQualPkgId pkg
+        | [_] <- filter ((== pkgid) . sourcePackageId)
+                        (allPackagesInStack db_stack)
+            = display pkgid
+        | otherwise = display pkgid ++ "@" ++ display (packageKey pkg)
+        where pkgid = sourcePackageId pkg
   when (not (null newly_broken)) $
       dieOrForceAll force ("unregistering would break the following packages: "
-              ++ unwords (map display newly_broken))
+              ++ unwords (map displayQualPkgId newly_broken))
 
   changeDB verbosity cmds db
 
@@ -1114,7 +1121,10 @@ listPackages verbosity my_flags mPackageName mModuleName = do
                    case pkgName p1 `compare` pkgName p2 of
                         LT -> LT
                         GT -> GT
-                        EQ -> pkgVersion p1 `compare` pkgVersion p2
+                        EQ -> case pkgVersion p1 `compare` pkgVersion p2 of
+                                LT -> LT
+                                GT -> GT
+                                EQ -> packageKey pkg1 `compare` packageKey pkg2
                    where (p1,p2) = (sourcePackageId pkg1, sourcePackageId pkg2)
 
       stack = reverse db_stack_sorted
@@ -1122,7 +1132,7 @@ listPackages verbosity my_flags mPackageName mModuleName = do
       match `exposedInPkg` pkg = any match (map display $ exposedModules pkg)
 
       pkg_map = allPackagesInStack db_stack
-      broken = map sourcePackageId (brokenPackages pkg_map)
+      broken = map packageKey (brokenPackages pkg_map)
 
       show_normal PackageDB{ location = db_name, packages = pkg_confs } =
           do hPutStrLn stdout (db_name ++ ":")
@@ -1133,7 +1143,7 @@ listPackages verbosity my_flags mPackageName mModuleName = do
                  -- Sort using instance Ord PackageId
                  pp_pkgs = map pp_pkg . sortBy (comparing installedPackageId) $ pkg_confs
                  pp_pkg p
-                   | sourcePackageId p `elem` broken = printf "{%s}" doc
+                   | packageKey p `elem` broken = printf "{%s}" doc
                    | exposed p = doc
                    | otherwise = printf "(%s)" doc
                    where doc | verbosity >= Verbose = printf "%s (%s)" pkg ipid
@@ -1160,7 +1170,7 @@ listPackages verbosity my_flags mPackageName mModuleName = do
                   map (termText "   " <#>) (map pp_pkg (packages db)))
           where
                    pp_pkg p
-                     | sourcePackageId p `elem` broken = withF Red  doc
+                     | packageKey p `elem` broken = withF Red  doc
                      | exposed p                       = doc
                      | otherwise                       = withF Blue doc
                      where doc | verbosity >= Verbose
@@ -1212,6 +1222,8 @@ showPackageDot verbosity myflags = do
 -- -----------------------------------------------------------------------------
 -- Prints the highest (hidden or exposed) version of a package
 
+-- ToDo: This is no longer well-defined with package keys, because the
+-- dependencies may be varying versions
 latestPackage ::  Verbosity -> [Flag] -> PackageIdentifier -> IO ()
 latestPackage verbosity my_flags pkgid = do
   (_, _, flag_db_stack) <- 
@@ -1500,6 +1512,7 @@ checkPackageConfig pkg verbosity db_stack auto_ghci_libs
                    multi_instance update = do
   checkInstalledPackageId pkg db_stack update
   checkPackageId pkg
+  checkPackageKey pkg
   checkDuplicates db_stack pkg multi_instance update
   mapM_ (checkDep db_stack) (depends pkg)
   checkDuplicateDepends (depends pkg)
@@ -1539,17 +1552,26 @@ checkPackageId ipi =
     []  -> verror CannotForce ("invalid package identifier: " ++ str)
     _   -> verror CannotForce ("ambiguous package identifier: " ++ str)
 
+checkPackageKey :: InstalledPackageInfo -> Validate ()
+checkPackageKey ipi =
+  let str = display (packageKey ipi) in
+  case [ x :: PackageKey | (x,ys) <- readP_to_S parse str, all isSpace ys ] of
+    [_] -> return ()
+    []  -> verror CannotForce ("invalid package key: " ++ str)
+    _   -> verror CannotForce ("ambiguous package key: " ++ str)
+
 checkDuplicates :: PackageDBStack -> InstalledPackageInfo
                 -> Bool -> Bool-> Validate ()
 checkDuplicates db_stack pkg multi_instance update = do
   let
+        pkg_key = packageKey pkg
         pkgid = sourcePackageId pkg
         pkgs  = packages (head db_stack)
   --
   -- Check whether this package id already exists in this DB
   --
   when (not update && not multi_instance
-                   && (pkgid `elem` map sourcePackageId pkgs)) $
+                   && (pkg_key `elem` map packageKey pkgs)) $
        verror CannotForce $
           "package " ++ display pkgid ++ " is already installed"