+;;;; Built-in structure and condition layouts should have NIL in
+;;;; LAYOUT-FOR-STD-CLASS-P, and classes should have T.
+
+(assert (not (sb-pcl::layout-for-std-class-p (sb-pcl::find-layout 'warning))))
+(assert (not (sb-pcl::layout-for-std-class-p (sb-pcl::find-layout 'hash-table))))
+(assert (eq t (sb-pcl::layout-for-std-class-p (sb-pcl::find-layout 'standard-object))))
+
+;;;; bug 402: PCL used to warn about non-standard declarations
+(declaim (declaration bug-402-d))
+(defgeneric bug-402-gf (x))
+(with-test (:name :bug-402)
+ (handler-bind ((warning #'error))
+ (eval '(defmethod bug-402-gf (x)
+ (declare (bug-402-d x))
+ x))))
+
+;;;; non-keyword :default-initargs + :before method on shared initialize
+;;;; interacted badly with CTOR optimizations
+(defclass ctor-default-initarg-problem ()
+ ((slot :initarg slotto))
+ (:default-initargs slotto 123))
+(defmethod shared-initialize :before ((instance ctor-default-initarg-problem) slot-names &rest initargs)
+ (format t "~&Rock on: ~A~%" initargs))
+(defun provoke-ctor-default-initarg-problem ()
+ (make-instance 'ctor-default-initarg-problem))
+(handler-bind ((warning #'error))
+ (assert (= 123 (slot-value (provoke-ctor-default-initarg-problem) 'slot))))
+
+;;;; discriminating net on streams used to generate code deletion notes on
+;;;; first call
+(defgeneric stream-fd (stream direction))
+(defmethod stream-fd ((stream sb-sys:fd-stream) direction)
+ (declare (ignore direction))
+ (sb-sys:fd-stream-fd stream))
+(defmethod stream-fd ((stream synonym-stream) direction)
+ (stream-fd (symbol-value (synonym-stream-symbol stream)) direction))
+(defmethod stream-fd ((stream two-way-stream) direction)
+ (ecase direction
+ (:input
+ (stream-fd
+ (two-way-stream-input-stream stream) direction))
+ (:output
+ (stream-fd
+ (two-way-stream-output-stream stream) direction))))
+(with-test (:name (:discriminating-name :code-deletion-note))
+ (handler-bind ((compiler-note #'error))
+ (stream-fd sb-sys:*stdin* :output)
+ (stream-fd sb-sys:*stdin* :output)))
+
+(with-test (:name :bug-380)
+ (defclass bug-380 ()
+ ((slot :accessor bug380-slot)))
+ (fmakunbound 'foo-slot)
+ (defgeneric foo-slot (x y z))
+ (defclass foo ()
+ ((slot :accessor foo-slot-value))))
+
+;;; SET and (SETF SYMBOL-VALUE) used to confuse permuation vector
+;;; optimizations
+(defclass fih ()
+ ((x :initform :fih)))
+(defclass fah ()
+ ((x :initform :fah)))
+(declaim (special *fih*))
+(defmethod fihfah ((*fih* fih))
+ (set '*fih* (make-instance 'fah))
+ (list (slot-value *fih* 'x)
+ (eval '(slot-value *fih* 'x))))
+(defmethod fihfah ((fah fah))
+ (declare (special fah))
+ (set 'fah (make-instance 'fih))
+ (list (slot-value fah 'x)
+ (eval '(slot-value fah 'x))))
+(with-test (:name :set-of-a-method-specializer)
+ (assert (equal '(:fah :fah) (fihfah (make-instance 'fih))))
+ (assert (equal '(:fih :fih) (fihfah (make-instance 'fah)))))
+
+(defmethod no-implicit-declarations-for-local-specials ((faax double-float))
+ (declare (special faax))
+ (set 'faax (when (< faax 0) (- faax)))
+ faax)
+(with-test (:name :no-implicit-declarations-for-local-specials)
+ (assert (not (no-implicit-declarations-for-local-specials 1.0d0))))
+
+(defstruct bug-357-a
+ slot1
+ (slot2 t)
+ (slot3 (coerce pi 'single-float) :type single-float))
+(defclass bug-357-b (bug-357-a)
+ ((slot2 :initform 't2)
+ (slot4 :initform -44)
+ (slot5)
+ (slot6 :initform t)
+ (slot7 :initform (floor (* pi pi)))
+ (slot8 :initform 88))
+ (:metaclass structure-class))
+(defstruct (bug-357-c (:include bug-357-b (slot8 -88) (slot5 :ok)))
+ slot9
+ (slot10 t)
+ (slot11 (floor (exp 3))))
+(with-test (:name :bug-357)
+ (flet ((slots (x)
+ (list (bug-357-c-slot1 x)
+ (bug-357-c-slot2 x)
+ (bug-357-c-slot3 x)
+ (bug-357-c-slot4 x)
+ (bug-357-c-slot5 x)
+ (bug-357-c-slot6 x)
+ (bug-357-c-slot7 x)
+ (bug-357-c-slot8 x)
+ (bug-357-c-slot9 x)
+ (bug-357-c-slot10 x)
+ (bug-357-c-slot11 x))))
+ (let ((base (slots (make-bug-357-c))))
+ (assert (equal base (slots (make-instance 'bug-357-c))))
+ (assert (equal base '(nil t2 3.1415927 -44 :ok t 9 -88 nil t 20))))))