[armedbear-cvs] r14343 - branches/1.1.x/src/org/armedbear/lisp

[mevenson at common-lisp.net]

Author: mevenson
Date: Sun Dec 23 08:46:01 2012
New Revision: 14343

Log:
Backport r14342 | rschlatte | 2012-12-23 16:19:32 +0100 (Sun, 23 Dec 2012) | 3 lines

Add new slots at the end in inherited classes

- Fixes #280 (reported by Pascal Costanza)

Modified:
   branches/1.1.x/src/org/armedbear/lisp/clos.lisp

Modified: branches/1.1.x/src/org/armedbear/lisp/clos.lisp
==============================================================================
--- branches/1.1.x/src/org/armedbear/lisp/clos.lisp	Sun Dec 23 07:19:32 2012	(r14342)
+++ branches/1.1.x/src/org/armedbear/lisp/clos.lisp	Sun Dec 23 08:46:01 2012	(r14343)
@@ -675,11 +675,12 @@
 ;;; Slot inheritance
 
 (defun std-compute-slots (class)
-  (let* ((all-slots (nreverse ;; Slots of base class should come first
-                     (mapappend #'(lambda (c) (reverse (class-direct-slots c)))
-                                (reverse (class-precedence-list class)))))
-         (all-names (remove-duplicates
-                     (mapcar 'slot-definition-name all-slots))))
+  (let* ((all-slots (mapappend #'(lambda (c) (class-direct-slots c))
+                               ;; Slots of base class must come first
+                               (reverse (class-precedence-list class))))
+         (all-names (delete-duplicates
+                     (mapcar 'slot-definition-name all-slots)
+                     :from-end t)))
     (mapcar #'(lambda (name)
                (funcall
                 (if (eq (class-of class) +the-standard-class+)
@@ -687,9 +688,12 @@
                     #'compute-effective-slot-definition)
                 class
                 name
-                (remove name all-slots
-                        :key 'slot-definition-name
-                        :test-not #'eq)))
+                ;; Slot of inherited class must override initfunction,
+                ;; documentation of base class
+                (nreverse
+                 (remove name all-slots
+                         :key 'slot-definition-name
+                         :test-not #'eq))))
             all-names)))
 
 (defun std-compute-effective-slot-definition (class name direct-slots)