diff options
| author | romes <rodrigo.m.mesquita@gmail.com> | 2023-03-13 19:58:35 +0000 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-05-04 14:58:14 -0400 |
| commit | 6689c9c6eba6f538bedfe7a08316d7c5dec8bfae (patch) | |
| tree | 366993c4fad18e48989984e52804559f73489b27 /compiler | |
| parent | 3fdb18f8df209ebfee51f16288c46acd1ca024b2 (diff) | |
| download | haskell-6689c9c6eba6f538bedfe7a08316d7c5dec8bfae.tar.gz | |
Validate compatibility of ghcs when loading plugins
Ensure, when loading plugins, that the ghc the plugin depends on is the
ghc loading the plugin -- otherwise fail to load the plugin.
Progress towards #20742.
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Runtime/Loader.hs | 19 |
1 files changed, 13 insertions, 6 deletions
diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs index cbe376b9cd..29f61fe591 100644 --- a/compiler/GHC/Runtime/Loader.hs +++ b/compiler/GHC/Runtime/Loader.hs @@ -43,11 +43,11 @@ import GHC.Driver.Env import GHCi.RemoteTypes ( HValue ) import GHC.Core.Type ( Type, mkTyConTy ) import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.TyCon ( TyCon ) +import GHC.Core.TyCon ( TyCon(tyConName) ) import GHC.Types.SrcLoc ( noSrcSpan ) -import GHC.Types.Name ( Name, nameModule_maybe ) +import GHC.Types.Name ( Name, nameModule, nameModule_maybe ) import GHC.Types.Id ( idType ) import GHC.Types.TyThing import GHC.Types.Name.Occurrence ( OccName, mkVarOccFS ) @@ -57,8 +57,8 @@ import GHC.Types.Unique.DFM import GHC.Unit.Finder ( findPluginModule, FindResult(..) ) import GHC.Driver.Config.Finder ( initFinderOpts ) import GHC.Driver.Config.Diagnostic ( initIfaceMessageOpts ) -import GHC.Unit.Module ( Module, ModuleName ) -import GHC.Unit.Module.ModIface ( ModIface_(mi_exports), ModIface ) +import GHC.Unit.Module ( Module, ModuleName, thisGhcUnit, GenModule(moduleUnit) ) +import GHC.Unit.Module.ModIface import GHC.Unit.Env import GHC.Utils.Panic @@ -175,7 +175,14 @@ loadPlugin' occ_name plugin_name hsc_env mod_name Just (name, mod_iface) -> do { plugin_tycon <- forceLoadTyCon hsc_env plugin_name - ; eith_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon) + ; case thisGhcUnit == (moduleUnit . nameModule . tyConName) plugin_tycon of { + False -> + throwGhcExceptionIO (CmdLineError $ showSDoc dflags $ hsep + [ text "The plugin module", ppr mod_name + , text "was built with a compiler that is incompatible with the one loading it" + ]) ; + True -> + do { eith_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon) ; case eith_plugin of Left actual_type -> throwGhcExceptionIO (CmdLineError $ @@ -186,7 +193,7 @@ loadPlugin' occ_name plugin_name hsc_env mod_name , text "did not have the type" , text "GHC.Plugins.Plugin" , text "as required"]) - Right (plugin, links, pkgs) -> return (plugin, mod_iface, links, pkgs) } } } + Right (plugin, links, pkgs) -> return (plugin, mod_iface, links, pkgs) } } } } } -- | Force the interfaces for the given modules to be loaded. The 'SDoc' parameter is used |