X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdfun.lisp;h=1db2f02d2cf2fe624bfe517a4ad4c2220345a526;hb=1acfa21e0796f5d72d776b0fd53645813d5f2d98;hp=251a5fadff8693c41715bc0514397c2e2b0a6a7a;hpb=942e45e3bb73fd55786e4a0ab4590324063c0c89;p=sbcl.git

diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp
index 251a5fa..1db2f02 100644
--- a/src/pcl/dfun.lisp
+++ b/src/pcl/dfun.lisp
@@ -987,7 +987,8 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
         ;; which are the parameters of the new state, and get other
         ;; information from the lexical variables bound above.
         (flet ((two-class (index w0 w1)
-               (when (zerop (random 2)) (psetf w0 w1 w1 w0))
+               (when (zerop (random 2 *pcl-misc-random-state*))
+                 (psetf w0 w1 w1 w0))
                (dfun-update gf
                             #'make-two-class-accessor-dfun
                             ntype
@@ -1326,21 +1327,26 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
                                   method))
                             (accessor-method-slot-name method))))
         (when (or (null specl-cpl)
+                  (null so-p)
                   (member *the-class-structure-object* specl-cpl))
           (return-from make-accessor-table nil))
-        (maphash (lambda (class slotd)
-                   (let ((cpl (if early-p
-                                  (early-class-precedence-list class)
-                                  (class-precedence-list class))))
-                     (when (memq specl cpl)
-                       (unless (and (or so-p
-                                        (member *the-class-standard-object*
-                                                cpl))
-                                    (or early-p
-                                        (slot-accessor-std-p slotd type)))
+        ;; Collect all the slot-definitions for SLOT-NAME from SPECL and
+        ;; all of its subclasses. If either SPECL or one of the subclasses
+        ;; is not a standard-class, bail out.
+        (labels ((aux (class)
+                   ;; FIND-SLOT-DEFINITION might not be defined yet
+                   (let ((slotd (find-if (lambda (x)
+                                           (eq (sb-pcl::slot-definition-name x)
+                                               slot-name))
+                                         (sb-pcl::class-slots class))))
+                     (when slotd
+                       (unless (or early-p
+                                   (slot-accessor-std-p slotd type))
                          (return-from make-accessor-table nil))
-                       (push (cons specl slotd) (gethash class table)))))
-                 (gethash slot-name *name->class->slotd-table*))))
+                       (push (cons specl slotd) (gethash class table))))
+                   (dolist (subclass (sb-pcl::class-direct-subclasses class))
+                     (aux subclass))))
+          (aux specl))))
     (maphash (lambda (class specl+slotd-list)
                (dolist (sclass (if early-p
                                    (early-class-precedence-list class)
@@ -1426,10 +1432,10 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
 (defun order-specializers (specl1 specl2 index compare-classes-function)
   (let ((type1 (if (eq *boot-state* 'complete)
                    (specializer-type specl1)
-                   (!bootstrap-get-slot 'specializer specl1 'type)))
+                   (!bootstrap-get-slot 'specializer specl1 '%type)))
         (type2 (if (eq *boot-state* 'complete)
                    (specializer-type specl2)
-                   (!bootstrap-get-slot 'specializer specl2 'type))))
+                   (!bootstrap-get-slot 'specializer specl2 '%type))))
     (cond ((eq specl1 specl2)
            nil)
           ((atom type1)