diff options
Diffstat (limited to 'lisp/emacs-lisp/ert-x.el')
| -rw-r--r-- | lisp/emacs-lisp/ert-x.el | 26 |
1 files changed, 25 insertions, 1 deletions
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 7d99cb30274..4cf9d9609e9 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el | |||
| @@ -97,7 +97,7 @@ To be used in ERT tests. If BODY finishes successfully, the test | |||
| 97 | buffer is killed; if there is an error, the test buffer is kept | 97 | buffer is killed; if there is an error, the test buffer is kept |
| 98 | around on error for further inspection. Its name is derived from | 98 | around on error for further inspection. Its name is derived from |
| 99 | the name of the test and the result of NAME-FORM." | 99 | the name of the test and the result of NAME-FORM." |
| 100 | (declare (debug ((form) body)) | 100 | (declare (debug ((":name" form) body)) |
| 101 | (indent 1)) | 101 | (indent 1)) |
| 102 | `(ert--call-with-test-buffer ,name-form (lambda () ,@body))) | 102 | `(ert--call-with-test-buffer ,name-form (lambda () ,@body))) |
| 103 | 103 | ||
| @@ -285,6 +285,30 @@ BUFFER defaults to current buffer. Does not modify BUFFER." | |||
| 285 | (kill-buffer clone))))))) | 285 | (kill-buffer clone))))))) |
| 286 | 286 | ||
| 287 | 287 | ||
| 288 | (defmacro ert-with-message-capture (var &rest body) | ||
| 289 | "Execute BODY while collecting anything written with `message' in VAR. | ||
| 290 | |||
| 291 | Capture all messages produced by `message' when it is called from | ||
| 292 | Lisp, and concatenate them separated by newlines into one string. | ||
| 293 | |||
| 294 | This is useful for separating the issuance of messages by the | ||
| 295 | code under test from the behavior of the *Messages* buffer." | ||
| 296 | (declare (debug (symbolp body)) | ||
| 297 | (indent 1)) | ||
| 298 | (let ((g-advice (cl-gensym))) | ||
| 299 | `(let* ((,var "") | ||
| 300 | (,g-advice (lambda (func &rest args) | ||
| 301 | (if (or (null args) (equal (car args) "")) | ||
| 302 | (apply func args) | ||
| 303 | (let ((msg (apply #'format-message args))) | ||
| 304 | (setq ,var (concat ,var msg "\n")) | ||
| 305 | (funcall func "%s" msg)))))) | ||
| 306 | (advice-add 'message :around ,g-advice) | ||
| 307 | (unwind-protect | ||
| 308 | (progn ,@body) | ||
| 309 | (advice-remove 'message ,g-advice))))) | ||
| 310 | |||
| 311 | |||
| 288 | (provide 'ert-x) | 312 | (provide 'ert-x) |
| 289 | 313 | ||
| 290 | ;;; ert-x.el ends here | 314 | ;;; ert-x.el ends here |