signal errors for bad initialization of slot definitions

[sbcl.git] / src / pcl / braid.lisp

diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp
index ce6bbc1..8f1ef7b 100644 (file)
--- a/src/pcl/braid.lisp
+++ b/src/pcl/braid.lisp
@@ -386,8 +386,9 @@
       (set-val 'initform     (get-val :initform))
       (set-val 'initfunction (get-val :initfunction))
       (set-val 'initargs     (get-val :initargs))
-      (set-val 'readers      (get-val :readers))
-      (set-val 'writers      (get-val :writers))
+      (unless effective-p
+        (set-val 'readers      (get-val :readers))
+        (set-val 'writers      (get-val :writers)))
       (set-val 'allocation   :instance)
       (set-val '%type        (or (get-val :type) t))
       (set-val '%documentation (or (get-val :documentation) ""))
@@ -580,11 +581,9 @@
            :readers ,(condition-slot-readers slot)
            :writers ,(condition-slot-writers slot)
            ,@(when (condition-slot-initform-p slot)
-               (let ((form-or-fun (condition-slot-initform slot)))
-                 (if (functionp form-or-fun)
-                     `(:initfunction ,form-or-fun)
-                     `(:initform ,form-or-fun
-                       :initfunction ,(lambda () form-or-fun)))))
+               (let ((initform (condition-slot-initform slot))
+                     (initfun (condition-slot-initfunction slot)))
+                 `(:initform ',initform :initfunction ,initfun)))
            :allocation ,(condition-slot-allocation slot)
            :documentation ,(condition-slot-documentation slot))))
     (cond ((structure-type-p name)