Andrea Vezzosi pushed to branch wip/romes/async-rpc at Glasgow Haskell Compiler / GHC

Commits:

8 changed files:

Changes:

  • testsuite/tests/plugins/all.T
    ... ... @@ -374,6 +374,14 @@ test('plugins-external',
    374 374 
           when(opsys('mingw32') or (opsys('linux') and not ghc_dynamic()), fragile(20706))],
    375 375 
          makefile_test, [])
    376 376
    377 
    +test('static-plugin-interp-panic',
    378 
    +     [extra_files(['static-plugin-interp-panic-module.hs']),
    379 
    +      unless(config.have_RTS_linker, skip),
    380 
    +      extra_run_opts('"' + config.libdir + '"'),
    381 
    +      req_th],
    382 
    +     compile_and_run,
    383 
    +     ['-package ghc -j1'])
    384 
    +
    377 385 
     test('test-phase-hooks-plugin',
    378 386 
          [extra_files(['hooks-plugin/']),
    379 387 
           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
    1 
    +{-# LANGUAGE TemplateHaskell #-}
    2 
    +
    3 
    +-- reifyModule forces a fresh interface load from inside the ReifyModule
    4 
    +-- THMessage handler, which is where the plugin hook panics. ghc-internal is
    5 
    +-- wired in, so its unit id carries no version.
    6 
    +module StaticPluginInterpPanicModule where
    7 
    +
    8 
    +import Language.Haskell.TH
    9 
    +import Language.Haskell.TH.Syntax (Module(..), PkgName(..), ModName(..), reifyModule)
    10 
    +
    11 
    +x :: Int
    12 
    +x = $(do _ <- reifyModule (Module (PkgName "ghc-internal")
    13 
    +                                  (ModName "GHC.Internal.Real"))
    14 
    +         litE (integerL 42))

  • testsuite/tests/plugins/static-plugin-interp-panic.hs
    1 
    +-- Tests panic in handleTHMessage is handled properly.
    2 
    +-- Plugin is just a convenient way to inject a panic.
    3 
    +module Main where
    4 
    +
    5 
    +import Control.Monad.IO.Class (liftIO)
    6 
    +import System.Environment (getArgs)
    7 
    +
    8 
    +import GHC
    9 
    +import GHC.Driver.Env (hsc_plugins)
    10 
    +import GHC.Driver.Monad (modifySession)
    11 
    +import GHC.Driver.Plugins
    12 
    +import GHC.Driver.Session (defaultFatalMessager, defaultFlushOut, gopt_set)
    13 
    +import GHC.Tc.Types (IfM)
    14 
    +import GHC.Unit.Module.ModIface (ModIface, mi_module)
    15 
    +import GHC.Utils.Panic (panic)
    16 
    +
    17 
    +main :: IO ()
    18 
    +main = do
    19 
    +  libdir:_ <- getArgs
    20 
    +  defaultErrorHandler defaultFatalMessager defaultFlushOut $
    21 
    +    runGhc (Just libdir) $ do
    22 
    +      dflags <- getSessionDynFlags
    23 
    +      setSessionDynFlags (gopt_set dflags Opt_ExternalInterpreter)
    24 
    +                           { ghcLink = LinkInMemory }
    25 
    +
    26 
    +      modifySession $ \hsc_env ->
    27 
    +        hsc_env { hsc_plugins = (hsc_plugins hsc_env)
    28 
    +                    { staticPlugins = [StaticPlugin (PluginWithArgs panicPlugin []) False] } }
    29 
    +
    30 
    +      target <- guessTarget "static-plugin-interp-panic-module.hs" Nothing Nothing
    31 
    +      setTargets [target]
    32 
    +      ok <- load LoadAllTargets
    33 
    +      liftIO $ putStrLn ("load succeeded: " ++ show (succeeded ok))
    34 
    +
    35 
    +panicPlugin :: Plugin
    36 
    +panicPlugin = defaultPlugin
    37 
    +  { interfaceLoadAction = ifaceAction
    38 
    +  , pluginRecompile     = purePlugin
    39 
    +  }
    40 
    +
    41 
    +ifaceAction :: [CommandLineOption] -> ModIface -> IfM lcl ModIface
    42 
    +ifaceAction _ iface
    43 
    +  | modName == "GHC.Internal.Real" = panic ("static-plugin-interp-panic: panic loading " ++ modName)
    44 
    +  | otherwise                      = return iface
    45 
    +  where
    46 
    +    modName = moduleNameString (moduleName (mi_module iface))

  • testsuite/tests/plugins/static-plugin-interp-panic.stderr
    1 
    +static-plugin-interp-panic-module.hs:12:5: error: [GHC-87897]
    2 
    +    • Exception when trying to run compile-time code:
    3 
    +        panic! (the 'impossible' happened)
    4 
    +  GHC version 10.1.20261027:
    5 
    +	static-plugin-interp-panic: panic loading GHC.Internal.Real
    6 
    +
    7 
    +Please report this as a GHC bug:  https://www.haskell.org/ghc/reportabug
    8 
    +
    9 
    +      Code: (do _ <- reifyModule
    10 
    +                       (Module (PkgName "ghc-internal") (ModName "GHC.Internal.Real"))
    11 
    +                litE (integerL 42))
    12 
    +    • In the untyped splice:
    13 
    +        $(do _ <- reifyModule
    14 
    +                    (Module (PkgName "ghc-internal") (ModName "GHC.Internal.Real"))
    15 
    +             litE (integerL 42))
    16 
    +   |
    17 
    +12 | x = $(do _ <- reifyModule (Module (PkgName "ghc-internal")
    18 
    +   |     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
    19 
    +

  • testsuite/tests/plugins/static-plugin-interp-panic.stdout
    1 
    +load succeeded: False

  • testsuite/tests/th/TH_ReifyModuleFail.hs
    1 
    +{-# LANGUAGE TemplateHaskell #-}
    2 
    +
    3 
    +-- A TH splice whose ReifyModule request fails on the GHC side.
    4 
    +--
    5 
    +-- `reifyModule` on a non-existing module/package should result into a clean
    6 
    +-- error message on both internal and external interpreter, and no deadlocks.
    7 
    +module TH_ReifyModuleFail where
    8 
    +
    9 
    +import Language.Haskell.TH
    10 
    +import Language.Haskell.TH.Syntax (Module(..), PkgName(..), ModName(..), reifyModule)
    11 
    +
    12 
    +x :: Int
    13 
    +x = $(do _ <- reifyModule (Module (PkgName "no-such-package-0")
    14 
    +                                  (ModName "No.Such.Module"))
    15 
    +         litE (integerL 1))

  • testsuite/tests/th/TH_ReifyModuleFail.stderr
    1 
    +TH_ReifyModuleFail.hs:13:5: error: [GHC-87897]
    2 
    +    • Exception when trying to run compile-time code:
    3 
    +        Failed to load interface for ‘No.Such.Module’.
    4 
    +no unit id matching ‘no-such-package-0’ was found
    5 
    +      Code: (do _ <- reifyModule
    6 
    +                       (Module (PkgName "no-such-package-0") (ModName "No.Such.Module"))
    7 
    +                litE (integerL 1))
    8 
    +    • In the untyped splice:
    9 
    +        $(do _ <- reifyModule
    10 
    +                    (Module (PkgName "no-such-package-0") (ModName "No.Such.Module"))
    11 
    +             litE (integerL 1))
    12 
    +

  • testsuite/tests/th/all.T
    ... ... @@ -667,4 +667,5 @@ test('TH_cvt_RecGadtNoCons', normal, compile_fail, ['-v0'])
    667 667 
     test('TH_cvt_InvalidCCallImpent', normal, compile_fail, ['-v0'])
    668 668 
     test('TH_cvt_SumAltArityExceeded', normal, compile_fail, ['-v0'])
    669 669 
     test('TH_cvt_IllegalSumAlt', normal, compile_fail, ['-v0'])
    670 
    +test('TH_ReifyModuleFail', normal, compile_fail, ['-v0'])
    670 671

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/compare/b784216f6ebe314dc63b3ad82c008968a5b981a4...c507c7fe036940934805efd2c0fd5226d452ace8 at 1793620308