[commit: ghc] master: Fix: hPutBuf issues unnecessary empty write syscalls for large writes (#13246) (805db96)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/805db96544111bd548c9a32488a9c97996cc2b49/ghc

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

commit 805db96544111bd548c9a32488a9c97996cc2b49
Author: Niklas Hambüchen <mail at nh2.me>
Date:   Sat Feb 11 19:24:30 2017 -0500

    Fix: hPutBuf issues unnecessary empty write syscalls for large writes (#13246)
    
    Until now, any `hPutBuf` that wrote `>= the handle buffer size` would
    trigger an unnecessary `write("")` system call before the actual write
    system call.
    
    This is fixed by making sure that we never flush an empty handle buffer:
    Only flush `when (w > 0)`.
    
    Reviewers: simonmar, austin, hvr, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D3119


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

805db96544111bd548c9a32488a9c97996cc2b49
 libraries/base/GHC/IO/Handle/Text.hs | 13 ++++++++-----
 1 file changed, 8 insertions(+), 5 deletions(-)

diff --git a/libraries/base/GHC/IO/Handle/Text.hs b/libraries/base/GHC/IO/Handle/Text.hs
index 4a5e4cf..c53b429 100644
--- a/libraries/base/GHC/IO/Handle/Text.hs
+++ b/libraries/base/GHC/IO/Handle/Text.hs
@@ -745,11 +745,14 @@ bufWrite h_ at Handle__{..} ptr count can_block =
                 writeIORef haByteBuffer old_buf{ bufR = w + count }
                 return count
 
-        -- else, we have to flush
-        else do debugIO "hPutBuf: flushing first"
-                old_buf' <- Buffered.flushWriteBuffer haDevice old_buf
-                        -- TODO: we should do a non-blocking flush here
-                writeIORef haByteBuffer old_buf'
+        -- else, we have to flush any existing handle buffer data
+        -- and can then write out the data in `ptr` directly.
+        else do -- No point flushing when there's nothing in the buffer.
+                when (w > 0) $ do
+                  debugIO "hPutBuf: flushing first"
+                  flushed_buf <- Buffered.flushWriteBuffer haDevice old_buf
+                          -- TODO: we should do a non-blocking flush here
+                  writeIORef haByteBuffer flushed_buf
                 -- if we can fit in the buffer, then just loop
                 if count < size
                    then bufWrite h_ ptr count can_block