X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fstream.lisp;h=f436ab05d9787796cc625bb20afce2e2eee43ff5;hb=a22dd643fb599880f4c0856e1a85bffe4358aea8;hp=63b3fa382f733ffd992d20450553a39d1b9880fe;hpb=c47519c9e63fd32a635943a84ec13d8a60d95f08;p=sbcl.git

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 63b3fa3..f436ab0 100644
--- 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)