From ef793f0d484ac3a527e945a62c93f904d73049a6 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Mon, 7 Nov 2005 20:55:56 +0000 Subject: [PATCH] 0.9.6.31: Better error messages for method initialization violations --- src/code/condition.lisp | 2 ++ src/pcl/methods.lisp | 30 ++++++++++++++++++++++++------ version.lisp-expr | 2 +- 3 files changed, 27 insertions(+), 7 deletions(-) diff --git a/src/code/condition.lisp b/src/code/condition.lisp index c0f051d..165fa06 100644 --- a/src/code/condition.lisp +++ b/src/code/condition.lisp @@ -830,6 +830,8 @@ (format stream ", ") (destructuring-bind (type data) (cdr reference) (ecase type + (:initialization + (format stream "Initialization of ~A Metaobjects" data)) (:generic-function (format stream "Generic Function ~S" data)) (:section (format stream "Section ~{~D~^.~}" data))))) (:ansi-cl diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp index ae16f99..4122b7b 100644 --- a/src/pcl/methods.lisp +++ b/src/pcl/methods.lisp @@ -53,12 +53,30 @@ ;;; ;;; Methods are not reinitializable. -(defmethod reinitialize-instance ((method standard-method) &rest initargs) - (declare (ignore initargs)) - (error "An attempt was made to reinitialize the method ~S.~%~ - Method objects cannot be reinitialized." - method)) - +(define-condition metaobject-initialization-violation + (reference-condition simple-condition) + ()) + +(macrolet ((def (name args control) + `(defmethod ,name ,args + (declare (ignore initargs)) + (error 'metaobject-initialization-violation + :format-control ,(format nil "~@<~A~@:>" control ) + :format-arguments (list ',name) + :references (list '(:amop :initialization "Method")))))) + (def reinitialize-instance ((method method) &rest initargs) + "Method objects cannot be redefined by ~S.") + (def change-class ((method method) new &rest initargs) + "Method objects cannot be redefined by ~S.") + ;; FIXME: NEW being a subclass of METHOD. + (def update-instance-for-redefined-class ((method method) added discarded + plist &rest initargs) + "No behaviour specified for ~S on method objects.") + (def update-instance-for-different-class (old (new method) &rest initargs) + "No behaviour specified for ~S on method objects.") + (def update-instance-for-different-class ((old method) new &rest initargs) + "No behaviour specified for ~S on method objects.")) + (defmethod legal-documentation-p ((object standard-method) x) (if (or (null x) (stringp x)) t diff --git a/version.lisp-expr b/version.lisp-expr index 905c7e6..65c8b29 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.9.6.30" +"0.9.6.31" -- 1.7.10.4