[project @ 2001-06-29 12:45:39 by simonmar]

Fix a bug in hGetContents, namely that it wasn't closing the handle
when the end of file was reached.  Also tried to tidy the code up a
bit while I was here.

diff --git a/ghc/lib/std/PrelHandle.hsc b/ghc/lib/std/PrelHandle.hsc
index 9c72ab2..a7e51d2 100644 (file)
--- a/ghc/lib/std/PrelHandle.hsc
+++ b/ghc/lib/std/PrelHandle.hsc
@@ -4,7 +4,7 @@
 #undef DEBUG
 
 -- -----------------------------------------------------------------------------
--- $Id: PrelHandle.hsc,v 1.10 2001/06/22 12:36:33 rrt Exp $
+-- $Id: PrelHandle.hsc,v 1.11 2001/06/29 12:45:39 simonmar Exp $
 --
 -- (c) The University of Glasgow, 1994-2001
 --
@@ -22,9 +22,11 @@ module PrelHandle (
 
   stdin, stdout, stderr,
   IOMode(..), IOModeEx(..), openFile, openFileEx, openFd,
-  hClose, hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
+  hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
   hFlush, 
 
+  hClose, hClose_help,
+
   HandlePosn(..), hGetPosn, hSetPosn,
   SeekMode(..), hSeek,
 
@@ -127,9 +129,7 @@ but we might want to revisit this in the future --SDM ].
 {-# INLINE withHandle #-}
 withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
 withHandle fun h@(FileHandle m)     act = withHandle' fun h m act
-withHandle fun h@(DuplexHandle r w) act = do 
-  withHandle' fun h r act
-  withHandle' fun h w act
+withHandle fun h@(DuplexHandle m _) act = withHandle' fun h m act
 
 withHandle' fun h m act = 
    block $ do
@@ -764,8 +764,9 @@ hClose h@(DuplexHandle r w) = do
                  haType = ClosedHandle
                 }
 
-hClose' h m =
-  withHandle__' "hClose" h m $ \ handle_ -> do
+hClose' h m = withHandle__' "hClose" h m $ hClose_help
+
+hClose_help handle_ =
   case haType handle_ of 
       ClosedHandle -> return handle_
       _ -> do
@@ -1164,18 +1165,20 @@ hIsTerminalDevice handle = do
 
 #ifdef _WIN32
 hSetBinaryMode handle bin = 
