0.7.13.7:

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

diff --git a/src/code/target-defstruct.lisp b/src/code/target-defstruct.lisp
index 858e452..8f35d3c 100644 (file)
--- a/src/code/target-defstruct.lisp
+++ b/src/code/target-defstruct.lisp
@@ -177,19 +177,22 @@
   (dolist (dsd (dd-slots dd))
     (/show0 "doing FDEFINITION for slot accessor")
     (let ((accessor-name (dsd-accessor-name dsd)))
-      (/show0 "ACCESSOR-NAME=..")
-      (/hexstr accessor-name)
-      (protect-cl accessor-name)
-      (/hexstr "getting READER-FUN and WRITER-FUN")
-      (multiple-value-bind (reader-fun writer-fun) (slot-accessor-funs dd dsd)
-       (declare (type function reader-fun writer-fun))
-       (/show0 "got READER-FUN and WRITER-FUN=..")
-       (/hexstr reader-fun)
-       (setf (symbol-function accessor-name) reader-fun)
-       (unless (dsd-read-only dsd)
-         (/show0 "setting FDEFINITION for WRITER-FUN=..")
-         (/hexstr writer-fun)
-         (setf (fdefinition `(setf ,accessor-name)) writer-fun)))))
+      ;; We mustn't step on any inherited accessors
+      (unless (accessor-inherited-data accessor-name dd)
+       (/show0 "ACCESSOR-NAME=..")
+       (/hexstr accessor-name)
+       (protect-cl accessor-name)
+       (/hexstr "getting READER-FUN and WRITER-FUN")
+       (multiple-value-bind (reader-fun writer-fun)
+           (slot-accessor-funs dd dsd)
+         (declare (type function reader-fun writer-fun))
+         (/show0 "got READER-FUN and WRITER-FUN=..")
+         (/hexstr reader-fun)
+         (setf (symbol-function accessor-name) reader-fun)
+         (unless (dsd-read-only dsd)
+           (/show0 "setting FDEFINITION for WRITER-FUN=..")
+           (/hexstr writer-fun)
+           (setf (fdefinition `(setf ,accessor-name)) writer-fun))))))
 
   ;; Set FDEFINITION for copier.
   (when (dd-copier-name dd)
@@ -387,7 +390,7 @@
 
 (defun %default-structure-pretty-print (structure stream)
   (let* ((layout (%instance-layout structure))
-        (name (sb!xc:class-name (layout-class layout)))
+        (name (class-name (layout-class layout)))
         (dd (layout-info layout)))
     (pprint-logical-block (stream nil :prefix "#S(" :suffix ")")
       (prin1 name stream)
@@ -413,7 +416,7 @@
             (pprint-newline :linear stream))))))))
 (defun %default-structure-ugly-print (structure stream)
   (let* ((layout (%instance-layout structure))
-        (name (sb!xc:class-name (layout-class layout)))
+        (name (class-name (layout-class layout)))
         (dd (layout-info layout)))
     (descend-into (stream)
       (write-string "#S(" stream)