[armedbear-cvs] r13799 - trunk/abcl/src/org/armedbear/lisp

[rschlatte at common-lisp.net]

Author: rschlatte
Date: Wed Jan 25 00:53:50 2012
New Revision: 13799

Log:
Handle metaclasses given as symbols.

Modified:
   trunk/abcl/src/org/armedbear/lisp/clos.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/clos.lisp	Tue Jan 24 23:48:02 2012	(r13798)
+++ trunk/abcl/src/org/armedbear/lisp/clos.lisp	Wed Jan 25 00:53:50 2012	(r13799)
@@ -2572,6 +2572,7 @@
                                      &allow-other-keys)
   (setf all-keys (copy-list all-keys))  ; since we modify it
   (remf all-keys :metaclass)
+  (unless (classp metaclass) (setf metaclass (find-class metaclass)))
   (let ((class (apply (if (eq metaclass +the-standard-class+)
                           #'make-instance-standard-class
                           #'make-instance)
@@ -2593,6 +2594,7 @@
                                      direct-superclasses &allow-other-keys)
   (setf all-keys (copy-list all-keys))  ; since we modify it
   (remf all-keys :metaclass)
+  (unless (classp metaclass) (setf metaclass (find-class metaclass)))
   (change-class class metaclass)
   (apply #'reinitialize-instance class
          :name name
@@ -2608,6 +2610,7 @@
   (declare (ignore name))
   (setf all-keys (copy-list all-keys))  ; since we modify it
   (remf all-keys :metaclass)
+  (unless (classp metaclass) (setf metaclass (find-class metaclass)))
   (when (and metaclassp (not (eq (class-of class) metaclass)))
     (error 'program-error
            "Trying to redefine class ~S with different metaclass."