0.8.10.42:

         Fixed bug reported by Thomas Burdick (sbcl-devel 2004-05-09),
         which causes an AVER to fail from identical :READER and :WRITER
         names in DEFCLASS slot definitions:
         ... Moved error checking from FIND-METHOD to REAL-GET-METHOD so
                that internals bypassing FIND-METHOD can benefit from it.
         ... Added regression test.

diff --git a/NEWS b/NEWS
index 323e4a1..b063d62 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2403,6 +2403,9 @@ changes in sbcl-0.8.11 relative to sbcl-0.8.10:
     SB-EXT:INHIBIT-WARNINGS OPTIMIZE quality.  See the manual for
     documentation on this feature.  The SB-EXT:INHIBIT-WARNINGS
     quality should be considered deprecated.
+  * fixed bug: DEFCLASS slot definitions with identical :READER and
+    :WRITER names now signal a reasonable error. (reported by Thomas
+    Burdick)
   * fixed bug: CLOSE :ABORT T on appending stream no longer causes
     file deletion.
   * fixed bug: Invalid slot specification errors now print correctly. 

diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp
index db593a5..8cd94fa 100644 (file)
--- a/src/pcl/methods.lisp
+++ b/src/pcl/methods.lisp
@@ -289,37 +289,48 @@
     new))
 
 (defun real-get-method (generic-function qualifiers specializers
-                                        &optional (errorp t))
-  (let* ((lspec (length specializers))
-        (hit 
-         (dolist (method (generic-function-methods generic-function))
-           (let ((mspecializers (method-specializers method)))
-             (aver (= lspec (length mspecializers)))
-             (when (and (equal qualifiers (method-qualifiers method))
-                        (every #'same-specializer-p specializers
-                               (method-specializers method)))
-               (return method))))))
-    (cond (hit hit)
-         ((null errorp) nil)
-         (t
-          (error "~@<There is no method on ~S with ~
-                   ~:[no qualifiers~;~:*qualifiers ~S~] ~
-                   and specializers ~S.~@:>"
-                 generic-function qualifiers specializers)))))
+                       &optional (errorp t) 
+                       always-check-specializers)
+  (let ((lspec (length specializers))
+       (methods (generic-function-methods generic-function)))
+    (when (or methods always-check-specializers)
+      (let ((nreq (length (arg-info-metatypes (gf-arg-info generic-function)))))
+       ;; Since we internally bypass FIND-METHOD by using GET-METHOD
+       ;; instead we need to to this here or users may get hit by a
+       ;; failed AVER instead of a sensible error message.
+       (when (/= lspec nreq)
+         (error "~@<The generic function ~S takes ~D required argument~:P; ~
+                 was asked to find a method with specializers ~S~@:>"
+                generic-function nreq specializers))))
+    (let ((hit 
+          (dolist (method methods)
+            (let ((mspecializers (method-specializers method)))
+              (aver (= lspec (length mspecializers)))
+              (when (and (equal qualifiers (method-qualifiers method))
+                         (every #'same-specializer-p specializers
+                                (method-specializers method)))
+                (return method))))))
+      (cond (hit hit)
+           ((null errorp) nil)
+           (t
+            (error "~@<There is no method on ~S with ~
+                    ~:[no qualifiers~;~:*qualifiers ~S~] ~
+                    and specializers ~S.~@:>"
+                   generic-function qualifiers specializers))))))
 
 (defmethod find-method ((generic-function standard-generic-function)
                        qualifiers specializers &optional (errorp t))
-  (let ((nreq (length (arg-info-metatypes (gf-arg-info generic-function)))))
-    ;; ANSI: "The specializers argument contains the parameter
-    ;; specializers for the method. It must correspond in length to
-    ;; the number of required arguments of the generic function, or an
-    ;; error is signaled."
-    (when (/= (length specializers) nreq)
-      (error "~@<The generic function ~S takes ~D required argument~:P; ~
-              was asked to find a method with specializers ~S~@:>"
-            generic-function nreq specializers))
-    (real-get-method generic-function qualifiers
-                    (parse-specializers specializers) errorp)))
+  ;; ANSI about FIND-METHOD: "The specializers argument contains the
+  ;; parameter specializers for the method. It must correspond in
+  ;; length to the number of required arguments of the generic
+  ;; function, or an error is signaled."
+  ;;
+  ;; This error checking is done by REAL-GET-METHOD.
+  (real-get-method generic-function 
+                  qualifiers
+                  (parse-specializers specializers) 
+                  errorp 
+                  t))
 \f
 ;;; Compute various information about a generic-function's arglist by looking
 ;;; at the argument lists of the methods. The hair for trying not to use

diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index 7ef3e46..ccdfeca 100644 (file)
--- a/tests/clos.impure.lisp
+++ b/tests/clos.impure.lisp
@@ -784,5 +784,13 @@
 (assert (eq (find-class 'one-more-to-obsolete) 
            (make-instances-obsolete (find-class 'one-more-to-obsolete))))
 
+;;; Sensible error instead of a BUG. Reported by Thomas Burdick.
+(multiple-value-bind (value err)
+    (ignore-errors
+      (defclass slot-def-with-duplicate-accessors ()
+       ((slot :writer get-slot :reader get-slot))))
+  (assert (typep err 'error))
+  (assert (not (typep err 'sb-int:bug))))
+
 ;;;; success
 (sb-ext:quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index 95de0ce..a2ee4d0 100644 (file)
--- 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.10.41"
+"0.8.10.42"