X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcondition.impure.lisp;h=aaa9d54ee15cf63781ee322cbf281dc661a531f8;hb=9e7a18990d8cfe726edca3450f84510f5676a3e1;hp=2b6303bea3758b1fe92874cfa9ea8c5b52b0bc74;hpb=9c0c32bf94b510ea0f7bed34a91d0ddf3ea909fc;p=sbcl.git diff --git a/tests/condition.impure.lisp b/tests/condition.impure.lisp index 2b6303b..aaa9d54 100644 --- a/tests/condition.impure.lisp +++ b/tests/condition.impure.lisp @@ -194,7 +194,7 @@ (condition-with-constant-function-initform-foo (make-instance 'condition-with-constant-function-initform))))) -;;; bug- +;;; bug-1164969 (defvar bar-counter 0) @@ -256,3 +256,39 @@ (test :compile+make-instance (make-instance 'condition-with-non-constant-default-initarg)))) + +;;; 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.")))