diff --git a/testsuite/tests/plugins/Makefile b/testsuite/tests/plugins/Makefile index 0076e720f011321bdf52bc0178291a6c6f98867f..827485c4bbd0dfa8aaed58791d133a36b99174e2 100644 --- a/testsuite/tests/plugins/Makefile +++ b/testsuite/tests/plugins/Makefile @@ -224,3 +224,13 @@ plugins-external: cp shared-plugin/pkg.plugins01/dist/build/$(call DLL,HSsimple-plugin*) $(call DLL,HSsimple-plugin) "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 -fplugin-library "$(PWD)/$(call DLL,HSsimple-plugin);simple-plugin-1234;Simple.Plugin;[\"Plugin\",\"loaded\",\"from\",\"a shared lib\"]" plugins-external.hs ./plugins-external + +# Runs a plugin that is both a core plugin and a late plugin, then makes sure +# only the changes from the core plugin end up in the interface files. +test-late-plugin: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -O -package ghc $@.hs + SHOW_IFACE="$$($(TEST_HC) --show-iface $@.hi)" ; \ + ContainsEarlyBinding=$$(echo $$SHOW_IFACE | grep -o 111111) ; \ + ContainsLateBinding=$$(echo $$SHOW_IFACE | grep -o 222222) ; \ + echo "$$ContainsLateBinding" ; \ + [ "$$ContainsEarlyBinding" = "111111" ] && [ "$$ContainLateBinding" = "" ] diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T index 140c9aae0c92bb3eac4a682de5c7997051077165..e770d00feb3fbde71f20769d394eae69d79200df 100644 --- a/testsuite/tests/plugins/all.T +++ b/testsuite/tests/plugins/all.T @@ -358,3 +358,8 @@ test('test-log-hooks-plugin', pre_cmd('$MAKE -s --no-print-directory -C hooks-plugin package.test-log-hooks-plugin TOP={top}')], compile_fail, ['-package-db hooks-plugin/pkg.test-log-hooks-plugin/local.package.conf -fplugin Hooks.LogPlugin -package hooks-plugin ' + config.plugin_way_flags]) + +test('test-late-plugin', + [extra_files(['late-plugin/LatePlugin.hs']), ignore_stdout], + makefile_test, + []) diff --git a/testsuite/tests/plugins/late-plugin/LatePlugin.hs b/testsuite/tests/plugins/late-plugin/LatePlugin.hs new file mode 100644 index 0000000000000000000000000000000000000000..865df907e7771cbbae2e9889a19fa7461bd042d9 --- /dev/null +++ b/testsuite/tests/plugins/late-plugin/LatePlugin.hs @@ -0,0 +1,49 @@ +module LatePlugin where + +import Data.Bool +import GHC.Core +import GHC.Driver.Monad +import GHC.Plugins +import GHC.Types.Avail +import GHC.Types.Var +import GHC.Types.Id +import System.IO + +-- | Both a core plugin and a late plugin. The Core plugin edits the binding in +-- the test file (testBinding) to be the integer "111111". The late plugin then +-- edits the binding to be the integer "222222". Then we make sure the "222222" +-- did not make it in the interface file and the "111111" did. +plugin :: Plugin +plugin = + defaultPlugin + { installCoreToDos = earlyP + , latePlugin = lateP + } + +earlyP :: CorePlugin +earlyP _ todos = do + return + . (: todos) + $ CoreDoPluginPass "earlyP" + $ \mgs -> liftIO $ do + binds' <- editCoreBinding True (moduleName (mg_module mgs)) (mg_binds mgs) + return mgs { mg_binds = binds' } + +lateP :: LatePlugin +lateP _ opts (cg_guts, cc_state) = do + binds' <- editCoreBinding False (moduleName (cg_module cg_guts)) (cg_binds cg_guts) + return (cg_guts { cg_binds = binds' }, cc_state) + +editCoreBinding :: Bool -> ModuleName -> CoreProgram -> IO CoreProgram +editCoreBinding early modName pgm = do + putStrLn $ + bool "late " "early " early ++ "plugin running on module " ++ + moduleNameString modName + pure $ go pgm + where + go :: [CoreBind] -> [CoreBind] + go (b@(NonRec v e) : bs) + | occNameString (getOccName v) == "testBinding" = + NonRec v (mkUncheckedIntExpr $ bool 222222 111111 early) : bs + go (b:bs) = b : go bs + go [] = [] diff --git a/testsuite/tests/plugins/test-late-plugin.hs b/testsuite/tests/plugins/test-late-plugin.hs new file mode 100644 index 0000000000000000000000000000000000000000..79ec7a8329334fba4b57042d88821897302c50eb --- /dev/null +++ b/testsuite/tests/plugins/test-late-plugin.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE MagicHash #-} +{-# OPTIONS_GHC -fplugin=LatePlugin #-} + +module TestLatePlugin (testBinding) where + +import GHC.Exts + +-- This file is edited by a core plugin at the beginning of the core pipeline so +-- that the value of testBinding becomes 111111. Then, a late plugin edits the +-- binding to set testBinding to 222222. The test then checks that the early +-- binding value is what makes it into the interface file, just to be sure that +-- changes from late plugins do not end up in interface files. + +testBinding :: Int +testBinding = -1