EventLog: Loop fwrite if necessary during flush

Previously the eventlog flush code would fail if `fwrite` wrote less
than the requested amount. Like all Unix stream I/O operations, however,
`fwrite` isn't guaranteed to write the entire buffer. Here we loop as
long as `fwrite` succeeds in writing anything.

Fixes #11041.

Test Plan: Validate with eventlog

Reviewers: austin, simonmar

Reviewed By: simonmar

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1415

GHC Trac Issues: #11041

1 files changed, 12 insertions, 10 deletions

diff --git a/rts/eventlog/EventLog.c b/rts/eventlog/EventLog.c
index 2153942648..db103a7f3c 100644
--- a/rts/eventlog/EventLog.c
+++ b/rts/eventlog/EventLog.c
@@ -1100,20 +1100,22 @@ void postBlockMarker (EventsBuf *eb)
 
 void printAndClearEventBuf (EventsBuf *ebuf)
 {
-    StgWord64 numBytes = 0, written = 0;
-
     closeBlockMarker(ebuf);
 
     if (ebuf->begin != NULL && ebuf->pos != ebuf->begin)
     {
-        numBytes = ebuf->pos - ebuf->begin;
-
-        written = fwrite(ebuf->begin, 1, numBytes, event_log_file);
-        if (written != numBytes) {
-            debugBelch(
-                "printAndClearEventLog: fwrite() failed, written=%" FMT_Word64
-                " doesn't match numBytes=%" FMT_Word64, written, numBytes);
-            return;
+        StgInt8 *begin = ebuf->begin;
+        while (begin < ebuf->pos) {
+            StgWord64 remain = ebuf->pos - begin;
+            StgWord64 written = fwrite(begin, 1, remain, event_log_file);
+            if (written == 0) {
+                debugBelch(
+                    "printAndClearEventLog: fwrite() failed to write anything;"
+                    " tried to write numBytes=%" FMT_Word64, remain);
+                resetEventsBuf(ebuf);
+                return;
+            }
+            begin += written;
         }
 
         resetEventsBuf(ebuf);