;;; Siivola. Not all methods for accessing slots are created equal...
(defclass yet-another-obsoletion-super () ((obs :accessor obs-of :initform 0)))
(defclass yet-another-obsoletion-sub (yet-another-obsoletion-super) ())
-(defmethod shared-initialize :after ((i yet-another-obsoletion-super)
+(defmethod shared-initialize :after ((i yet-another-obsoletion-super)
slots &rest init)
(incf (obs-of i)))
(let ((instance (make-instance 'slot-type-subclass)))
(setf (slot-value instance 'slot) 3))
\f
+;;; ctors where there's a non-standard SHARED-INITIALIZE method and an
+;;; initarg which isn't self-evaluating (kpreid on #lisp 2006-01-29)
+(defclass kpreid-enode ()
+ ((slot :initarg not-a-keyword)))
+(defmethod shared-initialize ((o kpreid-enode) slots &key &allow-other-keys)
+ (call-next-method))
+(defun make-kpreid-enode ()
+ (make-instance 'kpreid-enode 'not-a-keyword 3))
+(with-test (:name (:ctor :non-keyword-initarg))
+ (let ((x (make-kpreid-enode))
+ (y (make-kpreid-enode)))
+ (= (slot-value x 'slot) (slot-value y 'slot))))
+\f
+;;; 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)))
+\f
;;;; success