diff options
| author | Edward Z. Yang <ezyang@cs.stanford.edu> | 2014-07-04 17:01:08 +0100 |
|---|---|---|
| committer | Edward Z. Yang <ezyang@cs.stanford.edu> | 2014-07-25 17:59:55 -0700 |
| commit | 7f5c10864e7c26b90c7ff4ed09d00c8a09aa4349 (patch) | |
| tree | 45cc2f6c46f9cf583c8aeb7b324933d65586c1d5 | |
| parent | dae46da7de4d8c7104aea1be48586336bbd486ca (diff) | |
| download | haskell-7f5c10864e7c26b90c7ff4ed09d00c8a09aa4349.tar.gz | |
Module reexports, fixing #8407.
The general approach is to add a new field to the package database,
reexported-modules, which considered by the module finder as possible
module declarations. Unlike declaring stub module files, multiple
reexports of the same physical package at the same name do not
result in an ambiguous import.
Has submodule updates for Cabal and haddock.
NB: When a reexport renames a module, that renaming is *not* accessible
from inside the package. This is not so much a deliberate design choice
as for implementation expediency (reexport resolution happens only when
a package is in the package database.)
TODO: Error handling when there are duplicate reexports/etc is not very
well tested.
Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
Conflicts:
compiler/main/HscTypes.lhs
testsuite/.gitignore
utils/haddock
41 files changed, 484 insertions, 53 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 5fbbd3248b..0a18be4b2b 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3588,6 +3588,7 @@ compilerInfo dflags ("RTS ways", cGhcRTSWays), ("Support dynamic-too", if isWindows then "NO" else "YES"), ("Support parallel --make", "YES"), + ("Support reexported-modules", "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 a403163ac8..37395ce956 100644 --- a/compiler/main/Finder.lhs +++ b/compiler/main/Finder.lhs @@ -196,31 +196,36 @@ findExposedPackageModule hsc_env mod_name mb_pkg , fr_pkgs_hidden = [] , fr_mods_hidden = [] , fr_suggestions = suggest }) - Right found - | null found_exposed -- Found, but with no exposed copies + Right found' + | null found_visible -- Found, but with no exposed copies -> return (NotFound { fr_paths = [], fr_pkg = Nothing , fr_pkgs_hidden = pkg_hiddens , fr_mods_hidden = mod_hiddens , fr_suggestions = [] }) - | [(pkg_conf,_)] <- found_exposed -- Found uniquely + | [ModConf mod_name' pkg_conf _ _] <- found_visible -- Found uniquely -> let pkgid = packageConfigId pkg_conf in - findPackageModule_ hsc_env (mkModule pkgid mod_name) pkg_conf + findPackageModule_ hsc_env (mkModule pkgid mod_name') pkg_conf | otherwise -- Found in more than one place - -> return (FoundMultiple (map (packageConfigId.fst) found_exposed)) + -> return (FoundMultiple (map (packageConfigId.modConfPkg) + found_visible)) where + found = eltsUFM found' for_this_pkg = case mb_pkg of Nothing -> found - Just p -> filter ((`matches` p) . fst) found - found_exposed = filter is_exposed for_this_pkg - is_exposed (pkg_conf,exposed_mod) = exposed pkg_conf && exposed_mod + Just p -> filter ((`matches` p).modConfPkg) found + found_visible = filter modConfVisible for_this_pkg + -- NB: _vis is guaranteed to be False; a non-exposed module + -- can never be visible. mod_hiddens = [ packageConfigId pkg_conf - | (pkg_conf,False) <- found ] + | ModConf _ pkg_conf False _vis <- found ] + -- NB: We /re-report/ non-exposed modules of hidden packages. pkg_hiddens = [ packageConfigId pkg_conf - | (pkg_conf,_) <- found, not (exposed pkg_conf) ] + | ModConf _ pkg_conf _ False <- found + , not (exposed pkg_conf) ] pkg_conf `matches` pkg = case packageName pkg_conf of diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index e569440fb3..4933a54cdc 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -1169,7 +1169,7 @@ getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env) -- | Return all /external/ modules available in the package database. -- Modules from the current session (i.e., from the 'HomePackageTable') are --- not included. +-- not included. This includes module names which are reexported by packages. packageDbModules :: GhcMonad m => Bool -- ^ Only consider exposed packages. -> m [Module] @@ -1177,10 +1177,12 @@ packageDbModules only_exposed = do dflags <- getSessionDynFlags let pkgs = eltsUFM (pkgIdMap (pkgState dflags)) return $ - [ mkModule pid modname | p <- pkgs - , not only_exposed || exposed p - , let pid = packageConfigId p - , modname <- exposedModules p ] + [ mkModule pid modname + | p <- pkgs + , not only_exposed || exposed p + , let pid = packageConfigId p + , modname <- exposedModules p + ++ map exportName (reexportedModules p) ] -- ----------------------------------------------------------------------------- -- Misc exported utils diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index 9a382a81bf..c10475a995 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -1448,15 +1448,15 @@ mkPrintUnqualified dflags env = (qual_name, qual_mod) qual_mod mod | modulePackageKey mod == thisPackage dflags = False - | [pkgconfig] <- [pkg | (pkg,exposed_module) <- lookup, - exposed pkg && exposed_module], + | [pkgconfig] <- [modConfPkg m | m <- lookup + , modConfVisible m ], packageConfigId pkgconfig == modulePackageKey mod -- this says: we are given a module P:M, is there just one exposed package -- that exposes a module M, and is it package P? = False | otherwise = True - where lookup = lookupModuleInAllPackages dflags (moduleName mod) + where lookup = eltsUFM $ lookupModuleInAllPackages dflags (moduleName mod) \end{code} diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs index 9938d7370f..520b533380 100644 --- a/compiler/main/PackageConfig.hs +++ b/compiler/main/PackageConfig.hs @@ -66,8 +66,10 @@ packageConfigId = mkPackageKey . sourcePackageId packageConfigToInstalledPackageInfo :: PackageConfig -> InstalledPackageInfo packageConfigToInstalledPackageInfo (pkgconf@(InstalledPackageInfo { exposedModules = e, + reexportedModules = r, hiddenModules = h })) = pkgconf{ exposedModules = map convert e, + reexportedModules = map (fmap convert) r, hiddenModules = map convert h } where convert :: Module.ModuleName -> Distribution.ModuleName.ModuleName convert = (expectJust "packageConfigToInstalledPackageInfo") . simpleParse . moduleNameString @@ -77,7 +79,9 @@ packageConfigToInstalledPackageInfo installedPackageInfoToPackageConfig :: InstalledPackageInfo_ String -> PackageConfig installedPackageInfoToPackageConfig (pkgconf@(InstalledPackageInfo { exposedModules = e, + reexportedModules = r, hiddenModules = h })) = pkgconf{ exposedModules = map mkModuleName e, + reexportedModules = map (fmap mkModuleName) r, hiddenModules = map mkModuleName h } diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index d10b3b9f52..a6ecb1622b 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -14,6 +14,7 @@ module Packages ( -- * Reading the package config, and processing cmdline args PackageState(..), + ModuleConf(..), initPackages, getPackageDetails, lookupModuleInAllPackages, lookupModuleWithSuggestions, @@ -29,6 +30,7 @@ module Packages ( collectIncludeDirs, collectLibraryPaths, collectLinkOpts, packageHsLibs, + ModuleExport(..), -- * Utils isDllName @@ -52,6 +54,7 @@ import System.Environment ( getEnv ) import Distribution.InstalledPackageInfo import Distribution.InstalledPackageInfo.Binary import Distribution.Package hiding (PackageId,depends) +import Distribution.ModuleExport import FastString import ErrUtils ( debugTraceMsg, putMsg, MsgDoc ) import Exception @@ -109,6 +112,34 @@ import qualified Data.Set as Set -- When compiling A, we record in B's Module value whether it's -- in a different DLL, by setting the DLL flag. +-- | The result of performing a lookup on moduleToPkgConfAll, this +-- is one possible provider of a module. +data ModuleConf = ModConf { + -- | The original name of the module + modConfName :: ModuleName, + -- | The original package (config) of the module + modConfPkg :: PackageConfig, + -- | Does the original package expose this module to its clients? This + -- is cached result of whether or not the module name is in + -- exposed-modules or reexported-modules in the package config. While + -- this isn't actually how we want to figure out if a module is visible, + -- this is important for error messages. + modConfExposed :: Bool, + -- | Is the module visible to our current compilation? Interestingly, + -- this is not the same as if it was exposed: if the package is hidden + -- then exposed modules are not visible. However, if another exposed + -- package reexports the module in question, it's now visible! You + -- can't tell this just by looking at the original name, so we + -- record the calculation here. + modConfVisible :: Bool + } + +-- | Map from 'PackageId' (used for documentation) +type PackageIdMap = UniqFM + +-- | Map from 'Module' to 'PackageId' to 'ModuleConf', see 'moduleToPkgConfAll' +type ModuleToPkgConfAll = UniqFM (PackageIdMap ModuleConf) + data PackageState = PackageState { pkgIdMap :: PackageConfigMap, -- PackageKey -> PackageConfig -- The exposed flags are adjusted according to -package and @@ -119,11 +150,14 @@ data PackageState = PackageState { -- should be in reverse dependency order; that is, a package -- is always mentioned before the packages it depends on. - moduleToPkgConfAll :: UniqFM [(PackageConfig,Bool)], -- ModuleEnv mapping - -- Derived from pkgIdMap. - -- Maps Module to (pkgconf,exposed), where pkgconf is the - -- PackageConfig for the package containing the module, and - -- exposed is True if the package exposes that module. + -- | ModuleEnv mapping, derived from 'pkgIdMap'. + -- Maps 'Module' to an original module which is providing the module name. + -- Since the module may be provided by multiple packages, this result + -- is further recorded in a map of the original package IDs to + -- module information. The 'modSummaryPkgConf' should agree with + -- this key. Generally, 'modSummaryName' will be the same as the + -- module key, unless there is renaming. + moduleToPkgConfAll :: ModuleToPkgConfAll, installedPackageIdMap :: InstalledPackageIdMap } @@ -811,7 +845,7 @@ mkPackageState dflags pkgs0 preload0 this_package = do let pstate = PackageState{ preloadPackages = dep_preload, pkgIdMap = pkg_db, - moduleToPkgConfAll = mkModuleMap pkg_db, + moduleToPkgConfAll = mkModuleMap pkg_db ipid_map, installedPackageIdMap = ipid_map } @@ -819,23 +853,43 @@ mkPackageState dflags pkgs0 preload0 this_package = do -- ----------------------------------------------------------------------------- --- Make the mapping from module to package info +-- | Makes the mapping from module to package info for 'moduleToPkgConfAll' mkModuleMap :: PackageConfigMap - -> UniqFM [(PackageConfig, Bool)] -mkModuleMap pkg_db = foldr extend_modmap emptyUFM pkgids + -> InstalledPackageIdMap + -> ModuleToPkgConfAll +mkModuleMap pkg_db ipid_map = foldr extend_modmap emptyUFM pkgids where - pkgids = map packageConfigId (eltsUFM pkg_db) - - extend_modmap pkgid modmap = - addListToUFM_C (++) modmap - ([(m, [(pkg, True)]) | m <- exposed_mods] ++ - [(m, [(pkg, False)]) | m <- hidden_mods]) - where - pkg = expectJust "mkModuleMap" (lookupPackage pkg_db pkgid) - exposed_mods = exposedModules pkg - hidden_mods = hiddenModules pkg + pkgids = map packageConfigId (eltsUFM pkg_db) + + extend_modmap pkgid modmap = addListToUFM_C (plusUFM_C merge) modmap es + where -- ASSERT(m == m' && pkg == pkg' && e == e' + -- && (e || not (v || v'))) + -- Some notes about the assert. Merging only ever occurs when + -- we find a reexport. The interesting condition: + -- e || not (v || v') + -- says that a non-exposed module cannot ever become visible. + -- However, an invisible (but exported) module may become + -- visible when it is reexported by a visible package, + -- which is why we merge visibility using logical OR. + merge a b = a { modConfVisible = + modConfVisible a || modConfVisible b } + es = [(m, unitUFM pkgid (ModConf m pkg True (exposed pkg))) + | m <- exposed_mods] ++ + [(m, unitUFM pkgid (ModConf m pkg False False)) + | m <- hidden_mods] ++ + [(m, unitUFM pkgid' (ModConf m' pkg' True (exposed pkg))) + | ModuleExport{ exportName = m + , exportCachedTrueOrig = Just (ipid', m')} + <- reexported_mods + , Just pkgid' <- [Map.lookup ipid' ipid_map] + , let pkg' = pkg_lookup pkgid' ] + pkg = pkg_lookup pkgid + pkg_lookup = expectJust "mkModuleMap" . lookupPackage pkg_db + exposed_mods = exposedModules pkg + reexported_mods = reexportedModules pkg + hidden_mods = hiddenModules pkg pprSPkg :: PackageConfig -> SDoc pprSPkg p = text (display (sourcePackageId p)) @@ -940,18 +994,20 @@ getPackageFrameworks dflags pkgs = do -- ----------------------------------------------------------------------------- -- Package Utils --- | Takes a 'Module', and if the module is in a package returns --- @(pkgconf, exposed)@ where pkgconf is the PackageConfig for that package, --- and exposed is @True@ if the package exposes the module. -lookupModuleInAllPackages :: DynFlags -> ModuleName -> [(PackageConfig,Bool)] +-- | Takes a 'ModuleName', and if the module is in any package returns +-- a map of package IDs to 'ModuleConf', describing where the module lives +-- and whether or not it is exposed. +lookupModuleInAllPackages :: DynFlags + -> ModuleName + -> PackageIdMap ModuleConf lookupModuleInAllPackages dflags m = case lookupModuleWithSuggestions dflags m of Right pbs -> pbs - Left _ -> [] + Left _ -> emptyUFM lookupModuleWithSuggestions :: DynFlags -> ModuleName - -> Either [Module] [(PackageConfig,Bool)] + -> Either [Module] (PackageIdMap ModuleConf) -- Lookup module in all packages -- Right pbs => found in pbs -- Left ms => not found; but here are sugestions @@ -970,7 +1026,8 @@ lookupModuleWithSuggestions dflags m all_mods = [ (moduleNameString mod_nm, mkModule pkg_id mod_nm) | pkg_config <- eltsUFM (pkgIdMap pkg_state) , let pkg_id = packageConfigId pkg_config - , mod_nm <- exposedModules pkg_config ] + , mod_nm <- exposedModules pkg_config + ++ map exportName (reexportedModules pkg_config) ] -- | Find all the 'PackageConfig' in both the preload packages from 'DynFlags' and corresponding to the list of -- 'PackageConfig's diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 9ac3be4773..ab4ea8721b 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -39,7 +39,8 @@ import HscTypes ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, hsc_IC, setInteractivePrintName ) import Module import Name -import Packages ( trusted, getPackageDetails, exposed, exposedModules, pkgIdMap ) +import Packages ( ModuleExport(..), trusted, getPackageDetails, exposed, + exposedModules, reexportedModules, pkgIdMap ) import PprTyThing import RdrName ( getGRE_NameQualifier_maybes ) import SrcLoc @@ -2544,11 +2545,14 @@ wrapIdentCompleterWithModifier modifChars fun = completeWordWithPrev Nothing wor where getModifier = find (`elem` modifChars) +-- | Return a list of visible module names for autocompletion. allExposedModules :: DynFlags -> [ModuleName] allExposedModules dflags - = concat (map exposedModules (filter exposed (eltsUFM pkg_db))) + = concatMap extract (filter exposed (eltsUFM pkg_db)) where pkg_db = pkgIdMap (pkgState dflags) + extract pkg = exposedModules pkg ++ map exportName (reexportedModules pkg) + -- Extract the *new* name, because that's what is user visible completeExpression = completeQuotedWord (Just '\\') "\"" listFiles completeIdentifier diff --git a/libraries/Cabal b/libraries/Cabal -Subproject 90811eb4f0e06ba308e8a6e93089ff041d93295 +Subproject 96847693bf8ff48ae94f179d60c1f23411e1365 diff --git a/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs b/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs index 6ad169787f..f4d0a4b147 100644 --- a/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs +++ b/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs @@ -22,6 +22,7 @@ module Distribution.InstalledPackageInfo.Binary ( import Distribution.Version import Distribution.Package hiding (depends) import Distribution.License +import Distribution.ModuleExport import Distribution.InstalledPackageInfo as IPI import Data.Binary as Bin import Control.Exception as Exception @@ -60,6 +61,7 @@ putInstalledPackageInfo ipi = do put (category ipi) put (exposed ipi) put (exposedModules ipi) + put (reexportedModules ipi) put (hiddenModules ipi) put (trusted ipi) put (importDirs ipi) @@ -94,6 +96,7 @@ getInstalledPackageInfo = do category <- get exposed <- get exposedModules <- get + reexportedModules <- get hiddenModules <- get trusted <- get importDirs <- get @@ -158,3 +161,8 @@ instance Binary Version where deriving instance Binary PackageName deriving instance Binary InstalledPackageId + +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) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index 0d86770ac8..6bb794860f 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -40,6 +40,9 @@ Thumbs.db *.hp tests/**/*.ps *.stats +Setup +dist +tmp.d *.dyn_o *.dyn_hi @@ -102,17 +105,22 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk /tests/cabal/cabal04/Setup /tests/cabal/cabal04/dist/ /tests/cabal/cabal04/err +/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/local01.package.conf/ /tests/cabal/local03.package.conf/ /tests/cabal/local04.package.conf/ /tests/cabal/local05a.package.conf/ /tests/cabal/local05b.package.conf/ /tests/cabal/local06.package.conf/ +/tests/cabal/local07.package.conf/ /tests/cabal/local1750.package.conf/ /tests/cabal/localT1750.package.conf/ /tests/cabal/localshadow1.package.conf/ /tests/cabal/localshadow2.package.conf/ /tests/cabal/package.conf.*/ +/tests/cabal/recache_reexport_db/package.cache /tests/cabal/shadow.hs /tests/cabal/shadow1.out /tests/cabal/shadow2.out diff --git a/testsuite/tests/cabal/Makefile b/testsuite/tests/cabal/Makefile index e8ed2bd817..062850f76f 100644 --- a/testsuite/tests/cabal/Makefile +++ b/testsuite/tests/cabal/Makefile @@ -236,3 +236,18 @@ ghcpkg02: echo Updating $$i; \ $(GHC_PKG) describe --global $$i | $(GHC_PKG_ghcpkg02) update --global --force -; \ done + +PKGCONF07=local07.package.conf +LOCAL_GHC_PKG07 = '$(GHC_PKG)' --no-user-package-db -f $(PKGCONF07) +ghcpkg07: + @rm -rf $(PKGCONF07) + $(LOCAL_GHC_PKG07) init $(PKGCONF07) + $(LOCAL_GHC_PKG07) register --force test.pkg 2>/dev/null + $(LOCAL_GHC_PKG07) register --force test7a.pkg 2>/dev/null + $(LOCAL_GHC_PKG07) field testpkg7a reexported-modules + $(LOCAL_GHC_PKG07) register --force test7b.pkg 2>/dev/null + $(LOCAL_GHC_PKG07) field testpkg7b reexported-modules + +recache_reexport: + @rm -rf recache_reexport_db/package.cache + '$(GHC_PKG)' --no-user-package-db --global-package-db=recache_reexport_db recache diff --git a/testsuite/tests/cabal/all.T b/testsuite/tests/cabal/all.T index aa97f48209..60f8d6df9b 100644 --- a/testsuite/tests/cabal/all.T +++ b/testsuite/tests/cabal/all.T @@ -47,6 +47,12 @@ test('ghcpkg06', run_command, ['$MAKE -s --no-print-directory ghcpkg06']) +test('ghcpkg07', + extra_clean(['local07.package.conf', + 'local07.package.conf.old']), + run_command, + ['$MAKE -s --no-print-directory ghcpkg07']) + # Test that we *can* compile a module that also belongs to a package # (this was disallowed in GHC 6.4 and earlier) test('pkg01', normal, compile, ['']) diff --git a/testsuite/tests/cabal/cabal05/Makefile b/testsuite/tests/cabal/cabal05/Makefile new file mode 100644 index 0000000000..d4bc1c733a --- /dev/null +++ b/testsuite/tests/cabal/cabal05/Makefile @@ -0,0 +1,69 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +SETUP = ../Setup -v0 + +# This test is for package reexports +# 1. install p +# 2. install q (reexporting p modules) +# 3. install r (reexporting p and q modules) +# 4. configure and build s, using modules from q and r +# +# Here are the permutations we test for: +# - Package qualifier? (YES/NO) +# - Where is module? (defined in SELF / +# (ORIGinally defined/REEXported) in DEPendency) +# For deps, could be BOTH, if there is NO package qualifier +# - Renamed? (YES/NO) +# - Multiple modules with same name? (YES/NO) +# +# It's illegal for the module to be defined in SELF without renaming, or +# for a package to cause a conflict with itself. A reexport which does +# not rename definitionally "conflicts" with the original package's definition. +# +# Probably the trickiest bits are when we automatically pick out which package +# when the package qualifier is missing, and handling whether or not modules +# should be exposed or hidden. + +cabal05: clean + $(MAKE) clean + '$(GHC_PKG)' init tmp.d + '$(TEST_HC)' -v0 --make Setup + # build p + cd p && $(SETUP) clean + cd p && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/$$pkgid' + cd p && $(SETUP) build + cd p && $(SETUP) copy + cd p && $(SETUP) register + # build q + 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)/$$pkgid' + cd q && $(SETUP) build + cd q && $(SETUP) copy + cd q && $(SETUP) register + # build r + cd r && $(SETUP) clean + cd r && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/$$pkgid' + cd r && $(SETUP) build + cd r && $(SETUP) copy + cd r && $(SETUP) register + # build s + cd s && $(SETUP) clean + cd s && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d + cd s && $(SETUP) build + # now test that package recaching works + rm tmp.d/package.cache + '$(GHC_PKG)' --no-user-package-db --global-package-db=tmp.d recache + cd s && $(SETUP) clean + cd s && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d + cd s && $(SETUP) build +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 p-* q-* r-* tmp.d *.o *.hi */*.o */*.hi */Setup$(exeext) */dist Setup$(exeext) diff --git a/testsuite/tests/cabal/cabal05/Setup.hs b/testsuite/tests/cabal/cabal05/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/testsuite/tests/cabal/cabal05/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/testsuite/tests/cabal/cabal05/all.T b/testsuite/tests/cabal/cabal05/all.T new file mode 100644 index 0000000000..36dcbdf9de --- /dev/null +++ b/testsuite/tests/cabal/cabal05/all.T @@ -0,0 +1,9 @@ +if default_testopts.cleanup != '': + cleanup = 'CLEANUP=1' +else: + cleanup = '' + +test('cabal05', + ignore_output, + run_command, + ['$MAKE -s --no-print-directory cabal05 ' + cleanup]) diff --git a/testsuite/tests/cabal/cabal05/p/LICENSE b/testsuite/tests/cabal/cabal05/p/LICENSE new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/cabal/cabal05/p/LICENSE diff --git a/testsuite/tests/cabal/cabal05/p/P.hs b/testsuite/tests/cabal/cabal05/p/P.hs new file mode 100644 index 0000000000..f8b82de2ca --- /dev/null +++ b/testsuite/tests/cabal/cabal05/p/P.hs @@ -0,0 +1,3 @@ +module P where +data P = P +p = True diff --git a/testsuite/tests/cabal/cabal05/p/P2.hs b/testsuite/tests/cabal/cabal05/p/P2.hs new file mode 100644 index 0000000000..769760dff8 --- /dev/null +++ b/testsuite/tests/cabal/cabal05/p/P2.hs @@ -0,0 +1 @@ +module P2 where diff --git a/testsuite/tests/cabal/cabal05/p/Setup.hs b/testsuite/tests/cabal/cabal05/p/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/testsuite/tests/cabal/cabal05/p/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/testsuite/tests/cabal/cabal05/p/p.cabal b/testsuite/tests/cabal/cabal05/p/p.cabal new file mode 100644 index 0000000000..989156c5be --- /dev/null +++ b/testsuite/tests/cabal/cabal05/p/p.cabal @@ -0,0 +1,11 @@ +name: p +version: 0.1.0.0 +license-file: LICENSE +author: Edward Z. Yang +maintainer: ezyang@cs.stanford.edu +build-type: Simple +cabal-version: >=1.21 + +library + exposed-modules: P, P2 + build-depends: base diff --git a/testsuite/tests/cabal/cabal05/q/LICENSE b/testsuite/tests/cabal/cabal05/q/LICENSE new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/cabal/cabal05/q/LICENSE diff --git a/testsuite/tests/cabal/cabal05/q/Q.hs b/testsuite/tests/cabal/cabal05/q/Q.hs new file mode 100644 index 0000000000..721b231aa1 --- /dev/null +++ b/testsuite/tests/cabal/cabal05/q/Q.hs @@ -0,0 +1,4 @@ +module Q where +import P +data Q = Q +q = not p diff --git a/testsuite/tests/cabal/cabal05/q/Setup.hs b/testsuite/tests/cabal/cabal05/q/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/testsuite/tests/cabal/cabal05/q/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/testsuite/tests/cabal/cabal05/q/q.cabal b/testsuite/tests/cabal/cabal05/q/q.cabal new file mode 100644 index 0000000000..2ea54f2e8d --- /dev/null +++ b/testsuite/tests/cabal/cabal05/q/q.cabal @@ -0,0 +1,29 @@ +name: q +version: 0.1.0.0 +license-file: LICENSE +author: Edward Z. Yang +maintainer: ezyang@cs.stanford.edu +build-type: Simple +cabal-version: >=1.21 + +library + exposed-modules: Q + reexported-modules: + -- qualified=NO, where=DEP(ORIG), renaming=NO, conflict=NO + -- impossible + -- qualified=NO, where=DEP(ORIG), renaming=NO, conflict=YES (p,s) + P, + -- qualified=NO, where=DEP(ORIG), renaming=YES, conflict=NO + P as QP, + -- qualified=NO, where=DEP(ORIG), renaming=YES, conflict=YES (r) + P as PMerge, + P2 as PMerge2, + -- qualified=NO, where=SELF, renaming=NO, conflict=NO + -- impossible + -- qualified=NO, where=SELF, renaming=NO, conflict=YES + -- should error + -- qualified=NO, where=SELF, renaming=YES, conflict=NO + Q as QQ, + -- qualified=NO, where=SELF, renaming=YES, conflict=YES (r) + Q as QMerge + build-depends: base, p diff --git a/testsuite/tests/cabal/cabal05/r/LICENSE b/testsuite/tests/cabal/cabal05/r/LICENSE new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/cabal/cabal05/r/LICENSE diff --git a/testsuite/tests/cabal/cabal05/r/R.hs b/testsuite/tests/cabal/cabal05/r/R.hs new file mode 100644 index 0000000000..6f086340cf --- /dev/null +++ b/testsuite/tests/cabal/cabal05/r/R.hs @@ -0,0 +1,11 @@ +module R where +import P -- p (exposed), q (reexport p:P) +import P2 -- q (reexport p:P) +import Q -- q (exposed) +import qualified QP -- q (reexport p:P) +import qualified QQ -- q (reexport q:Q) +import qualified PMerge -- q (reexport p:P) +import qualified PMerge2 -- q (reexport p:P2) +import qualified QMerge -- q (reexport q:Q) +data R = R +r = p && q diff --git a/testsuite/tests/cabal/cabal05/r/Setup.hs b/testsuite/tests/cabal/cabal05/r/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/testsuite/tests/cabal/cabal05/r/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/testsuite/tests/cabal/cabal05/r/r.cabal b/testsuite/tests/cabal/cabal05/r/r.cabal new file mode 100644 index 0000000000..d550340c0e --- /dev/null +++ b/testsuite/tests/cabal/cabal05/r/r.cabal @@ -0,0 +1,32 @@ +name: r +version: 0.1.0.0 +license-file: LICENSE +author: Edward Z. Yang +maintainer: ezyang@cs.stanford.edu +build-type: Simple +cabal-version: >=1.21 + +library + exposed-modules: R + reexported-modules: + -- qualified=NO, where=DEP(BOTH), renaming=NO, conflict=YES (p,q) + P, + -- qualified=NO, where=DEP(BOTH), renaming=YES, conflict=NO + P as RP2, + -- qualified=NO, where=DEP(BOTH), renaming=YES, conflict=YES + P2 as PMerge, + -- qualified=YES, where=DEP(ORIG), renaming=YES, conflict=NO + p:P as RP, + -- qualified=YES, where=DEP(REEX), renaming=YES, conflict=NO + q:QP as RQP, + -- qualified=YES, where=DEP(REEX), renaming=YES, conflict=NO + q:P as RQP2, + -- qualified=YES, where=DEP(REEX), renaming=YES, conflict=YES + q:QQ as QMerge, + -- qualified=YES, where=SELF, renaming=YES, conflict=NO + r:R as RR, + -- qualified=YES, where=DEP, renaming=NO, conflict=YES (q) + q:Q, + -- qualified=YES, where=DEP(ORIG), renaming=YES, conflict=YES (q) + p:P2 as PMerge2 + build-depends: base, p, q diff --git a/testsuite/tests/cabal/cabal05/s/LICENSE b/testsuite/tests/cabal/cabal05/s/LICENSE new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/cabal/cabal05/s/LICENSE diff --git a/testsuite/tests/cabal/cabal05/s/S.hs b/testsuite/tests/cabal/cabal05/s/S.hs new file mode 100644 index 0000000000..ed3c378072 --- /dev/null +++ b/testsuite/tests/cabal/cabal05/s/S.hs @@ -0,0 +1,18 @@ +module S where +-- NB: package p is hidden! +import qualified QP -- q (reexport p:P) +import qualified RP -- r (reexport p:P) +import qualified Q -- q (exposed), r (reexport q:Q) +import qualified R -- r (exposed) +import qualified RR -- r (reexport r:R) +import qualified RP -- r (reexport p:P) +import qualified RQP -- r (reexport p:P) +import qualified RQP2 -- r (reexport p:P) +import qualified PMerge -- q (reexport p:P), r (reexport p:P) +import qualified PMerge2 -- q (reexport p:P2), r (reexport p:P2) +import qualified QMerge -- q (reexport q:Q), r (reexport q:Q) + +x :: QP.P +x = RP.P + +s = QP.p || Q.q || R.r diff --git a/testsuite/tests/cabal/cabal05/s/Setup.hs b/testsuite/tests/cabal/cabal05/s/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/testsuite/tests/cabal/cabal05/s/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/testsuite/tests/cabal/cabal05/s/s.cabal b/testsuite/tests/cabal/cabal05/s/s.cabal new file mode 100644 index 0000000000..a0b09939a1 --- /dev/null +++ b/testsuite/tests/cabal/cabal05/s/s.cabal @@ -0,0 +1,11 @@ +name: s +version: 0.1.0.0 +license-file: LICENSE +author: Edward Z. Yang +maintainer: ezyang@cs.stanford.edu +build-type: Simple +cabal-version: >=1.21 + +library + exposed-modules: S + build-depends: base, q, r diff --git a/testsuite/tests/cabal/ghcpkg07.stdout b/testsuite/tests/cabal/ghcpkg07.stdout new file mode 100644 index 0000000000..f890b5bfe1 --- /dev/null +++ b/testsuite/tests/cabal/ghcpkg07.stdout @@ -0,0 +1,11 @@ +Reading package info from "test.pkg" ... done. +Reading package info from "test7a.pkg" ... done. +reexported-modules: testpkg:A (A@testpkg-1.2.3.4-XXX) + testpkg:A as A1 (A@testpkg-1.2.3.4-XXX) + E as E2 (E@testpkg7a-1.0-XXX) +Reading package info from "test7b.pkg" ... done. +reexported-modules: testpkg:A as F1 (A@testpkg-1.2.3.4-XXX) + testpkg7a:A as F2 (A@testpkg-1.2.3.4-XXX) + testpkg7a:A1 as F3 (A@testpkg-1.2.3.4-XXX) + testpkg7a:E as F4 (E@testpkg7a-1.0-XXX) E (E@testpkg7a-1.0-XXX) + E2 as E3 (E@testpkg7a-1.0-XXX) diff --git a/testsuite/tests/cabal/recache_reexport_db/a.conf b/testsuite/tests/cabal/recache_reexport_db/a.conf new file mode 100644 index 0000000000..c0698d70b9 --- /dev/null +++ b/testsuite/tests/cabal/recache_reexport_db/a.conf @@ -0,0 +1,17 @@ +name: testpkg7a +version: 1.0 +id: testpkg7a-1.0-XXX +license: BSD3 +copyright: (c) The Univsersity of Glasgow 2004 +maintainer: glasgow-haskell-users@haskell.org +stability: stable +homepage: http://www.haskell.org/ghc +package-url: http://www.haskell.org/ghc +description: A Test Package +category: none +author: simonmar@microsoft.com +exposed: True +exposed-modules: E +reexported-modules: testpkg:A, testpkg:A as A1, E as E2 +hs-libraries: testpkg7a-1.0 +depends: testpkg-1.2.3.4-XXX diff --git a/testsuite/tests/cabal/test7a.pkg b/testsuite/tests/cabal/test7a.pkg new file mode 100644 index 0000000000..c0698d70b9 --- /dev/null +++ b/testsuite/tests/cabal/test7a.pkg @@ -0,0 +1,17 @@ +name: testpkg7a +version: 1.0 +id: testpkg7a-1.0-XXX +license: BSD3 +copyright: (c) The Univsersity of Glasgow 2004 +maintainer: glasgow-haskell-users@haskell.org +stability: stable +homepage: http://www.haskell.org/ghc +package-url: http://www.haskell.org/ghc +description: A Test Package +category: none +author: simonmar@microsoft.com +exposed: True +exposed-modules: E +reexported-modules: testpkg:A, testpkg:A as A1, E as E2 +hs-libraries: testpkg7a-1.0 +depends: testpkg-1.2.3.4-XXX diff --git a/testsuite/tests/cabal/test7b.pkg b/testsuite/tests/cabal/test7b.pkg new file mode 100644 index 0000000000..d8bf47ec36 --- /dev/null +++ b/testsuite/tests/cabal/test7b.pkg @@ -0,0 +1,17 @@ +name: testpkg7b +version: 1.0 +id: testpkg7b-1.0-XXX +license: BSD3 +copyright: (c) The Univsersity of Glasgow 2004 +maintainer: glasgow-haskell-users@haskell.org +stability: stable +homepage: http://www.haskell.org/ghc +package-url: http://www.haskell.org/ghc +description: A Test Package +category: none +author: simonmar@microsoft.com +exposed: True +reexported-modules: testpkg:A as F1, testpkg7a:A as F2, + testpkg7a:A1 as F3, testpkg7a:E as F4, E, E2 as E3 +hs-libraries: testpkg7b-1.0 +depends: testpkg-1.2.3.4-XXX, testpkg7a-1.0-XXX diff --git a/utils/ghc-cabal/ghc-cabal.cabal b/utils/ghc-cabal/ghc-cabal.cabal index 5437d63bb2..2641f19568 100644 --- a/utils/ghc-cabal/ghc-cabal.cabal +++ b/utils/ghc-cabal/ghc-cabal.cabal @@ -6,8 +6,7 @@ License: BSD3 Author: XXX Maintainer: XXX Synopsis: XXX -Description: - XXX +Description: XXX Category: Development build-type: Simple cabal-version: >=1.10 diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index a1f30f613c..52b7638708 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -16,6 +16,7 @@ import Distribution.ModuleName hiding (main) import Distribution.InstalledPackageInfo import Distribution.Compat.ReadP import Distribution.ParseUtils +import Distribution.ModuleExport import Distribution.Package hiding (depends) import Distribution.Text import Distribution.Version @@ -32,6 +33,8 @@ import System.Console.GetOpt import qualified Control.Exception as Exception import Data.Maybe +import qualified Data.Set as Set + import Data.Char ( isSpace, toLower ) import Data.Ord (comparing) import Control.Applicative (Applicative(..)) @@ -871,6 +874,10 @@ registerPackage input verbosity my_flags auto_ghci_libs multi_instance -- packages lower in the stack to refer to those higher up. validatePackageConfig pkg_expanded verbosity truncated_stack auto_ghci_libs multi_instance update force + + -- postprocess the package + pkg' <- resolveReexports truncated_stack pkg + 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 @@ -881,7 +888,7 @@ registerPackage input verbosity my_flags auto_ghci_libs multi_instance p <- packages db_to_operate_on, sourcePackageId p == sourcePackageId pkg ] -- - changeDB verbosity (removes ++ [AddPackage pkg]) db_to_operate_on + changeDB verbosity (removes ++ [AddPackage pkg']) db_to_operate_on parsePackageInfo :: String @@ -896,6 +903,47 @@ parsePackageInfo str = (Nothing, s) -> die s (Just l, s) -> die (show l ++ ": " ++ s) +-- | Takes the "reexported-modules" field of an InstalledPackageInfo +-- and resolves the references so they point to the original exporter +-- of a module (i.e. the module is in exposed-modules, not +-- reexported-modules). This is done by maintaining an invariant on +-- the installed package database that a reexported-module field always +-- points to the original exporter. +resolveReexports :: PackageDBStack + -> InstalledPackageInfo + -> IO InstalledPackageInfo +resolveReexports db_stack pkg = do + let dep_mask = Set.fromList (depends pkg) + deps = filter (flip Set.member dep_mask . installedPackageId) + (allPackagesInStack db_stack) + matchExposed pkg_dep m = map ((,) (installedPackageId pkg_dep)) + (filter (==m) (exposedModules pkg_dep)) + worker ModuleExport{ exportOrigPackageName = Just pnm } pkg_dep + | pnm /= packageName (sourcePackageId pkg_dep) = [] + -- Now, either the package matches, *or* we were asked to search the + -- true location ourselves. + worker ModuleExport{ exportOrigName = m } pkg_dep = + matchExposed pkg_dep m ++ + map (fromMaybe (error $ "Impossible! Missing true location in " ++ + display (installedPackageId pkg_dep)) + . exportCachedTrueOrig) + (filter ((==m) . exportName) (reexportedModules pkg_dep)) + self_reexports ModuleExport{ exportOrigPackageName = Just pnm } + | pnm /= packageName (sourcePackageId pkg) = [] + self_reexports ModuleExport{ exportName = m', exportOrigName = m } + -- Self-reexport without renaming doesn't make sense + | m == m' = [] + -- *Only* match against exposed modules! + | otherwise = matchExposed pkg m + + r <- forM (reexportedModules pkg) $ \me -> do + case nub (concatMap (worker me) deps ++ self_reexports me) of + [c] -> return me { exportCachedTrueOrig = Just c } + [] -> die $ "Couldn't resolve reexport " ++ display me + cs -> die $ "Found multiple possible ways to resolve reexport " ++ + display me ++ ": " ++ show cs + return (pkg { reexportedModules = r }) + -- ----------------------------------------------------------------------------- -- Making changes to a package database @@ -1316,15 +1364,19 @@ type InstalledPackageInfoString = InstalledPackageInfo_ String convertPackageInfoOut :: InstalledPackageInfo -> InstalledPackageInfoString convertPackageInfoOut (pkgconf@(InstalledPackageInfo { exposedModules = e, + reexportedModules = r, hiddenModules = h })) = pkgconf{ exposedModules = map display e, + reexportedModules = map (fmap display) r, hiddenModules = map display h } convertPackageInfoIn :: InstalledPackageInfoString -> InstalledPackageInfo convertPackageInfoIn (pkgconf@(InstalledPackageInfo { exposedModules = e, + reexportedModules = r, hiddenModules = h })) = pkgconf{ exposedModules = map convert e, + reexportedModules = map (fmap convert) r, hiddenModules = map convert h } where convert = fromJust . simpleParse @@ -1561,6 +1613,7 @@ doesFileExistOnPath filenames paths = go fullFilenames go ((p, fp) : xs) = do b <- doesFileExist fp if b then return (Just p) else go xs +-- XXX maybe should check reexportedModules too checkModules :: InstalledPackageInfo -> Validate () checkModules pkg = do mapM_ findModule (exposedModules pkg ++ hiddenModules pkg) diff --git a/utils/ghc-pkg/ghc-pkg.cabal b/utils/ghc-pkg/ghc-pkg.cabal index 574301086e..317aab7cfa 100644 --- a/utils/ghc-pkg/ghc-pkg.cabal +++ b/utils/ghc-pkg/ghc-pkg.cabal @@ -7,8 +7,7 @@ License: BSD3 Author: XXX Maintainer: cvs-fptools@haskell.org Synopsis: XXX -Description: - XXX +Description: XXX Category: Development build-type: Simple cabal-version: >=1.10 @@ -22,6 +21,7 @@ Executable ghc-pkg Build-Depends: base >= 4 && < 5, directory >= 1 && < 1.3, process >= 1 && < 1.3, + containers, filepath, Cabal, binary, diff --git a/utils/ghctags/ghctags.cabal b/utils/ghctags/ghctags.cabal index e9c784877b..cfa841dcb0 100644 --- a/utils/ghctags/ghctags.cabal +++ b/utils/ghctags/ghctags.cabal @@ -6,8 +6,7 @@ License: BSD3 Author: XXX Maintainer: XXX Synopsis: XXX -Description: - XXX +Description: XXX Category: Development build-type: Simple cabal-version: >=1.10 diff --git a/utils/haddock b/utils/haddock -Subproject 8ac42d3327473939c013551750425cac191ff0f +Subproject b99b57c0df072d12b67816b45eca2a03cb1da96 |