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.

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index c3825ac..4f69d9d 100644 (file)
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -59,38 +59,30 @@
 \f
 ;;; 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 64d589c..d01b63e 100644 (file)
--- 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 8b0291a..4f6b09b 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".)
-"1.0.13.2"
+"1.0.13.3"