X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fstd-class.lisp;h=5a86391467e6b13ff79cc4226bec837df576759a;hb=964e644f3f1ec2c169b1def87f11e2f5b09a748e;hp=76edec5438e133e874ddd58910ad9e9913e78667;hpb=a14326d4e328c778cd292884099eee7d2c1b8d0f;p=sbcl.git

diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index 76edec5..5a86391 100644
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -141,6 +141,8 @@
 
 (defmethod class-slot-cells ((class std-class))
   (plist-value class 'class-slot-cells))
+(defmethod (setf class-slot-cells) (new-value (class std-class))
+  (setf (plist-value class 'class-slot-cells) new-value))
 
 ;;;; class accessors that are even a little bit more complicated than those
 ;;;; above. These have a protocol for updating them, we must implement that
@@ -1040,8 +1042,20 @@
 	       (incf location))
 	      (:class
 	       (let* ((name (slot-definition-name eslotd))
-		      (from-class (slot-definition-allocation-class eslotd))
-		      (cell (assq name (class-slot-cells from-class))))
+		      (from-class 
+		       (or 
+			(slot-definition-allocation-class eslotd)
+			;; we get here if the user adds an extra slot
+			;; himself...
+			(setf (slot-definition-allocation-class eslotd) 
+			      class)))
+		      ;; which raises the question of what we should
+		      ;; do if we find that said user has added a slot
+		      ;; with the same name as another slot...
+		      (cell (or (assq name (class-slot-cells from-class))
+				(setf (class-slot-cells from-class)
+				      (cons (cons name +slot-unbound+)
+					    (class-slot-cells from-class))))))
 		 (aver (consp cell))
 		 (if (eq +slot-unbound+ (cdr cell))
 		     ;; We may have inherited an initfunction
@@ -1050,6 +1064,8 @@
 			   (rplacd cell (funcall initfun))
 			   cell))
 		     cell)))))
+      (unless (slot-definition-class eslotd)
+	(setf (slot-definition-class eslotd) class))
       (initialize-internal-slot-functions eslotd))))
 
 (defmethod compute-slots ((class funcallable-standard-class))