hGetBuf: fix a case of a short read being returned (#4427)

[ghc-base.git] / GHC / IO / Handle / Text.hs

diff --git a/GHC/IO/Handle/Text.hs b/GHC/IO/Handle/Text.hs
index f05905c..cf2541f 100644 (file)
--- a/GHC/IO/Handle/Text.hs
+++ b/GHC/IO/Handle/Text.hs
@@ -861,7 +861,7 @@ bufReadEmpty h_@Handle__{..}
                 bufReadNonEmpty h_ buf' ptr so_far count
  where
   loop :: FD -> Int -> Int -> IO Int
-  loop fd off bytes | bytes <= 0 = return off
+  loop fd off bytes | bytes <= 0 = return (so_far + off)
   loop fd off bytes = do
     r <- RawIO.read (fd::FD) (ptr `plusPtr` off) (fromIntegral bytes)
     if r == 0
@@ -891,9 +891,9 @@ bufReadEmpty h_@Handle__{..}
 hGetBufSome :: Handle -> Ptr a -> Int -> IO Int
 hGetBufSome h ptr count
   | count == 0 = return 0
-  | count <  0 = illegalBufferSize h "hGetBuf" count
+  | count <  0 = illegalBufferSize h "hGetBufSome" count
   | otherwise =
-      wantReadableHandle_ "hGetBuf" h $ \ h_@Handle__{..} -> do
+      wantReadableHandle_ "hGetBufSome" h $ \ h_@Handle__{..} -> do
          flushCharReadBuffer h_
          buf@Buffer{ bufSize=sz } <- readIORef haByteBuffer
          if isEmptyBuffer buf
@@ -903,7 +903,10 @@ hGetBufSome h ptr count
                             if r == 0
                                then return 0
                                else do writeIORef haByteBuffer buf'
-                                       bufReadNBNonEmpty h_ buf' (castPtr ptr) 0 count
+                                       bufReadNBNonEmpty h_ buf' (castPtr ptr) 0 (min r count)
+                                        -- new count is  (min r count), so
+                                        -- that bufReadNBNonEmpty will not
+                                        -- issue another read.
             else
               bufReadNBEmpty h_ buf (castPtr ptr) 0 count
 
@@ -949,7 +952,7 @@ bufReadNBEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
 bufReadNBEmpty   h_@Handle__{..}
                  buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
                  ptr so_far count
-  | count > sz, False,
+  | count > sz,
     Just fd <- cast haDevice = do
        m <- RawIO.readNonBlocking (fd::FD) ptr count
        case m of