+;;; ALLOCATE-INSTANCE should work on structures, even if defined by
+;;; DEFSTRUCT (and not DEFCLASS :METACLASS STRUCTURE-CLASS).
+(defstruct allocatable-structure a)
+(assert (typep (allocate-instance (find-class 'allocatable-structure))
+ 'allocatable-structure))
+\f
+;;; Bug found by Paul Dietz when devising CPL tests: somewhat
+;;; amazingly, calls to CPL would work a couple of times, and then
+;;; start returning NIL. A fix was found (relating to the
+;;; applicability of constant-dfun optimization) by Gerd Moellmann.
+(defgeneric cpl (x)
+ (:method-combination list)
+ (:method list ((x broadcast-stream)) 'broadcast-stream)
+ (:method list ((x integer)) 'integer)
+ (:method list ((x number)) 'number)
+ (:method list ((x stream)) 'stream)
+ (:method list ((x structure-object)) 'structure-object))
+(assert (equal (cpl 0) '(integer number)))
+(assert (equal (cpl 0) '(integer number)))
+(assert (equal (cpl 0) '(integer number)))
+(assert (equal (cpl 0) '(integer number)))
+(assert (equal (cpl 0) '(integer number)))
+(assert (equal (cpl (make-broadcast-stream))
+ '(broadcast-stream stream structure-object)))
+(assert (equal (cpl (make-broadcast-stream))
+ '(broadcast-stream stream structure-object)))
+(assert (equal (cpl (make-broadcast-stream))
+ '(broadcast-stream stream structure-object)))
+\f
+;;; Bug in CALL-NEXT-METHOD: assignment to the method's formal
+;;; parameters shouldn't affect the arguments to the next method for a
+;;; no-argument call to CALL-NEXT-METHOD
+(defgeneric cnm-assignment (x)
+ (:method (x) x)
+ (:method ((x integer)) (setq x 3)
+ (list x (call-next-method) (call-next-method x))))
+(assert (equal (cnm-assignment 1) '(3 1 3)))
+\f
+;;; Bug reported by Istvan Marko 2003-07-09
+(let ((class-name (gentemp)))
+ (loop for i from 1 to 9
+ for slot-name = (intern (format nil "X~D" i))
+ for initarg-name = (intern (format nil "X~D" i) :keyword)
+ collect `(,slot-name :initarg ,initarg-name) into slot-descs
+ append `(,initarg-name (list 0)) into default-initargs
+ finally (eval `(defclass ,class-name ()
+ (,@slot-descs)
+ (:default-initargs ,@default-initargs))))
+ (let ((f (compile nil `(lambda () (make-instance ',class-name)))))
+ (assert (typep (funcall f) class-name))))
+
+;;; bug 262: DEFMETHOD failed on a generic function without a lambda
+;;; list
+(ensure-generic-function 'bug262)
+(defmethod bug262 (x y)
+ (list x y))
+(assert (equal (bug262 1 2) '(1 2)))
+