From a1c063ae7150f7ca743bbbd81c2444c5fd6392d0 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Wed, 6 Jul 2005 10:43:36 +0000
Subject: [PATCH] [project @ 2005-07-06 10:43:36 by simonmar] ghc -e should
 exit(1) if the statement fails to compile.

Fixes #1233146 (this was already partially fixed, in that ghc -e would
exit(1) if the modules fail to compile, but if the expression itself
was invalid it would still exit(0)).
---
 ghc/compiler/ghci/InteractiveUI.hs |   32 +++++++++++++++++++++-----------
 1 file changed, 21 insertions(+), 11 deletions(-)

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index 5eeb1a3..174317e 100644
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -384,6 +384,11 @@ readlineLoop = do
 
 runCommand :: String -> GHCi Bool
 runCommand c = ghciHandle handler (doCommand c)
+  where 
+    doCommand (':' : command) = specialCommand command
+    doCommand stmt
+       = do timeIt (do nms <- runStmt stmt; finishEvalExpr nms)
+            return False
 
 -- This version is for the GHC command-line option -e.  The only difference
 -- from runCommand is that it catches the ExitException exception and
@@ -394,6 +399,14 @@ runCommandEval c = ghciHandle handleEval (doCommand c)
     handleEval e                    = do showException e
 				         io (exitWith (ExitFailure 1))
 
+    doCommand (':' : command) = specialCommand command
+    doCommand stmt
+       = do nms <- runStmt stmt
+	    case nms of 
+		Nothing -> io (exitWith (ExitFailure 1))
+		  -- failure to run the command causes exit(1) for ghc -e.
+		_       -> finishEvalExpr nms
+
 -- This is the exception handler for exceptions generated by the
 -- user's code; it normally just prints out the exception.  The
 -- handler must be recursive, in case showing the exception causes
@@ -420,29 +433,26 @@ showException (DynException dyn) =
 showException other_exception
   = io (putStrLn ("*** Exception: " ++ show other_exception))
 
-doCommand (':' : command) = specialCommand command
-doCommand stmt
-   = do timeIt (do nms <- runStmt stmt; finishEvalExpr nms)
-        return False
-
-runStmt :: String -> GHCi [Name]
+runStmt :: String -> GHCi (Maybe [Name])
 runStmt stmt
- | null (filter (not.isSpace) stmt) = return []
+ | null (filter (not.isSpace) stmt) = return (Just [])
  | otherwise
  = do st <- getGHCiState
       session <- getSession
       result <- io $ withProgName (progname st) $ withArgs (args st) $
 	     	     GHC.runStmt session stmt
       case result of
-	GHC.RunFailed      -> return []
+	GHC.RunFailed      -> return Nothing
 	GHC.RunException e -> throw e  -- this is caught by runCommand(Eval)
-	GHC.RunOk names    -> return names
+	GHC.RunOk names    -> return (Just names)
 
 -- possibly print the type and revert CAFs after evaluating an expression
-finishEvalExpr names
+finishEvalExpr mb_names
  = do b <- isOptionSet ShowType
       session <- getSession
-      when b (mapM_ (showTypeOfName session) names)
+      case mb_names of
+	Nothing    -> return ()      
+	Just names -> when b (mapM_ (showTypeOfName session) names)
 
       flushInterpBuffers
       io installSignalHandlers
-- 
1.7.10.4