Commit 20923588 authored by pfdietz's avatar pfdietz

Toned down the error/cerror tests, losing the assumption that the...

Toned down the error/cerror tests, losing the assumption that the :format-control or :format-arguments initializers for simple-conditions give the values that actually end up in those slots.
parent 5577be14
......@@ -1391,3 +1391,21 @@ the condition to go uncaught if it cannot be classified."
(defun with-package-iterator-all (packages)
(test-with-package-iterator packages :internal :external :inherited))
(defun frob-simple-condition (c expected-fmt &rest expected-args)
"Try out the format control and format arguments of a simple-condition C,
but make no assumptions about what they print as, only that they
do print."
(declare (ignore expected-fmt expected-args))
(and (typep c 'simple-condition)
(let ((fc (simple-condition-format-control c))
(args (simple-condition-format-arguments c)))
(and
(stringp (apply #'format nil fc args))
t))))
(defun frob-simple-error (c expected-fmt &rest expected-args)
(and (typep c 'simple-error)
(apply #'frob-simple-condition c expected-fmt expected-args)))
\ No newline at end of file
......@@ -9,51 +9,32 @@
(deftest cerror.1
(let ((fmt "Cerror"))
(handler-case (cerror "Keep going." fmt)
(simple-error (c)
(and
(null (simple-condition-format-arguments c))
(eqt (simple-condition-format-control c)
fmt)))))
(simple-error (c) (frob-simple-error c fmt))))
t)
(deftest cerror.2
(let* ((fmt "Cerror")
(cnd (make-condition 'simple-error :format-control fmt)))
(handler-case (cerror "Continue on." cnd)
(simple-error (c)
(and (eqt c cnd)
(eqt (simple-condition-format-control c)
fmt)))))
(simple-error (c) (frob-simple-error c fmt))))
t)
(deftest cerror.3
(let ((fmt "Cerror"))
(handler-case (cerror "Continue" 'simple-error :format-control fmt)
(simple-error (c)
(eqt (simple-condition-format-control c)
fmt))))
(simple-error (c) (frob-simple-error c fmt))))
t)
(deftest cerror.4
(let ((fmt "Cerror: ~A"))
(handler-case (cerror "On on" fmt 10)
(simple-error (c)
(and
(equalt
(simple-condition-format-arguments c)
'(10))
(eqt (simple-condition-format-control c)
fmt)))))
(simple-error (c) (frob-simple-error c fmt 10))))
t)
(deftest cerror.5
(let ((fmt (formatter "Cerror")))
(handler-case (cerror "Keep going." fmt)
(simple-error (c)
(and
(null (simple-condition-format-arguments c))
(eqt (simple-condition-format-control c)
fmt)))))
(simple-error (c) (frob-simple-error c fmt))))
t)
;;; Continuing from a cerror
......
......@@ -7,52 +7,36 @@
(deftest error.1
(let ((fmt "Error"))
(handler-case (error fmt)
(simple-error (c)
(and
(null (simple-condition-format-arguments c))
(eqt (simple-condition-format-control c)
fmt)))))
(handler-case
(error fmt)
(simple-error (c) (frob-simple-error c fmt))))
t)
(deftest error.2
(let* ((fmt "Error")
(cnd (make-condition 'simple-error :format-control fmt)))
(handler-case (error cnd)
(simple-error (c)
(and (eqt c cnd)
(eqt (simple-condition-format-control c)
fmt)))))
(handler-case
(error cnd)
(simple-error (c) (frob-simple-error c fmt))))
t)
(deftest error.3
(let ((fmt "Error"))
(handler-case (error 'simple-error :format-control fmt)
(simple-error (c)
(eqt (simple-condition-format-control c)
fmt))))
(handler-case
(error 'simple-error :format-control fmt)
(simple-error (c) (frob-simple-error c fmt))))
t)
(deftest error.4
(let ((fmt "Error: ~A"))
(handler-case (error fmt 10)
(simple-error (c)
(and
(equalt
(simple-condition-format-arguments c)
'(10))
(eqt (simple-condition-format-control c)
fmt)))))
(handler-case
(error fmt 10)
(simple-error (c) (frob-simple-error c fmt 10))))
t)
(deftest error.5
(let ((fmt (formatter "Error")))
(handler-case (error fmt)
(simple-error (c)
(and
(null (simple-condition-format-arguments c))
(eqt (simple-condition-format-control c)
fmt)))))
(handler-case
(error fmt)
(simple-error (c) (frob-simple-error c fmt))))
t)
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