X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fpcl%2Finit.lisp;h=a4c3dad8872e474b41b1071f35fc6822202190ed;hb=9af8ab0a80bbd4d579ed4a12d2a2819a7490901a;hp=6696bbaac304ff422a8f2cf2f5df44fe9f51db46;hpb=29003bacae52b0b32626b30e67d6f82a9f4dbce7;p=sbcl.git

diff --git a/src/pcl/init.lisp b/src/pcl/init.lisp
index 6696bba..a4c3dad 100644
--- a/src/pcl/init.lisp
+++ b/src/pcl/init.lisp
@@ -32,7 +32,7 @@
   (unless (class-finalized-p class) (finalize-inheritance class))
   (let ((class-default-initargs (class-default-initargs class)))
     (when class-default-initargs
-      (setf initargs (default-initargs class initargs class-default-initargs)))
+      (setf initargs (default-initargs initargs class-default-initargs)))
     (when initargs
       (when (and (eq *boot-state* 'complete)
                  (not (getf initargs :allow-other-keys)))
@@ -49,9 +49,7 @@
       (apply #'initialize-instance instance initargs)
       instance)))
 
-(defmethod default-initargs ((class slot-class)
-                             supplied-initargs
-                             class-default-initargs)
+(defun default-initargs (supplied-initargs class-default-initargs)
   (loop for (key nil fun) in class-default-initargs
         when (eq (getf supplied-initargs key '.not-there.) '.not-there.)
           append (list key (funcall fun)) into default-initargs
@@ -101,10 +99,10 @@
   (flet ((initialize-slot-from-initarg (class instance slotd)
            (let ((slot-initargs (slot-definition-initargs slotd)))
              (doplist (initarg value) initargs
-                      (when (memq initarg slot-initargs)
-                        (setf (slot-value-using-class class instance slotd)
-                              value)
-                        (return t)))))
+               (when (memq initarg slot-initargs)
+                 (setf (slot-value-using-class class instance slotd)
+                       value)
+                 (return t)))))
          (initialize-slot-from-initfunction (class instance slotd)
            ;; CLHS: If a before method stores something in a slot,
            ;; that slot won't be initialized from its :INITFORM, if any.
@@ -127,12 +125,9 @@
                   unless (initialize-slot-from-initarg class instance slotd)
                   collect slotd)))
       (dolist (slotd initfn-slotds)
-        (unless (eq (slot-definition-allocation slotd) :class)
-          ;; :ALLOCATION :CLASS slots use the :INITFORM when class is defined
-          ;; or redefined, not when instances are allocated.
-          (when (or (eq t slot-names)
-                    (memq (slot-definition-name slotd) slot-names))
-            (initialize-slot-from-initfunction class instance slotd)))))
+        (when (or (eq t slot-names)
+                  (memq (slot-definition-name slotd) slot-names))
+          (initialize-slot-from-initfunction class instance slotd))))
     instance))
 
 ;;; If initargs are valid return nil, otherwise signal an error.