[PATCH] Recognize '\r' for line buffering purposes

[Ludovic Courtès]

WDYT?

I’ll push it shortly if there are no objections.

Ludo’.

>From 8cc67b1087c32b4156668bfce8856306d7c23e1d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <address@hidden>
Date: Fri, 16 May 2014 11:38:17 +0200
Subject: [PATCH] Recognize '\r' as a line ending for line-buffering purposes.

* libguile/fports.c (contains_newline): New function.
  (fport_write): Use it when PORT has the SCM_BUFLINE flag.
* test-suite/tests/ports.test ("pipe, fdopen, and _IOLBF"): New test.
---
 libguile/fports.c           | 25 +++++++++++++++++++++++--
 test-suite/tests/ports.test | 23 +++++++++++++++++++++++
 2 files changed, 46 insertions(+), 2 deletions(-)

diff --git a/libguile/fports.c b/libguile/fports.c
index 29edc51..981e2af 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -736,6 +736,24 @@ fport_truncate (SCM port, scm_t_off length)
     scm_syserror ("ftruncate");
 }
 
+/* Return true if STR contains a newline character.  */
+static int
+contains_newline (const char *str, size_t len)
+{
+  size_t i;
+
+  for (i = 0; i < len; i++)
+    {
+      /* Honor both characters regardless of the end-of-line style.  On
+        Unix-style systems, carriage return goes to the beginning of
+        the line, so it can be considered a line ending.  */
+      if (str[i] == '\n' || str[i] == '\r')
+       return 1;
+    }
+
+  return 0;
+}
+
 static void
 fport_write (SCM port, const void *data, size_t size)
 #define FUNC_NAME "fport_write"
@@ -793,8 +811,11 @@ fport_write (SCM port, const void *data, size_t size)
        }
       }
 
-    /* handle line buffering.  */     
-    if ((SCM_CELL_WORD_0 (port) & SCM_BUFLINE) && memchr (data, '\n', size))
+    /* Handle line buffering.  */
+    if ((SCM_CELL_WORD_0 (port) & SCM_BUFLINE)
+       && contains_newline (data, size))
+      /* XXX: We're flushing the whole buffer, including what's after
+        the newline character(s).  */
       fport_flush (port);
   }
 }
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index c1a185f..f453aa4 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -623,6 +623,29 @@
             (equal? in-string "Mommy, why does everybody have a bomb?\n")))
   (delete-file filename))
 
+(pass-if-equal "pipe, fdopen, and _IOLBF"
+    "foo\nbar\r"
+  (let ((in+out (pipe))
+        (pid    (primitive-fork)))
+    (if (zero? pid)
+        (dynamic-wind
+          (const #t)
+          (lambda ()
+            (close (car in+out))
+            (let ((port (fdopen (fileno (cdr in+out)) "wl")))
+              ;; Strings containing '\n' or '\r' should be flushed;
+              ;; others should be kept in PORT's buffer.
+              (display "foo\n" port)
+              (display "bar\r" port)
+              (display "this will be kept in PORT's buffer" port)))
+          (lambda ()
+            (primitive-_exit 0)))
+        (begin
+          (close (cdr in+out))
+          (let ((str (read-all (car in+out))))
+            (waitpid pid)
+            str)))))
+
 
 ;;;; Void ports.  These are so trivial we don't test them.
 
-- 
1.8.4