0.9.1.38:
[sbcl.git] / src / pcl / init.lisp
index 236fc86..40a922a 100644 (file)
@@ -52,9 +52,9 @@
 (defmethod default-initargs ((class slot-class)
                             supplied-initargs
                             class-default-initargs)
-  (loop for (key fn) in 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 fn)) into default-initargs
+         append (list key (funcall fun)) into default-initargs
         finally
          (return (append supplied-initargs default-initargs))))
 
                       (let ((initfn (slot-definition-initfunction slotd)))
                         (when initfn
                           (funcall initfn)))))
-              (unless (or (slot-boundp-using-class class instance slotd)
-                          (null (slot-definition-initfunction slotd)))
+              (unless (or (null (slot-definition-initfunction slotd))
+                          (slot-boundp-using-class class instance slotd))
                 (setf (slot-value-using-class class instance slotd)
                       (funcall (slot-definition-initfunction slotd)))))))
     (let* ((class (class-of instance))
        (setq legal (append keys legal))))
     (values legal nil)))
 
-(define-condition initarg-error (program-error)
+(define-condition initarg-error (reference-condition program-error)
   ((class :reader initarg-error-class :initarg :class)
    (initargs :reader initarg-error-initargs :initarg :initargs))
+  (:default-initargs :references (list '(:ansi-cl :section (7 1 2))))
   (:report (lambda (condition stream)
-            (format stream "~@<Invalid initialization argument~P:~2I~_~
-                             ~<~{~S~^, ~}~@:>~I~_in call for class ~S.~:>"
+            (format stream "~@<Invalid initialization argument~P: ~2I~_~
+                             ~<~{~S~^, ~} ~@:>~I~_in call for class ~S.~:>"
                     (length (initarg-error-initargs condition))
                     (list (initarg-error-initargs condition))
                     (initarg-error-class condition)))))