From ae47ad0774edd8cb376772ae7e615428295f979e Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Fri, 15 Apr 2005 21:36:06 +0000 Subject: [PATCH] 0.8.21.45: Merge patch (Zach Beane sbcl-devel 2005-04-13) for redefining classes whose previous definition had an accessor which collided with a function. --- BUGS | 13 +++++++++++++ NEWS | 3 +++ src/pcl/std-class.lisp | 34 ++++++++++++++++++++-------------- tests/clos.impure.lisp | 17 +++++++++++++++++ version.lisp-expr | 2 +- 5 files changed, 54 insertions(+), 15 deletions(-) diff --git a/BUGS b/BUGS index 656648f..bf2c746 100644 --- a/BUGS +++ b/BUGS @@ -2065,3 +2065,16 @@ WORKAROUND: 379: TRACE :ENCAPSULATE NIL broken on ppc/darwin See commented-out test-case in debug.impure.lisp. + +380: Accessor redefinition fails because of old accessor name + When redefining an accessor, SB-PCL::FIX-SLOT-ACCESSORS may try to + find the generic function named by the old accessor name using + ENSURE-GENERIC-FUNCTION and then remove the old accessor's method in + the GF. If the old name does not name a function, or if the old name + does not name a generic function, no attempt to find the GF or remove + any methods is made. + + However, if an unrelated GF with an incompatible lambda list exists, + the class redefinition will fail when SB-PCL::REMOVE-READER-METHOD + tries to find and remove a method with an incompatible lambda list + from the unrelated generic function. diff --git a/NEWS b/NEWS index 8b51c9d..c142eb1 100644 --- a/NEWS +++ b/NEWS @@ -50,6 +50,9 @@ changes in sbcl-0.8.22 relative to sbcl-0.8.21: on x86-64 * bug fix: setting 31st element of a bit vector to zero did not work on Alpha-32. + * bug fix: redefining a class definition which failed due to a + previous accessor / function clash now works (but see BUGS entry + #380 for more problems in this area). (thanks to Zach Beane) * fixed some bugs related to Unicode integration: ** the restarts for recovering from input and output encoding errors only appear when there is in fact such an error to diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp index 09f820a..89815b9 100644 --- a/src/pcl/std-class.lisp +++ b/src/pcl/std-class.lisp @@ -744,20 +744,26 @@ (defun fix-slot-accessors (class dslotds add/remove) (flet ((fix (gfspec name r/w) - (let ((gf (if (fboundp gfspec) - (without-package-locks - (ensure-generic-function gfspec)) - (ensure-generic-function - gfspec :lambda-list (case r/w - (r '(object)) - (w '(new-value object))))))) - (case r/w - (r (if (eq add/remove 'add) - (add-reader-method class gf name) - (remove-reader-method class gf))) - (w (if (eq add/remove 'add) - (add-writer-method class gf name) - (remove-writer-method class gf))))))) + (let ((gf (cond ((eq add/remove 'add) + (if (fboundp gfspec) + (without-package-locks + (ensure-generic-function gfspec)) + (ensure-generic-function + gfspec :lambda-list (case r/w + (r '(object)) + (w '(new-value object)))))) + ((generic-function-p (and (fboundp gfspec) + (fdefinition gfspec))) + (without-package-locks + (ensure-generic-function gfspec)))))) + (when gf + (case r/w + (r (if (eq add/remove 'add) + (add-reader-method class gf name) + (remove-reader-method class gf))) + (w (if (eq add/remove 'add) + (add-writer-method class gf name) + (remove-writer-method class gf)))))))) (dolist (dslotd dslotds) (let ((slot-name (slot-definition-name dslotd))) (dolist (r (slot-definition-readers dslotd)) diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp index b4393ca..763ea83 100644 --- a/tests/clos.impure.lisp +++ b/tests/clos.impure.lisp @@ -905,6 +905,23 @@ (method-for-defined-classes #\3)) "3"))) + + +;;; When class definition does not complete due to a bad accessor +;;; name, do not cause an error when a new accessor name is provided +;;; during class redefinition + +(defun existing-name (object) + (list object)) + +(assert (raises-error? (defclass redefinition-of-accessor-class () + ((slot :accessor existing-name))))) + +(defclass redefinition-of-accessor-class () + ((slot :accessor new-name))) + + + (load "package-ctor-bug.lisp") (assert (= (package-ctor-bug:test) 3)) (delete-package "PACKAGE-CTOR-BUG") diff --git a/version.lisp-expr b/version.lisp-expr index e081594..fe9e1d4 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.8.21.44" +"0.8.21.45" -- 1.7.10.4