type safety errors reported by Peter Van Eynde July 25, 2000:
c: (COERCE 'AND 'FUNCTION) returns something related to
(MACRO-FUNCTION 'AND), but ANSI says it should raise an error.
- h: (MAKE-CONCATENATED-STREAM (MAKE-STRING-OUTPUT-STREAM))
- should signal TYPE-ERROR.
- i: MAKE-TWO-WAY-STREAM doesn't check that its arguments can
- be used for input and output as needed. It should fail with
- TYPE-ERROR when handed e.g. the results of
- MAKE-STRING-INPUT-STREAM or MAKE-STRING-OUTPUT-STREAM in
- the inappropriate positions, but doesn't.
k: READ-BYTE is supposed to signal TYPE-ERROR when its argument is
not a binary input stream, but instead cheerfully reads from
character streams, e.g. (MAKE-STRING-INPUT-STREAM "abc").
(bout #'broadcast-bout)
(sout #'broadcast-sout)
(misc #'broadcast-misc))
- (:constructor #!-high-security-support
- make-broadcast-stream
- #!+high-security-support
- %make-broadcast-stream (&rest
- streams))
+ (:constructor %make-broadcast-stream
+ (&rest streams))
(:copier nil))
;; a list of all the streams we broadcast to
(streams () :type list :read-only t))
-#!+high-security-support
(defun make-broadcast-stream (&rest streams)
(dolist (stream streams)
(unless (or (and (synonym-stream-p stream)
(bout #'two-way-bout)
(sout #'two-way-sout)
(misc #'two-way-misc))
- (:constructor #!-high-security-support
- make-two-way-stream
- #!+high-security-support
- %make-two-way-stream (input-stream output-stream))
+ (:constructor %make-two-way-stream (input-stream output-stream))
(:copier nil))
(input-stream (missing-arg) :type stream :read-only t)
(output-stream (missing-arg) :type stream :read-only t))
(defprinter (two-way-stream) input-stream output-stream)
-#!-high-security-support
-(setf (fdocumentation 'make-two-way-stream 'function)
- "Return a bidirectional stream which gets its input from Input-Stream and
- sends its output to Output-Stream.")
-#!+high-security-support
(defun make-two-way-stream (input-stream output-stream)
#!+sb-doc
- "Return a bidirectional stream which gets its input from Input-Stream and
- sends its output to Output-Stream."
+ "Return a bidirectional stream which gets its input from INPUT-STREAM and
+ sends its output to OUTPUT-STREAM."
;; 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.
(bin #'concatenated-bin)
(n-bin #'concatenated-n-bin)
(misc #'concatenated-misc))
- (:constructor
- #!-high-security-support make-concatenated-stream
- #!+high-security-support %make-concatenated-stream
- (&rest streams &aux (current streams)))
+ (:constructor %make-concatenated-stream
+ (&rest streams &aux (current streams)))
(:copier nil))
;; The car of this is the substream we are reading from now.
current
":STREAMS ~S"
(concatenated-stream-streams x))))
-#!-high-security-support
-(setf (fdocumentation 'make-concatenated-stream 'function)
- "Return a stream which takes its input from each of the Streams in turn,
- going on to the next at EOF.")
-
-#!+high-security-support
(defun make-concatenated-stream (&rest streams)
#!+sb-doc
- "Return a stream which takes its input from each of the Streams in turn,
+ "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)
(bin #'echo-bin)
(misc #'echo-misc)
(n-bin #'ill-bin))
- (:constructor make-echo-stream (input-stream output-stream))
+ (:constructor %make-echo-stream (input-stream output-stream))
(:copier nil))
unread-stuff)
(def!method print-object ((x echo-stream) stream)
(two-way-stream-input-stream x)
(two-way-stream-output-stream x))))
+(defun make-echo-stream (input-stream output-stream)
+ #!+sb-doc
+ "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))
+ (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))
+ (error 'type-error
+ :datum input-stream
+ :expected-type '(satisfies input-stream-p)))
+ (funcall #'%make-echo-stream input-stream output-stream))
+
(macrolet ((in-fun (name fun out-slot stream-method &rest args)
`(defun ,name (stream ,@args)
(or (pop (echo-stream-unread-stuff stream))
(funcall (ansi-stream-misc out) out operation arg1 arg2)
(stream-misc-dispatch out operation arg1 arg2)))))))
-#!+sb-doc
-(setf (fdocumentation 'make-echo-stream 'function)
- "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")
\f
;;;; string input streams
--- /dev/null
+;;;; tests related to Lisp streams
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
+(in-package :cl-user)
+
+(load "assertoid.lisp")
+
+;;; type errors for inappropriate stream arguments, fixed in
+;;; sbcl-0.7.8.19
+(locally
+ (declare (optimize (safety 3)))
+ (assert (raises-error? (make-two-way-stream (make-string-output-stream)
+ (make-string-output-stream))
+ type-error))
+ (assert (raises-error? (make-two-way-stream (make-string-input-stream "foo")
+ (make-string-input-stream "bar"))
+ type-error))
+ ;; the following two aren't actually guaranteed, because ANSI, as it
+ ;; happens, doesn't say "should signal an error" for
+ ;; MAKE-ECHO-STREAM. It's still good to have, but if future
+ ;; maintenance work causes this test to fail because of these
+ ;; MAKE-ECHO-STREAM clauses, consider simply removing these clauses
+ ;; from the test. -- CSR, 2002-10-06
+ (assert (raises-error? (make-echo-stream (make-string-output-stream)
+ (make-string-output-stream))
+ type-error))
+ (assert (raises-error? (make-echo-stream (make-string-input-stream "foo")
+ (make-string-input-stream "bar"))
+ type-error))
+ (assert (raises-error? (make-concatenated-stream
+ (make-string-output-stream)
+ (make-string-input-stream "foo"))
+ type-error)))
+\f
+;;; success
+(quit :unix-status 104)
projects / sbcl.git / commitdiff