diff options
| author | Edward Z. Yang <ezyang@cs.stanford.edu> | 2014-07-18 14:48:47 +0100 |
|---|---|---|
| committer | Edward Z. Yang <ezyang@cs.stanford.edu> | 2014-08-05 10:08:02 +0100 |
| commit | 66218d15b7c27a4a38992003bd761f60bae84b1f (patch) | |
| tree | 2537bf88de77a1a7f98204c498b0f623308d3cb6 | |
| parent | edff1efa74edcfa9db0010ae92e1e159ecb60b7e (diff) | |
| download | haskell-66218d15b7c27a4a38992003bd761f60bae84b1f.tar.gz | |
Package keys (for linking/type equality) separated from package IDs.
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, 537 insertions, 130 deletions
diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs index 3ec9f6a9b0..8f21d66bc1 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 838a908364..d449adac67 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 c236bcf7ff..d23d1fe5b6 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 74dec19d14..013918c13f 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 04b0476f30..2be6e9d4d8 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 686b352c2a..50cd824b24 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 dfd2e27457..8280730747 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 37395ce956..ded85140fd 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 f02abe84dd..8710297fd4 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 c0794def95..e0d11e4ef2 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 520b533380..864980be9d 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 5973bc5d4b..93b566fb0e 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 3a1712e2da..3fd0fd5422 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 e32261de65..a65607a7c3 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 1dd224a611..8381ca1254 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 62b4e96bfd..50549b409c 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 @@ -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 ab4ea8721b..96b78809d2 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 -Subproject 96847693bf8ff48ae94f179d60c1f23411e1365 +Subproject 6cc46998f0778c04b535c805416604995fe153b diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index e56724ce4f..b7828a9c20 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 f4d0a4b147..baf8a05159 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 bc9f57126a..9c1801b4d6 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 c0f6b60aa4..376139f102 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 51d3cc7b5b..d18a182012 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 fb8dbd7ab0..db268be212 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 0d2b341a51..c5dc06e0e3 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 8250bc2bb6..82d2870cde 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 294e43274a..3efe501451 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 ba1fa00f46..f93b99d5f8 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 93bc60b6b1..898485c0ca 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 c99aebaf4c..d160143978 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 9bda51eea0..3f4a96e22b 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 479ce7092c..caaaefaa1a 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 0000000000..5934b9b29c --- /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 0000000000..9a994af677 --- /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 0000000000..edca288265 --- /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 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/cabal/cabal06/cabal06.stderr diff --git a/testsuite/tests/cabal/cabal06/cabal06.stdout b/testsuite/tests/cabal/cabal06/cabal06.stdout new file mode 100644 index 0000000000..e5ff042302 --- /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 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/cabal/cabal06/p-1.0/LICENSE 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 0000000000..7d63e39dac --- /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 0000000000..ab7b3ebffe --- /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 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/cabal/cabal06/p-1.1/LICENSE 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 0000000000..446448039f --- /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 0000000000..8a7b7b271d --- /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 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/cabal/cabal06/q/LICENSE diff --git a/testsuite/tests/cabal/cabal06/q/Q.hs b/testsuite/tests/cabal/cabal06/q/Q.hs new file mode 100644 index 0000000000..03d0923450 --- /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 0000000000..2c25cee262 --- /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 0000000000..7b3a074f88 --- /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 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/cabal/cabal06/r/LICENSE diff --git a/testsuite/tests/cabal/cabal06/r/Main.hs b/testsuite/tests/cabal/cabal06/r/Main.hs new file mode 100644 index 0000000000..5e626645cd --- /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 0000000000..60e16c1c78 --- /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 da50cd92f6..c8faf7fdbb 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 7bf047f3d2..553ebeb776 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 b720dc9479..ae89641176 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 933ed3f67d..62c93f95e1 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 02a07ab7b6..42c557a0f9 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 a6d28d629a..c027ed3a15 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 6d3257126b..8f1ca04366 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 598559a80f..c4b1883512 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 fc27bc9ba5..48e198cd30 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 c0698d70b9..f90fa7320f 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 d8bf47ec36..e89ac444d8 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 77000eda27..0e368e5ae8 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 15c3559f7d..dc6edb21a8 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 60cb9cbfda..08c5158acc 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 815fbff1d4..6f77c09a36 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 576b0e3a86..d19a032cef 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 fec1ce42d3..4124feccf0 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 d1e5b643f3..51ee2830bd 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 a22386b7a8..43306a9eb7 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 a22386b7a8..43306a9eb7 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 17fc4823a5..a37dfa55a3 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 d33652fe96..47eb1de4fd 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 072dec0f37..2679639a46 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" |