[Git][ghc/ghc][master] driver: Ensure we run driverPlugin for staticPlugins (#25217)

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
f04fd0ae by Zubin Duggal at 2024-09-21T17:49:51-04:00
driver: Ensure we run driverPlugin for staticPlugins (#25217)

driverPlugins are only run when the plugin state changes. This meant they were
never run for static plugins, as their state never changes.

We need to keep track of whether a static plugin has been initialised to ensure
we run static driver plugins at least once. This necessitates an additional field
in the `StaticPlugin` constructor as this state has to be bundled with the plugin
itself, as static plugins have no name/identifier we can use to otherwise reference
them

- - - - -


6 changed files:

- compiler/GHC/Driver/Plugins.hs
- compiler/GHC/Runtime/Loader.hs
- + testsuite/tests/plugins/T25217.hs
- + testsuite/tests/plugins/T25217.stdout
- testsuite/tests/plugins/all.T
- testsuite/tests/plugins/static-plugins.hs


Changes:

=====================================
compiler/GHC/Driver/Plugins.hs
=====================================
@@ -244,6 +244,8 @@ data ExternalPlugin = ExternalPlugin
 data StaticPlugin = StaticPlugin
   { spPlugin :: PluginWithArgs
   -- ^ the actual plugin together with its commandline arguments
+  , spInitialised :: Bool
+  -- ^ has this plugin been initialised (i.e. driverPlugin has been run)
   }
 
 lpModuleName :: LoadedPlugin -> ModuleName


=====================================
compiler/GHC/Runtime/Loader.hs
=====================================
@@ -121,14 +121,15 @@ initializePlugins hsc_env
   , external_plugins <- externalPlugins (hsc_plugins hsc_env)
   , check_external_plugins external_plugins (externalPluginSpecs dflags)
 
-    -- FIXME: we should check static plugins too
+    -- ensure we have initialised static plugins
+  , all spInitialised (staticPlugins (hsc_plugins hsc_env))
 
   = return hsc_env -- no change, no need to reload plugins
 
   | otherwise
   = do (loaded_plugins, links, pkgs) <- loadPlugins hsc_env
        external_plugins <- loadExternalPlugins (externalPluginSpecs dflags)
-       let plugins' = (hsc_plugins hsc_env) { staticPlugins    = staticPlugins (hsc_plugins hsc_env)
+       let plugins' = (hsc_plugins hsc_env) { staticPlugins    = map (\sp -> sp{ spInitialised = True }) $ staticPlugins (hsc_plugins hsc_env)
                                             , externalPlugins  = external_plugins
                                             , loadedPlugins    = loaded_plugins
                                             , loadedPluginDeps = (links, pkgs)


=====================================
testsuite/tests/plugins/T25217.hs
=====================================
@@ -0,0 +1,42 @@
+module Main where
+
+import Control.Monad.IO.Class
+import GHC
+import GHC.Driver.Monad
+import GHC.Plugins
+import System.Environment
+
+main = do
+  libdir:args <- getArgs
+  defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
+    runGhc (Just libdir) $ do
+      dflags <- getSessionDynFlags
+      -- we need to LinkInMemory otherwise `setTarget [] >> load LoadAllTargets`
+      -- below will fail.
+      setSessionDynFlags dflags { ghcLink = LinkInMemory}
+
+      liftIO $ putStrLn "loading with driver plugin"
+      loadWithPlugins [StaticPlugin (PluginWithArgs plugin []) False]
+
+
+  where
+    loadWithPlugins the_plugins = do
+      -- first unload (like GHCi :load does)
+      GHC.setTargets []
+      _ <- GHC.load LoadAllTargets
+
+      target <- guessTarget "static-plugins-module.hs" Nothing Nothing
+      setTargets [target]
+
+      modifySession $ \hsc_env ->
+        let old_plugins = hsc_plugins hsc_env
+        in hsc_env { hsc_plugins = old_plugins { staticPlugins = the_plugins } }
+
+      dflags <- getSessionDynFlags
+      setSessionDynFlags dflags { outputFile_ = Nothing }
+      load LoadAllTargets
+      liftIO (putStrLn "loading done")
+
+
+plugin   =
+  defaultPlugin { driverPlugin = \_ env -> liftIO (putStrLn "driver plugin ran") >> pure env }


=====================================
testsuite/tests/plugins/T25217.stdout
=====================================
@@ -0,0 +1,3 @@
+loading with driver plugin
+driver plugin ran
+loading done


=====================================
testsuite/tests/plugins/all.T
=====================================
@@ -200,6 +200,15 @@ test('static-plugins',
      compile_and_run,
      ['-package ghc -isimple-plugin/ -j1'])
 
+test('T25217',
+     [extra_files(['static-plugins-module.hs']),
+      unless(config.have_RTS_linker, skip),
+      expect_broken_for(16803, prof_ways),
+      extra_run_opts('"' + config.libdir + '"'),
+      ],
+     compile_and_run,
+     ['-package ghc -j1'])
+
 test('T15858',
      [extra_files(['plugin-recomp/', 'plugin-recomp-test.hs']),
 #


=====================================
testsuite/tests/plugins/static-plugins.hs
=====================================
@@ -35,23 +35,23 @@ main = do
 
       -- Start with a pure plugin, this should trigger recomp.
       liftIO $ putStrLn "==pure.0"
-      loadWithPlugins [StaticPlugin $ PluginWithArgs plugin0_pure []]
+      loadWithPlugins [StaticPlugin (PluginWithArgs plugin0_pure []) False]
 
       -- The same (or a different) pure plugin shouldn't trigger recomp.
       liftIO $ putStrLn "==pure.1"
-      loadWithPlugins [StaticPlugin $ PluginWithArgs plugin0_pure []]
+      loadWithPlugins [StaticPlugin (PluginWithArgs plugin0_pure []) False]
 
       -- Next try with a fingerprint plugin, should trigger recomp.
       liftIO $ putStrLn "==fp0.0"
-      loadWithPlugins [StaticPlugin $ PluginWithArgs plugin_fp0 []]
+      loadWithPlugins [StaticPlugin (PluginWithArgs plugin_fp0 []) False]
 
       -- With the same fingerprint plugin, should not trigger recomp.
       liftIO $ putStrLn "==fp0.1"
-      loadWithPlugins [StaticPlugin $ PluginWithArgs plugin_fp0 []]
+      loadWithPlugins [StaticPlugin (PluginWithArgs plugin_fp0 []) False]
 
       -- Change the plugin fingerprint, should trigger recomp.
       liftIO $ putStrLn "==fp1"
-      loadWithPlugins [StaticPlugin $ PluginWithArgs plugin_fp1 []]
+      loadWithPlugins [StaticPlugin (PluginWithArgs plugin_fp1 []) False]
 
       -- TODO: this currently doesn't work, patch pending
       -- -- Even though the plugin is now pure we should still recomp since we



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f04fd0ae9b6283229f8891c8e7859b9f4cc3785a

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f04fd0ae9b6283229f8891c8e7859b9f4cc3785a
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240921/c9dca12e/attachment-0001.html>