X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fbraid.lisp;h=6b08ed17002cb110cd7d045f86dcf69aba27f013;hb=4ff8421d6f4590024f82ea6f6851e25b4ca3df99;hp=1b713ac138fc03bbe5cbbf627f2346be69a0f9ac;hpb=ab811c7aaca82ba6f86584f736071a28e24353d3;p=sbcl.git

diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp
index 1b713ac..6b08ed1 100644
--- a/src/pcl/braid.lisp
+++ b/src/pcl/braid.lisp
@@ -294,6 +294,22 @@
       (set-slot 'direct-slots direct-slots)
       (set-slot 'slots slots)
       (set-slot 'initialize-info nil))
+
+    ;; For all direct superclasses SUPER of CLASS, make sure CLASS is
+    ;; a direct subclass of SUPER.  Note that METACLASS-NAME doesn't
+    ;; matter here for the slot DIRECT-SUBCLASSES, since every class
+    ;; inherits the slot from class CLASS.
+    (dolist (super direct-supers)
+      (let* ((super (find-class super))
+	     (subclasses (!bootstrap-get-slot metaclass-name super
+					      'direct-subclasses)))
+	(cond ((eq +slot-unbound+ subclasses)
+	       (!bootstrap-set-slot metaclass-name super 'direct-subclasses
+				    (list class)))
+	      ((not (memq class subclasses))
+	       (!bootstrap-set-slot metaclass-name super 'direct-subclasses
+				    (cons class subclasses))))))
+
     (if (eq metaclass-name 'structure-class)
 	(let ((constructor-sym '|STRUCTURE-OBJECT class constructor|))
 	  (set-slot 'predicate-name (or (cadr (assoc name