From: Christophe Rhodes Date: Wed, 28 May 2003 11:51:10 +0000 (+0000) Subject: 0.8.0.11: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=3eedd5a020356291b2c1c2e426ef9fc7dd5928d9;p=sbcl.git 0.8.0.11: Merge patch from Antonio Martinez (sbcl-devel 2003-05-19 "read-sequence for fundamental-binary-input-streams") ... and WRITE-SEQUENCE, as well. Merge patch from Andreas Fuchs (sbcl-devel 2003-05-20 "(defmethod foo (&key bla &rest blub) t)") ... detect more erroneous specialized lambda lists; ... handle the error in the SOURCE-CONTEXT method for DEFMETHOD, otherwise we can't print the error message we want; ... fix the bogus lambda list in simple-streams and in the test suite; ... include tests for a variety of bogus input. (I would also like to mark the occasion of SBCL's very own millennium bug, as we observe the CVS revision number for version.lisp-expr tick over from 1.999 to 1.1000. "Should auld acquaintance be forgot...") --- diff --git a/NEWS b/NEWS index 90b4e1d..681b5c9 100644 --- a/NEWS +++ b/NEWS @@ -1769,6 +1769,9 @@ changes in sbcl-0.8.0 relative to sbcl-0.8alpha.0 they for GNU "make". changes in sbcl-0.8.1 relative to sbcl-0.8.0: + * minor incompatible change: some nonsensical specialized lambda + lists (used in DEFMETHOD) which were previously ignored now signal + errors. * changes in type checking closed the following bugs: ** type checking of unused values (192b, 194d, 203); ** template selection based on unsafe type assertions (192c, 236); @@ -1777,6 +1780,9 @@ changes in sbcl-0.8.1 relative to sbcl-0.8.0: * a short form of VALUES type specifier has ANSI meaning. * fixed bug in DEFSTRUCT: once again, naming structure slots with keywords or constants is permissible. + * STREAM-READ-SEQUENCE and STREAM-WRITE-SEQUENCE now have methods + defined on the relevant FUNDAMENTAL-BINARY-{INPUT,OUTPUT}-STREAM + classes. (thanks to Antonio Martinez) planned incompatible changes in 0.8.x: * (not done yet, but planned:) When the profiling interface settles diff --git a/contrib/sb-simple-streams/cl.lisp b/contrib/sb-simple-streams/cl.lisp index 1948f18..38335e4 100644 --- a/contrib/sb-simple-streams/cl.lisp +++ b/contrib/sb-simple-streams/cl.lisp @@ -995,7 +995,7 @@ simple-streams proposal.") ;;; (defmethod shared-initialize :after ((instance simple-stream) slot-names - &rest initargs &allow-other-keys) + &rest initargs &key &allow-other-keys) (declare (ignore slot-names)) (unless (slot-boundp instance 'melded-stream) (setf (slot-value instance 'melded-stream) instance) diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index 14e6984..8577b76 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -2312,19 +2312,34 @@ bootstrapping. (declare (ignore ignore1 ignore2 ignore3)) required-parameters)) -(defun parse-specialized-lambda-list (arglist &optional post-keyword) - ;;(declare (values parameters lambda-list specializers required-parameters)) +(defun parse-specialized-lambda-list + (arglist + &optional supplied-keywords (allowed-keywords '(&optional &rest &key &aux)) + &aux (specialized-lambda-list-keywords + '(&optional &rest &key &allow-other-keys &aux))) (let ((arg (car arglist))) (cond ((null arglist) (values nil nil nil nil)) ((eq arg '&aux) - (values nil arglist nil)) + (values nil arglist nil nil)) ((memq arg lambda-list-keywords) - (unless (memq arg '(&optional &rest &key &allow-other-keys &aux)) - ;; Now, since we try to conform to ANSI, non-standard - ;; lambda-list-keywords should be treated as errors. + ;; Now, since we try to conform to ANSI, non-standard + ;; lambda-list-keywords should be treated as errors. + (unless (memq arg specialized-lambda-list-keywords) (error 'simple-program-error - :format-control "unrecognized lambda-list keyword ~S ~ - in arglist.~%" + :format-control "unknown specialized-lambda-list ~ + keyword ~S~%" + :format-arguments (list arg))) + ;; no multiple &rest x &rest bla specifying + (when (memq arg supplied-keywords) + (error 'simple-program-error + :format-control "multiple occurrence of ~ + specialized-lambda-list keyword ~S~%" + :format-arguments (list arg))) + ;; And no placing &key in front of &optional, either. + (unless (memq arg allowed-keywords) + (error 'simple-program-error + :format-control "misplaced specialized-lambda-list ~ + keyword ~S~%" :format-arguments (list arg))) ;; When we are at a lambda-list keyword, the parameters ;; don't include the lambda-list keyword; the lambda-list @@ -2332,22 +2347,34 @@ bootstrapping. ;; specializers are allowed to follow the lambda-list ;; keywords (at least for now). (multiple-value-bind (parameters lambda-list) - (parse-specialized-lambda-list (cdr arglist) t) - (when (eq arg '&rest) - ;; check, if &rest is followed by a var ... - (when (or (null lambda-list) - (memq (car lambda-list) lambda-list-keywords)) - (error "Error in lambda-list:~%~ - After &REST, a DEFMETHOD lambda-list ~ - must be followed by at least one variable."))) + (parse-specialized-lambda-list (cdr arglist) + (cons arg supplied-keywords) + (if (eq arg '&key) + (cons '&allow-other-keys + (cdr (member arg allowed-keywords))) + (cdr (member arg allowed-keywords)))) + (when (and (eq arg '&rest) + (or (null lambda-list) + (memq (car lambda-list) + specialized-lambda-list-keywords) + (not (or (null (cadr lambda-list)) + (memq (cadr lambda-list) + specialized-lambda-list-keywords))))) + (error 'simple-program-error + :format-control + "in a specialized-lambda-list, excactly one ~ + variable must follow &REST.~%" + :format-arguments nil)) (values parameters (cons arg lambda-list) () ()))) - (post-keyword + (supplied-keywords ;; After a lambda-list keyword there can be no specializers. (multiple-value-bind (parameters lambda-list) - (parse-specialized-lambda-list (cdr arglist) t) + (parse-specialized-lambda-list (cdr arglist) + supplied-keywords + allowed-keywords) (values (cons (if (listp arg) (car arg) arg) parameters) (cons arg lambda-list) () diff --git a/src/pcl/compiler-support.lisp b/src/pcl/compiler-support.lisp index d4e113e..cbc6f9c 100644 --- a/src/pcl/compiler-support.lisp +++ b/src/pcl/compiler-support.lisp @@ -51,8 +51,10 @@ (let ((arg-pos (position-if #'listp stuff))) (if arg-pos `(defmethod ,name ,@(subseq stuff 0 arg-pos) - ,(nth-value 2 (sb-pcl::parse-specialized-lambda-list - (elt stuff arg-pos)))) + ,(handler-case + (nth-value 2 (sb-pcl::parse-specialized-lambda-list + (elt stuff arg-pos))) + (error () ""))) `(defmethod ,name "")))) (defvar sb-pcl::*internal-pcl-generalized-fun-name-symbols* nil) diff --git a/src/pcl/gray-streams.lisp b/src/pcl/gray-streams.lisp index 3603055..b273412 100644 --- a/src/pcl/gray-streams.lisp +++ b/src/pcl/gray-streams.lisp @@ -226,6 +226,13 @@ &optional (start 0) (end nil)) (basic-io-type-stream-read-sequence stream seq start end #'stream-read-char)) + +(defmethod stream-read-sequence ((stream fundamental-binary-input-stream) + (seq sequence) + &optional (start 0) (end nil)) + (basic-io-type-stream-read-sequence stream seq start end + #'stream-read-byte)) + ;;; character output streams ;;; @@ -430,6 +437,16 @@ (:documentation "Implements WRITE-BYTE; writes the integer to the stream and returns the integer as the result.")) + +;; Provide a reasonable default for binary Gray streams. We might be +;; able to do better by specializing on the sequence type, but at +;; least the behaviour is reasonable. --tony 2003/05/08. +(defmethod stream-write-sequence ((stream fundamental-binary-output-stream) + (seq sequence) + &optional (start 0) (end nil)) + (basic-io-type-stream-write-sequence stream seq start end + #'stream-write-byte)) + ;;; This is not in the Gray stream proposal, so it is left here ;;; as example code. diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp index 2f36ac7..8e6d414 100644 --- a/tests/clos.impure.lisp +++ b/tests/clos.impure.lisp @@ -70,7 +70,7 @@ (assert (expect-error (defgeneric foo2 (x a &rest)))) (defgeneric foo3 (x &rest y)) (defmethod foo3 ((x t) &rest y) nil) -(defmethod foo4 ((x t) &key y &rest z) nil) +(defmethod foo4 ((x t) &rest z &key y) nil) (defgeneric foo4 (x &rest z &key y)) (assert (expect-error (defgeneric foo5 (x &rest)))) (assert (expect-error (macroexpand-1 '(defmethod foo6 (x &rest))))) @@ -333,7 +333,18 @@ ((#1a() :initarg :a)))) (assert-program-error (defclass foo012 () ((t :initarg :t)))) - (assert-program-error (defclass foo013 () ("a")))) + (assert-program-error (defclass foo013 () ("a"))) + ;; specialized lambda lists have certain restrictions on ordering, + ;; repeating keywords, and the like: + (assert-program-error (defmethod foo014 ((foo t) &rest) nil)) + (assert-program-error (defmethod foo015 ((foo t) &rest x y) nil)) + (assert-program-error (defmethod foo016 ((foo t) &allow-other-keys) nil)) + (assert-program-error (defmethod foo017 ((foo t) + &optional x &optional y) nil)) + (assert-program-error (defmethod foo018 ((foo t) &rest x &rest y) nil)) + (assert-program-error (defmethod foo019 ((foo t) &rest x &optional y) nil)) + (assert-program-error (defmethod foo020 ((foo t) &key x &optional y) nil)) + (assert-program-error (defmethod foo021 ((foo t) &key x &rest y) nil))) ;;; DOCUMENTATION's argument-precedence-order wasn't being faithfully ;;; preserved through the bootstrap process until sbcl-0.7.8.39. diff --git a/version.lisp-expr b/version.lisp-expr index 4de3781..7656176 100644 --- 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".) -"0.8.0.10" +"0.8.0.11"