From: David Lichteblau <david@lichteblau.com>
Date: Mon, 17 Dec 2012 17:33:43 +0000 (+0100)
Subject: Preserve superclass structure accessors in infodb
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=d8422b9967f465801891907396bcc5bfde0f3297;p=sbcl.git

Preserve superclass structure accessors in infodb

Do not overwrite inherited structure accessor entries in infodb when
a sub-structure-class gets defined with same conc-name.

Fixes CAS access to slots of direct superclass instances in this
case (and in particular, non-futex safepoint builds).
---

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index c3beef9..9ff1cb9 100644
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -1127,10 +1127,10 @@
       (let* ((accessor-name (dsd-accessor-name dsd))
              (dsd-type (dsd-type dsd)))
         (when accessor-name
-          (setf (info :function :structure-accessor accessor-name) dd)
           (let ((inherited (accessor-inherited-data accessor-name dd)))
             (cond
               ((not inherited)
+               (setf (info :function :structure-accessor accessor-name) dd)
                (multiple-value-bind (reader-designator writer-designator)
                    (slot-accessor-transforms dd dsd)
                  (sb!xc:proclaim `(ftype (sfunction (,dtype) ,dsd-type)
diff --git a/tests/compare-and-swap.impure.lisp b/tests/compare-and-swap.impure.lisp
index e1dc09b..b368f8c 100644
--- a/tests/compare-and-swap.impure.lisp
+++ b/tests/compare-and-swap.impure.lisp
@@ -120,6 +120,10 @@
 (defstruct box
   (word 0 :type sb-vm:word))
 
+;; Have the following tests check that CAS access to the superclass
+;; works in the presence of a subclass sharing the conc-name.
+(defstruct (subbox (:include box) (:conc-name "BOX-")))
+
 (defun inc-box (box n)
   (declare (fixnum n) (box box))
   (loop repeat n