diff options
-rw-r--r-- | compiler/main/GHC.hs | 2 | ||||
-rw-r--r-- | compiler/main/InteractiveEval.hs | 17 | ||||
-rw-r--r-- | ghc/GHCi/UI.hs | 17 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/T10663.script | 1 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/T10663.stderr | 1 | ||||
-rwxr-xr-x | testsuite/tests/ghci/scripts/all.T | 1 |
6 files changed, 29 insertions, 10 deletions
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 31f809c716..2dad92a482 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -132,7 +132,7 @@ module GHC ( -- ** Other runTcInteractive, -- Desired by some clients (Trac #8878) - isStmt, isImport, isDecl, + isStmt, hasImport, isImport, isDecl, -- ** The debugger SingleStep(..), diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index e1f2cfcbd0..013be3c07f 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -14,7 +14,7 @@ module InteractiveEval ( Resume(..), History(..), execStmt, ExecOptions(..), execOptions, ExecResult(..), resumeExec, runDecls, runDeclsWithLocation, - isStmt, isImport, isDecl, + isStmt, hasImport, isImport, isDecl, parseImportDecl, SingleStep(..), resume, abandon, abandonAll, @@ -89,7 +89,7 @@ import Outputable import FastString import Bag import qualified Lexer (P (..), ParseResult(..), unP, mkPState) -import qualified Parser (parseStmt, parseModule, parseDeclaration) +import qualified Parser (parseStmt, parseModule, parseDeclaration, parseImport) import System.Directory import Data.Dynamic @@ -821,15 +821,22 @@ isStmt dflags stmt = Lexer.POk _ _ -> True Lexer.PFailed _ _ -> False --- | Returns @True@ if passed string is an import declaration. -isImport :: DynFlags -> String -> Bool -isImport dflags stmt = +-- | Returns @True@ if passed string has an import declaration. +hasImport :: DynFlags -> String -> Bool +hasImport dflags stmt = case parseThing Parser.parseModule dflags stmt of Lexer.POk _ thing -> hasImports thing Lexer.PFailed _ _ -> False where hasImports = not . null . hsmodImports . unLoc +-- | Returns @True@ if passed string is an import declaration. +isImport :: DynFlags -> String -> Bool +isImport dflags stmt = + case parseThing Parser.parseImport dflags stmt of + Lexer.POk _ _ -> True + Lexer.PFailed _ _ -> False + -- | Returns @True@ if passed string is a declaration but __/not a splice/__. isDecl :: DynFlags -> String -> Bool isDecl dflags stmt = do diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index 7bd9bbeb77..1303af554f 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -933,12 +933,21 @@ enqueueCommands cmds = do runStmt :: String -> SingleStep -> GHCi (Maybe GHC.ExecResult) runStmt stmt step = do dflags <- GHC.getInteractiveDynFlags - if | GHC.isStmt dflags stmt -> run_stmt - | GHC.isImport dflags stmt -> run_imports - | otherwise -> run_decl + if | GHC.isStmt dflags stmt -> run_stmt + | GHC.isImport dflags stmt -> 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 + (CmdLineError "error: expecting a single import declaration") + -- 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 where - run_imports = do + run_import = do addImportToContext stmt return (Just (GHC.ExecComplete (Right []) 0)) diff --git a/testsuite/tests/ghci/scripts/T10663.script b/testsuite/tests/ghci/scripts/T10663.script new file mode 100644 index 0000000000..10be57f52a --- /dev/null +++ b/testsuite/tests/ghci/scripts/T10663.script @@ -0,0 +1 @@ +import Data.List; sort [2, 1]
\ No newline at end of file diff --git a/testsuite/tests/ghci/scripts/T10663.stderr b/testsuite/tests/ghci/scripts/T10663.stderr new file mode 100644 index 0000000000..7170dbf29c --- /dev/null +++ b/testsuite/tests/ghci/scripts/T10663.stderr @@ -0,0 +1 @@ +error: expecting a single import declaration
\ No newline at end of file diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index da0ea0d55e..06a91259a8 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -225,6 +225,7 @@ test('T10466', normal, ghci_script, ['T10466.script']) test('T10501', normal, ghci_script, ['T10501.script']) test('T10508', normal, ghci_script, ['T10508.script']) test('T10520', normal, ghci_script, ['T10520.script']) +test('T10663', normal, ghci_script, ['T10663.script']) test('T10989', [ extra_clean(['dummy.hs', 'dummy.lhs', 'dummy.tags']) |