From 8151587cdfac76dfdebe98caf4790839ff5aaa38 Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Thu, 30 Sep 2010 08:23:34 +0000
Subject: [PATCH] 1.0.43.6: fix overeager input-buffer filling by
 external-format routines

 Fixes lp#643686.

 Previously the character-input functions returned only after filling the
 entire request by fast-read-char-refill, or if an EOF was reached.

 This meant that on a pipe we would not receive any input until there
 was a buffer's worth of it, or the other end closed.

 Not so good. New the drill is:

   0, N characters requested.

   1. Decode upto N characters from binary buffer to the character
      buffer.

   2. If any characters were decoded or at EOF, return.

   3. Otherwise refill the binary buffer with at most one read()
      and goto 1.

 Previously at #1 we returned only if the entire request was
 satisfied.
---
 src/code/fd-stream.lisp  |    4 ++--
 tests/stream.impure.lisp |   36 ++++++++++++++++++++++++++++++++++++
 version.lisp-expr        |    2 +-
 3 files changed, 39 insertions(+), 3 deletions(-)

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 4a92214..82da2b3 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -1546,8 +1546,8 @@
                 (return-from ,in-function total-copied)))
             (setf (buffer-head ibuf) head)
             ;; Maybe we need to refill the stream buffer.
-            (cond ( ;; If there were enough data in the stream buffer, we're done.
-                   (= total-copied requested)
+            (cond ( ;; If was data in the stream buffer, we're done.
+                   (plusp total-copied)
                    (return total-copied))
                   ( ;; If EOF, we're done in another way.
                    (or (eq decode-break-reason 'eof)
diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp
index 955bd97..57fb7ec 100644
--- a/tests/stream.impure.lisp
+++ b/tests/stream.impure.lisp
@@ -639,4 +639,40 @@
       (when fifo
         (ignore-errors (delete-file fifo))))))
 
+#-win32
+(require :sb-posix)
+#-win32
+(with-test (:name :overager-character-buffering)
+  (let ((fifo nil)
+        (proc nil))
+    (maphash
+     (lambda (format _)
+       (declare (ignore _))
+       (format t "trying ~A~%" format)
+       (finish-output t)
+       (unwind-protect
+            (progn
+              (setf fifo (sb-posix:mktemp "SBCL-fifo-XXXXXXX.tmp"))
+              (sb-posix:mkfifo fifo (logior sb-posix:s-iwusr sb-posix:s-irusr))
+              ;; KLUDGE: because we have both ends in the same process, we would
+              ;; need to use O_NONBLOCK, but this works too.
+              (setf proc
+                    (run-program "/bin/sh"
+                                 (list "-c"
+                                       (format nil "cat > ~A" (native-namestring fifo)))
+                                 :input :stream
+                                 :wait nil
+                                 :external-format format))
+              (write-line "foobar" (process-input proc))
+              (finish-output (process-input proc))
+              (with-open-file (f fifo :direction :input :external-format format)
+                (assert (equal "foobar" (read-line f)))))
+         (when proc
+           (ignore-errors (process-close proc))
+           (setf proc nil))
+         (when fifo
+           (ignore-errors (delete-file fifo))
+           (setf fifo nil))))
+     sb-impl::*external-formats*)))
+
 ;;; success
diff --git a/version.lisp-expr b/version.lisp-expr
index 3bf3152..b4478e5 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.43.5"
+"1.0.43.6"
-- 
1.7.10.4