Changeset 13788 for trunk/abcl/src/org/armedbear/lisp/clos.lisp

Timestamp:

01/17/12 20:15:55 (11 years ago)

Author:

rschlatte

Message:

move error checking into canonicalize-direct-superclasses

File:

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

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

@@ -290 +290 @@
   (let ((classes '()))
     (dolist (class-specifier direct-superclasses)
-      (if (classp class-specifier)
-          (push class-specifier classes)
-          (let ((class (find-class class-specifier nil)))
-            (unless class
-              (setf class (make-forward-referenced-class class-specifier)))
-            (push class classes))))
+      (let ((class (if (classp class-specifier)
+                       class-specifier
+                       (find-class class-specifier nil))))
+        (unless class
+          (setf class (make-forward-referenced-class class-specifier)))
+        (when (and (typep class 'built-in-class)
+                   (not (member class *extensible-built-in-classes*)))
+          (error "Attempt to define a subclass of built-in-class ~S."
+                 class-specifier))
+        (push class classes)))
     (nreverse classes)))
 
@@ -791 +795 @@
                :format-control "Duplicate initialization argument name ~S in :DEFAULT-INITARGS."
                :format-arguments (list name)))))
-  (let ((direct-superclasses (getf all-keys :direct-superclasses)))
-    (dolist (class direct-superclasses)
-      (when (and (typep class 'built-in-class)
-                 (not (member class *extensible-built-in-classes*)))
-        (error "Attempt to define a subclass of a built-in-class: ~S" class))))
   (let ((old-class (find-class name nil)))
     (cond ((and old-class (eq name (class-name old-class)))