Andrea Vezzosi pushed to branch wip/romes/async-rpc at Glasgow Haskell Compiler / GHC Commits: f38d805c by Andrea Vezzosi at 2026-11-02T12:10:05+01:00 interp: test: no deadlock when handleTHMessage throws. it used to be that handleTHMessage throwing would neglect to notify and/or tear down the external interpreter, causing it to deadlock (or fail with blocked indefinitely). Now we reply with the exception, before rethrowing it, so the external interpreter can shutdown cleanly. - - - - - c507c7fe by Andrea Vezzosi at 2026-11-02T12:50:28+01:00 interp: test: panic in handleTHMessage does not deadlock similar to TH_ReifyModuleFail but with a plugin. - - - - - 8 changed files: - testsuite/tests/plugins/all.T - + testsuite/tests/plugins/static-plugin-interp-panic-module.hs - + testsuite/tests/plugins/static-plugin-interp-panic.hs - + testsuite/tests/plugins/static-plugin-interp-panic.stderr - + testsuite/tests/plugins/static-plugin-interp-panic.stdout - + testsuite/tests/th/TH_ReifyModuleFail.hs - + testsuite/tests/th/TH_ReifyModuleFail.stderr - testsuite/tests/th/all.T Changes: ===================================== testsuite/tests/plugins/all.T ===================================== @@ -374,6 +374,14 @@ test('plugins-external', when(opsys('mingw32') or (opsys('linux') and not ghc_dynamic()), fragile(20706))], makefile_test, []) +test('static-plugin-interp-panic', + [extra_files(['static-plugin-interp-panic-module.hs']), + unless(config.have_RTS_linker, skip), + extra_run_opts('"' + config.libdir + '"'), + req_th], + compile_and_run, + ['-package ghc -j1']) + test('test-phase-hooks-plugin', [extra_files(['hooks-plugin/']), pre_cmd('$MAKE -s --no-print-directory -C hooks-plugin package.test-phase-hooks-plugin TOP={top}'), ===================================== testsuite/tests/plugins/static-plugin-interp-panic-module.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE TemplateHaskell #-} + +-- reifyModule forces a fresh interface load from inside the ReifyModule +-- THMessage handler, which is where the plugin hook panics. ghc-internal is +-- wired in, so its unit id carries no version. +module StaticPluginInterpPanicModule where + +import Language.Haskell.TH +import Language.Haskell.TH.Syntax (Module(..), PkgName(..), ModName(..), reifyModule) + +x :: Int +x = $(do _ <- reifyModule (Module (PkgName "ghc-internal") + (ModName "GHC.Internal.Real")) + litE (integerL 42)) ===================================== testsuite/tests/plugins/static-plugin-interp-panic.hs ===================================== @@ -0,0 +1,46 @@ +-- Tests panic in handleTHMessage is handled properly. +-- Plugin is just a convenient way to inject a panic. +module Main where + +import Control.Monad.IO.Class (liftIO) +import System.Environment (getArgs) + +import GHC +import GHC.Driver.Env (hsc_plugins) +import GHC.Driver.Monad (modifySession) +import GHC.Driver.Plugins +import GHC.Driver.Session (defaultFatalMessager, defaultFlushOut, gopt_set) +import GHC.Tc.Types (IfM) +import GHC.Unit.Module.ModIface (ModIface, mi_module) +import GHC.Utils.Panic (panic) + +main :: IO () +main = do + libdir:_ <- getArgs + defaultErrorHandler defaultFatalMessager defaultFlushOut $ + runGhc (Just libdir) $ do + dflags <- getSessionDynFlags + setSessionDynFlags (gopt_set dflags Opt_ExternalInterpreter) + { ghcLink = LinkInMemory } + + modifySession $ \hsc_env -> + hsc_env { hsc_plugins = (hsc_plugins hsc_env) + { staticPlugins = [StaticPlugin (PluginWithArgs panicPlugin []) False] } } + + target <- guessTarget "static-plugin-interp-panic-module.hs" Nothing Nothing + setTargets [target] + ok <- load LoadAllTargets + liftIO $ putStrLn ("load succeeded: " ++ show (succeeded ok)) + +panicPlugin :: Plugin +panicPlugin = defaultPlugin + { interfaceLoadAction = ifaceAction + , pluginRecompile = purePlugin + } + +ifaceAction :: [CommandLineOption] -> ModIface -> IfM lcl ModIface +ifaceAction _ iface + | modName == "GHC.Internal.Real" = panic ("static-plugin-interp-panic: panic loading " ++ modName) + | otherwise = return iface + where + modName = moduleNameString (moduleName (mi_module iface)) ===================================== testsuite/tests/plugins/static-plugin-interp-panic.stderr ===================================== @@ -0,0 +1,19 @@ +static-plugin-interp-panic-module.hs:12:5: error: [GHC-87897] + • Exception when trying to run compile-time code: + panic! (the 'impossible' happened) + GHC version 10.1.20261027: + static-plugin-interp-panic: panic loading GHC.Internal.Real + +Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug + + Code: (do _ <- reifyModule + (Module (PkgName "ghc-internal") (ModName "GHC.Internal.Real")) + litE (integerL 42)) + • In the untyped splice: + $(do _ <- reifyModule + (Module (PkgName "ghc-internal") (ModName "GHC.Internal.Real")) + litE (integerL 42)) + | +12 | x = $(do _ <- reifyModule (Module (PkgName "ghc-internal") + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^... + ===================================== testsuite/tests/plugins/static-plugin-interp-panic.stdout ===================================== @@ -0,0 +1 @@ +load succeeded: False ===================================== testsuite/tests/th/TH_ReifyModuleFail.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE TemplateHaskell #-} + +-- A TH splice whose ReifyModule request fails on the GHC side. +-- +-- `reifyModule` on a non-existing module/package should result into a clean +-- error message on both internal and external interpreter, and no deadlocks. +module TH_ReifyModuleFail where + +import Language.Haskell.TH +import Language.Haskell.TH.Syntax (Module(..), PkgName(..), ModName(..), reifyModule) + +x :: Int +x = $(do _ <- reifyModule (Module (PkgName "no-such-package-0") + (ModName "No.Such.Module")) + litE (integerL 1)) ===================================== testsuite/tests/th/TH_ReifyModuleFail.stderr ===================================== @@ -0,0 +1,12 @@ +TH_ReifyModuleFail.hs:13:5: error: [GHC-87897] + • Exception when trying to run compile-time code: + Failed to load interface for ‘No.Such.Module’. +no unit id matching ‘no-such-package-0’ was found + Code: (do _ <- reifyModule + (Module (PkgName "no-such-package-0") (ModName "No.Such.Module")) + litE (integerL 1)) + • In the untyped splice: + $(do _ <- reifyModule + (Module (PkgName "no-such-package-0") (ModName "No.Such.Module")) + litE (integerL 1)) + ===================================== testsuite/tests/th/all.T ===================================== @@ -667,4 +667,5 @@ test('TH_cvt_RecGadtNoCons', normal, compile_fail, ['-v0']) test('TH_cvt_InvalidCCallImpent', normal, compile_fail, ['-v0']) test('TH_cvt_SumAltArityExceeded', normal, compile_fail, ['-v0']) test('TH_cvt_IllegalSumAlt', normal, compile_fail, ['-v0']) +test('TH_ReifyModuleFail', normal, compile_fail, ['-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b784216f6ebe314dc63b3ad82c00896... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b784216f6ebe314dc63b3ad82c00896... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help