From 4ef6d8eff3d934bd0a4a8973b2d6f84df9153ded Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Fri, 13 Aug 2004 13:38:06 +0000 Subject: [PATCH] Check that format logical block errors are signalled even in unsafe code. --- ansi-tests/ansi-aux.lsp | 9 ++- ansi-tests/format-logical-block.lsp | 96 ++++++++++++++--------------- 2 files changed, 55 insertions(+), 50 deletions(-) diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index 4b702a6e..e24df14c 100644 --- a/ansi-tests/ansi-aux.lsp +++ b/ansi-tests/ansi-aux.lsp @@ -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 diff --git a/ansi-tests/format-logical-block.lsp b/ansi-tests/format-logical-block.lsp index 20ad6707..e358b049 100644 --- a/ansi-tests/format-logical-block.lsp +++ b/ansi-tests/format-logical-block.lsp @@ -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 -- GitLab