Ticket #653: ccl-finalize-bug.lisp

(eval-when (:load-toplevel :execute :compile-toplevel)
  (defclass my-metaclass (standard-class)
    ())

  (defclass my-effective-slot-definition ( standard-effective-slot-definition)
    (slot :accessor my-slot))

  (defmethod effective-slot-definition-class ((class my-metaclass) &rest initargs)
    (declare (ignore initargs))
    (find-class 'my-effective-slot-definition))

  (defmethod finalize-inheritance :after ((mm my-metaclass))
    (map nil 'bind-my-slot (class-slots mm)))

  (defmethod validate-superclass ((class my-metaclass) (super standard-class))
    t)

  (defun bind-my-slot (slotd)
    (setf (slot-value slotd 'slot) t)))



(eval-when (:load-toplevel :execute :compile-toplevel)
  (defclass my-class ()
    (slot)
    (:metaclass my-metaclass))
  (make-instance 'my-class))

(eval-when (:load-toplevel :execute :compile-toplevel)
  (defun bug ()
    (let ((c (find-class 'my-class)))
      (assert (eq (class-finalized-p c) (slot-boundp (first (class-slots c)) 'slot))))))