Commit 4ef6d8ef authored by pfdietz's avatar pfdietz

Check that format logical block errors are signalled even in unsafe code.

parent e583bd07
......@@ -264,7 +264,7 @@ the condition to go uncaught if it cannot be classified."
;;; The above is badly designed, since it fails when some signals
;;; may be in more than one class/
(defmacro signals-error (form error-name)
(defmacro signals-error (form error-name &key (safety 3))
`(handler-bind
((warning #'(lambda (c) (declare (ignore c))
(muffle-warning))))
......@@ -275,11 +275,16 @@ the condition to go uncaught if it cannot be classified."
(multiple-value-list
(if regression-test::*compile-tests*
(funcall (compile nil '(lambda ()
(declare (optimize safety))
(declare (optimize (safety ,safety)))
,form)))
(eval ',form))))
(,error-name (c) (printable-p c)))))
(defmacro signals-error-always (form error-name)
`(values
(signals-error ,form ,error-name)
(signals-error ,form ,error-name :safety 0)))
(defun printable-p (obj)
"Returns T iff obj can be printed to a string."
(with-standard-io-syntax
......
......@@ -12,100 +12,100 @@
;;; Prefix and suffix cannot contain format directives
(deftest format.logical-block.error.1
(signals-error (format nil "~<foo~A~;~A~;bar~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~<foo~A~;~A~;bar~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.2
(signals-error (format nil "~<foo~A~@;~A~;bar~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~<foo~A~@;~A~;bar~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.3
(signals-error (format nil "~<foo~;~A~;bar~A~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~<foo~;~A~;bar~A~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.4
(signals-error (format nil "~<foo~@;~A~;bar~A~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~<foo~@;~A~;bar~A~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.5
(signals-error (format nil "~<foo~A~;~A~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~<foo~A~;~A~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.6
(signals-error (format nil "~<foo~A~@;~A~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~<foo~A~@;~A~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.7
(signals-error (format nil "~<~;~A~;bar~A~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~<~;~A~;bar~A~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.8
(signals-error (format nil "~<~@;~A~;bar~A~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~<~@;~A~;bar~A~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.9
(signals-error (format nil "~:<foo~A~;~A~;bar~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~:<foo~A~;~A~;bar~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.10
(signals-error (format nil "~:<foo~A~@;~A~;bar~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~:<foo~A~@;~A~;bar~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.11
(signals-error (format nil "~:<foo~;~A~;bar~A~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~:<foo~;~A~;bar~A~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.12
(signals-error (format nil "~:<foo~@;~A~;bar~A~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~:<foo~@;~A~;bar~A~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.13
(signals-error (format nil "~:<foo~A~;~A~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~:<foo~A~;~A~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.14
(signals-error (format nil "~:<foo~A~@;~A~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~:<foo~A~@;~A~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.15
(signals-error (format nil "~:<~;~A~;bar~A~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~:<~;~A~;bar~A~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.16
(signals-error (format nil "~:<~@;~A~;bar~A~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~:<~@;~A~;bar~A~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.17
(signals-error (format nil "~@<foo~A~;~A~;bar~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~@<foo~A~;~A~;bar~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.18
(signals-error (format nil "~@<foo~A~@;~A~;bar~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~@<foo~A~@;~A~;bar~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.19
(signals-error (format nil "~@<foo~;~A~;bar~A~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~@<foo~;~A~;bar~A~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.20
(signals-error (format nil "~@<foo~@;~A~;bar~A~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~@<foo~@;~A~;bar~A~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.21
(signals-error (format nil "~@<foo~A~;~A~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~@<foo~A~;~A~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.22
(signals-error (format nil "~@<foo~A~@;~A~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~@<foo~A~@;~A~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.23
(signals-error (format nil "~@<~;~A~;bar~A~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~@<~;~A~;bar~A~:>" '(X) '(Y)) error)
t t)
(deftest format.logical-block.error.24
(signals-error (format nil "~@<~@;~A~;bar~A~:>" '(X) '(Y)) error)
t)
(signals-error-always (format nil "~@<~@;~A~;bar~A~:>" '(X) '(Y)) error)
t t)
;;; Non-error tests
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment