X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fclos.impure.lisp;h=c415f1a8ffa73d8750a311da34cc6eb428bcbd36;hb=aa8c8cd473f1d487fa2c1a7490c78a59b9955bbe;hp=19c91023a532c510a1c6c27d1e11c275bc53903b;hpb=46c2f716d2ea2290951a30a39c7356ca51d247f1;p=sbcl.git

diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index 19c9102..c415f1a 100644
--- a/tests/clos.impure.lisp
+++ b/tests/clos.impure.lisp
@@ -1244,4 +1244,28 @@
         (y (make-kpreid-enode)))
     (= (slot-value x 'slot) (slot-value y 'slot))))
 
+;;; defining a class hierarchy shouldn't lead to spurious classoid
+;;; errors on TYPEP questions (reported by Tim Moore on #lisp
+;;; 2006-03-10)
+(defclass backwards-2 (backwards-1) (a b))
+(defclass backwards-3 (backwards-2) ())
+(defun typep-backwards-3 (x)
+  (typep x 'backwards-3))
+(defclass backwards-1 () (a b))
+(assert (not (typep-backwards-3 1)))
+(assert (not (typep-backwards-3 (make-instance 'backwards-2))))
+(assert (typep-backwards-3 (make-instance 'backwards-3)))
+
+(defgeneric remove-method-1 (x)
+  (:method ((x integer)) (1+ x)))
+(defgeneric remove-method-2 (x)
+  (:method ((x integer)) (1- x)))
+(assert (eq #'remove-method-1
+            (remove-method #'remove-method-1
+                           (find-method #'remove-method-2
+                                        nil
+                                        (list (find-class 'integer))))))
+(assert (= (remove-method-1 3) 4))
+(assert (= (remove-method-2 3) 2))
+
 ;;;; success