mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-25 05:51:55 -08:00
Code Issues Projects Releases Packages Wiki Activity

tests: improve signals macro to allow description

Browse source
This commit is contained in:
Daniel Kochmański 2019-04-04 20:48:31 +02:00
parent 0c8fe7e2c8
commit 22865f0c55
1 changed files with 15 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

26
src/tests/2am.lisp
View file

@ -181,26 +181,30 @@
:format-control ,fmt-ctrl
:format-arguments (list ,@fmt-args)))))
(defun %signals (expected fn)
(defun %signals (expected fn &rest args)
(flet ((handler (condition)
(cond ((typep condition expected)
(return-from %signals (passed)))
(t
(return-from %signals
(failed (make-condition 'test-failure
:name *test-name*
:format-control "Expected to signal ~s, but got ~s:~%~a"
:format-arguments (list expected (type-of condition) condition))))))))
(let ((fmt-ctrl (if args (car args) "Expected to signal ~s, but got ~s:~%~a"))
(fmt-args (if args (cdr args) (list expected (type-of condition) condition))))
(failed (make-condition 'test-failure
:name *test-name*
:format-control fmt-ctrl
:format-arguments fmt-args))))))))
(handler-bind ((condition #'handler))
(funcall fn)))
(failed (make-condition 'test-failure
:name *test-name*
:format-control "Expected to signal ~s, but got nothing"
:format-arguments `(,expected))))
(let ((fmt-ctrl (if args (car args) "Expected to signal ~s, but got nothing"))
(fmt-args (if args (cdr args) `(,expected))))
(failed (make-condition 'test-failure
:name *test-name*
:format-control fmt-ctrl
:format-arguments fmt-args))))
(defmacro signals (condition &body body)
(defmacro signals (condition form &rest args)
"Assert that `body' signals a condition of type `condition'."
`(%signals ',condition (lambda () ,@body)))
`(%signals ',condition (lambda () ,form) ,@args))
(defmacro finishes (form)
`(handler-case (progn