X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIO%2FHandle%2FText.hs;fp=GHC%2FIO%2FHandle%2FText.hs;h=ebb29c8545bc7c53616ab6597c6e943dbc1e9405;hb=3efe74f3acd0dff20d078b6e8416664193b219d4;hp=745dc183be06dcc7b2ff2e00f3ffd99932cad1c9;hpb=1f35ed03ae66a8a3dcc689a7bdea02b935077d44;p=ghc-base.git

diff --git a/GHC/IO/Handle/Text.hs b/GHC/IO/Handle/Text.hs
index 745dc18..ebb29c8 100644
--- a/GHC/IO/Handle/Text.hs
+++ b/GHC/IO/Handle/Text.hs
@@ -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