X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=test%2Ftest-lib.el;h=79a9d4d6fc5b574cbd21e6e9bd27039689a2d01a;hp=a12333900801736843d6032db91f071647a0b056;hb=HEAD;hpb=09f6533c3781b61ea634790d4bad38aadf89115c

diff --git a/test/test-lib.el b/test/test-lib.el
index a1233390..4cfb8ef1 100644
--- a/test/test-lib.el
+++ b/test/test-lib.el
@@ -1,4 +1,4 @@
-;; test-lib.el --- auxiliary stuff for Notmuch Emacs tests.
+;;; test-lib.el --- auxiliary stuff for Notmuch Emacs tests
 ;;
 ;; Copyright © Carl Worth
 ;; Copyright © David Edmondson
@@ -20,6 +20,17 @@
 ;;
 ;; Authors: Dmitry Kurochkin <dmitry.kurochkin@gmail.com>
 
+;;; Code:
+
+;; minimize impact of native compilation on the test suite.
+;; These are the Emacs 29.1 version of the variables.
+;; Leave trampolines enabled per Emacs upstream recommendations.
+;; It is important to set these variables before loading any
+;; .elc files.
+(setq native-comp-jit-compilation nil)
+(setq native-comp-speed -1)
+(setq native-comp-async-jobs-number 1)
+
 (require 'cl-lib)
 
 ;; Ensure that the dynamic variables that are defined by this library
@@ -34,23 +45,6 @@
 ;; `read' call.
 (setq read-file-name-function (lambda (&rest _) (read)))
 
-;; 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))
-  (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.
-(if (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))
@@ -114,13 +108,8 @@ running, quit if it terminated."
 (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))))
+(defvar notmuch-test-tag-hook-output nil)
+(defun notmuch-test-tag-hook () (push (cons query tag-changes) notmuch-test-tag-hook-output))
 
 (defun notmuch-test-mark-links ()
   "Enclose links in the current buffer with << and >>."
@@ -153,23 +142,22 @@ running, quit if it terminated."
 	  "Output:\t" (prin1-to-string output) "\n"))
 
 (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 (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)))))
+  "Compare OUTPUT with EXPECTED. Report any discrepancies."
+  (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))
@@ -180,6 +168,38 @@ running, quit if it terminated."
 	 (lambda (x) `(prog1 ,x (notmuch-post-command)))
 	 body)))
 
+;; For testing functions in
+;; notmuch-{search,tree,unsorted}-result-format
+(defun notmuch-test-result-flags (format-string result)
+  (let ((tags-to-letters (quote (("attachment" . "&")
+				 ("signed" . "=")
+				 ("unread" . "u")
+				 ("inbox" . "i"))))
+	(tags (plist-get result :tags)))
+    (format format-string
+	    (mapconcat (lambda (t2l)
+			 (if (member (car t2l) tags)
+			     (cdr t2l)
+			   " "))
+		       tags-to-letters ""))))
+
+;; Log any signalled error (and other messages) to MESSAGES
+;; Log "COMPLETE" if forms complete without error.
+(defmacro test-log-error (&rest body)
+  `(progn
+     (with-current-buffer "*Messages*"
+       (let ((inhibit-read-only t)) (erase-buffer)))
+     (condition-case err
+       (progn ,@body
+	  (message "COMPLETE"))
+       (t (message "%s" err)))
+     (with-current-buffer "*Messages*" (test-output "MESSAGES"))))
+
+(defmacro test-time (&rest body)
+  `(let ((results (mapcar (lambda (x) (/ x 5.0)) (benchmark-run 5 ,@body))))
+     (message "\t\t%0.2f\t%0.2f\t%0.2f" (nth 0 results) (nth 1 results) (nth 2 results))
+     (with-current-buffer "*Messages*" (test-output "MESSAGES"))))
+
 ;; For historical reasons, we hide deleted tags by default in the test
 ;; suite
 (setq notmuch-tag-deleted-formats
@@ -194,3 +214,8 @@ running, quit if it terminated."
 ;; environments
 
 (setq mm-text-html-renderer 'html2text)
+
+;; Set our own default for message-hidden-headers, to avoid tests
+;; breaking when the Emacs default changes.
+(setq message-hidden-headers
+      '("^References:" "^Face:" "^X-Face:" "^X-Draft-From:"))