-  withHandle "hSetBinaryMode" handle $ \ handle_ ->
+  withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
     do let flg | bin       = (#const O_BINARY)
               | otherwise = (#const O_TEXT)
        throwErrnoIfMinus1_ "hSetBinaryMode"
           (setmode (fromIntegral (haFD handle_)) flg)
-       return (handle_{haIsBin=bin}, ())
+       return handle_{haIsBin=bin}
+  return ()
 
 foreign import "setmode" setmode :: CInt -> CInt -> IO CInt
 #else
-hSetBinaryMode handle bin =
-  withHandle "hSetBinaryMode" handle $ \ handle_ ->
-    return (handle_{haIsBin=bin}, ())
+hSetBinaryMode handle bin = do
+  withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
+    return handle_{haIsBin=bin}
+  return ()
 #endif
 
 -- -----------------------------------------------------------------------------

diff --git a/ghc/lib/std/PrelIO.hsc b/ghc/lib/std/PrelIO.hsc
index a8573ba..637d64f 100644 (file)
--- a/ghc/lib/std/PrelIO.hsc
+++ b/ghc/lib/std/PrelIO.hsc
@@ -3,7 +3,7 @@
 #undef DEBUG_DUMP
 
 -- -----------------------------------------------------------------------------
--- $Id: PrelIO.hsc,v 1.5 2001/06/22 12:36:33 rrt Exp $
+-- $Id: PrelIO.hsc,v 1.6 2001/06/29 12:45:39 simonmar Exp $
 --
 -- (c) The University of Glasgow, 1992-2001
 --
@@ -251,6 +251,16 @@ hGetLineBufferedLoop handle_ ref
                     hGetLineBufferedLoop handle_ ref new_buf (xs:xss)
 
 
+maybeFillReadBuffer fd is_line buf
+  = catch 
+     (do buf <- fillReadBuffer fd is_line buf
+        return (Just buf)
+     )
+     (\e -> do if isEOFError e 
+                 then return Nothing 
+                 else throw e)
+
+
 unpack :: RawBuffer -> Int -> Int -> IO [Char]
 unpack buf r 0   = return ""
 unpack buf (I## r) (I## len) = IO $ \s -> unpack [] (len -## 1##) s
@@ -297,12 +307,8 @@ hGetLineUnBuffered h = do
 -- carry on writing to it afterwards.
 
 hGetContents :: Handle -> IO String
-hGetContents handle@(DuplexHandle r w) 
-  = withHandle' "hGetContents" handle r (hGetContents' handle)
-hGetContents handle@(FileHandle m) 
-  = withHandle' "hGetContents" handle m (hGetContents' handle)
-
-hGetContents' handle handle_ = 
+hGetContents handle = 
+    withHandle "hGetContents" handle $ \handle_ ->
     case haType handle_ of 
       ClosedHandle        -> ioe_closedHandle
       SemiClosedHandle            -> ioe_closedHandle
@@ -318,9 +324,9 @@ hGetContents' handle handle_ =
 lazyRead :: Handle -> IO String
 lazyRead handle = 
    unsafeInterleaveIO $
-       withHandle_ "lazyRead" handle $ \ handle_ -> do
+       withHandle "lazyRead" handle $ \ handle_ -> do
        case haType handle_ of
-         ClosedHandle     -> return ""
+         ClosedHandle     -> return (handle_, "")
          SemiClosedHandle -> lazyRead' handle handle_
          _ -> ioException 
                  (IOError (Just handle) IllegalOperation "lazyRead"
@@ -334,7 +340,7 @@ lazyRead' h handle_ = do
   -- (see hLookAhead)
   buf <- readIORef ref
   if not (bufferEmpty buf)
-       then lazyReadBuffered h fd ref buf
+       then lazyReadHaveBuffer h handle_ fd ref buf
        else do
 
   case haBufferMode handle_ of
@@ -342,41 +348,36 @@ lazyRead' h handle_ = do
        -- make use of the minimal buffer we already have
        let raw = bufBuf buf
            fd  = haFD handle_
-       r <- throwErrnoIfMinus1RetryMayBlock "hGetChar"
+       r <- throwErrnoIfMinus1RetryMayBlock "lazyRead"
                (read_off (fromIntegral fd) raw 0 1)
                (threadWaitRead fd)
        if r == 0
-          then return ""
+          then do handle_ <- hClose_help handle_ 
+                  return (handle_, "")
           else do (c,_) <- readCharFromBuffer raw 0
                   rest <- lazyRead h
-                  return (c : rest)
+                  return (handle_, c : rest)
 
-     LineBuffering    -> lazyReadBuffered h fd ref buf
-     BlockBuffering _ -> lazyReadBuffered h fd ref buf
+     LineBuffering    -> lazyReadBuffered h handle_ fd ref buf
+     BlockBuffering _ -> lazyReadBuffered h handle_ fd ref buf
 
 -- we never want to block during the read, so we call fillReadBuffer with
 -- is_line==True, which tells it to "just read what there is".
-lazyReadBuffered h fd ref buf = do
-   maybe_new_buf <- 
-       if bufferEmpty buf 
-          then maybeFillReadBuffer fd True buf
-          else return (Just buf)
-   case maybe_new_buf of
-       Nothing  -> return ""
-       Just buf -> do
-          more <- lazyRead h
-          writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
-          unpackAcc (bufBuf buf) (bufRPtr buf) (bufWPtr buf) more
-
-
-maybeFillReadBuffer fd is_line buf
-  = catch 
-     (do buf <- fillReadBuffer fd is_line buf
-        return (Just buf)
-     )
-     (\e -> if isEOFError e 
-               then return Nothing 
-               else throw e)
+lazyReadBuffered h handle_ fd ref buf = do
+   catch 
+       (do buf <- fillReadBuffer fd True{-is_line-} buf
+           lazyReadHaveBuffer h handle_ fd ref buf
+       )
+       -- all I/O errors are discarded.  Additionally, we close the handle.
+       (\e -> do handle_ <- hClose_help handle_
+                 return (handle_, "")
+       )
+
+lazyReadHaveBuffer h handle_ fd ref buf = do
+   more <- lazyRead h
+   writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
+   s <- unpackAcc (bufBuf buf) (bufRPtr buf) (bufWPtr buf) more
+   return (handle_, s)
 
 
 unpackAcc :: RawBuffer -> Int -> Int -> [Char] -> IO [Char]