diff options
author | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2019-01-09 18:44:48 +0300 |
---|---|---|
committer | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2019-01-13 00:17:20 -0500 |
commit | a34ee61545930d569d0dbafb3a4a5db3a7a711e5 (patch) | |
tree | 940ad55163a9c12a97b15a529d7a2c57a8efef7a | |
parent | 448f0e7dd78a8d9404f1aa5e8522cc284360c06d (diff) | |
download | haskell-a34ee61545930d569d0dbafb3a4a5db3a7a711e5.tar.gz |
Refactor GHCi UI to fix #11606, #12091, #15721, #16096
Instead of parsing and executing a statement or declaration directly we
now parse them first and then execute in a separate step. This gives us
the flexibility to inspect the parsed declaration before execution.
Using this we now inspect parsed declarations, and if it's a single
declaration of form `x = y` we execute it as `let x = y` instead, fixing
a ton of problems caused by poor declaration support in GHCi.
To avoid any users of the modules I left `execStmt` and `runDecls`
unchanged and added `execStmt'` and `runDecls'` which work on parsed
statements/declarations.
-rw-r--r-- | compiler/deSugar/Desugar.hs | 19 | ||||
-rw-r--r-- | compiler/main/GHC.hs | 4 | ||||
-rw-r--r-- | compiler/main/HscMain.hs | 18 | ||||
-rw-r--r-- | compiler/main/HscTypes.hs | 12 | ||||
-rw-r--r-- | compiler/main/InteractiveEval.hs | 54 | ||||
-rw-r--r-- | ghc/GHCi/UI.hs | 101 | ||||
-rw-r--r-- | ghc/GHCi/UI/Monad.hs | 22 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/T11606.script | 5 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/T11606.stderr | 12 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/T16089.script | 4 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/T16089.stdout | 3 | ||||
-rwxr-xr-x | testsuite/tests/ghci/scripts/all.T | 4 | ||||
-rw-r--r-- | testsuite/tests/ghci/should_run/T12525.stdout | 2 | ||||
-rw-r--r-- | testsuite/tests/ghci/should_run/T16096.script | 4 | ||||
-rw-r--r-- | testsuite/tests/ghci/should_run/T16096.stdout | 56 | ||||
-rw-r--r-- | testsuite/tests/ghci/should_run/all.T | 2 |
16 files changed, 246 insertions, 76 deletions
diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs index aa24ee0a5d..aa9748ee35 100644 --- a/compiler/deSugar/Desugar.hs +++ b/compiler/deSugar/Desugar.hs @@ -149,8 +149,7 @@ deSugar hsc_env keep_alive <- readIORef keep_var ; let (rules_for_locals, rules_for_imps) = partition isLocalRule all_rules final_prs = addExportFlagsAndRules target export_set keep_alive - mod rules_for_locals - (fromOL all_prs) + rules_for_locals (fromOL all_prs) final_pgm = combineEvBinds ds_ev_binds final_prs -- Notice that we put the whole lot in a big Rec, even the foreign binds @@ -284,9 +283,9 @@ deSugarExpr hsc_env tc_expr = do { -} addExportFlagsAndRules - :: HscTarget -> NameSet -> NameSet -> Module -> [CoreRule] + :: HscTarget -> NameSet -> NameSet -> [CoreRule] -> [(Id, t)] -> [(Id, t)] -addExportFlagsAndRules target exports keep_alive mod rules prs +addExportFlagsAndRules target exports keep_alive rules prs = mapFst add_one prs where add_one bndr = add_rules name (add_export name bndr) @@ -319,20 +318,10 @@ addExportFlagsAndRules target exports keep_alive mod rules prs -- simplification), and retain them all in the TypeEnv so they are -- available from the command line. -- - -- Most of the time, this can be accomplished by use of - -- targetRetainsAllBindings, which returns True if the target is - -- HscInteractive. However, there are cases when one can use GHCi with - -- a target other than HscInteractive (e.g., with the -fobject-code - -- flag enabled, as in #12091). In such scenarios, - -- targetRetainsAllBindings can return False, so we must fall back on - -- isInteractiveModule to be doubly sure we export entities defined in - -- a GHCi session. - -- -- isExternalName separates the user-defined top-level names from those -- introduced by the type checker. is_exported :: Name -> Bool - is_exported | targetRetainsAllBindings target - || isInteractiveModule mod = isExternalName + is_exported | targetRetainsAllBindings target = isExternalName | otherwise = (`elemNameSet` exports) {- diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 8817b41c8a..f289cd4229 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -96,11 +96,11 @@ module GHC ( -- * Interactive evaluation -- ** Executing statements - execStmt, ExecOptions(..), execOptions, ExecResult(..), + execStmt, execStmt', ExecOptions(..), execOptions, ExecResult(..), resumeExec, -- ** Adding new declarations - runDecls, runDeclsWithLocation, + runDecls, runDeclsWithLocation, runParsedDecls, -- ** Get/set the current context parseImportDecl, diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 2ff2ca07af..9a4dd4aafe 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -63,8 +63,8 @@ module HscMain , hscGetModuleInterface , hscRnImportDecls , hscTcRnLookupRdrName - , hscStmt, hscStmtWithLocation, hscParsedStmt - , hscDecls, hscDeclsWithLocation + , hscStmt, hscParseStmtWithLocation, hscStmtWithLocation, hscParsedStmt + , hscDecls, hscParseDeclsWithLocation, hscDeclsWithLocation, hscParsedDecls , hscTcExpr, TcRnExprMode(..), hscImport, hscKcType , hscParseExpr , hscCompileCoreExpr @@ -1602,17 +1602,27 @@ hscDecls :: HscEnv -> IO ([TyThing], InteractiveContext) hscDecls hsc_env str = hscDeclsWithLocation hsc_env str "<interactive>" 1 +hscParseDeclsWithLocation :: HscEnv -> String -> Int -> String -> IO [LHsDecl GhcPs] +hscParseDeclsWithLocation hsc_env source line_num str = do + L _ (HsModule{ hsmodDecls = decls }) <- + runInteractiveHsc hsc_env $ + hscParseThingWithLocation source line_num parseModule str + return decls + -- | Compile a decls hscDeclsWithLocation :: HscEnv -> String -- ^ The statement -> String -- ^ The source -> Int -- ^ Starting line -> IO ([TyThing], InteractiveContext) -hscDeclsWithLocation hsc_env0 str source linenumber = - runInteractiveHsc hsc_env0 $ do +hscDeclsWithLocation hsc_env str source linenumber = do L _ (HsModule{ hsmodDecls = decls }) <- + runInteractiveHsc hsc_env $ hscParseThingWithLocation source linenumber parseModule str + hscParsedDecls hsc_env decls +hscParsedDecls :: HscEnv -> [LHsDecl GhcPs] -> IO ([TyThing], InteractiveContext) +hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do {- Rename and typecheck it -} hsc_env <- getHscEnv tc_gblenv <- ioMsgMaybe $ tcRnDeclsi hsc_env decls diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 456332daeb..d17fa5fcef 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -23,7 +23,7 @@ module HscTypes ( needsTemplateHaskellOrQQ, mgBootModules, -- * Hsc monad - Hsc(..), runHsc, runInteractiveHsc, + Hsc(..), runHsc, mkInteractiveHscEnv, runInteractiveHsc, -- * Information about modules ModDetails(..), emptyModDetails, @@ -253,13 +253,15 @@ runHsc hsc_env (Hsc hsc) = do printOrThrowWarnings (hsc_dflags hsc_env) w return a +mkInteractiveHscEnv :: HscEnv -> HscEnv +mkInteractiveHscEnv hsc_env = hsc_env{ hsc_dflags = interactive_dflags } + where + interactive_dflags = ic_dflags (hsc_IC hsc_env) + runInteractiveHsc :: HscEnv -> Hsc a -> IO a -- A variant of runHsc that switches in the DynFlags from the -- InteractiveContext before running the Hsc computation. -runInteractiveHsc hsc_env - = runHsc (hsc_env { hsc_dflags = interactive_dflags }) - where - interactive_dflags = ic_dflags (hsc_IC hsc_env) +runInteractiveHsc hsc_env = runHsc (mkInteractiveHscEnv hsc_env) -- ----------------------------------------------------------------------------- -- Source Errors diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index cceec31fec..ad3c500d1f 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -11,8 +11,8 @@ module InteractiveEval ( Resume(..), History(..), - execStmt, ExecOptions(..), execOptions, ExecResult(..), resumeExec, - runDecls, runDeclsWithLocation, + execStmt, execStmt', ExecOptions(..), execOptions, ExecResult(..), resumeExec, + runDecls, runDeclsWithLocation, runParsedDecls, isStmt, hasImport, isImport, isDecl, parseImportDecl, SingleStep(..), abandon, abandonAll, @@ -165,23 +165,40 @@ execStmt => String -- ^ a statement (bind or expression) -> ExecOptions -> m ExecResult -execStmt stmt ExecOptions{..} = do +execStmt input exec_opts@ExecOptions{..} = do + hsc_env <- getSession + + mb_stmt <- + liftIO $ + runInteractiveHsc hsc_env $ + hscParseStmtWithLocation execSourceFile execLineNumber input + + case mb_stmt of + -- empty statement / comment + Nothing -> return (ExecComplete (Right []) 0) + Just stmt -> execStmt' stmt input exec_opts + +-- | Like `execStmt`, but takes a parsed statement as argument. Useful when +-- doing preprocessing on the AST before execution, e.g. in GHCi (see +-- GHCi.UI.runStmt). +execStmt' :: GhcMonad m => GhciLStmt GhcPs -> String -> ExecOptions -> m ExecResult +execStmt' stmt stmt_text ExecOptions{..} = do hsc_env <- getSession -- Turn off -fwarn-unused-local-binds when running a statement, to hide -- warnings about the implicit bindings we introduce. + -- (This is basically `mkInteractiveHscEnv hsc_env`, except we unset + -- -wwarn-unused-local-binds) let ic = hsc_IC hsc_env -- use the interactive dflags idflags' = ic_dflags ic `wopt_unset` Opt_WarnUnusedLocalBinds - hsc_env' = hsc_env{ hsc_IC = ic{ ic_dflags = idflags' } } + hsc_env' = mkInteractiveHscEnv (hsc_env{ hsc_IC = ic{ ic_dflags = idflags' } }) - -- compile to value (IO [HValue]), don't run - r <- liftIO $ hscStmtWithLocation hsc_env' stmt - execSourceFile execLineNumber + r <- liftIO $ hscParsedStmt hsc_env' stmt case r of - -- empty statement / comment - Nothing -> return (ExecComplete (Right []) 0) - + Nothing -> + -- empty statement / comment + return (ExecComplete (Right []) 0) Just (ids, hval, fix_env) -> do updateFixityEnv fix_env @@ -195,20 +212,27 @@ execStmt stmt ExecOptions{..} = do size = ghciHistSize idflags' - handleRunStatus execSingleStep stmt bindings ids + handleRunStatus execSingleStep stmt_text bindings ids status (emptyHistory size) - runDecls :: GhcMonad m => String -> m [Name] runDecls = runDeclsWithLocation "<interactive>" 1 -- | Run some declarations and return any user-visible names that were brought -- into scope. runDeclsWithLocation :: GhcMonad m => String -> Int -> String -> m [Name] -runDeclsWithLocation source linenumber expr = - do +runDeclsWithLocation source line_num input = do + hsc_env <- getSession + decls <- liftIO (hscParseDeclsWithLocation hsc_env source line_num input) + runParsedDecls decls + +-- | Like `runDeclsWithLocation`, but takes parsed declarations as argument. +-- Useful when doing preprocessing on the AST before execution, e.g. in GHCi +-- (see GHCi.UI.runStmt). +runParsedDecls :: GhcMonad m => [LHsDecl GhcPs] -> m [Name] +runParsedDecls decls = do hsc_env <- getSession - (tyThings, ic) <- liftIO $ hscDeclsWithLocation hsc_env expr source linenumber + (tyThings, ic) <- liftIO (hscParsedDecls hsc_env decls) setSession $ hsc_env { hsc_IC = ic } hsc_env <- getSession diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index 2cc055ae8a..d6d86fcecc 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -31,8 +31,8 @@ module GHCi.UI ( #include "HsVersions.h" -- GHCi -import qualified GHCi.UI.Monad as GhciMonad ( args, runStmt, runDecls ) -import GHCi.UI.Monad hiding ( args, runStmt, runDecls ) +import qualified GHCi.UI.Monad as GhciMonad ( args, runStmt, runDecls' ) +import GHCi.UI.Monad hiding ( args, runStmt ) import GHCi.UI.Tags import GHCi.UI.Info import Debugger @@ -50,10 +50,11 @@ import GHC ( LoadHowMuch(..), Target(..), TargetId(..), InteractiveImport(..), TyThing(..), Phase, BreakIndex, Resume, SingleStep, Ghc, GetDocsFailure(..), getModuleGraph, handleSourceError ) +import HscMain (hscParseDeclsWithLocation, hscParseStmtWithLocation) import HsImpExp import HsSyn import HscTypes ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, hsc_IC, - setInteractivePrintName, hsc_dflags, msObjFilePath ) + setInteractivePrintName, hsc_dflags, msObjFilePath, runInteractiveHsc ) import Module import Name import Packages ( trusted, getPackageDetails, getInstalledPackageDetails, @@ -82,6 +83,7 @@ import NameSet import Panic hiding ( showException ) import Util import qualified GHC.LanguageExtensions as LangExt +import Bag (unitBag) -- Haskell Libraries import System.Console.Haskeline as Haskeline @@ -1088,51 +1090,94 @@ enqueueCommands cmds = do -- | Entry point to execute some haskell code from user. -- The return value True indicates success, as in `runOneCommand`. runStmt :: String -> SingleStep -> GHCi (Maybe GHC.ExecResult) -runStmt stmt step = do +runStmt input step = do dflags <- GHC.getInteractiveDynFlags -- In GHCi, we disable `-fdefer-type-errors`, as well as `-fdefer-type-holes` -- and `-fdefer-out-of-scope-variables` for **naked expressions**. The -- declarations and statements are not affected. -- See Note [Deferred type errors in GHCi] in typecheck/TcRnDriver.hs - if | GHC.isStmt dflags stmt -> run_stmt - | GHC.isImport dflags stmt -> run_import + st <- getGHCiState + let source = progname st + let line = line_number st + + if | GHC.isStmt dflags input -> do + hsc_env <- GHC.getSession + mb_stmt <- liftIO (runInteractiveHsc hsc_env (hscParseStmtWithLocation source line input)) + case mb_stmt of + Nothing -> + -- empty statement / comment + return (Just exec_complete) + Just stmt -> + run_stmt stmt + + | GHC.isImport dflags input -> run_import + -- Every import declaration should be handled by `run_import`. As GHCi -- in general only accepts one command at a time, we simply throw an -- exception when the input contains multiple commands of which at least -- one is an import command (see #10663). - | GHC.hasImport dflags stmt -> throwGhcException + | GHC.hasImport dflags input -> throwGhcException (CmdLineError "error: expecting a single import declaration") + + -- Otherwise assume a declaration (or a list of declarations) -- Note: `GHC.isDecl` returns False on input like -- `data Infix a b = a :@: b; infixl 4 :@:` -- and should therefore not be used here. - | otherwise -> run_decl - + | otherwise -> do + hsc_env <- GHC.getSession + decls <- liftIO (hscParseDeclsWithLocation hsc_env source line input) + run_decls decls where + exec_complete = GHC.ExecComplete (Right []) 0 + run_import = do - addImportToContext stmt - return (Just (GHC.ExecComplete (Right []) 0)) + addImportToContext input + return (Just exec_complete) - run_decl = - do _ <- liftIO $ tryIO $ hFlushAll stdin - m_result <- GhciMonad.runDecls stmt - case m_result of - Nothing -> return Nothing - Just result -> - Just <$> afterRunStmt (const True) - (GHC.ExecComplete (Right result) 0) - - run_stmt = - do -- In the new IO library, read handles buffer data even if the Handle - -- is set to NoBuffering. This causes problems for GHCi where there - -- are really two stdin Handles. So we flush any bufferred data in - -- GHCi's stdin Handle here (only relevant if stdin is attached to - -- a file, otherwise the read buffer can't be flushed). - _ <- liftIO $ tryIO $ hFlushAll stdin - m_result <- GhciMonad.runStmt stmt step + run_stmt :: GhciLStmt GhcPs -> GHCi (Maybe GHC.ExecResult) + run_stmt stmt = do + m_result <- GhciMonad.runStmt stmt input step case m_result of Nothing -> return Nothing Just result -> Just <$> afterRunStmt (const True) result + -- `x = y` (a declaration) should be treated as `let x = y` (a statement). + -- The reason is because GHCi wasn't designed to support `x = y`, but then + -- b98ff3 (#7253) added support for it, except it did not do a good job and + -- caused problems like: + -- + -- - not adding the binders defined this way in the necessary places caused + -- `x = y` to not work in some cases (#12091). + -- - some GHCi command crashed after `x = y` (#15721) + -- - warning generation did not work for `x = y` (#11606) + -- - because `x = y` is a declaration (instead of a statement) differences + -- in generated code caused confusion (#16089) + -- + -- Instead of dealing with all these problems individually here we fix this + -- mess by just treating `x = y` as `let x = y`. + run_decls :: [LHsDecl GhcPs] -> GHCi (Maybe GHC.ExecResult) + -- Only turn `FunBind` and `VarBind` into statements, other bindings + -- (e.g. `PatBind`) need to stay as decls. + run_decls [L l (ValD _ bind@FunBind{})] = run_stmt (mk_stmt l bind) + run_decls [L l (ValD _ bind@VarBind{})] = run_stmt (mk_stmt l bind) + -- Note that any `x = y` declarations below will be run as declarations + -- instead of statements (e.g. `...; x = y; ...`) + run_decls decls = do + -- In the new IO library, read handles buffer data even if the Handle + -- is set to NoBuffering. This causes problems for GHCi where there + -- are really two stdin Handles. So we flush any bufferred data in + -- GHCi's stdin Handle here (only relevant if stdin is attached to + -- a file, otherwise the read buffer can't be flushed). + _ <- liftIO $ tryIO $ hFlushAll stdin + m_result <- GhciMonad.runDecls' decls + forM m_result $ \result -> + afterRunStmt (const True) (GHC.ExecComplete (Right result) 0) + + mk_stmt :: SrcSpan -> HsBind GhcPs -> GhciLStmt GhcPs + mk_stmt loc bind = + let l = L loc + in l (LetStmt noExt (l (HsValBinds noExt (ValBinds noExt (unitBag (l bind)) [])))) + -- | Clean up the GHCi environment after a statement has run afterRunStmt :: (SrcSpan -> Bool) -> GHC.ExecResult -> GHCi GHC.ExecResult afterRunStmt step_here run_result = do diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs index 969111b214..cbf527e623 100644 --- a/ghc/GHCi/UI/Monad.hs +++ b/ghc/GHCi/UI/Monad.hs @@ -20,7 +20,7 @@ module GHCi.UI.Monad ( TickArray, getDynFlags, - runStmt, runDecls, resume, timeIt, recordBreak, revertCAFs, + runStmt, runDecls, runDecls', resume, timeIt, recordBreak, revertCAFs, printForUserNeverQualify, printForUserModInfo, printForUser, printForUserPartWay, prettyLocations, @@ -46,7 +46,7 @@ import SrcLoc import Module import GHCi import GHCi.RemoteTypes -import HsSyn (ImportDecl, GhcPs) +import HsSyn (ImportDecl, GhcPs, GhciLStmt, LHsDecl) import Util import Exception @@ -338,8 +338,8 @@ printForUserPartWay doc = do liftIO $ Outputable.printForUserPartWay dflags stdout (pprUserLength dflags) unqual doc -- | Run a single Haskell expression -runStmt :: String -> GHC.SingleStep -> GHCi (Maybe GHC.ExecResult) -runStmt expr step = do +runStmt :: GhciLStmt GhcPs -> String -> GHC.SingleStep -> GHCi (Maybe GHC.ExecResult) +runStmt stmt stmt_text step = do st <- getGHCiState GHC.handleSourceError (\e -> do GHC.printException e; return Nothing) $ do let opts = GHC.execOptions @@ -348,7 +348,7 @@ runStmt expr step = do , GHC.execSingleStep = step , GHC.execWrap = \fhv -> EvalApp (EvalThis (evalWrapper st)) (EvalThis fhv) } - Just <$> GHC.execStmt expr opts + Just <$> GHC.execStmt' stmt stmt_text opts runDecls :: String -> GHCi (Maybe [GHC.Name]) runDecls decls = do @@ -362,6 +362,18 @@ runDecls decls = do r <- GHC.runDeclsWithLocation (progname st) (line_number st) decls return (Just r) +runDecls' :: [LHsDecl GhcPs] -> GHCi (Maybe [GHC.Name]) +runDecls' decls = do + st <- getGHCiState + reifyGHCi $ \x -> + withProgName (progname st) $ + withArgs (args st) $ + reflectGHCi x $ + GHC.handleSourceError + (\e -> do GHC.printException e; + return Nothing) + (Just <$> GHC.runParsedDecls decls) + resume :: (SrcSpan -> Bool) -> GHC.SingleStep -> GHCi GHC.ExecResult resume canLogSpan step = do st <- getGHCiState diff --git a/testsuite/tests/ghci/scripts/T11606.script b/testsuite/tests/ghci/scripts/T11606.script new file mode 100644 index 0000000000..0fb5fff7ad --- /dev/null +++ b/testsuite/tests/ghci/scripts/T11606.script @@ -0,0 +1,5 @@ +:set -Wall +x = 1 :: Int +x = 1 :: Int +x <- return (1 :: Int) +let x = 1 :: Int diff --git a/testsuite/tests/ghci/scripts/T11606.stderr b/testsuite/tests/ghci/scripts/T11606.stderr new file mode 100644 index 0000000000..bbfb7406c6 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T11606.stderr @@ -0,0 +1,12 @@ + +<interactive>:3:1: warning: [-Wname-shadowing (in -Wall)] + This binding for ‘x’ shadows the existing binding + defined at <interactive>:2:1 + +<interactive>:4:1: warning: [-Wname-shadowing (in -Wall)] + This binding for ‘x’ shadows the existing binding + defined at <interactive>:3:1 + +<interactive>:5:5: warning: [-Wname-shadowing (in -Wall)] + This binding for ‘x’ shadows the existing binding + defined at <interactive>:4:1 diff --git a/testsuite/tests/ghci/scripts/T16089.script b/testsuite/tests/ghci/scripts/T16089.script new file mode 100644 index 0000000000..d4e6676244 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T16089.script @@ -0,0 +1,4 @@ +x = [0 .. 100000] :: [Int] +:sprint x +x `seq` True +:sprint x diff --git a/testsuite/tests/ghci/scripts/T16089.stdout b/testsuite/tests/ghci/scripts/T16089.stdout new file mode 100644 index 0000000000..7d5cc0b192 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T16089.stdout @@ -0,0 +1,3 @@ +x = _ +True +x = 0 : _ diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index ad4a24f583..2567db4f3d 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -262,7 +262,7 @@ test('T12091', [extra_run_opts('-fobject-code')], ghci_script, ['T12091.script']) test('T12523', normal, ghci_script, ['T12523.script']) test('T12024', normal, ghci_script, ['T12024.script']) -test('T12158', expect_broken(12158), ghci_script, ['T12158.script']) +test('T12158', normal, ghci_script, ['T12158.script']) test('T12447', normal, ghci_script, ['T12447.script']) test('T10249', normal, ghci_script, ['T10249.script']) test('T12550', normal, ghci_script, ['T12550.script']) @@ -293,3 +293,5 @@ test('T15827', normal, ghci_script, ['T15827.script']) test('T15898', normal, ghci_script, ['T15898.script']) test('T15941', normal, ghci_script, ['T15941.script']) test('T16030', normal, ghci_script, ['T16030.script']) +test('T11606', normal, ghci_script, ['T11606.script']) +test('T16089', normal, ghci_script, ['T16089.script']) diff --git a/testsuite/tests/ghci/should_run/T12525.stdout b/testsuite/tests/ghci/should_run/T12525.stdout index 31049e14d1..652a5cdd03 100644 --- a/testsuite/tests/ghci/should_run/T12525.stdout +++ b/testsuite/tests/ghci/should_run/T12525.stdout @@ -1,3 +1,3 @@ -x :: () = _ +x :: () = () y :: () = () class Foo a diff --git a/testsuite/tests/ghci/should_run/T16096.script b/testsuite/tests/ghci/should_run/T16096.script new file mode 100644 index 0000000000..8fb9453fd8 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T16096.script @@ -0,0 +1,4 @@ +:set -ddump-ds -dsuppress-uniques +-- These two should desugar to same Core +let x = [1..] :: [Int] +x = [1..] :: [Int] diff --git a/testsuite/tests/ghci/should_run/T16096.stdout b/testsuite/tests/ghci/should_run/T16096.stdout new file mode 100644 index 0000000000..8b87b7d61c --- /dev/null +++ b/testsuite/tests/ghci/should_run/T16096.stdout @@ -0,0 +1,56 @@ + +==================== Desugared ==================== +letrec { + x :: [GHC.Types.Int] + [LclId] + x = let { + $dEnum :: GHC.Enum.Enum GHC.Types.Int + [LclId] + $dEnum = GHC.Enum.$fEnumInt } in + letrec { + x :: [GHC.Types.Int] + [LclId] + x = GHC.Enum.enumFrom + @ GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in + x; } in +GHC.Base.returnIO + @ [()] + (GHC.Types.: + @ () + (GHC.Prim.unsafeCoerce# + @ 'GHC.Types.LiftedRep + @ 'GHC.Types.LiftedRep + @ [GHC.Types.Int] + @ () + x) + (GHC.Types.[] @ ())) + + + +==================== Desugared ==================== +letrec { + x :: [GHC.Types.Int] + [LclId] + x = let { + $dEnum :: GHC.Enum.Enum GHC.Types.Int + [LclId] + $dEnum = GHC.Enum.$fEnumInt } in + letrec { + x :: [GHC.Types.Int] + [LclId] + x = GHC.Enum.enumFrom + @ GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in + x; } in +GHC.Base.returnIO + @ [()] + (GHC.Types.: + @ () + (GHC.Prim.unsafeCoerce# + @ 'GHC.Types.LiftedRep + @ 'GHC.Types.LiftedRep + @ [GHC.Types.Int] + @ () + x) + (GHC.Types.[] @ ())) + + diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T index ea734e74aa..004794b5e5 100644 --- a/testsuite/tests/ghci/should_run/all.T +++ b/testsuite/tests/ghci/should_run/all.T @@ -56,3 +56,5 @@ test('T15633b', extra_hc_opts("-package-db tc-plugin-ghci/pkg.plugins01/local.package.conf") ], ghci_script, ['T15633b.script']) + +test('T16096', just_ghci, ghci_script, ['T16096.script']) |