From e98706e107b99ae4f0850f5275af4197501b42ce Mon Sep 17 00:00:00 2001 From: Richard M Kreuter Date: Sun, 30 Dec 2007 22:30:34 +0000 Subject: [PATCH] 1.0.13.3: Fix minor bug in INPUT-STREAM-P, OUTPUT-STREAM-P * ANSI-STREAM-{INPUT,OUTPUT}-STREAM-P incorrectly assumed that a synonym stream's destination stream was an ANSI-STREAM, and so signaled errors when a synonym stream's target was a user-defined stream. Reported by Jean-Philippe "Hexstream" Paradis in #lisp. * Also add test for same. --- src/code/stream.lisp | 28 ++++++++++------------------ tests/stream.impure.lisp | 20 ++++++++++++++++++++ version.lisp-expr | 2 +- 3 files changed, 31 insertions(+), 19 deletions(-) diff --git a/src/code/stream.lisp b/src/code/stream.lisp index c3825ace6..4f69d9db3 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -59,38 +59,30 @@ ;;; stream manipulation functions -(declaim (inline ansi-stream-input-stream-p)) (defun ansi-stream-input-stream-p (stream) (declare (type ansi-stream stream)) - - (when (synonym-stream-p stream) - (setf stream - (symbol-value (synonym-stream-symbol stream)))) - - (and (not (eq (ansi-stream-in stream) #'closed-flame)) + (if (synonym-stream-p stream) + (input-stream-p (symbol-value (synonym-stream-symbol stream))) + (and (not (eq (ansi-stream-in stream) #'closed-flame)) ;;; KLUDGE: It's probably not good to have EQ tests on function ;;; values like this. What if someone's redefined the function? ;;; Is there a better way? (Perhaps just VALID-FOR-INPUT and ;;; VALID-FOR-OUTPUT flags? -- WHN 19990902 - (or (not (eq (ansi-stream-in stream) #'ill-in)) - (not (eq (ansi-stream-bin stream) #'ill-bin))))) + (or (not (eq (ansi-stream-in stream) #'ill-in)) + (not (eq (ansi-stream-bin stream) #'ill-bin)))))) (defun input-stream-p (stream) (declare (type stream stream)) (and (ansi-stream-p stream) (ansi-stream-input-stream-p stream))) -(declaim (inline ansi-stream-output-stream-p)) (defun ansi-stream-output-stream-p (stream) (declare (type ansi-stream stream)) - - (when (synonym-stream-p stream) - (setf stream (symbol-value - (synonym-stream-symbol stream)))) - - (and (not (eq (ansi-stream-in stream) #'closed-flame)) - (or (not (eq (ansi-stream-out stream) #'ill-out)) - (not (eq (ansi-stream-bout stream) #'ill-bout))))) + (if (synonym-stream-p stream) + (output-stream-p (symbol-value (synonym-stream-symbol stream))) + (and (not (eq (ansi-stream-in stream) #'closed-flame)) + (or (not (eq (ansi-stream-out stream) #'ill-out)) + (not (eq (ansi-stream-bout stream) #'ill-bout)))))) (defun output-stream-p (stream) (declare (type stream stream)) diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp index 64d589cd6..d01b63e6a 100644 --- a/tests/stream.impure.lisp +++ b/tests/stream.impure.lisp @@ -467,4 +467,24 @@ (assert (equal copy string))) (delete-file "read-sequence-character-test-data.tmp")) +;;; ANSI-STREAM-OUTPUT-STREAM-P used to assume that a SYNONYM-STREAM's +;;; target was an ANSI stream, but it could be a user-defined stream, +;;; e.g., a SLIME stream. +(defclass user-output-stream (fundamental-output-stream) + ()) + +(let ((*stream* (make-instance 'user-output-stream))) + (declare (special *stream*)) + (with-open-stream (stream (make-synonym-stream '*stream*)) + (assert (output-stream-p stream)))) + +(defclass user-input-stream (fundamental-input-stream) + ()) + +(let ((*stream* (make-instance 'user-input-stream))) + (declare (special *stream*)) + (with-open-stream (stream (make-synonym-stream '*stream*)) + (assert (input-stream-p stream)))) + + ;;; success diff --git a/version.lisp-expr b/version.lisp-expr index 8b0291ab5..4f6b09b79 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.13.2" +"1.0.13.3" -- 2.11.4.GIT