0.8.1.5:

[sbcl.git] / src / code / defstruct.lisp

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index feec05a..4b0f84d 100644 (file)
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -805,9 +805,16 @@
                           (dsd-index included-slot))
                     (dd-inherited-accessor-alist dd)
                     :test #'eq :key #'car))
-         (parse-1-dsd dd
-                      modified
-                      (copy-structure included-slot)))))))
+         (let ((new-slot (parse-1-dsd dd
+                                       modified
+                                       (copy-structure included-slot))))
+            (when (and (neq (dsd-type new-slot) (dsd-type included-slot))
+                       (not (subtypep (dsd-type included-slot)
+                                      (dsd-type new-slot)))
+                       (dsd-safe-p included-slot))
+              (setf (dsd-safe-p new-slot) nil)
+              ;; XXX: notify?
+              )))))))
 \f
 ;;;; various helper functions for setting up DEFSTRUCTs