[commit: base] master: Ensure hGetBufSome does not cause potentially blocking reads (#5843) (370fc0b)

[Paolo Capriotti]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/370fc0b455f6a03283fbd5c0baa5d08d9115379d

>---------------------------------------------------------------

commit 370fc0b455f6a03283fbd5c0baa5d08d9115379d
Author: Paolo Capriotti <p.capriotti at gmail.com>
Date:   Tue Mar 27 16:37:06 2012 +0100

    Ensure hGetBufSome does not cause potentially blocking reads (#5843)
    
    When there is data in a handle buffer, never fetch more than the
    available number of elements, since that can cause a blocking read on
    Windows.

>---------------------------------------------------------------

 GHC/IO/Handle/Text.hs |    3 ++-
 1 files changed, 2 insertions(+), 1 deletions(-)

diff --git a/GHC/IO/Handle/Text.hs b/GHC/IO/Handle/Text.hs
index 280cebd..3eedae6 100644
--- a/GHC/IO/Handle/Text.hs
+++ b/GHC/IO/Handle/Text.hs
@@ -889,7 +889,8 @@ hGetBufSome h ptr count
                                         -- that bufReadNBNonEmpty will not
                                         -- issue another read.
             else
-              bufReadNBNonEmpty h_ buf (castPtr ptr) 0 count
+              let count' = min count (bufferElems buf)
+              in bufReadNBNonEmpty h_ buf (castPtr ptr) 0 count'
 
 haFD :: Handle__ -> FD
 haFD h_ at Handle__{..} =