diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs
index 3ec9f6a9b061fcc6eeb04ec57c83808d4a7d1b67..8f21d66bc18f551672b54c18b4fb686936797e91 100644
--- a/compiler/basicTypes/Module.lhs
+++ b/compiler/basicTypes/Module.lhs
@@ -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}
%************************************************************************
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 838a9083645a2f5510595da8e08d86adc603abf9..d449adac6744d562a21455aa91635d460716c78c 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -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
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index c236bcf7ff3eaec30e52cca6dfb9a79720d57bff..d23d1fe5b6073c561d1aa6b63129f890e176c842 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -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
diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index 74dec19d1431936734d0cd3f1aa8c841907d49e2..013918c13f5bd2bc88d5c3058b3851ae36f811e5 100644
--- a/compiler/ghci/Linker.lhs
+++ b/compiler/ghci/Linker.lhs
@@ -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}
diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index 04b0476f30ad6ba5a16a2e9d2ee5c97e43546664..2be6e9d4d83d51060e012ef80b2bf4688bb4b502 100644
--- a/compiler/iface/LoadIface.lhs
+++ b/compiler/iface/LoadIface.lhs
@@ -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.
diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index 686b352c2ade8d2efa11a9411972179e1d7f9500..50cd824b2481f95d84e83886d57e8f84c344f76e 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -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))
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index dfd2e274579fe7f46f57e964ec447d65c2ba380a..8280730747bbef33d5dc8bd850bc04ee968cca0e 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -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
diff --git a/compiler/main/Finder.lhs b/compiler/main/Finder.lhs
index 37395ce956fd0d921d3513fcfecc2889a91107a4..ded85140fd226fd42433df6e67e3e034d8da3826 100644
--- a/compiler/main/Finder.lhs
+++ b/compiler/main/Finder.lhs
@@ -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
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index f02abe84dda6a7112adc3de40752da2b8bc39892..8710297fd4e81bd9b7da7c8e20f7cc6d7469c328 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -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!"
diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index c0794def952d4ae713ce3ee5eeffbf856b065f4a..e0d11e4ef2af2799556b37c5eab449f6d075458a 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -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}
diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs
index 520b53338067a0ec66a40d3a50823d21e59f0c8d..864980be9da55f2e46ab072359886ad261ef9b3d 100644
--- a/compiler/main/PackageConfig.hs
+++ b/compiler/main/PackageConfig.hs
@@ -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
diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index 5973bc5d4ba2c69687bb5366269ea16ce3fdfaeb..93b566fb0e1f4f4e43487a45ea7d8711fd279d98 100644
--- a/compiler/main/Packages.lhs
+++ b/compiler/main/Packages.lhs
@@ -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
diff --git a/compiler/main/Packages.lhs-boot b/compiler/main/Packages.lhs-boot
index 3a1712e2da1ca6da61198b701be2951f7a524e0f..3fd0fd54223597121a99a9c2e9efb3e9ea2b1bbd 100644
--- a/compiler/main/Packages.lhs-boot
+++ b/compiler/main/Packages.lhs-boot
@@ -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}
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index e32261de65b4a816de87fce179885e4b7458c844..a65607a7c3ebe1ff67d3d914484fa67be121be67 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -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
diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index 1dd224a61108f2c9966e9424cd1e13bdc85d0029..8381ca12546b5357b967b4bdb99e19b3628dfdd7 100644
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -590,7 +590,7 @@
</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>
diff --git a/docs/users_guide/packages.xml b/docs/users_guide/packages.xml
index 62b4e96bfdf1af8209a2f2cd465f482cb1da12aa..50549b409c05c48b34d217bdf38abf72402a0f79 100644
--- a/docs/users_guide/packages.xml
+++ b/docs/users_guide/packages.xml
@@ -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 a1d304ebd0efd82d3c7e0e4f69e8a22577fb9322..8ba90fe83137ea3a766bf829cb8332b37d5ac280 100644
--- 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 \
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index ab4ea8721bf64bbaa5e964ff0e0a2bbab84b0a75..96b78809d2bfc1cad2ce61dbe54fa2ca2d5810d9 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -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
diff --git a/libraries/Cabal b/libraries/Cabal
index 96847693bf8ff48ae94f179d60c1f23411e1365e..6cc46998f0778c04b535c805416604995fe153b5 160000
--- a/libraries/Cabal
+++ b/libraries/Cabal
@@ -1 +1 @@
-Subproject commit 96847693bf8ff48ae94f179d60c1f23411e1365e
+Subproject commit 6cc46998f0778c04b535c805416604995fe153b5
diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
index e56724ce4fe0cc8798decf45ff10f7d46d020855..b7828a9c20fe6f3b9a8c85af1fa1d31385d1ed48 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/base.cabal
@@ -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
diff --git a/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs b/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs
index f4d0a4b1471d49ae96d6c912491c68247a3a697e..baf8a05159a789e56867e94d30d7d41b1b4336bb 100644
--- a/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs
+++ b/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs
@@ -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)
diff --git a/libraries/ghc-prim/ghc-prim.cabal b/libraries/ghc-prim/ghc-prim.cabal
index bc9f57126a7bd121f4684a11e290f91a7ca30306..9c1801b4d64076ed3627b35eb84088a3c2f02e3d 100644
--- a/libraries/ghc-prim/ghc-prim.cabal
+++ b/libraries/ghc-prim/ghc-prim.cabal
@@ -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
diff --git a/libraries/integer-gmp/integer-gmp.cabal b/libraries/integer-gmp/integer-gmp.cabal
index c0f6b60aa4158a39c78683ab2c9205502dc391b2..376139f10242548a9d680b7fff8280d575ef2251 100644
--- a/libraries/integer-gmp/integer-gmp.cabal
+++ b/libraries/integer-gmp/integer-gmp.cabal
@@ -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
diff --git a/libraries/integer-simple/integer-simple.cabal b/libraries/integer-simple/integer-simple.cabal
index 51d3cc7b5b4255476b5f4f5774b601df033ca97d..d18a18201294b9fb9408e33cf67b4e74ff79fd20 100644
--- a/libraries/integer-simple/integer-simple.cabal
+++ b/libraries/integer-simple/integer-simple.cabal
@@ -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
diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal
index fb8dbd7ab0b2834555791bbb7edd1cfa5b6bcbc6..db268be2128dd65889641c10ebfee6472c0de5b8 100644
--- a/libraries/template-haskell/template-haskell.cabal
+++ b/libraries/template-haskell/template-haskell.cabal
@@ -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
diff --git a/rts/ghc.mk b/rts/ghc.mk
index 0d2b341a51f50c26949b50b946c69593dde9c502..c5dc06e0e3bdb320822c14f29a0baaa5302d44c3 100644
--- a/rts/ghc.mk
+++ b/rts/ghc.mk
@@ -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
diff --git a/rts/package.conf.in b/rts/package.conf.in
index 8250bc2bb618be68133d9ad7cfcbd3ca1311ba90..82d2870cde9299f36eb284def95d2d465fad675c 100644
--- a/rts/package.conf.in
+++ b/rts/package.conf.in
@@ -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
diff --git a/rules/build-package-way.mk b/rules/build-package-way.mk
index 294e43274a7404415cad423670a65b39b0da714f..3efe501451b9fb7724614c96c48090202e5059db 100644
--- a/rules/build-package-way.mk
+++ b/rules/build-package-way.mk
@@ -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"
diff --git a/rules/build-prog.mk b/rules/build-prog.mk
index ba1fa00f465e6467e6bc3b19acf31ab1c36c526a..f93b99d5f8fc6be39bb253641a235545cc71a8e0 100644
--- a/rules/build-prog.mk
+++ b/rules/build-prog.mk
@@ -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");' >> $$@
diff --git a/rules/distdir-way-opts.mk b/rules/distdir-way-opts.mk
index 93bc60b6b1a50c87fa03a83cb8c7c6bae7142f4b..898485c0ca166f84cdb4a5e4d210f1fc32c13d64 100644
--- a/rules/distdir-way-opts.mk
+++ b/rules/distdir-way-opts.mk
@@ -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
diff --git a/testsuite/.gitignore b/testsuite/.gitignore
index c99aebaf4ca471c3040b776a4164ec78f8f13b2f..d160143978ce0ece8c026fb61c1f4e4defcbbcbe 100644
--- a/testsuite/.gitignore
+++ b/testsuite/.gitignore
@@ -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/
diff --git a/testsuite/tests/cabal/T1750A.pkg b/testsuite/tests/cabal/T1750A.pkg
index 9bda51eea08d613e458310ee62ad4136d18b7d40..3f4a96e22b601816b408fd30bb875056a73a1478 100644
--- a/testsuite/tests/cabal/T1750A.pkg
+++ b/testsuite/tests/cabal/T1750A.pkg
@@ -1,4 +1,5 @@
name: T1750A
version: 1
id: T1750A-1-XXX
+key: T1750A-1
depends: T1750B-1-XXX
diff --git a/testsuite/tests/cabal/T1750B.pkg b/testsuite/tests/cabal/T1750B.pkg
index 479ce7092c66d1f2cb64be3dfab27f934f052d7f..caaaefaa1a1ecdd2c8951a6ca4d2bf76e386771b 100644
--- a/testsuite/tests/cabal/T1750B.pkg
+++ b/testsuite/tests/cabal/T1750B.pkg
@@ -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
index 0000000000000000000000000000000000000000..5934b9b29c6431924332cec5f89d96ad4bd1cfc0
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/Makefile
@@ -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
index 0000000000000000000000000000000000000000..9a994af677b0dfd41b4e3b76b3e7e604003d64e1
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/Setup.hs
@@ -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
index 0000000000000000000000000000000000000000..edca288265028c30bd86c00fbbb505cb80d12bac
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/all.T
@@ -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
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/testsuite/tests/cabal/cabal06/cabal06.stdout b/testsuite/tests/cabal/cabal06/cabal06.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..e5ff042302ab9d84aa41f0d62f083da91e89aaf1
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/cabal06.stdout
@@ -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
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
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
index 0000000000000000000000000000000000000000..7d63e39dac6f4d692b76378b00a24758fde7a244
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/p-1.0/P.hs
@@ -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
index 0000000000000000000000000000000000000000..ab7b3ebffe0ec0ef69f3715cd7a457ae4a054f48
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/p-1.0/p.cabal
@@ -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
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
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
index 0000000000000000000000000000000000000000..446448039f3948a6077de916f729f9abadab2595
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/p-1.1/P.hs
@@ -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
index 0000000000000000000000000000000000000000..8a7b7b271d150e4b09d5e835cd5ef60a2fd2bfa6
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/p-1.1/p.cabal
@@ -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
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/testsuite/tests/cabal/cabal06/q/Q.hs b/testsuite/tests/cabal/cabal06/q/Q.hs
new file mode 100644
index 0000000000000000000000000000000000000000..03d0923450b8d857c1e8a97a700782d8bd555868
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/q/Q.hs
@@ -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
index 0000000000000000000000000000000000000000..2c25cee262b6ead8ff0e1124b999756277118ee9
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/q/q-1.0.conf
@@ -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
index 0000000000000000000000000000000000000000..7b3a074f886f7ba38544bb79fb2fd79b08beb893
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/q/q.cabal
@@ -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
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/testsuite/tests/cabal/cabal06/r/Main.hs b/testsuite/tests/cabal/cabal06/r/Main.hs
new file mode 100644
index 0000000000000000000000000000000000000000..5e626645cdc4227aa829b5d33baab046e4c645fc
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/r/Main.hs
@@ -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
index 0000000000000000000000000000000000000000..60e16c1c78de6167d328cbe7a8fca8be2fbb9e07
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/r/r.cabal
@@ -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
diff --git a/testsuite/tests/cabal/ghcpkg01.stdout b/testsuite/tests/cabal/ghcpkg01.stdout
index da50cd92f664aa88c5449f35a88f827183ac685c..c8faf7fdbbebd161618c2d29b90968374f132263 100644
--- a/testsuite/tests/cabal/ghcpkg01.stdout
+++ b/testsuite/tests/cabal/ghcpkg01.stdout
@@ -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
diff --git a/testsuite/tests/cabal/shadow1.pkg b/testsuite/tests/cabal/shadow1.pkg
index 7bf047f3d2b1a8e49e7cc6f5a2b7f63c2f0c6b2f..553ebeb7768b96cac97760fb135f46195973ac2f 100644
--- a/testsuite/tests/cabal/shadow1.pkg
+++ b/testsuite/tests/cabal/shadow1.pkg
@@ -1,4 +1,5 @@
name: shadow
version: 1
id: shadow-1-XXX
+key: shadow-1
depends:
diff --git a/testsuite/tests/cabal/shadow2.pkg b/testsuite/tests/cabal/shadow2.pkg
index b720dc947956a8a7a813166a4462562544e6ff36..ae89641176137b3a97b403242fb2814a8bed1f40 100644
--- a/testsuite/tests/cabal/shadow2.pkg
+++ b/testsuite/tests/cabal/shadow2.pkg
@@ -1,4 +1,5 @@
name: shadowdep
version: 1
id: shadowdep-1-XXX
+key: shadowdep-1
depends: shadow-1-XXX
diff --git a/testsuite/tests/cabal/shadow3.pkg b/testsuite/tests/cabal/shadow3.pkg
index 933ed3f67d867ad43d4bd5864170cb857f041a93..62c93f95e1b31a4235fced29c771538eb8fa08a3 100644
--- a/testsuite/tests/cabal/shadow3.pkg
+++ b/testsuite/tests/cabal/shadow3.pkg
@@ -1,4 +1,5 @@
name: shadow
version: 1
id: shadow-1-YYY
+key: shadow-1
depends:
diff --git a/testsuite/tests/cabal/test.pkg b/testsuite/tests/cabal/test.pkg
index 02a07ab7b694b37556b7ed64f15b741c6ef83a91..42c557a0f9029386e58143999a415ec87779b7b6 100644
--- a/testsuite/tests/cabal/test.pkg
+++ b/testsuite/tests/cabal/test.pkg
@@ -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
diff --git a/testsuite/tests/cabal/test2.pkg b/testsuite/tests/cabal/test2.pkg
index a6d28d629a357003e5a036bac18326f4b90cc79c..c027ed3a15b773118d22a83256a458304f7ecf3f 100644
--- a/testsuite/tests/cabal/test2.pkg
+++ b/testsuite/tests/cabal/test2.pkg
@@ -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
diff --git a/testsuite/tests/cabal/test3.pkg b/testsuite/tests/cabal/test3.pkg
index 6d3257126bd8d53d88b4dea807afd6b3fc48b6bd..8f1ca04366a6f377ef02096a84ec332a60af34d0 100644
--- a/testsuite/tests/cabal/test3.pkg
+++ b/testsuite/tests/cabal/test3.pkg
@@ -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
diff --git a/testsuite/tests/cabal/test4.pkg b/testsuite/tests/cabal/test4.pkg
index 598559a80fd14a7d40ee39eaacf0e621fd7c7511..c4b1883512ea6adf8b6ca408a672be8ba289606f 100644
--- a/testsuite/tests/cabal/test4.pkg
+++ b/testsuite/tests/cabal/test4.pkg
@@ -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
diff --git a/testsuite/tests/cabal/test5.pkg b/testsuite/tests/cabal/test5.pkg
index fc27bc9ba599a6544c1d1f95ae31de068ea46b4e..48e198cd301ba1f8f32672bfa9bf29d91862436b 100644
--- a/testsuite/tests/cabal/test5.pkg
+++ b/testsuite/tests/cabal/test5.pkg
@@ -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
diff --git a/testsuite/tests/cabal/test7a.pkg b/testsuite/tests/cabal/test7a.pkg
index c0698d70b9c2286afc0bfff62b1e37bac6dce88c..f90fa7320f65b975660f5295b50b3de28d912bc6 100644
--- a/testsuite/tests/cabal/test7a.pkg
+++ b/testsuite/tests/cabal/test7a.pkg
@@ -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
diff --git a/testsuite/tests/cabal/test7b.pkg b/testsuite/tests/cabal/test7b.pkg
index d8bf47ec366cadbfb2ee2ec8066c26a69dcc77d8..e89ac444d8da42978865a49b01a79dbf6dc8fe0b 100644
--- a/testsuite/tests/cabal/test7b.pkg
+++ b/testsuite/tests/cabal/test7b.pkg
@@ -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
diff --git a/testsuite/tests/cabal/testdup.pkg b/testsuite/tests/cabal/testdup.pkg
index 77000eda2737a93726b1836876ea7bd134d758f9..0e368e5ae8947fa7f8fdeb0806b940bb8ee37e6f 100644
--- a/testsuite/tests/cabal/testdup.pkg
+++ b/testsuite/tests/cabal/testdup.pkg
@@ -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
diff --git a/testsuite/tests/ghc-api/T7478/T7478.hs b/testsuite/tests/ghc-api/T7478/T7478.hs
index 15c3559f7dfa75b82591fe361419d4ee49cd6984..dc6edb21a8cca360ad19992af6b3fbe812fa6504 100644
--- a/testsuite/tests/ghc-api/T7478/T7478.hs
+++ b/testsuite/tests/ghc-api/T7478/T7478.hs
@@ -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 ()
diff --git a/testsuite/tests/ghci/linking/Makefile b/testsuite/tests/ghci/linking/Makefile
index 60cb9cbfdaaa6c304e5aa18ceb7fb2896ff5277c..08c5158acc14e5e5792e49c654d7280332c9dce6 100644
--- a/testsuite/tests/ghci/linking/Makefile
+++ b/testsuite/tests/ghci/linking/Makefile
@@ -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
diff --git a/testsuite/tests/module/base01/Makefile b/testsuite/tests/module/base01/Makefile
index 815fbff1d4ab5dbbbe0b030810cb6b922dec8ce8..6f77c09a36eb0d5267ebf7715cd50d2d5b0b968a 100644
--- a/testsuite/tests/module/base01/Makefile
+++ b/testsuite/tests/module/base01/Makefile
@@ -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
diff --git a/testsuite/tests/module/mod73.stderr b/testsuite/tests/module/mod73.stderr
index 576b0e3a860a74d9b87bcbdb30c918f23d6a064c..d19a032cef39ba9bf13dae275ce69ebc1d5bc58f 100644
--- a/testsuite/tests/module/mod73.stderr
+++ b/testsuite/tests/module/mod73.stderr
@@ -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)
diff --git a/testsuite/tests/rename/prog006/Makefile b/testsuite/tests/rename/prog006/Makefile
index fec1ce42d3d7f89822df683e081c33a09212f417..4124feccf059da038e3d0ca49119b07925569e4e 100644
--- a/testsuite/tests/rename/prog006/Makefile
+++ b/testsuite/tests/rename/prog006/Makefile
@@ -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)
diff --git a/testsuite/tests/rename/should_compile/T3103/test.T b/testsuite/tests/rename/should_compile/T3103/test.T
index d1e5b643f31c448119e498af67b9ecd5f00be0f6..51ee2830bdfeb4c99012c37eedcee8b0641ac09f 100644
--- a/testsuite/tests/rename/should_compile/T3103/test.T
+++ b/testsuite/tests/rename/should_compile/T3103/test.T
@@ -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'])
diff --git a/testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly07.stderr b/testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly07.stderr
index a22386b7a843f373315d3caea1d9e87633617e4a..43306a9eb7f39328c8bff6e80bc697758404a398 100644
--- a/testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly07.stderr
+++ b/testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly07.stderr
@@ -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!
diff --git a/testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly08.stderr b/testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly08.stderr
index a22386b7a843f373315d3caea1d9e87633617e4a..43306a9eb7f39328c8bff6e80bc697758404a398 100644
--- a/testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly08.stderr
+++ b/testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly08.stderr
@@ -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!
diff --git a/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout b/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
index 17fc4823a56ff268c33d9aecace93cb1b53b36a8..a37dfa55a393c1a852cb51fdb9754587eb197296 100644
--- a/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
+++ b/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
@@ -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
diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs
index d33652fe960e091845bd7d6081545472cc48ad3b..47eb1de4fd438075fd852872013facca40142cf7 100644
--- a/utils/ghc-cabal/Main.hs
+++ b/utils/ghc-cabal/Main.hs
@@ -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),
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 072dec0f3794f1888b1eb521fc9ea6b27b5f76ae..2679639a463e3cbd52ca9bf759288bda0105f9f9 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -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"