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

1 files changed, 8 insertions, 5 deletions

diff --git a/libraries/base/GHC/IO/Handle/Text.hs b/libraries/base/GHC/IO/Handle/Text.hs
index 4a5e4cf6e6..c53b4294b8 100644
--- a/libraries/base/GHC/IO/Handle/Text.hs
+++ b/libraries/base/GHC/IO/Handle/Text.hs
@@ -745,11 +745,14 @@ bufWrite h_@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