Skip to content

Commit

Permalink
Removed :test argument from `should-error'; it now returns the error …
Browse files Browse the repository at this point in the history 
…instead.

This is simpler to understand and use.
  • Loading branch information
Christian Ohler committed Oct 10, 2010
1 parent 66485d4 commit 56ab197
Show file tree
Hide file tree
Showing 4 changed files with 50 additions and 105 deletions.
3 changes: 3 additions & 0 deletions doc/misc/ert.texi
View file
Expand Up @@ -371,6 +371,9 @@ use of @code{should-error}:
This checks that dividing one by zero signals an error of type
@code{arith-error}. The @code{:type} argument to @code{should-error}
is optional; if absent, any type of error is accepted.
@code{should-error} returns an error description of the error that was
signalled, to allow additional checks to be made. The error
description has the format @code{(ERROR-SYMBOL . DATA)}.

There is no @code{should-not-error} macro since tests that signal an
error fail anyway, so @code{should-not-error} is effectively the
Expand Down
69 changes: 30 additions & 39 deletions lisp/emacs-lisp/ert.el
View file
Expand Up @@ -376,17 +376,14 @@ DATA is displayed to the user and should state the reason of the failure."
(cl-macroexpand form (and (boundp 'cl-macro-environment)
cl-macro-environment)))
(macroexpand form))))
;; It's sort of a wart that `inner-expander' can't influence the
;; value the expansion returns.
(cond
((atom form)
(funcall inner-expander form `(list ',whole :form ',form :value ,form)))
((ert--special-operator-p (car form))
((or (atom form) (ert--special-operator-p (car form)))
(let ((value (ert--gensym "value-")))
`(let ((,value (ert--gensym "ert-form-evaluation-aborted-")))
,(funcall inner-expander
`(setq ,value ,form)
`(list ',whole :form ',form :value ,value))
`(list ',whole :form ',form :value ,value)
value)
,value)))
(t
(let ((fn-name (car form))
Expand All @@ -413,7 +410,8 @@ DATA is displayed to the user and should state the reason of the failure."
(get ',fn-name 'ert-explainer))))
(when -explainer-
(list :explanation
(apply -explainer- ,args))))))
(apply -explainer- ,args)))))
value)
,value))))))))

(defun ert--expand-should (whole form inner-expander)
Expand All @@ -434,22 +432,23 @@ FORM-DESCRIPTION-FORM before it has called INNER-FORM."
(lexical-let ((inner-expander inner-expander))
(ert--expand-should-1
whole form
(lambda (inner-form form-description-form)
(lambda (inner-form form-description-form value-var)
(let ((form-description (ert--gensym "form-description-")))
`(let (,form-description)
,(funcall inner-expander
`(unwind-protect
,inner-form
(setq ,form-description ,form-description-form)
(ert--signal-should-execution ,form-description))
`,form-description)))))))
`,form-description
value-var)))))))

(defmacro* should (form)
"Evaluate FORM. If it returns nil, abort the current test as failed.
Returns the value of FORM."
(ert--expand-should `(should ,form) form
(lambda (inner-form form-description-form)
(lambda (inner-form form-description-form value-var)
`(unless ,inner-form
(ert-fail ,form-description-form)))))

Expand All @@ -458,16 +457,16 @@ Returns the value of FORM."
Returns nil."
(ert--expand-should `(should-not ,form) form
(lambda (inner-form form-description-form)
(lambda (inner-form form-description-form value-var)
`(unless (not ,inner-form)
(ert-fail ,form-description-form)))))

(defun ert--should-error-handle-error (form-description-fn
condition type exclude-subtypes test)
condition type exclude-subtypes)
"Helper function for `should-error'.
Determines whether CONDITION matches TYPE, EXCLUDE-SUBTYPES and
TEST, and aborts the current test as failed if it doesn't."
Determines whether CONDITION matches TYPE and EXCLUDE-SUBTYPES,
and aborts the current test as failed if it doesn't."
(let ((signalled-conditions (get (car condition) 'error-conditions))
(handled-conditions (etypecase type
(list type)
Expand All @@ -487,33 +486,28 @@ TEST, and aborts the current test as failed if it doesn't."
(list
:condition condition
:fail-reason (concat "the error signalled was a subtype"
" of the expected type"))))))
(unless (funcall test condition)
(ert-fail (append
(funcall form-description-fn)
(list
:condition condition
:fail-reason "the error signalled did not pass the test"))))))
" of the expected type"))))))))

