From 301bcbc899874437313f4690b0b9d6f9c66b4895 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Mon, 19 May 2003 16:25:10 +0000 Subject: [PATCH] 0.8alpha.0.39: A couple more CLOS fixes: ... make &OPTIONAL argument count checking less lax in methods (caught by pfdietz' MAKE-LOAD-FORM.ERROR.2) ... make :ARGUMENT-PRECEDENCE-ORDER and :METHOD-COMBINATION DEFGENERIC options do sanity checking on their arguments (:A-P-O caught by pfdietz' suite; :M-C checking defensively installed :-) --- NEWS | 5 +++++ src/pcl/boot.lisp | 41 ++++++++++++++++++++++++++++++++++------- version.lisp-expr | 2 +- 3 files changed, 40 insertions(+), 8 deletions(-) diff --git a/NEWS b/NEWS index 7dcd85a..815d29e 100644 --- a/NEWS +++ b/NEWS @@ -1755,6 +1755,11 @@ changes in sbcl-0.8.0 relative to sbcl-0.8alpha.0 STRUCTURE-OBJECT, CONDITION and STANDARD-OBJECT. ** MAKE-LOAD-FORM-SAVING-SLOTS no longer returns a special keyword, and now implements the SLOT-NAMES argument. + ** methods with &OPTIONAL arguments no longer allow too many + arguments to be passed in the call without error. + ** DEFGENERIC now checks that the :ARGUMENT-PRECEDENCE-ORDER + option is consistent with the required arguments of the generic + function lambda list. planned incompatible changes in 0.8.x: * (not done yet, but planned:) When the profiling interface settles diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index e10af04..49edcfe 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -190,11 +190,32 @@ bootstrapping. is not allowed inside DEFGENERIC." :format-arguments (list (cadr option)))) (push (cadr option) (initarg :declarations))) - ((:argument-precedence-order :method-combination) - (if (initarg car-option) - (duplicate-option car-option) - (setf (initarg car-option) - `',(cdr option)))) + (:method-combination + (when (initarg car-option) + (duplicate-option car-option)) + (unless (symbolp (cadr option)) + (error 'simple-program-error + :format-control "METHOD-COMBINATION name not a ~ + symbol: ~S" + :format-arguments (list (cadr option)))) + (setf (initarg car-option) + `',(cdr option))) + (:argument-precedence-order + (let* ((required (parse-lambda-list lambda-list)) + (supplied (cdr option))) + (unless (= (length required) (length supplied)) + (error 'simple-program-error + :format-control "argument count discrepancy in ~ + :ARGUMENT-PRECEDENCE-ORDER clause." + :format-arguments nil)) + (when (set-difference required supplied) + (error 'simple-program-error + :format-control "unequal sets for ~ + :ARGUMENT-PRECEDENCE-ORDER clause: ~ + ~S and ~S" + :format-arguments (list required supplied))) + (setf (initarg car-option) + `',(cdr option)))) ((:documentation :generic-function-class :method-class) (unless (proper-list-of-length-p option 2) (error "bad list length for ~S" option)) @@ -1173,8 +1194,14 @@ bootstrapping. (aux `(,var)))))) (let ((bindings (mapcan #'process-var lambda-list))) `(let* ((,args-tail ,args) - ,@bindings) - (declare (ignorable ,args-tail)) + ,@bindings + (.dummy0. + ,@(when (eq state 'optional) + `((unless (null ,args-tail) + (error 'simple-program-error + :format-control "surplus arguments: ~S" + :format-arguments (list ,args-tail))))))) + (declare (ignorable ,args-tail .dummy0.)) ,@body))))) (defun get-key-arg-tail (keyword list) diff --git a/version.lisp-expr b/version.lisp-expr index 69cfebc..077543b 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.8alpha.0.38" +"0.8alpha.0.39" -- 1.7.10.4