Always force the exception in enqueued commands
authorZejun Wu <watashi@watashi.ws>
Tue, 9 Jun 2015 10:42:38 +0000 (05:42 -0500)
committerAustin Seipp <austin@well-typed.com>
Tue, 9 Jun 2015 10:43:30 +0000 (05:43 -0500)
`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

ghc/InteractiveUI.hs
ghc/ghc-bin.cabal.in
testsuite/tests/ghci/scripts/T10501.script [new file with mode: 0644]
testsuite/tests/ghci/scripts/T10501.stderr [new file with mode: 0644]
testsuite/tests/ghci/scripts/all.T

index d2940fa..6e4880b 100644 (file)
@@ -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
 
index b4fdf10..30eb7a7 100644 (file)
@@ -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 (file)
index 0000000..06e75ec
--- /dev/null
@@ -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 (file)
index 0000000..6c3cc16
--- /dev/null
@@ -0,0 +1,2 @@
+*** Exception: Prelude.head: empty list
+*** Exception: Prelude.undefined
index a366c1f..f0d7c19 100755 (executable)
@@ -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'])