[commit: ghc] master: Always force the exception in enqueued commands (3b55659)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/3b55659d4f54e503f4e550d762bc55a2650ed13d/ghc

>---------------------------------------------------------------

commit 3b55659d4f54e503f4e550d762bc55a2650ed13d
Author: Zejun Wu <watashi at watashi.ws>
Date:   Tue Jun 9 05:42:38 2015 -0500

    Always force the exception in enqueued commands
    
    `enqueueCommands` should always force exception in commands. Otherwise
    the exception thrown in `:cmd` (e.g. `:cmd return $ head []`) will cause
    GHCi to terminate with panic.
    
    Test Plan: `cd testsuite/tests/ghci/ && make`
    
    Reviewed By: austin
    
    Differential Revision: https://phabricator.haskell.org/D967
    
    GHC Trac Issues: #10501


>---------------------------------------------------------------

3b55659d4f54e503f4e550d762bc55a2650ed13d
 ghc/InteractiveUI.hs                       | 16 ++++++++--------
 ghc/ghc-bin.cabal.in                       |  1 +
 testsuite/tests/ghci/scripts/T10501.script |  2 ++
 testsuite/tests/ghci/scripts/T10501.stderr |  2 ++
 testsuite/tests/ghci/scripts/all.T         |  1 +
 5 files changed, 14 insertions(+), 8 deletions(-)

diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index d2940fa..6e4880b 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -64,11 +64,11 @@ import Util
 -- Haskell Libraries
 import System.Console.Haskeline as Haskeline
 
-import Control.Monad as Monad
-
 import Control.Applicative hiding (empty)
-import Control.Monad.Trans.Class
+import Control.DeepSeq (deepseq)
+import Control.Monad as Monad
 import Control.Monad.IO.Class
+import Control.Monad.Trans.Class
 
 import Data.Array
 import qualified Data.ByteString.Char8 as BS
@@ -881,8 +881,11 @@ checkInputForLayout stmt getStmt = do
 
 enqueueCommands :: [String] -> GHCi ()
 enqueueCommands cmds = do
-  st <- getGHCiState
-  setGHCiState st{ cmdqueue = cmds ++ cmdqueue st }
+  -- make sure we force any exceptions in the commands while we're
+  -- still inside the exception handler, otherwise bad things will
+  -- happen (see #10501)
+  cmds `deepseq` return ()
+  modifyGHCiState $ \st -> st{ cmdqueue = cmds ++ cmdqueue st }
 
 -- | If we one of these strings prefixes a command, then we treat it as a decl
 -- rather than a stmt. NB that the appropriate decl prefixes depends on the
@@ -1328,9 +1331,6 @@ defineMacro overwrite s = do
 runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
 runMacro fun s = do
   str <- liftIO ((unsafeCoerce# fun :: String -> IO String) s)
-  -- make sure we force any exceptions in the result, while we are still
-  -- inside the exception handler for commands:
-  seqList str (return ())
   enqueueCommands (lines str)
   return False
 
diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in
index b4fdf10..30eb7a7 100644
--- a/ghc/ghc-bin.cabal.in
+++ b/ghc/ghc-bin.cabal.in
@@ -43,6 +43,7 @@ Executable ghc
 
     GHC-Options: -Wall
     if flag(ghci)
+        Build-depends: deepseq >= 1.4 && < 1.5
         CPP-Options: -DGHCI
         GHC-Options: -fno-warn-name-shadowing
         Other-Modules:
diff --git a/testsuite/tests/ghci/scripts/T10501.script b/testsuite/tests/ghci/scripts/T10501.script
new file mode 100644
index 0000000..06e75ec
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T10501.script
@@ -0,0 +1,2 @@
+:cmd return $ head []
+:cmd return ('1':'2':undefined)
diff --git a/testsuite/tests/ghci/scripts/T10501.stderr b/testsuite/tests/ghci/scripts/T10501.stderr
new file mode 100644
index 0000000..6c3cc16
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T10501.stderr
@@ -0,0 +1,2 @@
+*** Exception: Prelude.head: empty list
+*** Exception: Prelude.undefined
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index a366c1f..f0d7c19 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -218,3 +218,4 @@ test('T10248', normal, ghci_script, ['T10248.script'])
 test('T10110', normal, ghci_script, ['T10110.script'])
 test('T10322', normal, ghci_script, ['T10322.script'])
 test('T10466', normal, ghci_script, ['T10466.script'])
+test('T10501', normal, ghci_script, ['T10501.script'])