diff --git a/general-info/release-19a.txt b/general-info/release-19a.txt index 8def337e24aef2d8aae4d2cbfb2e36c2b0717768..00416a719369ed48717d4f131d7ea6e1b75e8aae 100644 --- a/general-info/release-19a.txt +++ b/general-info/release-19a.txt @@ -75,6 +75,8 @@ New in this release: - SUBTYPEP works in presence of forward-referenced classes. - Accessing slots of specialized parameters in (SETF SLOT-VALUE-USING-CLASS) methods works. + - DIRECT-SLOT-DEFINITION-CLASS and EFFECTIVE-SLOT-DEFINITION-CLASS + AMOP compliant. * Improvements to Hemlock, the Emacs-like editor: diff --git a/pcl/generic-functions.lisp b/pcl/generic-functions.lisp index 397d35dcc134fdb7861bb202bba5b0becb63f456..26189aa96af8ad3a7a047716d98f81cc738945bb 100644 --- a/pcl/generic-functions.lisp +++ b/pcl/generic-functions.lisp @@ -1,7 +1,7 @@ ;;;-*-Mode:LISP; Package:PCL; Base:10; Syntax:Common-lisp -*- (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/generic-functions.lisp,v 1.22 2003/04/13 11:57:16 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/generic-functions.lisp,v 1.23 2003/04/29 10:33:51 gerd Exp $") ;;; (in-package :pcl) @@ -513,11 +513,11 @@ ; (slot-object t) ; (t t) -(defgeneric direct-slot-definition-class (class initargs)) +(defgeneric direct-slot-definition-class (class &rest initargs)) ; (structure-class t) ; (std-class t) -(defgeneric effective-slot-definition-class (class initargs)) +(defgeneric effective-slot-definition-class (class &rest initargs)) ; (std-class t) ; (structure-class t) diff --git a/pcl/std-class.lisp b/pcl/std-class.lisp index e3053a933316811f6c422fdd57e0070133b11fd3..6b673caba4b51d00b778b1cf95270ff22cd8fdbc 100644 --- a/pcl/std-class.lisp +++ b/pcl/std-class.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.56 2003/04/26 21:24:06 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.57 2003/04/29 10:33:51 gerd Exp $") (in-package :pcl) @@ -709,7 +709,8 @@ (make-class-predicate class predicate-name) (add-slot-accessors class direct-slots)) -(defmethod direct-slot-definition-class ((class structure-class) initargs) +(defmethod direct-slot-definition-class ((class structure-class) + &rest initargs) (declare (ignore initargs)) (find-class 'structure-direct-slot-definition)) @@ -927,13 +928,14 @@ ;;; ;;; ;;; -(defmethod direct-slot-definition-class ((class std-class) initargs) +(defmethod direct-slot-definition-class ((class std-class) &rest initargs) (declare (ignore initargs)) (find-class 'standard-direct-slot-definition)) (defun make-direct-slotd (class initargs) (let ((initargs (list* :class class initargs))) - (apply #'make-instance (direct-slot-definition-class class initargs) + (apply #'make-instance + (apply #'direct-slot-definition-class class initargs) initargs))) ;;; @@ -1048,14 +1050,15 @@ ((class slot-class) slot-name dslotds) (declare (ignore slot-name)) (let* ((initargs (compute-effective-slot-definition-initargs class dslotds)) - (class (effective-slot-definition-class class initargs))) + (class (apply #'effective-slot-definition-class class initargs))) (apply #'make-instance class initargs))) -(defmethod effective-slot-definition-class ((class std-class) initargs) +(defmethod effective-slot-definition-class ((class std-class) &rest initargs) (declare (ignore initargs)) (find-class 'standard-effective-slot-definition)) -(defmethod effective-slot-definition-class ((class structure-class) initargs) +(defmethod effective-slot-definition-class ((class structure-class) + &rest initargs) (declare (ignore initargs)) (find-class 'structure-effective-slot-definition))