Flush streams more precisely.

The test for the space left in the stream buffer was too conservative,
leaving 1 byte unused.
Patch by Ken Olum.
Fixes lp#910213.

diff --git a/NEWS b/NEWS
index d82f039..b909a15 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -12,6 +12,8 @@ changes relative to sbcl-1.1.10
     Patch by Douglas Katzman.
   * bug fix: improved threading on PPC.
   * bug fix: ROOM works again on Windows.
+  * bug fix: Streams were flushed even when there was one byte still left in
+    the buffer. (lp#910213)
 
 changes in sbcl-1.1.10 relative to sbcl-1.1.9:
   * enhancement: ASDF has been updated to 3.0.2.

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 789e962..8c0ca30 100644 (file)
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -525,7 +525,7 @@
             (tail (buffer-tail obuf))
             (size ,size))
       ,(unless (eq (car buffering) :none)
-         `(when (<= (buffer-length obuf) (+ tail size))
+         `(when (< (buffer-length obuf) (+ tail size))
             (setf obuf (flush-output-buffer ,stream-var)
                   tail (buffer-tail obuf))))
       ,(unless (eq (car buffering) :none)
@@ -552,28 +552,28 @@
     `(let* ((,stream-var ,stream)
             (obuf (fd-stream-obuf ,stream-var))
             (tail (buffer-tail obuf)))
-      ,(unless (eq (car buffering) :none)
-         `(when (<= (buffer-length obuf) (+ tail ,size))
-            (setf obuf (flush-output-buffer ,stream-var)
-                  tail (buffer-tail obuf))))
-      ;; FIXME: Why this here? Doesn't seem necessary.
-      ,(unless (eq (car buffering) :none)
-         `(synchronize-stream-output ,stream-var))
-      ,(if restart
-           `(catch 'output-nothing
-              ,@body
-              (setf (buffer-tail obuf) (+ tail ,size)))
-           `(progn
-             ,@body
-             (setf (buffer-tail obuf) (+ tail ,size))))
-      ,(ecase (car buffering)
-         (:none
-          `(flush-output-buffer ,stream-var))
-         (:line
-          `(when (eql byte #\Newline)
-             (flush-output-buffer ,stream-var)))
-         (:full))
-    (values))))
+       ,(unless (eq (car buffering) :none)
+          `(when (< (buffer-length obuf) (+ tail ,size))
+             (setf obuf (flush-output-buffer ,stream-var)
+                   tail (buffer-tail obuf))))
+       ;; FIXME: Why this here? Doesn't seem necessary.
+       ,(unless (eq (car buffering) :none)
+          `(synchronize-stream-output ,stream-var))
+       ,(if restart
+            `(catch 'output-nothing
+               ,@body
+               (setf (buffer-tail obuf) (+ tail ,size)))
+            `(progn
+               ,@body
+               (setf (buffer-tail obuf) (+ tail ,size))))
+       ,(ecase (car buffering)
+          (:none
+           `(flush-output-buffer ,stream-var))
+          (:line
+           `(when (eql byte #\Newline)
+              (flush-output-buffer ,stream-var)))
+          (:full))
+       (values))))
 
 (defmacro def-output-routines/variable-width
     ((name-fmt size restart external-format &rest bufferings)