From 2e4a94905d6e70d0e1c45ad86c3b29c1b36c96fc Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Thu, 17 Apr 2003 15:33:57 +0000 Subject: [PATCH] 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. --- src/pcl/generic-functions.lisp | 4 ++-- src/pcl/std-class.lisp | 10 +++++++--- tests/mop.impure.lisp | 15 +++++++++++++++ version.lisp-expr | 2 +- 4 files changed, 25 insertions(+), 6 deletions(-) diff --git a/src/pcl/generic-functions.lisp b/src/pcl/generic-functions.lisp index 4e2eb2c..4fc9134 100644 --- 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 --- 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 --- 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)) +;;; 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)) + ;;;; success (sb-ext:quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 0f5249c..faff0e9 100644 --- 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" -- 1.7.10.4