From 3b497ddb231981bc6aeb5533426bf632ba126e39 Mon Sep 17 00:00:00 2001
From: "Dr. ERDI Gergo" <gergo@erdi.hu>
Date: Sun, 21 Dec 2014 15:07:43 +0800
Subject: Check dflags for language extensions when deciding if "foreign " and
 "deriving " look like prefixes of valid declarations (fixes #9915)

---
 ghc/InteractiveUI.hs                         | 51 +++++++++++++++++-----------
 testsuite/tests/ghci/should_run/T9915.script |  5 +++
 testsuite/tests/ghci/should_run/all.T        |  1 +
 3 files changed, 38 insertions(+), 19 deletions(-)
 create mode 100644 testsuite/tests/ghci/should_run/T9915.script

diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index a1f0dba2f4..4a296dabd0 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -877,9 +877,17 @@ enqueueCommands cmds = do
 
 -- | If we one of these strings prefixes a command, then we treat it as a decl
 -- rather than a stmt.
-declPrefixes :: [String]
-declPrefixes = ["class ","data ","newtype ","type ","instance ", "deriving ",
-                "foreign ", "default ", "default("]
+declPrefixes :: DynFlags -> [String]
+declPrefixes dflags = keywords ++ concat opt_keywords
+  where
+    keywords = [ "class ", "instance "
+               , "data ", "newtype ", "type "
+               , "default ", "default("
+               ]
+
+    opt_keywords = [ ["foreign "  | xopt Opt_ForeignFunctionInterface dflags]
+                   , ["deriving " | xopt Opt_StandaloneDeriving dflags]
+                   ]
 
 -- | Entry point to execute some haskell code from user
 runStmt :: String -> SingleStep -> GHCi Bool
@@ -892,23 +900,28 @@ runStmt stmt step
  | "import " `isPrefixOf` stmt
  = do addImportToContext stmt; return False
 
- -- data, class, newtype...
- | any (flip isPrefixOf stmt) declPrefixes
- = do _ <- liftIO $ tryIO $ hFlushAll stdin
-      result <- GhciMonad.runDecls stmt
-      afterRunStmt (const True) (GHC.RunOk result)
-
  | otherwise
- = 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
-      case m_result of
-        Nothing     -> return False
-        Just result -> afterRunStmt (const True) result
+ = do dflags <- getDynFlags
+      if any (`isPrefixOf` stmt) (declPrefixes dflags)
+        then run_decl
+        else run_stmt
+  where
+    run_decl =
+        do _ <- liftIO $ tryIO $ hFlushAll stdin
+           result <- GhciMonad.runDecls stmt
+           afterRunStmt (const True) (GHC.RunOk result)
+
+    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
+           case m_result of
+               Nothing     -> return False
+               Just result -> afterRunStmt (const True) result
 
 -- | Clean up the GHCi environment after a statement has run
 afterRunStmt :: (SrcSpan -> Bool) -> GHC.RunResult -> GHCi Bool
diff --git a/testsuite/tests/ghci/should_run/T9915.script b/testsuite/tests/ghci/should_run/T9915.script
new file mode 100644
index 0000000000..d504e05e2c
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T9915.script
@@ -0,0 +1,5 @@
+:set -XHaskell98
+foreign = 42
+let foreign = 42
+foreign
+foreign -- Note extra space after name!
diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T
index c42681fcd3..effad6a725 100644
--- a/testsuite/tests/ghci/should_run/all.T
+++ b/testsuite/tests/ghci/should_run/all.T
@@ -20,3 +20,4 @@ test('T3171',
 
 test('ghcirun004', just_ghci, compile_and_run, [''])
 test('T8377',      just_ghci, compile_and_run, [''])
+test('T9915',      just_ghci, ghci_script, ['T9915.script'])
-- 
cgit v1.2.1