From a72df65cd95038f7338cf7874b824138a3d79077 Mon Sep 17 00:00:00 2001 From: Rudi Schlatte Date: Mon, 7 Mar 2005 17:56:10 +0000 Subject: [PATCH] 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) --- contrib/sb-simple-streams/impl.lisp | 15 +++++++-------- contrib/sb-simple-streams/simple-stream-tests.lisp | 14 ++++---------- src/code/stream.lisp | 9 ++++++--- version.lisp-expr | 2 +- 4 files changed, 18 insertions(+), 22 deletions(-) diff --git a/contrib/sb-simple-streams/impl.lisp b/contrib/sb-simple-streams/impl.lisp index 1e22e1c..c37e141 100644 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4