;; FIXME: The expansion will evaluate the keyword args (if any) in
;; nonstandard order.
(defmacro* should-error (form &rest keys &key type exclude-subtypes test)
"Evaluate FORM. Unless it signals an error, abort the current test as failed.
The error signalled additionally needs to match TYPE and satisfy
TEST. TYPE should be a condition name or a list of condition
names. If EXCLUDE-SUBTYPES is nil, the error matches TYPE if one
of its condition names is an element of TYPE. If
EXCLUDE-SUBTYPES is non-nil, the error matches TYPE if it is an
element of TYPE. TEST should be a predicate."
;; Returns a gensym named `ert-form-evaluation-aborted-XXX', but
;; that's a wart, so let's not document it.
(defmacro* should-error (form &rest keys &key type exclude-subtypes)
"Evaluate FORM and check that it signals an error.
The error signalled needs to match TYPE. TYPE should be a list
of condition names. (It can also be a non-nil symbol, which is
equivalent to a singleton list containing that symbol.) If
EXCLUDE-SUBTYPES is nil, the error matches TYPE if one of its
condition names is an element of TYPE. If EXCLUDE-SUBTYPES is
non-nil, the error matches TYPE if it is an element of TYPE.
If the error matches, returns (ERROR-SYMBOL . DATA) from the
error. If not, or if no error was signalled, abort the test as
failed."
(unless type (setq type ''error))
(unless test (setq test '(lambda (condition) t)))
(ert--expand-should
`(should-error ,form ,@keys)
form
(lambda (inner-form form-description-form)
(lambda (inner-form form-description-form value-var)
(let ((errorp (ert--gensym "errorp"))
(form-description-fn (ert--gensym "form-description-fn-")))
`(let ((,errorp nil)
Expand All @@ -525,11 +519,8 @@ element of TYPE. TEST should be a predicate."
(setq ,errorp t)
(ert--should-error-handle-error ,form-description-fn
-condition-
,type ,exclude-subtypes ,test)
;; It would make sense to have the `should-error' form
;; return the error in this case, but `ert--expand-should'
;; doesn't allow that at the moment.
))
,type ,exclude-subtypes)
(setq ,value-var -condition-)))
(unless ,errorp
(ert-fail (append
(funcall ,form-description-fn)
Expand Down
6 changes: 2 additions & 4 deletions test/automated/ert-exp-t.el
View file
Expand Up @@ -221,10 +221,8 @@
(save-window-excursion
(ert-with-buffer-renamed ("*Help*")
(if (< emacs-major-version 24)
(should-error (ert-describe-test 'ert-describe-test)
:test (lambda (condition)
(should (equal condition
'(error "Requires Emacs 24")))))
(should (equal (should-error (ert-describe-test 'ert-describe-test))
'(error "Requires Emacs 24")))
(ert-describe-test 'ert-test-describe-test)
(with-current-buffer "*Help*"
(let ((case-fold-search nil))
Expand Down
77 changes: 15 additions & 62 deletions test/automated/ert-tests.el
View file
Expand Up @@ -216,10 +216,9 @@ failed or if there was a problem."
:value nil
:fail-reason "did not signal an error"))))))
;; A simple error.
(let ((test (make-ert-test :body (lambda () (should-error (error "Foo"))))))
(let ((result (ert-run-test test)))
(should (typep result 'ert-test-passed))))
;; Error of unexpected type, no test.
(should (equal (should-error (error "Foo"))
'(error "Foo")))
;; Error of unexpected type.
(let ((test (make-ert-test :body (lambda ()
(should-error (error "Foo")
:type 'singularity-error)))))
Expand All @@ -233,67 +232,21 @@ failed or if there was a problem."
:condition (error "Foo")
:fail-reason
"the error signalled did not have the expected type"))))))
;; Error of the expected type, no test.
(let ((test (make-ert-test :body (lambda ()
(should-error (signal 'singularity-error
nil)
:type 'singularity-error)))))
(let ((result (ert-run-test test)))
(should (typep result 'ert-test-passed))))
;; Error that fails the test, no type.
(let ((test (make-ert-test :body (lambda ()
(should-error
(error "Foo")
:test (lambda (error) nil))))))
(let ((result (ert-run-test test)))
(should (typep result 'ert-test-failed))
(should (equal (ert-test-result-with-condition-condition result)
'(ert-test-failed
((should-error (error "Foo") :test (lambda (error) nil))
:form (error "Foo")
:condition (error "Foo")
:fail-reason
"the error signalled did not pass the test"))))))
;; Error that passes the test, no type.
(let ((test (make-ert-test :body (lambda ()
(should-error (error "Foo")
:test (lambda (error) t))))))
(let ((result (ert-run-test test)))
(should (typep result 'ert-test-passed))))
;; Error that has the expected type but fails the test.
(let ((test (make-ert-test :body (lambda ()
(should-error
(signal 'singularity-error nil)
:type 'singularity-error
:test (lambda (error) nil))))))
;; Error of the expected type.
(let* ((error nil)
(test (make-ert-test
:body (lambda ()
(setq error
(should-error (signal 'singularity-error nil)
:type 'singularity-error))))))
(let ((result (ert-run-test test)))
(should (typep result 'ert-test-failed))
(should (equal (ert-test-result-with-condition-condition result)
'(ert-test-failed
((should-error (signal 'singularity-error nil)
:type 'singularity-error
:test (lambda (error) nil))
:form (signal singularity-error nil)
:condition (singularity-error)
:fail-reason
"the error signalled did not pass the test"))))))
;; Error that has the expected type and passes the test.
(let ((test (make-ert-test :body (lambda ()
(should-error
(signal 'singularity-error nil)
:type 'singularity-error
:test (lambda (error) t))))))
(let ((result (ert-run-test test)))
(should (typep result 'ert-test-passed)))))
(should (typep result 'ert-test-passed))
(should (equal error '(singularity-error))))))

(ert-deftest ert-test-should-error-subtypes ()
(let ((test (make-ert-test
:body (lambda ()
(should-error (signal 'singularity-error nil)
:type 'singularity-error
:exclude-subtypes t)))))
(let ((result (ert-run-test test)))
(should (typep result 'ert-test-passed))))
(should-error (signal 'singularity-error nil)
:type 'singularity-error
:exclude-subtypes t)
(let ((test (make-ert-test
:body (lambda ()
(should-error (signal 'arith-error nil)
Expand Down

0 comments on commit 56ab197

Please sign in to comment.