From 6dda11d0244179dd9ca9ff54a12de47a01a976ca Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Thu, 5 Dec 2002 12:36:54 +0000
Subject: [PATCH] [project @ 2002-12-05 12:36:54 by simonmar] Don't put a
 recursive exception handler around the flushing of
 stdout/stderr after running a command.  If the user closes
 stdout or stderr, we now fail rather than going into an
 infinite loop.

---
 ghc/compiler/ghci/InteractiveUI.hs |   28 +++++++++++++++++-----------
 1 file changed, 17 insertions(+), 11 deletions(-)

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index af140e5..aa82735 100644
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -#include "Linker.h" -#include "SchedAPI.h" #-}
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.137 2002/10/17 14:49:52 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.138 2002/12/05 12:36:54 simonmar Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -334,16 +334,22 @@ readlineLoop = do
           	  if quit then return () else readlineLoop
 #endif
 
--- Top level exception handler, just prints out the exception 
--- and carries on.
 runCommand :: String -> GHCi Bool
-runCommand c = 
-  ghciHandle ( \exception -> do
-		flushInterpBuffers
-		showException exception
-		return False
-	     ) $
-  doCommand c
+runCommand c = ghciHandle handler (doCommand c)
+
+-- 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
+-- more exceptions to be raised.
+--
+-- Bugfix: if the user closed stdout or stderr, the flushing will fail,
+-- raising another exception.  We therefore don't put the recursive
+-- handler arond the flushing operation, so if stderr is closed
+-- GHCi will just die gracefully rather than going into an infinite loop.
+handler :: Exception -> GHCi Bool
+handler exception = do
+  flushInterpBuffers
+  ghciHandle handler (showException exception >> return False)
 
 showException (DynException dyn) =
   case fromDynamic dyn of
@@ -1009,7 +1015,7 @@ io m = GHCi { unGHCi = \s -> m >>= return }
 ghciHandle :: (Exception -> GHCi a) -> GHCi a -> GHCi a
 ghciHandle h (GHCi m) = GHCi $ \s -> 
    Exception.catch (m s) 
-	(\e -> unGHCi (ghciHandle h (ghciUnblock (h e))) s)
+	(\e -> unGHCi (ghciUnblock (h e)) s)
 
 ghciUnblock :: GHCi a -> GHCi a
 ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
-- 
1.7.10.4