From: Ian Lynagh <igloo@earth.li>
Date: Sat, 16 Aug 2008 18:27:15 +0000 (+0000)
Subject: Fix hReady (trac #1063)
X-Git-Tag: 6_10_branch_has_been_forked~41
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=b1c845d526296f874ef33fd1a4568c7dfe63c55b;p=ghc-base.git

Fix hReady (trac #1063)
We now throw an EOF exception when appropriate
---

diff --git a/GHC/Handle.hs b/GHC/Handle.hs
index 5cb0a40..e94d2d5 100644
--- a/GHC/Handle.hs
+++ b/GHC/Handle.hs
@@ -38,7 +38,7 @@ module GHC.Handle (
 
   stdin, stdout, stderr,
   IOMode(..), openFile, openBinaryFile, fdToHandle_stat, fdToHandle, fdToHandle',
-  hFileSize, hSetFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
+  hFileSize, hSetFileSize, hIsEOF, isEOF, hLookAhead, hLookAhead', hSetBuffering, hSetBinaryMode,
   hFlush, hDuplicate, hDuplicateTo,
 
   hClose, hClose_help,
@@ -1245,8 +1245,11 @@ isEOF = hIsEOF stdin
 --  * 'isEOFError' if the end of file has been reached.
 
 hLookAhead :: Handle -> IO Char
-hLookAhead handle = do
-  wantReadableHandle "hLookAhead"  handle $ \handle_ -> do
+hLookAhead handle =
+  wantReadableHandle "hLookAhead"  handle hLookAhead'
+
+hLookAhead' :: Handle__ -> IO Char
+hLookAhead' handle_ = do
   let ref     = haBuffer handle_
       fd      = haFD handle_
       is_line = haBufferMode handle_ == LineBuffering
@@ -1256,7 +1259,7 @@ hLookAhead handle = do
   new_buf <- if bufferEmpty buf
                 then fillReadBuffer fd True (haIsStream handle_) buf
                 else return buf
-  
+
   writeIORef ref new_buf
 
   (c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf)
diff --git a/GHC/IO.hs b/GHC/IO.hs
index 7ca3e6e..a5e34f2 100644
--- a/GHC/IO.hs
+++ b/GHC/IO.hs
@@ -93,7 +93,11 @@ hWaitForInput h msecs = do
                      fdReady (haFD handle_) 0 {- read -}
                                 (fromIntegral msecs)
                                 (fromIntegral $ fromEnum $ haIsStream handle_)
-                return (r /= 0)
+                if r /= 0 then do -- Call hLookAhead' to throw an EOF
+                                  -- exception if appropriate
+                                  hLookAhead' handle_
+                                  return True
+                          else return False
 
 foreign import ccall safe "fdReady"
   fdReady :: CInt -> CInt -> CInt -> CInt -> IO CInt