From 797a5e384384d83d52cb711f10b5d10f12cb7871 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Thu, 16 Jun 2005 13:03:08 +0000 Subject: [PATCH] Add FORMATTER format control tests to warn, error, cerror tests --- ansi-tests/cerror.lsp | 14 ++++++++++++++ ansi-tests/error.lsp | 39 ++++++++++++++++++++++++++++++++++----- ansi-tests/warn.lsp | 14 ++++++++++++++ 3 files changed, 62 insertions(+), 5 deletions(-) diff --git a/ansi-tests/cerror.lsp b/ansi-tests/cerror.lsp index b153bf02..16ac6c92 100644 --- a/ansi-tests/cerror.lsp +++ b/ansi-tests/cerror.lsp @@ -19,6 +19,13 @@ (simple-error (c) (frob-simple-error c fmt)))) t) +(deftest cerror.2a + (let* ((fmt (formatter "Cerror")) + (cnd (make-condition 'simple-error :format-control fmt))) + (handler-case (cerror "Continue on." cnd) + (simple-error (c) (frob-simple-error c fmt)))) + t) + (deftest cerror.3 (let ((fmt "Cerror")) (handler-case (cerror "Continue" 'simple-error :format-control fmt) @@ -31,6 +38,12 @@ (simple-error (c) (frob-simple-error c fmt 10)))) t) +(deftest cerror.4a + (let ((fmt (formatter "Cerror: ~A"))) + (handler-case (cerror "On on" fmt 10) + (simple-error (c) (frob-simple-error c fmt 10)))) + t) + (deftest cerror.5 (let ((fmt (formatter "Cerror"))) (handler-case (cerror "Keep going." fmt) @@ -46,6 +59,7 @@ 10)) 10) +;;; Program error cases (deftest cerror.error.1 (signals-error (cerror) program-error) diff --git a/ansi-tests/error.lsp b/ansi-tests/error.lsp index 1bd9c7dd..dd3e357e 100644 --- a/ansi-tests/error.lsp +++ b/ansi-tests/error.lsp @@ -44,16 +44,16 @@ (deftest error.6 (handler-case (error 'simple-condition) - (error (c) :wrong) - (simple-condition (c) :right)) + (error (c) (declare (ignore c)) :wrong) + (simple-condition (c) (declare (ignore c)) :right)) :right) (deftest error.7 (handler-case (error 'simple-warning) - (error (c) :wrong) - (simple-warning (c) :right) - (condition (c) :wrong2)) + (error (c) (declare (ignore c)) :wrong) + (simple-warning (c) (declare (ignore c)) :right) + (condition (c) (declare (ignore c)) :wrong2)) :right) (deftest error.8 @@ -63,4 +63,33 @@ (simple-warning (c) (frob-simple-warning c fmt)))) t) +(deftest error.9 + (let ((fmt (formatter "Boo!"))) + (handler-case + (error 'simple-warning :format-control fmt) + (simple-warning (c) (frob-simple-warning c fmt)))) + t) + +(deftest error.10 + (let ((fmt (formatter "Error"))) + (handler-case + (error 'simple-error :format-control fmt) + (simple-error (c) (frob-simple-error c fmt)))) + t) + +(deftest error.11 + (let ((fmt (formatter "Error"))) + (handler-case + (error fmt) + (simple-error (c) (frob-simple-error c fmt)))) + t) + +(deftest error.12 + (let* ((fmt (formatter "Error")) + (cnd (make-condition 'simple-error :format-control fmt))) + (handler-case + (error cnd) + (simple-error (c) (frob-simple-error c fmt)))) + t) + ;;; Tests for other conditions will in their own files. diff --git a/ansi-tests/warn.lsp b/ansi-tests/warn.lsp index 127fd9a9..a1fd6842 100644 --- a/ansi-tests/warn.lsp +++ b/ansi-tests/warn.lsp @@ -159,3 +159,17 @@ (deftest warn.18 (signals-error (warn (make-condition 'simple-error)) type-error) t) + +(deftest warn.19 + (let ((warned nil)) + (handler-bind + ((warning #'(lambda (c) + (assert (typep c 'simple-warning)) + (setf warned t) + (muffle-warning c)))) + (values + (multiple-value-list + (warn (make-condition 'simple-warning + :format-control (formatter "Foo!")))) + warned))) + (nil) t) \ No newline at end of file -- GitLab