diff options
author | Roland Senn <rsx@bluewin.ch> | 2021-01-01 14:01:41 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-01-07 00:12:09 -0500 |
commit | 1de2050edd8a2647e89a9269278a79b61892b59e (patch) | |
tree | 2c902e80f7b030d42ddc38770b878a5db1315e48 | |
parent | 06982b6cc886d65aa325475ddfb4ad38c69b2d96 (diff) | |
download | haskell-1de2050edd8a2647e89a9269278a79b61892b59e.tar.gz |
GHCi: Fill field `DynFlags.dumpPrefix`. (Fixes #17500)
For interactive evaluations set the field `DynFlags.dumpPrefix` to the
GHCi internal module name. The GHCi module name for an interactive
evaluation is something like `Ghci9`.
To avoid user confusion, don't dump any data for GHCi internal evaluations.
Extend the comment for `DynFlags.dumpPrefix` and fix a little typo in a
comment about the GHCi internal module names.
-rw-r--r-- | compiler/GHC/Builtin/Names.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Driver/Session.hs | 7 | ||||
-rw-r--r-- | ghc/GHCi/UI.hs | 13 | ||||
-rw-r--r-- | ghc/GHCi/UI/Monad.hs | 7 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/T17500.hs | 8 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/T17500.script | 10 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/T17500.stdout | 3 | ||||
-rwxr-xr-x | testsuite/tests/ghci/scripts/all.T | 1 |
8 files changed, 45 insertions, 6 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs index cf0f72c50f..5cf4753a45 100644 --- a/compiler/GHC/Builtin/Names.hs +++ b/compiler/GHC/Builtin/Names.hs @@ -612,7 +612,7 @@ rOOT_MAIN :: Module rOOT_MAIN = mkMainModule (fsLit ":Main") -- Root module for initialisation mkInteractiveModule :: Int -> Module --- (mkInteractiveMoudule 9) makes module 'interactive:M9' +-- (mkInteractiveMoudule 9) makes module 'interactive:Ghci9' mkInteractiveModule n = mkModule interactiveUnit (mkModuleName ("Ghci" ++ show n)) pRELUDE_NAME, mAIN_NAME :: ModuleName diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index 3bbd049144..109d854526 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -529,11 +529,12 @@ data DynFlags = DynFlags { -- used to query the appropriate fields -- (outputFile/dynOutputFile, ways, etc.) - -- | This is set by 'GHC.Driver.Pipeline.runPipeline' based on where - -- its output is going. + -- | This is set by 'GHC.Driver.Pipeline.runPipeline' + -- or 'ghc.GHCi.UI.runStmt' based on where its output is going. dumpPrefix :: Maybe FilePath, - -- | Override the 'dumpPrefix' set by 'GHC.Driver.Pipeline.runPipeline'. + -- | Override the 'dumpPrefix' set by 'GHC.Driver.Pipeline.runPipeline' + -- or 'ghc.GHCi.UI.runStmt'. -- Set by @-ddump-file-prefix@ dumpPrefixForce :: Maybe FilePath, diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index 4a1b91a9fc..5beca7882d 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -458,7 +458,7 @@ interactiveUI config srcs maybe_exprs = do _ <- liftIO $ newStablePtr stderr -- Initialise buffering for the *interpreted* I/O system - (nobuffering, flush) <- initInterpBuffering + (nobuffering, flush) <- runInternal initInterpBuffering -- The initial set of DynFlags used for interactive evaluation is the same -- as the global DynFlags, plus -XExtendedDefaultRules and @@ -1215,6 +1215,10 @@ runStmt input step = do -- and should therefore not be used here. | otherwise -> do hsc_env <- GHC.getSession + let !ic = hsc_IC hsc_env -- Bang-pattern to avoid space leaks + setDumpFilePrefix ic + -- `-ddump-to-file` must work for normal GHCi compilations / + -- evaluations. (#17500) decls <- liftIO (hscParseDeclsWithLocation hsc_env source line input) run_decls decls where @@ -1270,6 +1274,13 @@ runStmt input step = do l = L loc in l (LetStmt noExtField (l (HsValBinds noExtField (ValBinds noExtField (unitBag (l bind)) [])))) + setDumpFilePrefix :: GHC.GhcMonad m => InteractiveContext -> m () -- #17500 + setDumpFilePrefix ic = do + dflags <- GHC.getInteractiveDynFlags + GHC.setInteractiveDynFlags dflags { dumpPrefix = Just (modStr ++ ".") } + where + modStr = moduleNameString $ moduleName $ icInteractiveModule $ ic + -- | Clean up the GHCi environment after a statement has run afterRunStmt :: GhciMonad m => (SrcSpan -> Bool) -> GHC.ExecResult -> m GHC.ExecResult diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs index 87de1a83cb..b371a9b8b4 100644 --- a/ghc/GHCi/UI/Monad.hs +++ b/ghc/GHCi/UI/Monad.hs @@ -31,6 +31,7 @@ module GHCi.UI.Monad ( initInterpBuffering, turnOffBuffering, turnOffBuffering_, flushInterpBuffers, + runInternal, mkEvalWrapper ) where @@ -74,6 +75,7 @@ import Control.Monad.Trans.Reader import Control.Monad.IO.Class import Data.Map.Strict (Map) import qualified Data.IntMap.Strict as IntMap +import qualified GHC.Data.EnumSet as EnumSet import qualified GHC.LanguageExtensions as LangExt ----------------------------------------------------------------------------- @@ -519,7 +521,10 @@ runInternal = -- Running GHCi's internal expression is incompatible with -XSafe. -- We temporarily disable any Safe Haskell settings while running -- GHCi internal expressions. (see #12509) - safeHaskell = Sf_None + safeHaskell = Sf_None, + -- Disable dumping of any data during evaluation of GHCi's internal + -- expressions. (#17500) + dumpFlags = EnumSet.empty } -- RebindableSyntax can wreak havoc with GHCi in several ways -- (see #13385 and #14342 for examples), so we temporarily diff --git a/testsuite/tests/ghci/scripts/T17500.hs b/testsuite/tests/ghci/scripts/T17500.hs new file mode 100644 index 0000000000..a3e05741a7 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T17500.hs @@ -0,0 +1,8 @@ +module T17500 where + +import Data.List ( isInfixOf ) + +isBCOsFile :: String -> IO Bool +isBCOsFile fname = do + content <- readFile fname + pure $ "== Proto-BCOs ==" `isInfixOf` content -- Check title line diff --git a/testsuite/tests/ghci/scripts/T17500.script b/testsuite/tests/ghci/scripts/T17500.script new file mode 100644 index 0000000000..f8ea5e9166 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T17500.script @@ -0,0 +1,10 @@ +:l T17500 +b = 42 +:{ +fac :: Integer -> Integer +fac 0 = 1 +fac n = n * fac (n - 1) +:} +isBCOsFile "T17500.dump-BCOs" +isBCOsFile "Ghci1.dump-BCOs" +isBCOsFile "Ghci2.dump-BCOs" diff --git a/testsuite/tests/ghci/scripts/T17500.stdout b/testsuite/tests/ghci/scripts/T17500.stdout new file mode 100644 index 0000000000..b8ca7e7ef0 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T17500.stdout @@ -0,0 +1,3 @@ +True +True +True diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 6fec18bd92..b9b534ca9e 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -319,6 +319,7 @@ test('T17345', normal, ghci_script, ['T17345.script']) test('T17384', normal, ghci_script, ['T17384.script']) test('T17403', normal, ghci_script, ['T17403.script']) test('T17431', normal, ghci_script, ['T17431.script']) +test('T17500', [extra_run_opts('-ddump-to-file -ddump-bcos')], ghci_script, ['T17500.script']) test('T17549', normal, ghci_script, ['T17549.script']) test('T17669', [extra_run_opts('-fexternal-interpreter -fobject-code'), expect_broken(17669)], ghci_script, ['T17669.script']) test('T18501', normal, ghci_script, ['T18501.script']) |