From: Nikodemus S. <de...@us...> - 2004-05-20 22:56:59
|
Update of /cvsroot/sbcl/sbcl/src/pcl In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27744/src/pcl Modified Files: methods.lisp Log Message: 0.8.10.42: Fixed bug reported by Thomas Burdick (sbcl-devel 2004-05-09), which causes an AVER to fail from identical :READER and :WRITER names in DEFCLASS slot definitions: ... Moved error checking from FIND-METHOD to REAL-GET-METHOD so that internals bypassing FIND-METHOD can benefit from it. ... Added regression test. Index: methods.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/methods.lisp,v retrieving revision 1.32 retrieving revision 1.33 diff -u -d -r1.32 -r1.33 --- methods.lisp 15 Oct 2003 16:28:15 -0000 1.32 +++ methods.lisp 20 May 2004 22:56:42 -0000 1.33 @@ -289,37 +289,48 @@ new)) (defun real-get-method (generic-function qualifiers specializers - &optional (errorp t)) - (let* ((lspec (length specializers)) - (hit - (dolist (method (generic-function-methods generic-function)) - (let ((mspecializers (method-specializers method))) - (aver (= lspec (length mspecializers))) - (when (and (equal qualifiers (method-qualifiers method)) - (every #'same-specializer-p specializers - (method-specializers method))) - (return method)))))) - (cond (hit hit) - ((null errorp) nil) - (t - (error "~@<There is no method on ~S with ~ - ~:[no qualifiers~;~:*qualifiers ~S~] ~ - and specializers ~S.~@:>" - generic-function qualifiers specializers))))) + &optional (errorp t) + always-check-specializers) + (let ((lspec (length specializers)) + (methods (generic-function-methods generic-function))) + (when (or methods always-check-specializers) + (let ((nreq (length (arg-info-metatypes (gf-arg-info generic-function))))) + ;; Since we internally bypass FIND-METHOD by using GET-METHOD + ;; instead we need to to this here or users may get hit by a + ;; failed AVER instead of a sensible error message. + (when (/= lspec nreq) + (error "~@<The generic function ~S takes ~D required argument~:P; ~ + was asked to find a method with specializers ~S~@:>" + generic-function nreq specializers)))) + (let ((hit + (dolist (method methods) + (let ((mspecializers (method-specializers method))) + (aver (= lspec (length mspecializers))) + (when (and (equal qualifiers (method-qualifiers method)) + (every #'same-specializer-p specializers + (method-specializers method))) + (return method)))))) + (cond (hit hit) + ((null errorp) nil) + (t + (error "~@<There is no method on ~S with ~ + ~:[no qualifiers~;~:*qualifiers ~S~] ~ + and specializers ~S.~@:>" + generic-function qualifiers specializers)))))) (defmethod find-method ((generic-function standard-generic-function) qualifiers specializers &optional (errorp t)) - (let ((nreq (length (arg-info-metatypes (gf-arg-info generic-function))))) - ;; ANSI: "The specializers argument contains the parameter - ;; specializers for the method. It must correspond in length to - ;; the number of required arguments of the generic function, or an - ;; error is signaled." - (when (/= (length specializers) nreq) - (error "~@<The generic function ~S takes ~D required argument~:P; ~ - was asked to find a method with specializers ~S~@:>" - generic-function nreq specializers)) - (real-get-method generic-function qualifiers - (parse-specializers specializers) errorp))) + ;; ANSI about FIND-METHOD: "The specializers argument contains the + ;; parameter specializers for the method. It must correspond in + ;; length to the number of required arguments of the generic + ;; function, or an error is signaled." + ;; + ;; This error checking is done by REAL-GET-METHOD. + (real-get-method generic-function + qualifiers + (parse-specializers specializers) + errorp + t)) ;;; Compute various information about a generic-function's arglist by looking ;;; at the argument lists of the methods. The hair for trying not to use |