X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=inline;f=tests%2Fmop.impure.lisp;h=8aad5b4101fb46b2217555361f6d4424e73d6f8a;hb=22a6702974b7d6ff4e8f2b3b7b5ff446fc632de0;hp=3c3ae3e065e9081c7967231ec41f277bf08e9d3c;hpb=2d237dbc3edb1f6f5337ab19dd74a317e43234db;p=sbcl.git diff --git a/tests/mop.impure.lisp b/tests/mop.impure.lisp index 3c3ae3e..8aad5b4 100644 --- a/tests/mop.impure.lisp +++ b/tests/mop.impure.lisp @@ -382,6 +382,23 @@ (let ((subs (sb-mop:class-direct-subclasses (find-class 'bug-331-super)))) (assert (= 1 (length subs))) (assert (eq (car subs) (find-class 'bug-331-sub)))) +;;; (addendum to test for #331: conditions suffered the same problem) +(define-condition condition-bug-331-super () ()) +(define-condition condition-bug-331-sub (condition-bug-331-super) ()) +(let ((subs (sb-mop:class-direct-subclasses + (find-class 'condition-bug-331-super)))) + (assert (= 1 (length subs))) + (assert (eq (car subs) (find-class 'condition-bug-331-sub)))) +;;; (addendum to the addendum: the fix for this revealed breakage in +;;; REINITIALIZE-INSTANCE) +(define-condition condition-bug-331a () ((slot331a :reader slot331a))) +(reinitialize-instance (find-class 'condition-bug-331a)) +(let* ((gf #'slot331a) + (methods (sb-mop:generic-function-methods gf))) + (assert (= (length methods) 1)) + (assert (eq (car methods) + (find-method #'slot331a nil + (list (find-class 'condition-bug-331a)))))) ;;; detection of multiple class options in defclass, reported by Bruno Haible (defclass option-class (standard-class) @@ -434,7 +451,7 @@ ((scforfsc-slot :initarg :scforfsc-slot :accessor scforfsc-slot))) (defvar *standard-class-for-fsc* (make-instance 'standard-class-for-fsc :scforfsc-slot 1)) -(defclass fsc-with-standard-class-superclass +(defclass fsc-with-standard-class-superclass (standard-class-for-fsc funcallable-standard-object) ((fsc-slot :initarg :fsc-slot :accessor fsc-slot)) (:metaclass funcallable-standard-class))