Module reexports, fixing #8407.
authorEdward Z. Yang <ezyang@cs.stanford.edu>
Fri, 4 Jul 2014 16:01:08 +0000 (17:01 +0100)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Sat, 26 Jul 2014 00:59:55 +0000 (17:59 -0700)
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:
compiler/main/DynFlags.hs
compiler/main/Finder.lhs
compiler/main/GHC.hs
compiler/main/HscTypes.lhs
compiler/main/PackageConfig.hs
compiler/main/Packages.lhs
ghc/InteractiveUI.hs
libraries/Cabal
libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs
testsuite/.gitignore
testsuite/tests/cabal/Makefile
testsuite/tests/cabal/all.T
testsuite/tests/cabal/cabal05/Makefile [new file with mode: 0644]
testsuite/tests/cabal/cabal05/Setup.hs [new file with mode: 0644]
testsuite/tests/cabal/cabal05/all.T [new file with mode: 0644]
testsuite/tests/cabal/cabal05/p/LICENSE [new file with mode: 0644]
testsuite/tests/cabal/cabal05/p/P.hs [new file with mode: 0644]
testsuite/tests/cabal/cabal05/p/P2.hs [new file with mode: 0644]
testsuite/tests/cabal/cabal05/p/Setup.hs [new file with mode: 0644]
testsuite/tests/cabal/cabal05/p/p.cabal [new file with mode: 0644]
testsuite/tests/cabal/cabal05/q/LICENSE [new file with mode: 0644]
testsuite/tests/cabal/cabal05/q/Q.hs [new file with mode: 0644]
testsuite/tests/cabal/cabal05/q/Setup.hs [new file with mode: 0644]
testsuite/tests/cabal/cabal05/q/q.cabal [new file with mode: 0644]
testsuite/tests/cabal/cabal05/r/LICENSE [new file with mode: 0644]
testsuite/tests/cabal/cabal05/r/R.hs [new file with mode: 0644]
testsuite/tests/cabal/cabal05/r/Setup.hs [new file with mode: 0644]
testsuite/tests/cabal/cabal05/r/r.cabal [new file with mode: 0644]
testsuite/tests/cabal/cabal05/s/LICENSE [new file with mode: 0644]
testsuite/tests/cabal/cabal05/s/S.hs [new file with mode: 0644]
testsuite/tests/cabal/cabal05/s/Setup.hs [new file with mode: 0644]
testsuite/tests/cabal/cabal05/s/s.cabal [new file with mode: 0644]
testsuite/tests/cabal/ghcpkg07.stdout [new file with mode: 0644]
testsuite/tests/cabal/recache_reexport_db/a.conf [new file with mode: 0644]
testsuite/tests/cabal/test7a.pkg [new file with mode: 0644]
testsuite/tests/cabal/test7b.pkg [new file with mode: 0644]
utils/ghc-cabal/ghc-cabal.cabal
utils/ghc-pkg/Main.hs
utils/ghc-pkg/ghc-pkg.cabal
utils/ghctags/ghctags.cabal
utils/haddock

index 5fbbd32..0a18be4 100644 (file)
@@ -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
index a403163..37395ce 100644 (file)
@@ -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
index e569440..4933a54 100644 (file)
@@ -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
index 9a382a8..c10475a 100644 (file)
@@ -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}
 
 
index 9938d73..520b533 100644 (file)
@@ -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 }
 
index d10b3b9..a6ecb16 100644 (file)
@@ -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
index 9ac3be4..ab4ea87 100644 (file)
@@ -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
index 90811eb..9684769 160000 (submodule)
@@ -1 +1 @@
-Subproject commit 90811eb4f0e06ba308e8a6e93089ff041d932952
+Subproject commit 96847693bf8ff48ae94f179d60c1f23411e1365e
index 6ad1697..f4d0a4b 100644 (file)
@@ -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)
index 0d86770..6bb7948 100644 (file)
@@ -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
index e8ed2bd..062850f 100644 (file)
@@ -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
index aa97f48..60f8d6d 100644 (file)
@@ -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 (file)
index 0000000..d4bc1c7
--- /dev/null
@@ -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 (file)
index 0000000..9a994af
--- /dev/null
@@ -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 (file)
index 0000000..36dcbdf
--- /dev/null
@@ -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 (file)
index 0000000..e69de29
diff --git a/testsuite/tests/cabal/cabal05/p/P.hs b/testsuite/tests/cabal/cabal05/p/P.hs
new file mode 100644 (file)
index 0000000..f8b82de
--- /dev/null
@@ -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 (file)
index 0000000..769760d
--- /dev/null
@@ -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 (file)
index 0000000..9a994af
--- /dev/null
@@ -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 (file)
index 0000000..989156c
--- /dev/null
@@ -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 (file)
index 0000000..e69de29
diff --git a/testsuite/tests/cabal/cabal05/q/Q.hs b/testsuite/tests/cabal/cabal05/q/Q.hs
new file mode 100644 (file)
index 0000000..721b231
--- /dev/null
@@ -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 (file)
index 0000000..9a994af
--- /dev/null
@@ -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 (file)
index 0000000..2ea54f2
--- /dev/null
@@ -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 (file)
index 0000000..e69de29
diff --git a/testsuite/tests/cabal/cabal05/r/R.hs b/testsuite/tests/cabal/cabal05/r/R.hs
new file mode 100644 (file)
index 0000000..6f08634
--- /dev/null
@@ -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 (file)
index 0000000..9a994af
--- /dev/null
@@ -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 (file)
index 0000000..d550340
--- /dev/null
@@ -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 (file)
index 0000000..e69de29
diff --git a/testsuite/tests/cabal/cabal05/s/S.hs b/testsuite/tests/cabal/cabal05/s/S.hs
new file mode 100644 (file)
index 0000000..ed3c378
--- /dev/null
@@ -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 (file)
index 0000000..9a994af
--- /dev/null
@@ -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 (file)
index 0000000..a0b0993
--- /dev/null
@@ -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 (file)
index 0000000..f890b5b
--- /dev/null
@@ -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 (file)
index 0000000..c0698d7
--- /dev/null
@@ -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 (file)
index 0000000..c0698d7
--- /dev/null
@@ -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 (file)
index 0000000..d8bf47e
--- /dev/null
@@ -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
index 5437d63..2641f19 100644 (file)
@@ -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
index a1f30f6..52b7638 100644 (file)
@@ -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)
index 5743010..317aab7 100644 (file)
@@ -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,
index e9c7848..cfa841d 100644 (file)
@@ -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
index 8ac42d3..b99b57c 160000 (submodule)
@@ -1 +1 @@
-Subproject commit 8ac42d3327473939c013551750425cac191ff0fd
+Subproject commit b99b57c0df072d12b67816b45eca2a03cb1da96d