0.pre8.65:

	Make COMPUTE-EFFECTIVE-SLOT-DEFINITION (more) AMOP compliant, as
		per KMR cmucl-imp 2003-04-12
	... write a FIXME in the test, because I don't understand the
		required behaviour, but it's better than it was.

diff --git a/src/pcl/generic-functions.lisp b/src/pcl/generic-functions.lisp
index 4e2eb2c..4fc9134 100644 (file)
--- a/src/pcl/generic-functions.lisp
+++ b/src/pcl/generic-functions.lisp
@@ -328,8 +328,6 @@
 (defgeneric compute-applicable-methods-using-classes
   (generic-function classes))
 
-(defgeneric compute-effective-slot-definition (class dslotds))
-
 (defgeneric compute-effective-slot-definition-initargs (class direct-slotds))
 
 (defgeneric describe-object (object stream))
@@ -415,6 +413,8 @@
                                      combin
                                      applicable-methods))
 
+(defgeneric compute-effective-slot-definition (class name dslotds))
+
 (defgeneric compute-slot-accessor-info (slotd type gf))
 
 (defgeneric default-initargs (class initargs defaults))

diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index a8f2cce..06d0779 100644 (file)
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -895,6 +895,7 @@
              (push (list name slot) name-dslotds-alist)))))
     (mapcar (lambda (direct)
              (compute-effective-slot-definition class
+                                                (car direct)
                                                 (nreverse (cdr direct))))
            name-dslotds-alist)))
 
@@ -968,8 +969,10 @@
 (defmethod compute-slots ((class structure-class))
   (mapcan (lambda (superclass)
            (mapcar (lambda (dslotd)
-                     (compute-effective-slot-definition class
-                                                        (list dslotd)))
+                     (compute-effective-slot-definition
+                      class
+                      (slot-definition-name dslotd)
+                      (list dslotd)))
                    (class-direct-slots superclass)))
          (reverse (slot-value class 'class-precedence-list))))
 
@@ -978,7 +981,8 @@
     (mapc #'initialize-internal-slot-functions eslotds)
     eslotds))
 
-(defmethod compute-effective-slot-definition ((class slot-class) dslotds)
+(defmethod compute-effective-slot-definition ((class slot-class) name dslotds)
+  (declare (ignore name))
   (let* ((initargs (compute-effective-slot-definition-initargs class dslotds))
         (class (effective-slot-definition-class class initargs)))
     (apply #'make-instance class initargs)))

diff --git a/tests/mop.impure.lisp b/tests/mop.impure.lisp
index 9f2e9e5..e010957 100644 (file)
--- a/tests/mop.impure.lisp
+++ b/tests/mop.impure.lisp
@@ -146,5 +146,20 @@
 (defvar *automethod-object* (make-instance 'automethod-object))
 (assert (typep *automethod-object* 'automethod-object))
 \f
+;;; COMPUTE-EFFECTIVE-SLOT-DEFINITION should take three arguments, one
+;;; of which is the name of the slot.
+(defvar *compute-effective-slot-definition-count* 0)
+(defmethod compute-effective-slot-definition :before
+    (class (name (eql 'foo)) dsds)
+  (incf *compute-effective-slot-definition-count*))
+(defclass cesd-test-class ()
+  ((foo :initarg :foo)))
+(make-instance 'cesd-test-class :foo 3)
+;;; FIXME: this assertion seems a little weak.  I don't know why
+;;; COMPUTE-EFFECTIVE-SLOT-DEFINITION gets called twice in this
+;;; sequence, nor whether that's compliant with AMOP.  -- CSR,
+;;; 2003-04-17
+(assert (> *compute-effective-slot-definition-count* 0))
+\f
 ;;;; success
 (sb-ext:quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index 0f5249c..faff0e9 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.pre8.64"
+"0.pre8.65"