X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fpcl%2Fbraid.lisp;h=82f15630bacd051853d5b3c14fca61b42bd8aefe;hb=227096b878fee7afae9d3bc2cee5df01449bca2d;hp=ed010f8ba6a6c64c934cd0412b248ed589777f86;hpb=479ef26343b45753fc019b6535d3aa0ee54cb324;p=sbcl.git diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp index ed010f8..82f1563 100644 --- a/src/pcl/braid.lisp +++ b/src/pcl/braid.lisp @@ -194,7 +194,8 @@ class) (dolist (slot slots) (unless (eq (getf slot :allocation :instance) :instance) - (error "Slot allocation ~S is not supported in bootstrap."))) + (error "Slot allocation ~S is not supported in bootstrap." + (getf slot :allocation)))) (when (typep wrapper 'wrapper) (setf (wrapper-instance-slots-layout wrapper) @@ -697,7 +698,7 @@ (setq *boot-state* 'braid) (defmethod no-applicable-method (generic-function &rest args) - (error "~@" generic-function args)) @@ -719,3 +720,20 @@ ~I~_when called with arguments ~2I~_~S.~:>" generic-function args)) + +(defmethod invalid-qualifiers ((gf generic-function) + combin + method) + (let ((qualifiers (method-qualifiers method))) + (let ((why (cond + ((cdr qualifiers) "has too many qualifiers") + (t (aver (not (member (car qualifiers) + '(:around :before :after)))) + "has an invalid qualifier")))) + (invalid-method-error + method + "The method ~S on ~S ~A.~%~ + Standard method combination requires all methods to have one~%~ + of the single qualifiers :AROUND, :BEFORE and :AFTER or to~%~ + have no qualifier at all." + method gf why))))