Changeset 13217

Timestamp:

02/13/11 11:41:56 (10 years ago)

Author:

ehuelsmann

Message:

Move checking for FORWARD-REFERENCED-CLASS superclasses from
FINALIZE-INHERITANCE to COMPUTE-CLASS-PRECEDENCE-LIST, as per
AMOP, which says C-C-P-L should generate an error in such a case.

At the same time, STD-AFTER-INITIALIZATION-FOR-CLASSES doesn't
call FINALIZE-INHERITANCE directly - it generates an error now.

File:

• trunk/abcl/src/org/armedbear/lisp/clos.lisp (modified) (5 diffs)

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

@@ -434 +434 @@
                 #'compute-class-precedence-list)
             class))
-  (dolist (class (class-precedence-list class))
-    (when (typep class 'forward-referenced-class)
-      (return-from std-finalize-inheritance)))
   (setf (class-slots class)
                    (funcall (if (eq (class-of class) +the-standard-class+)
@@ -484 +481 @@
 (defun std-compute-class-precedence-list (class)
   (let ((classes-to-order (collect-superclasses* class)))
+    (dolist (super classes-to-order)
+      (when (typep super 'forward-referenced-class)
+        (error "Can't compute class precedence list for class ~A ~
+                which depends on forward referenced class ~A." class super)))
     (topological-sort classes-to-order
                       (remove-duplicates
@@ -730 +731 @@
         (add-writer-method class writer (slot-definition-name direct-slot)))))
   (setf (class-direct-default-initargs class) direct-default-initargs)
-  (funcall (if (eq (class-of class) +the-standard-class+)
-               #'std-finalize-inheritance
-               #'finalize-inheritance)
-           class)
+  (maybe-finalize-class-subtree class)
   (values))
 
@@ -785 +783 @@
                             (substitute new-class old-class
                                         (class-direct-superclasses subclass))))
-                    (finalize-class-subtree new-class)
+                    (maybe-finalize-class-subtree new-class)
                     new-class))
                  (t
@@ -807 +805 @@
 
 
-(defun finalize-class-subtree (class)
+(defun maybe-finalize-class-subtree (class)
   (when (every #'class-finalized-p (class-direct-superclasses class))
     (finalize-inheritance class)
     (dolist (subclass (class-direct-subclasses class))
-       (finalize-class-subtree subclass))))
+       (maybe-finalize-class-subtree subclass))))
 
 (defmacro defclass (&whole form name direct-superclasses direct-slots &rest options)