Skip to content
Snippets Groups Projects
Commit 4ef6d8ef authored by pfdietz's avatar pfdietz
Browse files

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

parent e583bd07
No related branches found
No related tags found
No related merge requests found
......@@ -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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment