diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2021-09-10 10:52:37 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-10-08 13:08:16 -0400 |
commit | 3d31f11e83a3d60d17459457e036ae387fc95323 (patch) | |
tree | 86def0d3861e72c25688fd28f761bdaa7dc19b67 | |
parent | 01f5324f8eaa2ce28d617922bc4d3b680ad4fc38 (diff) | |
download | haskell-3d31f11e83a3d60d17459457e036ae387fc95323.tar.gz |
Don't link plugins' units with target code (#20218)
Before this patch, plugin units were linked with the target code even
when the unit was passed via `-plugin-package`. This is an issue to
support plugins in cross-compilers (plugins are definitely not ABI
compatible with target code).
We now clearly separate unit dependencies for plugins and unit
dependencies for target code and only link the latter ones.
We've also added a test to ensure that plugin units passed via
`-package` are linked with target code so that `thNameToGhcName` can
still be used in plugins that need it (see T20218b).
-rw-r--r-- | compiler/GHC/Iface/Recomp.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Unit/Module/Deps.hs | 13 | ||||
-rw-r--r-- | testsuite/tests/plugins/Makefile | 11 | ||||
-rw-r--r-- | testsuite/tests/plugins/T20218.hs | 3 | ||||
-rw-r--r-- | testsuite/tests/plugins/T20218b.hs | 9 | ||||
-rw-r--r-- | testsuite/tests/plugins/T20218b.stderr | 1 | ||||
-rw-r--r-- | testsuite/tests/plugins/T20218b.stdout | 1 | ||||
-rw-r--r-- | testsuite/tests/plugins/all.T | 14 | ||||
-rw-r--r-- | testsuite/tests/plugins/simple-plugin/Simple/ReplacePlugin.hs | 55 | ||||
-rw-r--r-- | testsuite/tests/plugins/simple-plugin/simple-plugin.cabal | 1 |
10 files changed, 109 insertions, 2 deletions
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs index 6bbf8f58cb..f74012c0ac 100644 --- a/compiler/GHC/Iface/Recomp.hs +++ b/compiler/GHC/Iface/Recomp.hs @@ -531,7 +531,8 @@ checkDependencies hsc_env summary iface home_unit = hsc_home_unit hsc_env units = hsc_units hsc_env prev_dep_mods = map gwib_mod $ Set.toAscList $ dep_direct_mods (mi_deps iface) - prev_dep_pkgs = Set.toAscList (dep_direct_pkgs (mi_deps iface)) + prev_dep_pkgs = Set.toAscList (Set.union (dep_direct_pkgs (mi_deps iface)) + (dep_plugin_pkgs (mi_deps iface))) bkpk_units = map (("Signature",) . indefUnit . instUnitInstanceOf . moduleUnit) (requirementMerges units (moduleName (mi_module iface))) implicit_deps = map ("Implicit",) (implicitPackageDeps dflags) diff --git a/compiler/GHC/Unit/Module/Deps.hs b/compiler/GHC/Unit/Module/Deps.hs index c3c3340f41..73412c002c 100644 --- a/compiler/GHC/Unit/Module/Deps.hs +++ b/compiler/GHC/Unit/Module/Deps.hs @@ -8,6 +8,7 @@ module GHC.Unit.Module.Deps , dep_sig_mods , dep_trusted_pkgs , dep_orphs + , dep_plugin_pkgs , dep_finsts , dep_boot_mods , dep_orphs_update @@ -56,6 +57,9 @@ data Dependencies = Deps -- ^ All packages directly imported by this module -- I.e. packages to which this module's direct imports belong. + , dep_plugin_pkgs :: Set UnitId + -- ^ All units needed for plugins + ------------------------------------ -- Transitive information below here @@ -125,7 +129,7 @@ mkDependencies home_unit mod imports plugin_mods = -- We must also remove self-references from imp_orphs. See -- Note [Module self-dependency] - direct_pkgs = foldr Set.insert (imp_dep_direct_pkgs imports) plugin_units + direct_pkgs = imp_dep_direct_pkgs imports -- Set the packages required to be Safe according to Safe Haskell. -- See Note [Tracking Trust Transitively] in GHC.Rename.Names @@ -139,6 +143,7 @@ mkDependencies home_unit mod imports plugin_mods = in Deps { dep_direct_mods = direct_mods , dep_direct_pkgs = direct_pkgs + , dep_plugin_pkgs = plugin_units , dep_sig_mods = sort sig_mods , dep_trusted_pkgs = trust_pkgs , dep_boot_mods = source_mods @@ -164,6 +169,7 @@ dep_finsts_update deps f = do instance Binary Dependencies where put_ bh deps = do put_ bh (dep_direct_mods deps) put_ bh (dep_direct_pkgs deps) + put_ bh (dep_plugin_pkgs deps) put_ bh (dep_trusted_pkgs deps) put_ bh (dep_sig_mods deps) put_ bh (dep_boot_mods deps) @@ -172,6 +178,7 @@ instance Binary Dependencies where get bh = do dms <- get bh dps <- get bh + plugin_pkgs <- get bh tps <- get bh hsigms <- get bh sms <- get bh @@ -179,6 +186,7 @@ instance Binary Dependencies where fis <- get bh return (Deps { dep_direct_mods = dms , dep_direct_pkgs = dps + , dep_plugin_pkgs = plugin_pkgs , dep_sig_mods = hsigms , dep_boot_mods = sms , dep_trusted_pkgs = tps @@ -189,6 +197,7 @@ noDependencies :: Dependencies noDependencies = Deps { dep_direct_mods = Set.empty , dep_direct_pkgs = Set.empty + , dep_plugin_pkgs = Set.empty , dep_sig_mods = [] , dep_boot_mods = Set.empty , dep_trusted_pkgs = Set.empty @@ -200,6 +209,7 @@ noDependencies = Deps pprDeps :: UnitState -> Dependencies -> SDoc pprDeps unit_state (Deps { dep_direct_mods = dmods , dep_boot_mods = bmods + , dep_plugin_pkgs = plgns , dep_orphs = orphs , dep_direct_pkgs = pkgs , dep_trusted_pkgs = tps @@ -209,6 +219,7 @@ pprDeps unit_state (Deps { dep_direct_mods = dmods vcat [text "direct module dependencies:" <+> ppr_set ppr_mod dmods, text "boot module dependencies:" <+> ppr_set ppr bmods, text "direct package dependencies:" <+> ppr_set ppr pkgs, + text "plugin package dependencies:" <+> ppr_set ppr plgns, if null tps then empty else text "trusted package dependencies:" <+> ppr_set ppr tps, diff --git a/testsuite/tests/plugins/Makefile b/testsuite/tests/plugins/Makefile index 710cf827ec..c00b26684b 100644 --- a/testsuite/tests/plugins/Makefile +++ b/testsuite/tests/plugins/Makefile @@ -152,3 +152,14 @@ plugin-recomp-change-2: T20417: "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -hide-all-packages -package base -plugin-package plugin-recompilation-0.1 -fplugin PurePlugin "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -hide-all-packages -package base -plugin-package plugin-recompilation-0.1 -fplugin PurePlugin + +# Test that we don't link plugin with target code +.PHONY: T20218 +T20218: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v4 T20218.hs -package-db simple-plugin/pkg.T20218/local.package.conf -fplugin Simple.Plugin -plugin-package simple-plugin + +# T20218b tests that we correctly link with plugins passed with -package +.PHONY: T20218b +T20218b: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) T20218b.hs -package-db simple-plugin/pkg.T20218b/local.package.conf -fplugin Simple.ReplacePlugin -package simple-plugin -v0 + ./T20218b diff --git a/testsuite/tests/plugins/T20218.hs b/testsuite/tests/plugins/T20218.hs new file mode 100644 index 0000000000..de106fe48f --- /dev/null +++ b/testsuite/tests/plugins/T20218.hs @@ -0,0 +1,3 @@ +module Main where + +main = return () diff --git a/testsuite/tests/plugins/T20218b.hs b/testsuite/tests/plugins/T20218b.hs new file mode 100644 index 0000000000..c6215356e7 --- /dev/null +++ b/testsuite/tests/plugins/T20218b.hs @@ -0,0 +1,9 @@ +module Main where + +{-# NOINLINE wiz #-} +wiz :: Int -> Int +wiz x = x + 10 + +main = do + print (wiz 5) + return () diff --git a/testsuite/tests/plugins/T20218b.stderr b/testsuite/tests/plugins/T20218b.stderr new file mode 100644 index 0000000000..f051bb32ad --- /dev/null +++ b/testsuite/tests/plugins/T20218b.stderr @@ -0,0 +1 @@ +Got 5 diff --git a/testsuite/tests/plugins/T20218b.stdout b/testsuite/tests/plugins/T20218b.stdout new file mode 100644 index 0000000000..7ed6ff82de --- /dev/null +++ b/testsuite/tests/plugins/T20218b.stdout @@ -0,0 +1 @@ +5 diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T index 0242ab7d93..0fc41ec039 100644 --- a/testsuite/tests/plugins/all.T +++ b/testsuite/tests/plugins/all.T @@ -247,3 +247,17 @@ test('T20417', pre_cmd('$MAKE -s --no-print-directory -C plugin-recomp package.plugins01 TOP={top}') ], makefile_test, []) + +test('T20218', + [extra_files(['simple-plugin/']), only_ways([config.ghc_plugin_way]), + pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.T20218 TOP={top}'), + grep_errmsg(r'-lHSsimple-plugin'), + ignore_stdout + ], + makefile_test, []) + +test('T20218b', + [extra_files(['simple-plugin/']), only_ways([config.ghc_plugin_way]), + pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.T20218b TOP={top}') + ], + makefile_test, []) diff --git a/testsuite/tests/plugins/simple-plugin/Simple/ReplacePlugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/ReplacePlugin.hs new file mode 100644 index 0000000000..b20f3fe80a --- /dev/null +++ b/testsuite/tests/plugins/simple-plugin/Simple/ReplacePlugin.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE LambdaCase #-} + +module Simple.ReplacePlugin(plugin) where + +import GHC.Types.Unique.FM +import GHC.Plugins +import qualified GHC.Utils.Error +import GHC.Types.TyThing + +import Debug.Trace +import Data.Bifunctor (second) +import Control.Monad +import qualified Language.Haskell.TH as TH +import Data.List (isSuffixOf) + +woz :: Int -> Int +woz x = trace ("Got " ++ show x) x + +plugin :: Plugin +plugin = defaultPlugin { + installCoreToDos = install, + pluginRecompile = purePlugin + } + +install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] +install options todos = do + mb <- thNameToGhcName 'woz + case mb of + Nothing -> error "Failed to locate woz" + Just m -> do + rep <- lookupId m + return $ CoreDoPluginPass "Replace wiz with woz" (fixGuts rep) : todos + +fixGuts :: Id -> ModGuts -> CoreM ModGuts +fixGuts rep guts = pure $ guts { mg_binds = fmap fix_bind (mg_binds guts) } + where + fix_bind (NonRec b e) = NonRec b (fix_expr e) + fix_bind (Rec bes) = Rec (fmap (second fix_expr) bes) + + fix_expr :: CoreExpr -> CoreExpr + fix_expr = \case + Var i -> if "$wiz" `isSuffixOf` nameStableString (idName i) + then Var rep + else Var i + Lit l -> Lit l + App e1 e2 -> App (fix_expr e1) (fix_expr e2) + Lam b e -> Lam b (fix_expr e) + Case e b t as -> Case (fix_expr e) b t (map fix_alt as) + Cast e c -> Cast (fix_expr e) c + Tick t e -> Tick t (fix_expr e) + Type t -> Type t + Coercion c -> Coercion c + + fix_alt (Alt c bs e) = Alt c bs (fix_expr e) diff --git a/testsuite/tests/plugins/simple-plugin/simple-plugin.cabal b/testsuite/tests/plugins/simple-plugin/simple-plugin.cabal index af68c5ca3b..c5297440c9 100644 --- a/testsuite/tests/plugins/simple-plugin/simple-plugin.cabal +++ b/testsuite/tests/plugins/simple-plugin/simple-plugin.cabal @@ -22,3 +22,4 @@ Library Simple.RemovePlugin Simple.TrustworthyPlugin Simple.DefaultPlugin + Simple.ReplacePlugin |