Changeset 13830


Ignore:
Timestamp:
01/29/12 23:40:50 (9 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:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r13827 r13830  
    17781778
    17791779(defun std-add-method (gf method)
    1780   (when (method-generic-function method)
     1780  (when (and (method-generic-function method)
     1781             (not (eql gf (method-generic-function method))))
    17811782    (error 'simple-error
    1782            :format-control "ADD-METHOD: ~S is already a method of ~S."
    1783            :format-arguments (list method (method-generic-function method))))
     1783           :format-control "~S is already a method of ~S, cannot add to ~S."
     1784           :format-arguments (list method (method-generic-function method) gf)))
    17841785  ;; Remove existing method with same qualifiers and specializers (if any).
    17851786  (let ((old-method (%find-method gf (std-method-qualifiers method)
     
    17901791  (push method (generic-function-methods gf))
    17911792  (dolist (specializer (method-specializers method))
    1792     (when (typep specializer 'class) ;; FIXME What about EQL specializer objects?
     1793    ;; FIXME use add-direct-method here (AMOP pg. 165))
     1794    (when (typep specializer 'class)
    17931795      (pushnew method (class-direct-methods specializer))))
    17941796  (finalize-standard-generic-function gf)
     
    17981800  (setf (generic-function-methods gf)
    17991801        (remove method (generic-function-methods gf)))
    1800   (setf (std-slot-value method 'generic-function) gf)
     1802  (setf (std-slot-value method 'generic-function) nil)
    18011803  (dolist (specializer (method-specializers method))
    1802     (when (typep specializer 'class) ;; FIXME What about EQL specializer objects?
     1804    ;; FIXME use remove-direct-method here (AMOP pg. 227)
     1805    (when (typep specializer 'class)
    18031806      (setf (class-direct-methods specializer)
    18041807            (remove method (class-direct-methods specializer)))))
Note: See TracChangeset for help on using the changeset viewer.