From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Wed, 9 Nov 2005 13:02:46 +0000 (+0000)
Subject: 0.9.6.36:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=1831934a29eb9361472e4f49efbcd5398392a6b0;p=sbcl.git

0.9.6.36:
	More checking.  No more CHANGE-CLASS to metaobject classes,
	except for FORWARD-REFERENCED-CLASS -> CLASS
---

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 165fa06..32db3f7 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -831,7 +831,8 @@
      (destructuring-bind (type data) (cdr reference)
        (ecase type
          (:initialization
-          (format stream "Initialization of ~A Metaobjects" data))
+          (format stream "Initialization of ~:(~A~) Metaobjects"
+                  (substitute #\  #\- (symbol-name 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 9b8487f..041bcd6 100644
--- a/src/pcl/methods.lisp
+++ b/src/pcl/methods.lisp
@@ -63,7 +63,7 @@
                  (error 'metaobject-initialization-violation
                   :format-control ,(format nil "~@<~A~@:>" control)
                   :format-arguments (list ',name)
-                  :references (list '(:amop :initialization "Method"))))))
+                  :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)
diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index 651437a..9952a16 100644
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -1440,11 +1440,34 @@
 (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")))))
+    (dolist (class cpl)
+      (macrolet
+          ((frob (class-name)
+             `(when (eq class (find-class ',class-name))
+               (error 'metaobject-initialization-violation
+                :format-control "~@<Cannot ~S objects into ~S metaobjects.~@:>"
+                :format-arguments (list 'change-class ',class-name)
+                :references (list '(:amop :initialization ,class-name))))))
+        (frob class)
+        (frob generic-function)
+        (frob method)
+        (frob slot-definition))))
+  (change-class-internal instance new-class initargs))
+
+(defmethod change-class ((instance forward-referenced-class)
+                         (new-class standard-class) &rest initargs)
+  (let ((cpl (class-precedence-list new-class)))
+    (dolist (class cpl
+             (error 'metaobject-initialization-violation
+                    :format-control
+                    "~@<Cannot ~S ~S objects into non-~S objects.~@:>"
+                    :format-arguments
+                    (list 'change-class 'forward-referenced-class 'class)
+                    :references
+                    (list '(:amop :generic-function ensure-class-using-class)
+                          '(:amop :initialization class))))
+      (when (eq class (find-class 'class))
+        (return nil))))
   (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 93edf13..7914857 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.35"
+"0.9.6.36"