0.8.7.46:

[sbcl.git] / src / code / stream.lisp

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 63b3fa3..f436ab0 100644 (file)
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -63,7 +63,6 @@
 (defun ansi-stream-input-stream-p (stream)
   (declare (type ansi-stream stream))
 
-  #!+high-security
   (when (synonym-stream-p stream)
     (setf stream
          (symbol-value (synonym-stream-symbol stream))))
@@ -85,7 +84,6 @@
 (defun ansi-stream-output-stream-p (stream)
   (declare (type ansi-stream stream))
 
-  #!+high-security
   (when (synonym-stream-p stream)
     (setf stream (symbol-value
                  (synonym-stream-symbol stream))))
@@ -103,6 +101,7 @@
 (declaim (inline ansi-stream-open-stream-p))
 (defun ansi-stream-open-stream-p (stream)
   (declare (type ansi-stream stream))
+  ;; CLHS 22.1.4 lets us not worry about synonym streams here.
   (not (eq (ansi-stream-in stream) #'closed-flame)))
 
 (defun open-stream-p (stream)
@@ -581,10 +580,7 @@
 
 (defun make-broadcast-stream (&rest streams)
   (dolist (stream streams)
-    (unless (or (and (synonym-stream-p stream)
-                    (output-stream-p (symbol-value
-                                      (synonym-stream-symbol stream))))
-               (output-stream-p stream))
+    (unless (output-stream-p stream)
       (error 'type-error
             :datum stream
             :expected-type '(satisfies output-stream-p))))
@@ -601,8 +597,20 @@
 (defun broadcast-misc (stream operation &optional arg1 arg2)
   (let ((streams (broadcast-stream-streams stream)))
     (case operation
+      ;; FIXME: This may not be the best place to note this, but I
+      ;; think the :CHARPOS protocol needs revision.  Firstly, I think
+      ;; this is the last place where a NULL return value was possible
+      ;; (before adjusting it to be 0), so a bunch of conditionals IF
+      ;; CHARPOS can be removed; secondly, it is my belief that
+      ;; FD-STREAMS, when running FILE-POSITION, do not update the
+      ;; CHARPOS, and consequently there will be much wrongness.
+      ;;
+      ;; FIXME: see also TWO-WAY-STREAM treatment of :CHARPOS -- why
+      ;; is it testing the :charpos of an input stream?
+      ;;
+      ;; -- CSR, 2004-02-04
       (:charpos
-       (dolist (stream streams)
+       (dolist (stream streams 0)
         (let ((charpos (charpos stream)))
           (if charpos (return charpos)))))
       (:line-length
@@ -611,10 +619,18 @@
           (let ((res (line-length stream)))
             (when res (setq min (if min (min res min) res)))))))
       (:element-type
+       #+nil ; old, arguably more logical, version
        (let (res)
-        (dolist (stream streams (if (> (length res) 1) `(and ,@res) res))
-          (pushnew (stream-element-type stream) res :test #'equal))))
-      (:close)
+        (dolist (stream streams (if (> (length res) 1) `(and ,@res) t))
+          (pushnew (stream-element-type stream) res :test #'equal)))
+       ;; ANSI-specified version (under System Class BROADCAST-STREAM)
+       (let ((res t))
+        (do ((streams streams (cdr streams)))
+            ((null streams) res)
+          (when (null (cdr streams))
+            (setq res (stream-element-type (car streams)))))))
+      (:close
+       (set-closed-flame stream))
       (t
        (let ((res nil))
         (dolist (stream streams res)
@@ -706,17 +722,11 @@
   ;; FIXME: This idiom of the-real-stream-of-a-possibly-synonym-stream
   ;; should be encapsulated in a function, and used here and most of
   ;; the other places that SYNONYM-STREAM-P appears.
-  (unless (or (and (synonym-stream-p output-stream)
-                  (output-stream-p (symbol-value
-                                    (synonym-stream-symbol output-stream))))
-             (output-stream-p output-stream))
+  (unless (output-stream-p output-stream)
     (error 'type-error
           :datum output-stream
           :expected-type '(satisfies output-stream-p)))
-  (unless (or (and (synonym-stream-p input-stream)
-                  (input-stream-p (symbol-value
-                                   (synonym-stream-symbol input-stream))))
-             (input-stream-p input-stream))
+  (unless (input-stream-p input-stream)
     (error 'type-error
           :datum input-stream
           :expected-type '(satisfies input-stream-p)))
@@ -804,10 +814,7 @@
   "Return a stream which takes its input from each of the streams in turn,
    going on to the next at EOF."
   (dolist (stream streams)
-    (unless (or (and (synonym-stream-p stream)
-                    (input-stream-p (symbol-value
-                                     (synonym-stream-symbol stream))))
-               (input-stream-p stream))
+    (unless (input-stream-p stream)
       (error 'type-error
             :datum stream
             :expected-type '(satisfies input-stream-p))))
@@ -899,17 +906,11 @@
   "Return a bidirectional stream which gets its input from INPUT-STREAM and
    sends its output to OUTPUT-STREAM. In addition, all input is echoed to
    the output stream."
-  (unless (or (and (synonym-stream-p output-stream)
-                  (output-stream-p (symbol-value
-                                    (synonym-stream-symbol output-stream))))
-             (output-stream-p output-stream))
+  (unless (output-stream-p output-stream)
     (error 'type-error
           :datum output-stream
           :expected-type '(satisfies output-stream-p)))
-  (unless (or (and (synonym-stream-p input-stream)
-                  (input-stream-p (symbol-value
-                                   (synonym-stream-symbol input-stream))))
-             (input-stream-p input-stream))
+  (unless (input-stream-p input-stream)
     (error 'type-error
           :datum input-stream
           :expected-type '(satisfies input-stream-p)))
@@ -1421,7 +1422,8 @@
 (defun case-frob-misc (stream op &optional arg1 arg2)
   (declare (type case-frob-stream stream))
   (case op
-    (:close)
+    (:close
+     (set-closed-flame stream))
     (t
      (let ((target (case-frob-stream-target stream)))
        (if (ansi-stream-p target)