From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Mon, 7 Nov 2005 21:52:54 +0000 (+0000)
Subject: 0.9.6.33:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=1ffd970d36b42c9d3448d412eb9bd91c55914643;p=sbcl.git

0.9.6.33:
	Implement the last bit of Method metaobject
	initialization checking
---

diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp
index f333085..9b8487f 100644
--- a/src/pcl/methods.lisp
+++ b/src/pcl/methods.lisp
@@ -68,7 +68,8 @@
     "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.
+  ;; NEW being a subclass of method is dealt with in the general
+  ;; method of CHANGE-CLASS
   (def update-instance-for-redefined-class ((method method) added discarded
                                             plist &rest initargs)
     "No behaviour specified for ~S on method objects.")
diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index b4aa166..651437a 100644
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -1437,9 +1437,14 @@
     (apply #'update-instance-for-different-class copy instance initargs)
     instance))
 
-(defmethod change-class ((instance standard-object)
-                         (new-class standard-class)
+(defmethod change-class ((instance standard-object) (new-class standard-class)
                          &rest initargs)
+  (let ((cpl (class-precedence-list new-class)))
+    (when (member (find-class 'method) cpl)
+      (error 'metaobject-initialization-violation
+             :format-control "~@<Cannot ~S objects into ~S metaobjects.~@:>"
+             :format-arguments (list 'change-class 'method)
+             :references (list '(:amop :initialization "Method")))))
   (change-class-internal instance new-class initargs))
 
 (defmethod change-class ((instance funcallable-standard-object)
diff --git a/version.lisp-expr b/version.lisp-expr
index 8e5be81..36a2bd4 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.32"
+"0.9.6.33"