X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefstruct.lisp;h=4b0f84da86fe202712ce741cd1c376892115c87d;hb=f409f90c5e8c4c87ed9fa6efdc0e5c1952d94602;hp=feec05a3c3b231958cb109e8616483a90a4bc362;hpb=f601ededaa926a19ca60f95e8bc6f7f0d966f9d1;p=sbcl.git

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index feec05a..4b0f84d 100644
--- 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?
+              )))))))
 
 ;;;; various helper functions for setting up DEFSTRUCTs