X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Finit.lisp;h=236fc867fd8a6c0ba19094edceae2d004fb10134;hb=dca55270cf662763243dfc8ee207370473da2a6f;hp=5fe2982d79d0ac78c08d332662855b09d91d7e5e;hpb=619ee68faffc3990c5108611762ef54bf8cbbd1e;p=sbcl.git

diff --git a/src/pcl/init.lisp b/src/pcl/init.lisp
index 5fe2982..236fc86 100644
--- a/src/pcl/init.lisp
+++ b/src/pcl/init.lisp
@@ -132,11 +132,15 @@
             (loop for slotd in (class-slots class)
                   unless (initialize-slot-from-initarg class instance slotd)
                     collect slotd)))
-      (loop for slotd in initfn-slotds
-            when (and (not (eq :class (slot-definition-allocation slotd)))
-                      (or (eq t slot-names)
-                          (memq (slot-definition-name slotd) slot-names))) do
-              (initialize-slot-from-initfunction class instance slotd)))
+      (dolist (slotd initfn-slotds)
+	(if (eq (slot-definition-allocation slotd) :class)
+	    (when (or (eq t slot-names)
+		      (memq (slot-definition-name slotd) slot-names))
+	      (unless (slot-boundp-using-class class instance slotd)
+		(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.
@@ -190,7 +194,9 @@
       ;; Now check the supplied-initarg-names and the default initargs
       ;; against the total set that we know are legal.
       (doplist (key val) initargs
-	(unless (memq key legal)
+	(unless (or (memq key legal)
+		    ;; :ALLOW-OTHER-KEYS NIL gets here
+		    (eq key :allow-other-keys))
 	  (push key invalid-keys)))
       (when (and invalid-keys error-p)
 	(error 'initarg-error :class class :initargs invalid-keys)))