diff options
| author | Matthew Pickering <matthewtpickering@gmail.com> | 2021-12-06 11:44:18 +0000 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-12-09 04:27:11 -0500 |
| commit | 803eefb1109564f4dbabd80721cd45ce7268c4a2 (patch) | |
| tree | cc7bcc8ece06758953dbae423ed9553b1f0ab156 /compiler/GHC/Driver | |
| parent | aafa5079bd49a55f5c71664ddb95ffcb9d8ca102 (diff) | |
| download | haskell-803eefb1109564f4dbabd80721cd45ce7268c4a2.tar.gz | |
package imports: Take into account package visibility when renaming
In 806e49ae the package imports refactoring code was modified to rename
package imports. There was a small oversight which meant the code didn't
account for module visibility. This patch fixes that oversight.
In general the "lookupPackageName" function is unsafe to use as it
doesn't account for package visiblity/thinning/renaming etc, there is
just one use in the compiler which would be good to audit.
Fixes #20779
Diffstat (limited to 'compiler/GHC/Driver')
| -rw-r--r-- | compiler/GHC/Driver/Backpack.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Make.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Pipeline/Execute.hs | 3 |
3 files changed, 3 insertions, 4 deletions
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs index 1da05dbda8..8ca120e462 100644 --- a/compiler/GHC/Driver/Backpack.hs +++ b/compiler/GHC/Driver/Backpack.hs @@ -863,7 +863,7 @@ hsModuleToModSummary pn hsc_src modname implicit_imports = mkPrelImports modname loc implicit_prelude imps - rn_pkg_qual = renameRawPkgQual (hsc_unit_env hsc_env) + rn_pkg_qual = renameRawPkgQual (hsc_unit_env hsc_env) modname convImport (L _ i) = (rn_pkg_qual (ideclPkgQual i), reLoc $ ideclName i) extra_sig_imports <- liftIO $ findExtraSigImports hsc_env hsc_src modname diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs index 209a6a9e76..3a37a06809 100644 --- a/compiler/GHC/Driver/Make.hs +++ b/compiler/GHC/Driver/Make.hs @@ -1955,7 +1955,7 @@ getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do mimps <- getImports popts imp_prelude pi_hspp_buf pi_hspp_fn src_fn return (first (mkMessages . fmap mkDriverPsHeaderMessage . getMessages) mimps) let rn_pkg_qual = renameRawPkgQual (hsc_unit_env hsc_env) - let rn_imps = fmap (first rn_pkg_qual) + let rn_imps = fmap (\(pk, lmn@(L _ mn)) -> (rn_pkg_qual mn pk, lmn)) let pi_srcimps = rn_imps pi_srcimps' let pi_theimps = rn_imps pi_theimps' return PreprocessedImports {..} diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs index 133f3005b2..95d2c35a0c 100644 --- a/compiler/GHC/Driver/Pipeline/Execute.hs +++ b/compiler/GHC/Driver/Pipeline/Execute.hs @@ -83,7 +83,6 @@ import GHC.Unit.Module.Env import GHC.Driver.Env.KnotVars import GHC.Driver.Config.Finder import GHC.Rename.Names -import Data.Bifunctor (first) newtype HookedUse a = HookedUse { runHookedUse :: (Hooks, PhaseHook) -> IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch) via (ReaderT (Hooks, PhaseHook) IO) @@ -642,7 +641,7 @@ runHscPhase pipe_env hsc_env0 input_fn src_flavour = do let imp_prelude = xopt LangExt.ImplicitPrelude dflags popts = initParserOpts dflags rn_pkg_qual = renameRawPkgQual (hsc_unit_env hsc_env) - rn_imps = fmap (first rn_pkg_qual) + rn_imps = fmap (\(rpk, lmn@(L _ mn)) -> (rn_pkg_qual mn rpk, lmn)) eimps <- getImports popts imp_prelude buf input_fn (basename <.> suff) case eimps of Left errs -> throwErrors (GhcPsMessage <$> errs) |