diff options
| author | Lars Ingebrigtsen <larsi@gnus.org> | 2022-01-13 09:48:15 +0100 |
|---|---|---|
| committer | Lars Ingebrigtsen <larsi@gnus.org> | 2022-01-13 09:49:19 +0100 |
| commit | 9c31be6dc31f10efcfb8dc76053e8bf3f62eef2c (patch) | |
| tree | d7d7381ee7a9d74d355e8957e0b7334f6df48f28 | |
| parent | d30fde6b0ccc02eada1f43e0b4cc1873e42f14d2 (diff) | |
| download | emacs-9c31be6dc31f10efcfb8dc76053e8bf3f62eef2c.tar.gz | |
Make ert explainers work on function aliases
* lisp/emacs-lisp/ert.el: New function.
(ert--expand-should-1): Use it (bug#53178).
| -rw-r--r-- | lisp/emacs-lisp/ert.el | 17 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/ert-tests.el | 3 |
2 files changed, 14 insertions, 6 deletions
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index e31ebf5f7bb..9c6b0e15bbe 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -335,15 +335,20 @@ It should only be stopped when ran from inside `ert--run-test-internal'." (unless (eql ,value ',default-value) (list :value ,value)) (unless (eql ,value ',default-value) - (let ((-explainer- - (and (symbolp ',fn-name) - (get ',fn-name 'ert-explainer)))) - (when -explainer- - (list :explanation - (apply -explainer- ,args)))))) + (when-let ((-explainer- + (ert--get-explainer ',fn-name))) + (list :explanation + (apply -explainer- ,args))))) value) ,value)))))))) +(defun ert--get-explainer (fn-name) + (when (symbolp fn-name) + (cl-loop for fn in (cons fn-name (function-alias-p fn-name)) + for explainer = (get fn 'ert-explainer) + when explainer + return explainer))) + (defun ert--expand-should (whole form inner-expander) "Helper function for the `should' macro and its variants. diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index ac130644743..270cca1c2e7 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -881,6 +881,9 @@ This macro is used to test if macroexpansion in `should' works." "Check that `lexical-binding' in `ert-deftest' has the file value." (should (equal lexical-binding t))) +(ert-deftest ert-test-get-explainer () + (should (eq (ert--get-explainer 'string-equal) 'ert--explain-string-equal)) + (should (eq (ert--get-explainer 'string=) 'ert--explain-string-equal))) (provide 'ert-tests) |