Fix OPEN when :if-exists/:if-does-not-exist are both NIL or :ERROR.
[sbcl.git] / tests / condition.impure.lisp
index 2b6303b..aaa9d54 100644 (file)
            (condition-with-constant-function-initform-foo
             (make-instance 'condition-with-constant-function-initform)))))
 
-;;; bug-
+;;; bug-1164969
 
 (defvar bar-counter 0)
 
     (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.")))