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

5 files changed, 14 insertions, 8 deletions

diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index d2940fa88a..6e4880b987 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 b4fdf1022a..30eb7a758d 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 0000000000..06e75ec251
--- /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 0000000000..6c3cc16efd
--- /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 a366c1f345..f0d7c192b1 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'])