0.8.21.45:
authorChristophe Rhodes <csr21@cam.ac.uk>
Fri, 15 Apr 2005 21:36:06 +0000 (21:36 +0000)
committerChristophe Rhodes <csr21@cam.ac.uk>
Fri, 15 Apr 2005 21:36:06 +0000 (21:36 +0000)
Merge patch (Zach Beane sbcl-devel 2005-04-13) for redefining
classes whose previous definition had an accessor which collided
with a function.

BUGS
NEWS
src/pcl/std-class.lisp
tests/clos.impure.lisp
version.lisp-expr

diff --git a/BUGS b/BUGS
index 656648f..bf2c746 100644 (file)
--- 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 (file)
--- 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
index 09f820a..89815b9 100644 (file)
 
 (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)) 
index b4393ca..763ea83 100644 (file)
                     (method-for-defined-classes #\3))
                   "3")))
 
+
+\f
+;;; 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)))
+
+\f
+
 (load "package-ctor-bug.lisp")
 (assert (= (package-ctor-bug:test) 3))
 (delete-package "PACKAGE-CTOR-BUG")
index e081594..fe9e1d4 100644 (file)
@@ -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"