[armedbear-cvs] r14289 - trunk/abcl/src/org/armedbear/lisp

[rschlatte at common-lisp.net]

Author: rschlatte
Date: Tue Dec  4 08:36:39 2012
New Revision: 14289

Log:
Don't shortcut add-method for subclasses of standard-generic-function

- Fixes #276

- Reported by Pascal Costanza

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

Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/clos.lisp	Mon Dec  3 06:43:07 2012	(r14288)
+++ trunk/abcl/src/org/armedbear/lisp/clos.lisp	Tue Dec  4 08:36:39 2012	(r14289)
@@ -1718,7 +1718,7 @@
         ;; Remove methods defined by previous DEFGENERIC forms, as
         ;; specified by CLHS, 7.7 (Macro DEFGENERIC).
         (dolist (method (generic-function-initial-methods gf))
-          (if (typep gf 'standard-generic-function)
+          (if (eq  (class-of gf) +the-standard-generic-function-class+)
               (progn
                 (std-remove-method gf method)
                 (map-dependents gf
@@ -2125,7 +2125,9 @@
            (if (eq (generic-function-method-class gf) +the-standard-method-class+)
                (apply #'make-instance-standard-method gf all-keys)
                (apply #'make-instance (generic-function-method-class gf) all-keys))))
-      (if (eq (generic-function-method-class gf) +the-standard-method-class+)
+      (if (and
+           (eq (generic-function-method-class gf) +the-standard-method-class+)
+           (eq (class-of gf) +the-standard-generic-function-class+))
           (progn
             (std-add-method gf method)
             (map-dependents gf