From 796d3abb79fdb3ac896b639b83756ef9d86007f6 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Mon, 12 May 2003 14:10:30 +0000 Subject: [PATCH] 0.8alpha.0.25: A couple of PCL fixes: ... REMOVE-METHOD should always return its generic function argument. Make it so. ... SHARED-INITIALIZE should initialize :CLASS slots too. --- NEWS | 4 ++++ src/pcl/init.lisp | 14 +++++++++----- src/pcl/methods.lisp | 11 +++++------ version.lisp-expr | 2 +- 4 files changed, 19 insertions(+), 12 deletions(-) diff --git a/NEWS b/NEWS index ba73d33..5a501fd 100644 --- a/NEWS +++ b/NEWS @@ -1727,6 +1727,10 @@ changes in sbcl-0.8.0 relative to sbcl-0.8alpha.0 ** :ALLOCATION :CLASS slots are better treated; their values are updated on class redefinition, and initforms inherited from superclasses are applied. + ** REMOVE-METHOD returns its generic function argument even when + no method was removed. + ** SHARED-INITIALIZE now initializes the values of the requested + slots, including those with :ALLOCATION :CLASS. planned incompatible changes in 0.8.x: * (not done yet, but planned:) When the profiling interface settles diff --git a/src/pcl/init.lisp b/src/pcl/init.lisp index 2fc6eba..236fc86 100644 --- a/src/pcl/init.lisp +++ b/src/pcl/init.lisp @@ -132,11 +132,15 @@ (loop for slotd in (class-slots class) unless (initialize-slot-from-initarg class instance slotd) collect slotd))) - (loop for slotd in initfn-slotds - when (and (not (eq :class (slot-definition-allocation slotd))) - (or (eq t slot-names) - (memq (slot-definition-name slotd) slot-names))) do - (initialize-slot-from-initfunction class instance slotd))) + (dolist (slotd initfn-slotds) + (if (eq (slot-definition-allocation slotd) :class) + (when (or (eq t slot-names) + (memq (slot-definition-name slotd) slot-names)) + (unless (slot-boundp-using-class class instance slotd) + (initialize-slot-from-initfunction class instance slotd))) + (when (or (eq t slot-names) + (memq (slot-definition-name slotd) slot-names)) + (initialize-slot-from-initfunction class instance slotd))))) instance)) ;;; If initargs are valid return nil, otherwise signal an error. diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp index 8d0f176..dff22ed 100644 --- a/src/pcl/methods.lisp +++ b/src/pcl/methods.lisp @@ -515,12 +515,11 @@ method))) (defun real-remove-method (generic-function method) - ;; Note: Error check prohibited by ANSI spec removed. (when (eq generic-function (method-generic-function method)) - (let* ((name (generic-function-name generic-function)) + (let* ((name (generic-function-name generic-function)) (specializers (method-specializers method)) - (methods (generic-function-methods generic-function)) - (new-methods (remove method methods))) + (methods (generic-function-methods generic-function)) + (new-methods (remove method methods))) (setf (method-generic-function method) nil) (setf (generic-function-methods generic-function) new-methods) (dolist (specializer (method-specializers method)) @@ -529,8 +528,8 @@ (update-ctors 'remove-method :generic-function generic-function :method method) - (update-dfun generic-function) - generic-function))) + (update-dfun generic-function))) + generic-function) (defun compute-applicable-methods-function (generic-function arguments) (values (compute-applicable-methods-using-types diff --git a/version.lisp-expr b/version.lisp-expr index 4497f8f..25e32af 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8alpha.0.24" +"0.8alpha.0.25" -- 1.7.10.4