>From 435dca993596e4e7beec888f810d2a52181eed69 Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Tue, 9 May 2017 15:26:05 -0700 Subject: [PATCH 1/2] Catch more messages in ert-with-message-capture * lisp/emacs-lisp/ert-x.el (ert-with-message-capture): Capture messages from prin1, princ and print. (ert--make-message-advice): New function. (ert--make-print-advice): New function. --- lisp/emacs-lisp/ert-x.el | 57 ++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 45 insertions(+), 12 deletions(-) diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 4cf9d9609e..bdd1ea973d 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -286,27 +286,60 @@ ert-buffer-string-reindented (defmacro ert-with-message-capture (var &rest body) - "Execute BODY while collecting anything written with `message' in VAR. + "Execute BODY while collecting messages in VAR. -Capture all messages produced by `message' when it is called from -Lisp, and concatenate them separated by newlines into one string. +Capture messages issued by Lisp code and concatenate them +separated by newlines into one string. This includes messages +written by `message' as well as objects printed by `print', +`prin1' and `princ' to the echo area. Messages issued from C +code using the above mentioned functions will not be captured. This is useful for separating the issuance of messages by the code under test from the behavior of the *Messages* buffer." (declare (debug (symbolp body)) (indent 1)) - (let ((g-advice (cl-gensym))) + (let ((g-message-advice (cl-gensym)) + (g-print-advice (cl-gensym)) + (g-collector (cl-gensym))) `(let* ((,var "") - (,g-advice (lambda (func &rest args) - (if (or (null args) (equal (car args) "")) - (apply func args) - (let ((msg (apply #'format-message args))) - (setq ,var (concat ,var msg "\n")) - (funcall func "%s" msg)))))) - (advice-add 'message :around ,g-advice) + (,g-collector (lambda (msg) (setq ,var (concat ,var msg)))) + (,g-message-advice (ert--make-message-advice ,g-collector)) + (,g-print-advice (ert--make-print-advice ,g-collector))) + (advice-add 'message :around ,g-message-advice) + (advice-add 'prin1 :around ,g-print-advice) + (advice-add 'princ :around ,g-print-advice) + (advice-add 'print :around ,g-print-advice) (unwind-protect (progn ,@body) - (advice-remove 'message ,g-advice))))) + (advice-remove 'print ,g-print-advice) + (advice-remove 'princ ,g-print-advice) + (advice-remove 'prin1 ,g-print-advice) + (advice-remove 'message ,g-message-advice))))) + +(defun ert--make-message-advice (collector) + "Create around advice for `message' for `ert-collect-messages'. +COLLECTOR will be called with the message before it is passed +to the real `message'." + (lambda (func &rest args) + (if (or (null args) (equal (car args) "")) + (apply func args) + (let ((msg (apply #'format-message args))) + (funcall collector (concat msg "\n")) + (funcall func "%s" msg))))) + +(defun ert--make-print-advice (collector) + "Create around advice for print functions for `ert-collect-messages'. +The created advice function will just call the original function +unless the output is going to the echo area (when PRINTCHARFUN is +t or PRINTCHARFUN is nil and `standard-output' is t). If the +output is destined for the echo area, the advice function will +convert it to a string and pass it to COLLECTOR first." + (lambda (func object &optional printcharfun) + (if (not (eq t (or printcharfun standard-output))) + (funcall func object printcharfun) + (funcall collector (with-output-to-string + (funcall func object))) + (funcall func object printcharfun)))) (provide 'ert-x) -- 2.12.2