Changeset 13830

Timestamp:

01/29/12 23:40:50 (10 years ago)

Author:

rschlatte

Message:

Clear generic-function slot of method object in remove-method.

... Fixes ansi tests ADD-METHOD.1, ADD-METHOD.2.

File:

• trunk/abcl/src/org/armedbear/lisp/clos.lisp (modified) (3 diffs)

trunk/abcl/src/org/armedbear/lisp/clos.lisp

@@ -1778 +1778 @@
 
 (defun std-add-method (gf method)
-  (when (method-generic-function method)
+  (when (and (method-generic-function method)
+             (not (eql gf (method-generic-function method))))
     (error 'simple-error
-           :format-control "ADD-METHOD: ~S is already a method of ~S."
-           :format-arguments (list method (method-generic-function method))))
+           :format-control "~S is already a method of ~S, cannot add to ~S."
+           :format-arguments (list method (method-generic-function method) gf)))
   ;; Remove existing method with same qualifiers and specializers (if any).
   (let ((old-method (%find-method gf (std-method-qualifiers method)
@@ -1790 +1791 @@
   (push method (generic-function-methods gf))
   (dolist (specializer (method-specializers method))
-    (when (typep specializer 'class) ;; FIXME What about EQL specializer objects?
+    ;; FIXME use add-direct-method here (AMOP pg. 165))
+    (when (typep specializer 'class)
       (pushnew method (class-direct-methods specializer))))
   (finalize-standard-generic-function gf)
@@ -1798 +1800 @@
   (setf (generic-function-methods gf)
         (remove method (generic-function-methods gf)))
-  (setf (std-slot-value method 'generic-function) gf)
+  (setf (std-slot-value method 'generic-function) nil)
   (dolist (specializer (method-specializers method))
-    (when (typep specializer 'class) ;; FIXME What about EQL specializer objects?
+    ;; FIXME use remove-direct-method here (AMOP pg. 227)
+    (when (typep specializer 'class)
       (setf (class-direct-methods specializer)
             (remove method (class-direct-methods specializer)))))