X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=test%2Ftest-lib.el;h=e9e7c3798770e53c33fe7020133199b80e3d9982;hp=5b32e0abe4d524f272922f119fce3bcea6d57fec;hb=73b8f0b8d71af395667022395b6d6bb692c3aaf2;hpb=c70c7f86b83601231bac94db8a6596a1d729ae24 diff --git a/test/test-lib.el b/test/test-lib.el index 5b32e0ab..e9e7c379 100644 --- a/test/test-lib.el +++ b/test/test-lib.el @@ -16,11 +16,17 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with Notmuch. If not, see . +;; along with Notmuch. If not, see . ;; ;; Authors: Dmitry Kurochkin -(require 'cl) ;; This code is generally used uncompiled. +(require 'cl-lib) + +;; Ensure that the dynamic variables that are defined by this library +;; are defined by the time that we let-bind them. This is needed +;; because starting with Emacs 27 undeclared variables in evaluated +;; interactive code (such as our tests) use lexical scope. +(require 'smtpmail) ;; `read-file-name' by default uses `completing-read' function to read ;; user input. It does not respect `standard-input' variable which we @@ -30,24 +36,38 @@ ;; Work around a bug in emacs 23.1 and emacs 23.2 which prevents ;; noninteractive (kill-emacs) from emacsclient. -(if (and (= emacs-major-version 23) (< emacs-minor-version 3)) +(when (and (= emacs-major-version 23) (< emacs-minor-version 3)) (defadvice kill-emacs (before disable-yes-or-no-p activate) "Disable yes-or-no-p before executing kill-emacs" (defun yes-or-no-p (prompt) t))) +;; Emacs bug #2930: +;; 23.0.92; `accept-process-output' and `sleep-for' do not run sentinels +;; seems to be present in Emacs 23.1. +;; Running `list-processes' after `accept-process-output' seems to work +;; around this problem. +(when (and (= emacs-major-version 23) (= emacs-minor-version 1)) + (defadvice accept-process-output (after run-list-processes activate) + "run list-processes after executing accept-process-output" + (list-processes))) + (defun notmuch-test-wait () "Wait for process completion." (while (get-buffer-process (current-buffer)) - (sleep-for 0.1))) + (accept-process-output nil 0.1))) (defun test-output (&optional filename) "Save current buffer to file FILENAME. Default FILENAME is OUTPUT." + (notmuch-post-command) (write-region (point-min) (point-max) (or filename "OUTPUT"))) (defun test-visible-output (&optional filename) "Save visible text in current buffer to file FILENAME. Default FILENAME is OUTPUT." - (let ((text (visible-buffer-string))) + (notmuch-post-command) + (let ((text (visible-buffer-string)) + ;; Tests expect output in UTF-8 encoding + (coding-system-for-write 'utf-8)) (with-temp-file (or filename "OUTPUT") (insert text)))) (defun visible-buffer-string () @@ -61,38 +81,67 @@ invisible text." (let (str) (while (< start end) (let ((next-pos (next-char-property-change start end))) - (when (not (invisible-p start)) + (unless (invisible-p start) (setq str (concat str (buffer-substring-no-properties start next-pos)))) (setq start next-pos))) str)) -(defun orphan-watchdog (pid) - "Periodically check that the process with id PID is still -running, quit if it terminated." - (if (not (process-attributes pid)) - (kill-emacs) - (run-at-time "1 min" nil 'orphan-watchdog pid))) +;; process-attributes is not defined everywhere, so define an +;; alternate way to test if a process still exists. -(defun hook-counter (hook) - "Count how many times a hook is called. Increments -`hook'-counter variable value if it is bound, otherwise does -nothing." - (let ((counter (intern (concat (symbol-name hook) "-counter")))) - (if (boundp counter) - (set counter (1+ (symbol-value counter)))))) +(defun test-process-running (pid) + (= 0 + (signal-process pid 0))) -(defun add-hook-counter (hook) - "Add hook to count how many times `hook' is called." - (add-hook hook (apply-partially 'hook-counter hook))) +(defun orphan-watchdog-check (pid) + "Periodically check that the process with id PID is still +running, quit if it terminated." + (unless (test-process-running pid) + (kill-emacs))) -(add-hook-counter 'notmuch-hello-mode-hook) -(add-hook-counter 'notmuch-hello-refresh-hook) +(defun orphan-watchdog (pid) + "Initiate orphan watchdog check." + (run-at-time 60 60 'orphan-watchdog-check pid)) + +(defvar notmuch-hello-mode-hook-counter -100 + "Tests that care about this counter must let-bind it to 0.") +(add-hook 'notmuch-hello-mode-hook + (lambda () (cl-incf notmuch-hello-mode-hook-counter))) + +(defvar notmuch-hello-refresh-hook-counter -100 + "Tests that care about this counter must let-bind it to 0.") +(add-hook 'notmuch-hello-refresh-hook + (lambda () (cl-incf notmuch-hello-refresh-hook-counter))) + +(defadvice notmuch-search-process-filter (around pessimal activate disable) + "Feed notmuch-search-process-filter one character at a time." + (let ((string (ad-get-arg 1))) + (cl-loop for char across string + do (progn + (ad-set-arg 1 (char-to-string char)) + ad-do-it)))) + +(defun notmuch-test-mark-links () + "Enclose links in the current buffer with << and >>." + ;; Links are often created by jit-lock functions + (jit-lock-fontify-now) + (save-excursion + (let ((inhibit-read-only t)) + (goto-char (point-min)) + (let ((button)) + (while (setq button (next-button (point))) + (goto-char (button-start button)) + (insert "<<") + (goto-char (button-end button)) + (insert ">>")))))) (defmacro notmuch-test-run (&rest body) "Evaluate a BODY of test expressions and output the result." `(with-temp-buffer - (let ((result (progn ,@body))) + (let ((buffer (current-buffer)) + (result (progn ,@body))) + (switch-to-buffer buffer) (insert (if (stringp result) result (prin1-to-string result))) @@ -105,19 +154,42 @@ nothing." (defun notmuch-test-expect-equal (output expected) "Compare OUTPUT with EXPECTED. Report any discrepencies." - (if (equal output expected) - t - (cond - ((and (listp output) - (listp expected)) - ;; Reporting the difference between two lists is done by - ;; reporting differing elements of OUTPUT and EXPECTED - ;; pairwise. This is expected to make analysis of failures - ;; simpler. - (apply #'concat (loop for o in output - for e in expected - if (not (equal o e)) - collect (notmuch-test-report-unexpected o e)))) - - (t - (notmuch-test-report-unexpected output expected))))) + (cond + ((equal output expected) + t) + ((and (listp output) + (listp expected)) + ;; Reporting the difference between two lists is done by + ;; reporting differing elements of OUTPUT and EXPECTED + ;; pairwise. This is expected to make analysis of failures + ;; simpler. + (apply #'concat (cl-loop for o in output + for e in expected + if (not (equal o e)) + collect (notmuch-test-report-unexpected o e)))) + (t + (notmuch-test-report-unexpected output expected)))) + +(defun notmuch-post-command () + (run-hooks 'post-command-hook)) + +(defmacro notmuch-test-progn (&rest body) + (cons 'progn + (mapcar + (lambda (x) `(prog1 ,x (notmuch-post-command))) + body))) + +;; For historical reasons, we hide deleted tags by default in the test +;; suite +(setq notmuch-tag-deleted-formats + '((".*" nil))) + +;; Also for historical reasons, we set the fcc handler to file not +;; insert. + +(setq notmuch-maildir-use-notmuch-insert nil) + +;; force a common html renderer, to avoid test variations between +;; environments + +(setq mm-text-html-renderer 'html2text)