diff options
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 |