Ticket #653: ccl-finalize-bug.lisp

File ccl-finalize-bug.lisp, 997 bytes (added by vii, 10 years ago)

test case

Line 
1(eval-when (:load-toplevel :execute :compile-toplevel)
2  (defclass my-metaclass (standard-class)
3    ())
4
5  (defclass my-effective-slot-definition ( standard-effective-slot-definition)
6    (slot :accessor my-slot))
7
8  (defmethod effective-slot-definition-class ((class my-metaclass) &rest initargs)
9    (declare (ignore initargs))
10    (find-class 'my-effective-slot-definition))
11
12  (defmethod finalize-inheritance :after ((mm my-metaclass))
13    (map nil 'bind-my-slot (class-slots mm)))
14
15  (defmethod validate-superclass ((class my-metaclass) (super standard-class))
16    t)
17
18  (defun bind-my-slot (slotd)
19    (setf (slot-value slotd 'slot) t)))
20
21
22
23(eval-when (:load-toplevel :execute :compile-toplevel)
24  (defclass my-class ()
25    (slot)
26    (:metaclass my-metaclass))
27  (make-instance 'my-class))
28
29(eval-when (:load-toplevel :execute :compile-toplevel)
30  (defun bug ()
31    (let ((c (find-class 'my-class)))
32      (assert (eq (class-finalized-p c) (slot-boundp (first (class-slots c)) 'slot))))))