X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcondition.pure.lisp;h=181b2018c7d41f0361a3e9d2e1ab2dfff1252bc0;hb=7a2ee8c1aff0bdd286cf5d43ab40bff7fed86bea;hp=835818e72d65304a586a9a3a8daeca5916d0954f;hpb=c4776b3b3121be1c3bad293a4fa7efffb592f7f7;p=sbcl.git diff --git a/tests/condition.pure.lisp b/tests/condition.pure.lisp index 835818e..181b201 100644 --- a/tests/condition.pure.lisp +++ b/tests/condition.pure.lisp @@ -163,3 +163,36 @@ (assert (equal '(restart-case (foo :report "quux" (quux))) (simple-condition-format-arguments e))) :ok))))) + +(with-test (:name :simple-condition-without-args) + (let ((sc (make-condition 'simple-condition))) + (assert (not (simple-condition-format-control sc))) + (assert (not (simple-condition-format-arguments sc))) + (assert (stringp (prin1-to-string sc))) + (assert + (eq :ok + (handler-case + (princ-to-string sc) + (simple-error (c) + (when (and (equal "No format-control for ~S" + (simple-condition-format-control c)) + (eq sc (car + (simple-condition-format-arguments c)))) + :ok))))))) + +(with-test (:name :malformed-simple-condition-printing-type-error) + (assert (eq :type-error + (handler-case + (princ-to-string + (make-condition 'simple-error :format-control "" :format-arguments 8)) + (type-error (e) + (when (and (eq 'list (type-error-expected-type e)) + (eql 8 (type-error-datum e))) + :type-error)))))) + +(with-test (:name (:printing-unintitialized-condition :bug-1184586)) + (prin1-to-string (make-condition 'simple-type-error))) + +(with-test (:name (:print-undefined-function-condition)) + (handler-case (funcall '#:foo) + (undefined-function (c) (princ c))))