X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcondition.impure.lisp;h=b66ed3f76372148db434f2d6a8936e3e98973016;hb=6e5c24e786277417fedfea9a6844092de11775df;hp=e21854c65e4162cfcb81e01a6a329cb3e0138f29;hpb=42702bd5e2af3e0042c9f27372c6f5d92335df12;p=sbcl.git diff --git a/tests/condition.impure.lisp b/tests/condition.impure.lisp index e21854c..b66ed3f 100644 --- a/tests/condition.impure.lisp +++ b/tests/condition.impure.lisp @@ -11,6 +11,8 @@ (cl:in-package :cl-user) +(use-package :test-util) + ;;; Bug from CLOCC. (defpackage :p1 (:use :cl) @@ -37,6 +39,8 @@ (assert (eql (code-msg code) 2)) (assert (eql (%code-msg code) 1))) +(in-package :cl-user) + ;;; Check that initializing the condition class metaobject doesn't create ;;; any instances. Reported by Marco Baringer on sbcl-devel Mon, 05 Jul 2004. (defvar *condition-count* 0) @@ -102,13 +106,32 @@ :stream *standard-input*))) ;; should be printable (dolist (c (list - ;; but not yet, o lord (should be fixed soon by WHN, in - ;; one or more commits ca. 1.0.9.55+, #+NILed out 'til - ;; then) - #+nil my-stream-error-1-0-9 - #+nil parse-foo-error-1-0-9 - ;; fixed, hallelujah + my-stream-error-1-0-9 + parse-foo-error-1-0-9 read-foo-error-1-0-9)) - ;; escaped or not + ;; whether escaped or not (dolist (*print-escape* '(nil t)) (write c :stream (make-string-output-stream))))) + +;;; Reported by Michael Weber: restart computation in :TEST-FUNCTION used to +;;; cause infinite recursion. +(defun restart-test-finds-restarts () + (restart-bind + ((bar (lambda () + (return-from restart-test-finds-restarts 42)) + :test-function + (lambda (condition) + (find-restart 'qux)))) + (when (find-restart 'bar) + (invoke-restart 'bar)))) +(assert (not (restart-test-finds-restarts))) + +(with-test (:name :bug-896379) + (let ((*evaluator-mode* :compile)) + (handler-bind ((style-warning #'error)) + (let ((reader (gensym "READER")) + (name (gensym "FOO-ERROR"))) + (eval `(define-condition ,name (error) + ((slot :initarg :slot :reader ,reader)) + (:report (lambda (c stream) + (format stream "Oops: ~S" (,reader c))))))))))