From: Christophe Rhodes Date: Sun, 6 Oct 2002 14:10:38 +0000 (+0000) Subject: 0.7.8.19: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=ebbaa0e11a4d5c9bf021d28f212cfb6d5cd4aaab;p=sbcl.git 0.7.8.19: Fix bugs 46h and 46i, by ensuring that MAKE-TWO-WAY-STREAM and MAKE-CONCATENATED-STREAM check the types of their arguments. ... also MAKE-ECHO-STREAM, though it's FLUSHABLE rather than UNSAFELY-FLUSHABLE Eliminate two superfluous calls to SPECIFIER-TYPE in numeric type handling code ... will make no practical difference to execution time; sorry... --- diff --git a/BUGS b/BUGS index bacda62..b823166 100644 --- a/BUGS +++ b/BUGS @@ -255,13 +255,6 @@ WORKAROUND: 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"). diff --git a/NEWS b/NEWS index 0f6fbe3..f29756b 100644 --- a/NEWS +++ b/NEWS @@ -1317,6 +1317,8 @@ changes in sbcl-0.7.9 relative to sbcl-0.7.8: derived types contradict their declared type. * DEFMACRO is implemented via EVAL-WHEN instead of IR1 translation, so it can be non-toplevel. + * fixed bugs 46h and 46i: TWO-WAY- and CONCATENATED-STREAM creation + functions now check the types of their inputs as required by ANSI. planned incompatible changes in 0.7.x: * When the profiling interface settles down, maybe in 0.7.x, maybe diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index a28eca6..171ad65 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -1533,7 +1533,7 @@ ;; previously we threw an error here: ;; (error "Lower bound ~S is greater than upper bound ~S." l h)) ;; but ANSI doesn't say anything about that, so: - (specifier-type 'nil) + *empty-type* (make-numeric-type :class 'integer :complexp :real :enumerable (not (null (and l h))) @@ -1548,7 +1548,7 @@ ;; as above, previously we did ;; (error "Lower bound ~S is not less than upper bound ~S." low high)) ;; but it is correct to do - (specifier-type 'nil) + *empty-type* (make-numeric-type :class ',class :format ',format :low lb :high hb))))) (!def-bounded-type rational rational nil) diff --git a/src/code/stream.lisp b/src/code/stream.lisp index 5788195..5676b14 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -607,16 +607,12 @@ (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) @@ -736,24 +732,16 @@ (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. @@ -832,10 +820,8 @@ (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 @@ -854,15 +840,9 @@ ":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) @@ -945,7 +925,7 @@ (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) @@ -955,6 +935,27 @@ (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)) @@ -997,11 +998,6 @@ (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") ;;;; string input streams diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp new file mode 100644 index 0000000..caf58cc --- /dev/null +++ b/tests/stream.impure.lisp @@ -0,0 +1,46 @@ +;;;; 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))) + +;;; success +(quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index afa4eac..76cdc82 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; internal versions off the main CVS branch, it gets hairier, e.g. ;;; "0.pre7.14.flaky4.13".) -"0.7.8.18" +"0.7.8.19"