0.8.20.9

Fix sb-simple-streams; all tests pass again:

  * Test that clear-input can be called without errors but don't make
    assumptions about the stream state afterwards

  * Fix some LISTEN failures (simple-stream encapsulated in a two-way
    stream, incorrect assumptions about return value of
    stream-misc-dispatch :listen)

diff --git a/contrib/sb-simple-streams/impl.lisp b/contrib/sb-simple-streams/impl.lisp
index 1e22e1c..c37e141 100644 (file)
--- a/contrib/sb-simple-streams/impl.lisp
+++ b/contrib/sb-simple-streams/impl.lisp
@@ -292,14 +292,13 @@
     (if (not (or (eql width 1) (null width)))
        (funcall-stm-handler j-listen (sm melded-stream stream))
        (or (< (sm buffpos stream) (sm buffer-ptr stream))
-           (when (or (not (any-stream-instance-flags stream :dual :string))
-                      (>= (sm mode stream) 0)) ;; device-connected @@ single-channel
-             (let ((lcrs (sm last-char-read-size stream)))
-               (unwind-protect
-                    (progn
-                      (setf (sm last-char-read-size stream) (1+ lcrs))
-                      (plusp (refill-buffer stream nil)))
-                 (setf (sm last-char-read-size stream) lcrs))))))))
+           ;; Attempt buffer refill
+           (let ((lcrs (sm last-char-read-size stream)))
+             (when (and (not (any-stream-instance-flags stream :dual :string))
+                        (>= (sm mode stream) 0))
+               ;; single-channel stream dirty -> write data before reading
+               (flush-buffer stream nil))
+             (>= (refill-buffer stream nil) width))))))
 
 (defun %clear-input (stream buffer-only)
   (declare (type simple-stream stream))

diff --git a/contrib/sb-simple-streams/simple-stream-tests.lisp b/contrib/sb-simple-streams/simple-stream-tests.lisp
index 182b752..a845bd5 100644 (file)
--- a/contrib/sb-simple-streams/simple-stream-tests.lisp
+++ b/contrib/sb-simple-streams/simple-stream-tests.lisp
@@ -373,8 +373,6 @@ Nothing to see here, move along.")
         :initial-content ,(or initial-content '*multi-line-string*))
      ,@body))
 
-;;; 0.8.3.93 tried to fix LISTEN on dual channel streams, but failed to do so:
-
 (deftest listen-dc-1
     ;; LISTEN with filled buffer
     (with-dc-test-stream (s) (read-char s) (listen s))
@@ -502,8 +500,7 @@ Nothing to see here, move along.")
     ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
     (with-sc-test-stream (*synonym*)
       (let ((s (make-synonym-stream '*synonym*)))
-        (clear-input s)
-        (listen s)))
+        (clear-input s)))
   NIL)
 
 (deftest synonym-stream-9
@@ -708,8 +705,7 @@ Nothing to see here, move along.")
     ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
     (with-sc-test-stream (synonym)
       (let ((s (make-two-way-stream synonym synonym)))
-        (clear-input s)
-        (listen s)))
+        (clear-input s)))
   NIL)
 
 (deftest two-way-stream-9
@@ -794,8 +790,7 @@ Nothing to see here, move along.")
     ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
     (with-sc-test-stream (*synonym*)
       (let ((s (make-echo-stream *synonym* *synonym*)))
-        (clear-input s)
-        (listen s)))
+        (clear-input s)))
   NIL)
 
 (deftest echo-stream-11
@@ -866,8 +861,7 @@ Nothing to see here, move along.")
     ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH)
     (with-sc-test-stream (*synonym*)
       (let ((s (make-concatenated-stream *synonym*)))
-        (clear-input s)
-        (listen s)))
+        (clear-input s)))
   NIL)
 
 (deftest concatenated-stream-11

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 48687ad..869a0cc 100644 (file)
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -298,8 +298,11 @@
 (defun ansi-stream-listen (stream)
   (or (/= (the fixnum (ansi-stream-in-index stream))
           +ansi-stream-in-buffer-length+)
-      ;; Test for T explicitly since misc methods return :EOF sometimes.
-      (eq (funcall (ansi-stream-misc stream) stream :listen) t)))
+      ;; Handle :EOF return from misc methods specially
+      (let ((result (funcall (ansi-stream-misc stream) stream :listen)))
+       (if (eq result :eof)
+           nil
+           result))))
 
 (defun listen (&optional (stream *standard-input*))
   (let ((stream (in-synonym-of stream)))
@@ -827,7 +830,7 @@
           (or (/= (the fixnum (ansi-stream-in-index in))
                   +ansi-stream-in-buffer-length+)
               (funcall (ansi-stream-misc in) in :listen))
-          (stream-listen in)))
+          (listen in)))
       ((:finish-output :force-output :clear-output)
        (if out-ansi-stream-p
           (funcall (ansi-stream-misc out) out operation arg1 arg2)

diff --git a/version.lisp-expr b/version.lisp-expr
index ecb1bf6..15559e9 100644 (file)
--- 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".)
-"0.8.20.8"
+"0.8.20.9"