- (lambda ()
- (loop :for direct-slot :in (class-direct-slots class)
- :do (let ((attribute
- (find (slot-definition-name direct-slot)
- attribute-objects
- :key #'attribute-name)))
- (apply #'reinitialize-instance attribute
- (direct-attribute-properties direct-slot))
- (apply #'change-class attribute (attribute-class attribute) (direct-attribute-properties direct-slot))
-
- (setf (slot-value description (attribute-name attribute))
- attribute))))))))
+ (lambda ()
+ (loop :for direct-slot :in (class-direct-slots class)
+ :do (let ((attribute
+ (find (slot-definition-name direct-slot)
+ attribute-objects
+ :key #'attribute-name)))
+ (let ((initargs
+ (prepare-initargs attribute (direct-attribute-properties direct-slot))))
+
+ (apply #'reinitialize-instance attribute
+ initargs )
+ (when (not (eq (find-class (attribute-class attribute))
+ (class-of attribute)))
+
+ (apply #'change-class attribute (attribute-class attribute)
+ initargs)))
+
+
+ (setf (slot-value description (attribute-name attribute))
+ attribute))))))))