Commit 406e43af authored by Zejun Wu's avatar Zejun Wu Committed by Marge Bot

Add `-fplugin-trustworthy` to avoid marking modules as unsafe

By default, when a module is compiled with plugins, it will be marked as
unsafe. With this flag passed, all plugins are treated as trustworthy
and the safety inference will no longer be affected.

This fixes Trac #16260.
parent ef25b59a
...@@ -648,6 +648,7 @@ data GeneralFlag ...@@ -648,6 +648,7 @@ data GeneralFlag
-- safe haskell flags -- safe haskell flags
| Opt_DistrustAllPackages | Opt_DistrustAllPackages
| Opt_PackageTrust | Opt_PackageTrust
| Opt_PluginTrustworthy
| Opt_G_NoStateHack | Opt_G_NoStateHack
| Opt_G_NoOptCoercion | Opt_G_NoOptCoercion
...@@ -3512,6 +3513,8 @@ dynamic_flags_deps = [ ...@@ -3512,6 +3513,8 @@ dynamic_flags_deps = [
------ Plugin flags ------------------------------------------------ ------ Plugin flags ------------------------------------------------
, make_ord_flag defGhcFlag "fplugin-opt" (hasArg addPluginModuleNameOption) , make_ord_flag defGhcFlag "fplugin-opt" (hasArg addPluginModuleNameOption)
, make_ord_flag defGhcFlag "fplugin-trustworthy"
(NoArg (setGeneralFlag Opt_PluginTrustworthy))
, make_ord_flag defGhcFlag "fplugin" (hasArg addPluginModuleName) , make_ord_flag defGhcFlag "fplugin" (hasArg addPluginModuleName)
, make_ord_flag defGhcFlag "fclear-plugins" (noArg clearPluginModuleNames) , make_ord_flag defGhcFlag "fclear-plugins" (noArg clearPluginModuleNames)
, make_ord_flag defGhcFlag "ffrontend-opt" (hasArg addFrontendPluginOption) , make_ord_flag defGhcFlag "ffrontend-opt" (hasArg addFrontendPluginOption)
......
...@@ -91,7 +91,7 @@ data Plugin = Plugin { ...@@ -91,7 +91,7 @@ data Plugin = Plugin {
-- `HsGroup` has been renamed. -- `HsGroup` has been renamed.
, typeCheckResultAction :: [CommandLineOption] -> ModSummary -> TcGblEnv , typeCheckResultAction :: [CommandLineOption] -> ModSummary -> TcGblEnv
-> TcM TcGblEnv -> TcM TcGblEnv
-- ^ Modify the module when it is type checked. This is called add the -- ^ Modify the module when it is type checked. This is called at the
-- very end of typechecking. -- very end of typechecking.
, spliceRunAction :: [CommandLineOption] -> LHsExpr GhcTc , spliceRunAction :: [CommandLineOption] -> LHsExpr GhcTc
-> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
...@@ -178,8 +178,10 @@ impurePlugin _args = return ForceRecompile ...@@ -178,8 +178,10 @@ impurePlugin _args = return ForceRecompile
flagRecompile = flagRecompile =
return . MaybeRecompile . fingerprintFingerprints . map fingerprintString . sort return . MaybeRecompile . fingerprintFingerprints . map fingerprintString . sort
-- | Default plugin: does nothing at all! For compatibility reasons -- | Default plugin: does nothing at all, except for marking that safe
-- you should base all your plugin definitions on this default value. -- inference has failed unless @-fplugin-trustworthy@ is passed. For
-- compatibility reaso you should base all your plugin definitions on this
-- default value.
defaultPlugin :: Plugin defaultPlugin :: Plugin
defaultPlugin = Plugin { defaultPlugin = Plugin {
installCoreToDos = const return installCoreToDos = const return
......
...@@ -2901,7 +2901,8 @@ runTypecheckerPlugin sum hsc_env gbl_env = do ...@@ -2901,7 +2901,8 @@ runTypecheckerPlugin sum hsc_env gbl_env = do
gbl_env gbl_env
mark_plugin_unsafe :: DynFlags -> TcM () mark_plugin_unsafe :: DynFlags -> TcM ()
mark_plugin_unsafe dflags = recordUnsafeInfer pluginUnsafe mark_plugin_unsafe dflags = unless (gopt Opt_PluginTrustworthy dflags) $
recordUnsafeInfer pluginUnsafe
where where
unsafeText = "Use of plugins makes the module unsafe" unsafeText = "Use of plugins makes the module unsafe"
pluginUnsafe = unitBag ( mkPlainWarnMsg dflags noSrcSpan pluginUnsafe = unitBag ( mkPlainWarnMsg dflags noSrcSpan
......
...@@ -216,6 +216,16 @@ be reset with the :ghc-flag:`-fclear-plugins` option. ...@@ -216,6 +216,16 @@ be reset with the :ghc-flag:`-fclear-plugins` option.
Give arguments to a plugin module; module must be specified with Give arguments to a plugin module; module must be specified with
:ghc-flag:`-fplugin=⟨module⟩`. :ghc-flag:`-fplugin=⟨module⟩`.
.. ghc-flag:: -fplugin-trustworthy
:shortdesc: Trust the used plugins and no longer mark the compiled module
as unsafe
:type: dynamic
:category: plugins
By default, when a module is compiled with plugins, it will be marked as
unsafe. With this flag passed, all plugins are treated as trustworthy
and the safety inference will no longer be affected.
.. ghc-flag:: -fclear-plugins .. ghc-flag:: -fclear-plugins
:shortdesc: Clear the list of active plugins :shortdesc: Clear the list of active plugins
:type: dynamic :type: dynamic
......
...@@ -125,3 +125,8 @@ plugin-recomp-change-prof: ...@@ -125,3 +125,8 @@ plugin-recomp-change-prof:
.PHONY: T16104 .PHONY: T16104
T16104: T16104:
"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 T16104.hs -package-db T16104-plugin/pkg.T16104-plugin/local.package.conf "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 T16104.hs -package-db T16104-plugin/pkg.T16104-plugin/local.package.conf
.PHONY: T16260
T16260:
"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 T16260.hs -package-db simple-plugin/pkg.T16260/local.package.conf -fplugin Simple.TrustworthyPlugin
"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 T16260.hs -package-db simple-plugin/pkg.T16260/local.package.conf -fplugin Simple.TrustworthyPlugin -fplugin-trustworthy
...@@ -215,3 +215,9 @@ test('T16104', ...@@ -215,3 +215,9 @@ test('T16104',
pre_cmd('$MAKE -s --no-print-directory -C T16104-plugin package.T16104-plugin TOP={top}') pre_cmd('$MAKE -s --no-print-directory -C T16104-plugin package.T16104-plugin TOP={top}')
], ],
makefile_test, []) makefile_test, [])
test('T16260',
[extra_files(['simple-plugin/']),
pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.T16260 TOP={top}')
],
makefile_test, [])
module Simple.TrustworthyPlugin (plugin) where
import GhcPlugins
import TcRnMonad
plugin :: Plugin
plugin = defaultPlugin
{ renamedResultAction = keepRenamedSource
, typeCheckResultAction = printHaskellSafeMode
}
where
printHaskellSafeMode _ ms tcg = liftIO $ do
let dflags = ms_hspp_opts ms
safe <- finalSafeMode dflags tcg
print $ gopt Opt_PluginTrustworthy dflags
putStrLn $ showPpr dflags safe
return tcg
...@@ -20,3 +20,4 @@ Library ...@@ -20,3 +20,4 @@ Library
Simple.DataStructures Simple.DataStructures
Simple.SourcePlugin Simple.SourcePlugin
Simple.RemovePlugin Simple.RemovePlugin
Simple.TrustworthyPlugin
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment