+
+;;; bug-1049404
+
+(define-condition condition-with-class-allocation ()
+ ((count :accessor condition-with-class-allocation-count
+ :initform 0
+ :allocation :class)))
+
+(with-test (:name (:condition-with-class-allocation :bug-1049404))
+ (loop repeat 5 do
+ (incf (condition-with-class-allocation-count
+ (make-condition 'condition-with-class-allocation))))
+ (assert (= 5 (condition-with-class-allocation-count
+ (make-condition 'condition-with-class-allocation)))))
+
+;;; bug-789497
+
+(with-test (:name (assert :print-intermediate-results :bug-789497))
+ (macrolet ((test (bindings expression expected-message)
+ `(let ,bindings
+ (handler-case (assert ,expression)
+ (simple-error (condition)
+ (assert (string= (princ-to-string condition)
+ ,expected-message)))))))
+ ;; Constant and variables => no special report.
+ (test () nil "The assertion NIL failed.")
+ (test ((a nil)) a "The assertion A failed.")
+ ;; Special operators => no special report.
+ (test ((a nil) (b nil)) (or a b) "The assertion (OR A B) failed.")
+ (test ((a nil) (b t)) (and a b) "The assertion (AND A B) failed.")
+ ;; Functions with constant and non-constant arguments => include
+ ;; non-constant arguments in report.
+ (test ((a t)) (not a) "The assertion (NOT A) failed with A = T.")
+ (test () (not t) "The assertion (NOT T) failed.")
+ (test ((a -1)) (plusp (signum a))
+ "The assertion (PLUSP (SIGNUM A)) failed with (SIGNUM A) = -1.")))
+
+(with-test (:name (find-restart :recheck-conditions-and-tests :bug-774410))
+ (let ((activep t))
+ (restart-bind ((switchable-restart
+ (constantly 'irrelevant)
+ :test-function (lambda (condition)
+ (declare (ignore condition))
+ activep)))
+ (let ((actual-restart (find-restart 'switchable-restart)))
+ ;; Inactive because of condition-restarts associations.
+ (let ((required-condition (make-condition 'condition))
+ (wrong-condition (make-condition 'condition)))
+ (with-condition-restarts required-condition (list actual-restart)
+ (assert (null (find-restart actual-restart wrong-condition)))))
+
+ ;; Inactive because of test-function.
+ (setf activep nil)
+ (assert (null (find-restart actual-restart)))))))