;;;; more information.
(load "assertoid.lisp")
+(load "compiler-test-util.lisp")
(use-package "ASSERTOID")
\f
;;;; examples from, or close to, the Common Lisp DEFSTRUCT spec
*manyraw*)))
(room)
(sb-ext:gc))
-(check-manyraws *manyraw*)
+(with-test (:name defstruct-raw-slot-gc)
+ (check-manyraws *manyraw*))
;;; try a full GC, too
(sb-ext:gc :full t)
-(check-manyraws *manyraw*)
+(with-test (:name (defstruct-raw-slot-gc :full))
+ (check-manyraws *manyraw*))
;;; fasl dumper and loader also have special handling of raw slots, so
;;; dump all of them into a fasl
;;; re-read the dumped structures and check them
(load "tmp-defstruct.manyraw.fasl")
-(check-manyraws (dumped-manyraws))
+(with-test (:name (defstruct-raw-slot load))
+ (check-manyraws (dumped-manyraws)))
\f
;;;; miscellaneous old bugs
(assert (eq t (boa-supplied-p.2-bar b2)))
(assert (eq nil (boa-supplied-p.2-barp b1)))
(assert (eq t (boa-supplied-p.2-barp b2)))))
+
+(defstruct structure-with-predicate)
+(defclass class-to-be-redefined () ())
+(let ((x (make-instance 'class-to-be-redefined)))
+ (defun function-trampoline (fun) (funcall fun x)))
+
+(with-test (:name (:struct-predicate :obsolete-instance))
+ (defclass class-to-be-redefined () ((a :initarg :a :initform 1)))
+ (function-trampoline #'structure-with-predicate-p))
+
+(with-test (:name (:defstruct :not-toplevel-silent))
+ (let ((sb-ext:*evaluator-mode* :compile))
+ (handler-bind ((warning #'error))
+ (eval `(let ()
+ (defstruct destruct-no-warning-not-at-toplevel bar))))))
+
+(with-test (:name :bug-941102)
+ (let ((test `((defstruct bug-941102)
+ (setf (find-class 'bug-941102-alias) (find-class 'bug-941102))
+ (setf (find-class 'bug-941102-alias) nil))))
+ (multiple-value-bind (warn fail) (ctu:file-compile test :load t)
+ (assert (not warn))
+ (assert (not fail)))
+ (multiple-value-bind (warn2 fail2) (ctu:file-compile test)
+ (assert (not warn2))
+ (assert (not fail2)))))