From 4f7e45c9c4d2c74a551f77e6fbe94527d6bc4864 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sat, 6 Mar 2004 19:54:51 +0000 Subject: [PATCH] 0.8.8.16: Allow CLOSE to work on (MAKE-CONCATENATED-STREAM) --- NEWS | 1 + src/code/stream.lisp | 66 ++++++++++++++++++++++++++------------------------ version.lisp-expr | 2 +- 3 files changed, 36 insertions(+), 33 deletions(-) diff --git a/NEWS b/NEWS index 044f4e9..7b85c6e 100644 --- a/NEWS +++ b/NEWS @@ -2340,6 +2340,7 @@ changes in sbcl-0.8.9 relative to sbcl-0.8.8: their output stream on EOF from read. ** CONCATENATED-STREAM-STREAMS discards constituent streams which have been read to end-of-file. + ** CLOSE works as expected on the null CONCATENATED-STREAM. planned incompatible changes in 0.8.x: * (not done yet, but planned:) When the profiling interface settles diff --git a/src/code/stream.lisp b/src/code/stream.lisp index 0766c4a..d5af885 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -841,38 +841,40 @@ (setf (concatenated-stream-streams stream) (cdr streams)))) (defun concatenated-misc (stream operation &optional arg1 arg2) - (let ((left (concatenated-stream-streams stream))) - (when left - (let* ((current (car left))) - (case operation - (:listen - (loop - (let ((stuff (if (ansi-stream-p current) - (funcall (ansi-stream-misc current) current - :listen) - (stream-misc-dispatch current :listen)))) - (cond ((eq stuff :eof) - ;; Advance STREAMS, and try again. - (pop (concatenated-stream-streams stream)) - (setf current - (car (concatenated-stream-streams stream))) - (unless current - ;; No further streams. EOF. - (return :eof))) - (stuff - ;; Stuff's available. - (return t)) - (t - ;; Nothing is available yet. - (return nil)))))) - (:clear-input (clear-input current)) - (:unread (unread-char arg1 current)) - (:close - (set-closed-flame stream)) - (t - (if (ansi-stream-p current) - (funcall (ansi-stream-misc current) current operation arg1 arg2) - (stream-misc-dispatch current operation arg1 arg2)))))))) + (let* ((left (concatenated-stream-streams stream)) + (current (car left))) + (case operation + (:listen + (unless left + (return-from concatenated-misc :eof)) + (loop + (let ((stuff (if (ansi-stream-p current) + (funcall (ansi-stream-misc current) current + :listen) + (stream-misc-dispatch current :listen)))) + (cond ((eq stuff :eof) + ;; Advance STREAMS, and try again. + (pop (concatenated-stream-streams stream)) + (setf current + (car (concatenated-stream-streams stream))) + (unless current + ;; No further streams. EOF. + (return :eof))) + (stuff + ;; Stuff's available. + (return t)) + (t + ;; Nothing is available yet. + (return nil)))))) + (:clear-input (when left (clear-input current))) + (:unread (when left (unread-char arg1 current))) + (:close + (set-closed-flame stream)) + (t + (when left + (if (ansi-stream-p current) + (funcall (ansi-stream-misc current) current operation arg1 arg2) + (stream-misc-dispatch current operation arg1 arg2))))))) ;;;; echo streams diff --git a/version.lisp-expr b/version.lisp-expr index aab955f..e63e667 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.8.15" +"0.8.8.16" -- 1.7.10.4