summaryrefslogtreecommitdiff
path: root/test/lisp/mh-e
diff options
context:
space:
mode:
Diffstat (limited to 'test/lisp/mh-e')
-rw-r--r--test/lisp/mh-e/mh-limit-tests.el35
-rw-r--r--test/lisp/mh-e/mh-thread-tests.el131
-rw-r--r--test/lisp/mh-e/mh-utils-tests.el551
-rw-r--r--test/lisp/mh-e/mh-xface-tests.el50
-rwxr-xr-xtest/lisp/mh-e/test-all-mh-variants.sh102
5 files changed, 869 insertions, 0 deletions
diff --git a/test/lisp/mh-e/mh-limit-tests.el b/test/lisp/mh-e/mh-limit-tests.el
new file mode 100644
index 00000000000..5aedb890546
--- /dev/null
+++ b/test/lisp/mh-e/mh-limit-tests.el
@@ -0,0 +1,35 @@
+;;; mh-limit-tests.el --- tests for mh-limit.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'mh-limit)
+
+(ert-deftest mh-pick-args-list ()
+ "Test `mh-pick-args-list'."
+ (should (equal '() (mh-pick-args-list "")))
+ (should (equal '("-subject" "a") (mh-pick-args-list "-subject a")))
+ (should (equal '("-subject" "a") (mh-pick-args-list " -subject a ")))
+ (should (equal '("-subject" "a" "-from" "b")
+ (mh-pick-args-list "-subject a -from b")))
+ (should (equal '("-subject" "a b" "-from" "c d")
+ (mh-pick-args-list "-subject a b -from c d"))))
+
+;;; mh-limit-tests.el ends here
diff --git a/test/lisp/mh-e/mh-thread-tests.el b/test/lisp/mh-e/mh-thread-tests.el
new file mode 100644
index 00000000000..ea8d441e2d1
--- /dev/null
+++ b/test/lisp/mh-e/mh-thread-tests.el
@@ -0,0 +1,131 @@
+;;; mh-thread-tests.el --- tests for mh-thread.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'mh-thread)
+(eval-when-compile (require 'cl-lib))
+
+(defun mh-thread-tests-before-from ()
+ "Generate the fields of a scan line up to where the \"From\" field would start.
+The exact contents are not important, but the number of characters is."
+ (concat (make-string mh-cmd-note ?9)
+ (make-string mh-scan-cmd-note-width ?A)
+ (make-string mh-scan-destination-width ?t)
+ (make-string mh-scan-date-width ?/)
+ (make-string mh-scan-date-flag-width ?*)))
+
+;;; Tests of support routines
+
+(ert-deftest mh-thread-current-indentation-level ()
+ "Test that `mh-thread-current-indentation-level' identifies the level."
+ (with-temp-buffer
+ (insert (mh-thread-tests-before-from) "[Sender One] Subject of msg 1\n")
+ (insert (mh-thread-tests-before-from) " [Sender Two] Subject of msg 2\n")
+ (goto-char (point-min))
+ (should (equal 0 (mh-thread-current-indentation-level)))
+ (forward-line)
+ (should (equal 2 (mh-thread-current-indentation-level)))))
+
+(ert-deftest mh-thread-find-children ()
+ "Test `mh-thread-find-children'."
+ (let (expected-start expected-end)
+ (with-temp-buffer
+ (insert (mh-thread-tests-before-from) "[Sender One] line 1\n")
+ (setq expected-start (point))
+ (insert (mh-thread-tests-before-from) " [Sender Two] line 2\n")
+ (insert (mh-thread-tests-before-from) " [Sender Three] line 3\n")
+ (insert (mh-thread-tests-before-from) " [Sender Four] line 4\n")
+ (setq expected-end (1- (point)))
+ (insert (mh-thread-tests-before-from) " [Sender Five] line 5\n")
+ (goto-char (1+ expected-start))
+ (should (equal (list expected-start expected-end)
+ (mh-thread-find-children))))))
+
+(ert-deftest mh-thread-immediate-ancestor ()
+ "Test that `mh-thread-immediate-ancestor' moves to the correct message."
+ (with-temp-buffer
+ (insert (mh-thread-tests-before-from) "[Sender Other] line 1\n")
+ (insert (mh-thread-tests-before-from) "[Sender One] line 2\n")
+ (insert (mh-thread-tests-before-from) " [Sender Two] line 3\n")
+ (insert (mh-thread-tests-before-from) " [Sender Three] line 4\n")
+ (insert (mh-thread-tests-before-from) " [Sender Four] line 5\n")
+ (insert (mh-thread-tests-before-from) " [Sender Five] line 6\n")
+ (forward-line -1)
+ (should (equal (line-number-at-pos) 6))
+ (mh-thread-immediate-ancestor)
+ (should (equal (line-number-at-pos) 4)) ;skips over sibling
+ (mh-thread-immediate-ancestor)
+ (should (equal (line-number-at-pos) 3)) ;goes up only one level at a time
+ (mh-thread-immediate-ancestor)
+ (should (equal (line-number-at-pos) 2))
+ (mh-thread-immediate-ancestor)
+ (should (equal (line-number-at-pos) 2)))) ;no further motion at thread root
+
+;;; Tests of MH-Folder Commands
+
+(ert-deftest mh-thread-sibling-and-ancestor ()
+ "Test motion by `mh-thread-ancestor' and `mh-thread-next-sibling'."
+ (with-temp-buffer
+ (insert (mh-thread-tests-before-from) "[Sender Other] line 1\n")
+ (insert (mh-thread-tests-before-from) "[Sender One] line 2\n")
+ (insert (mh-thread-tests-before-from) " [Sender Two] line 3\n")
+ (insert (mh-thread-tests-before-from) " [Sender Three] line 4\n")
+ (insert (mh-thread-tests-before-from) " [Sender Four] line 5\n")
+ (insert (mh-thread-tests-before-from) " [Sender Five] line 6\n")
+ (forward-line -1)
+ (let ((mh-view-ops '(unthread))
+ (show-count 0))
+ (cl-letf (((symbol-function 'mh-maybe-show)
+ (lambda ()
+ (setq show-count (1+ show-count)))))
+ (should (equal (line-number-at-pos) 6))
+ ;; test mh-thread-ancestor
+ (mh-thread-ancestor)
+ (should (equal (line-number-at-pos) 4)) ;skips over sibling
+ (should (equal show-count 1))
+ (mh-thread-ancestor t)
+ (should (equal (line-number-at-pos) 2)) ;root flag skips to root
+ (should (equal show-count 2))
+ (mh-thread-ancestor)
+ (should (equal (line-number-at-pos) 2)) ;do not move from root
+ (should (equal show-count 2)) ;do not re-show at root
+ ;; test mh-thread-sibling
+ (mh-thread-next-sibling)
+ (should (equal (line-number-at-pos) 2)) ;no next sibling, no motion
+ (should (equal show-count 2)) ;no sibling, no show
+ (mh-thread-next-sibling t)
+ (should (equal (line-number-at-pos) 1))
+ (should (equal show-count 3))
+ (mh-thread-next-sibling t)
+ (should (equal (line-number-at-pos) 1)) ;no previous sibling
+ (should (equal show-count 3))
+ (goto-char (point-max))
+ (forward-line -1)
+ (should (equal (line-number-at-pos) 6))
+ (mh-thread-next-sibling t)
+ (should (equal (line-number-at-pos) 5))
+ (should (equal show-count 4))
+ (mh-thread-next-sibling t)
+ (should (equal (line-number-at-pos) 5)) ;no previous sibling
+ (should (equal show-count 4))
+ ))))
+
+;;; mh-thread-tests.el ends here
diff --git a/test/lisp/mh-e/mh-utils-tests.el b/test/lisp/mh-e/mh-utils-tests.el
new file mode 100644
index 00000000000..72ee2fc4745
--- /dev/null
+++ b/test/lisp/mh-e/mh-utils-tests.el
@@ -0,0 +1,551 @@
+;;; mh-utils-tests.el --- tests for mh-utils.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This test suite runs tests that use and depend on MH programs
+;; installed on the system.
+
+;; When running such tests, MH-E can use a particular MH variant
+;; installed on the system, or it can use the mocks provided here.
+;; (Setup is done by the `with-mh-test-env' macro.)
+
+;; By setting environment variable TEST_MH_PATH, you can select which of
+;; the installed MH variants to use, or ignore them all and use mocks.
+;; See also the script test-all-mh-variants.sh in this directory.
+
+;; 1. To run these tests against the default MH variant installed on
+;; this system:
+;; cd ../.. && make lisp/mh-e/mh-utils-tests
+
+;; 2. To run these tests against an MH variant installed in a
+;; specific directory, set TEST_MH_PATH, as in this example:
+;; cd ../.. && make lisp/mh-e/mh-utils-tests TEST_MH_PATH=/usr/local/nmh/bin
+
+;; 3. To search for and run these tests against all MH variants
+;; installed on this system:
+;; ./test-all-mh-variants.sh
+
+;; Setting the environment variable TEST_MH_DEBUG or the Lisp variable
+;; mh-test-utils-debug-mocks logs access to the file system during the test.
+
+;;; Code:
+
+(require 'ert)
+(require 'mh-utils)
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'subr-x))
+
+(ert-deftest mh-quote-pick-expr ()
+ "Test `mh-quote-pick-expr'."
+ (should (equal nil (mh-quote-pick-expr nil)))
+ (should (equal '() (mh-quote-pick-expr '())))
+ (should (equal '("foo") (mh-quote-pick-expr '("foo"))))
+ (should (equal '("^\\[foo]?\\*+\\.\\$")
+ (mh-quote-pick-expr '("^[foo]?*+.$"))))
+ (should (equal '("^\\[foo]?\\*+\\.\\$" "bar" "baz\\$")
+ (mh-quote-pick-expr '("^[foo]?*+.$" "bar" "baz$")))))
+
+(ert-deftest mh-normalize-folder-name ()
+ "Test `mh-normalize-folder-name'."
+ (should (equal nil (mh-normalize-folder-name nil)))
+ (should (equal "+" (mh-normalize-folder-name "")))
+ (should (equal "" (mh-normalize-folder-name "" t)))
+ (should (equal nil (mh-normalize-folder-name "" nil nil t)))
+ (should (equal nil (mh-normalize-folder-name "+" nil nil t)))
+ (should (equal nil (mh-normalize-folder-name "+" t t t)))
+ (should (equal "+inbox" (mh-normalize-folder-name "inbox")))
+ (should (equal "+inbox" (mh-normalize-folder-name "+inbox")))
+ (should (equal "+inbox" (mh-normalize-folder-name "+inbox/")))
+ (should (equal "+inbox/" (mh-normalize-folder-name "+inbox/" t t t)))
+ (should (equal "+inbox/" (mh-normalize-folder-name "+inbox/" nil t)))
+ (should (equal "+news" (mh-normalize-folder-name "+inbox////../news")))
+ (should (equal "+news" (mh-normalize-folder-name "+inbox////../news/")))
+ (should (equal "+news/"
+ (mh-normalize-folder-name "+inbox////../news/" nil t)))
+ (should (equal "+inbox/news" (mh-normalize-folder-name "+inbox////./news"))))
+
+(ert-deftest mh-sub-folders-parse-no-folder ()
+ "Test `mh-sub-folders-parse' with no starting folder."
+ (let (others-position)
+ (with-temp-buffer
+ (insert "lines without has-string are ignored\n")
+ (insert "onespace has no messages.\n")
+ (insert "twospace has no messages.\n")
+ (insert " precedingblanks has no messages.\n")
+ (insert ".leadingdot has no messages.\n")
+ (insert "#leadinghash has no messages.\n")
+ (insert ",leadingcomma has no messages.\n")
+ (insert "withothers has no messages ; (others)")
+ (setq others-position (point))
+ (insert ".\n")
+ (insert "curf has no messages.\n")
+ (insert "curf+ has 123 messages.\n")
+ (insert "curf2+ has 17 messages.\n")
+ (insert "\ntotal after blank line is ignored has no messages.\n")
+ (should (equal
+ (mh-sub-folders-parse nil "curf+")
+ (list '("onespace") '("twospace") '("precedingblanks")
+ (cons "withothers" others-position)
+ '("curf") '("curf") '("curf2+")))))))
+
+(ert-deftest mh-sub-folders-parse-relative-folder ()
+ "Test `mh-sub-folders-parse' with folder."
+ (let (others-position)
+ (with-temp-buffer
+ (insert "testf+ has no messages.\n")
+ (insert "testf/sub1 has no messages.\n")
+ (insert "testf/sub2 has no messages ; (others)")
+ (setq others-position (point))
+ (insert ".\n")
+ (should (equal
+ (mh-sub-folders-parse "+testf" "testf+")
+ (list '("sub1") (cons "sub2" others-position)))))))
+
+(ert-deftest mh-sub-folders-parse-root-folder ()
+ "Test `mh-sub-folders-parse' with root folder."
+ (with-temp-buffer
+ (insert "/+ has no messages.\n")
+ (insert "/ has no messages.\n")
+ (insert "//nmh-style has no messages.\n")
+ (insert "/mu-style has no messages.\n")
+ (should (equal
+ (mh-sub-folders-parse "+/" "inbox+")
+ '(("") ("nmh-style") ("mu-style"))))))
+
+
+;; Folder names that are used by the following tests.
+(defvar mh-test-rel-folder "rela-folder")
+(defvar mh-test-abs-folder "/abso-folder")
+(defvar mh-test-no-such-folder "/testdir/none" "A folder that does not exist.")
+
+(defvar mh-test-utils-variants nil
+ "The value of `mh-variants' used for these tests.
+This variable allows setting `mh-variants' to a limited set for targeted
+testing. Its value can be different from the normal value when
+environment variable TEST_MH_PATH is set. By remembering the value, we
+can log the choice only once, which makes the batch log easier to read.")
+
+(defvar mh-test-variant-logged-already nil
+ "Whether `with-mh-test-env' has written the MH variant to the log.")
+
+(defvar mh-test-utils-debug-mocks (> (length (getenv "TEST_MH_DEBUG")) 0)
+ "Whether to log detailed behavior of mock functions.")
+
+(defvar mh-test-call-process-real (symbol-function 'call-process))
+(defvar mh-test-file-directory-p-real (symbol-function 'file-directory-p))
+
+;;; The macro with-mh-test-env wraps tests that touch the file system
+;;; and/or run programs.
+
+(defmacro with-mh-test-env (&rest body)
+ "Evaluate BODY with a test mail environment.
+Functions that touch the file system or run MH programs are either
+mocked out or pointed at a test tree. Uses `mh-test-utils-setup' to
+select which."
+ (declare (indent 0) (debug t))
+ `(cl-letf ((temp-home-dir nil)
+ ;; make local bindings for things we will modify for test env
+ (mh-user-path)
+ (mh-test-abs-folder)
+ ((symbol-function 'call-process))
+ ((symbol-function 'file-directory-p))
+ ;; the test always gets its own sub-folders cache
+ (mh-sub-folders-cache (make-hash-table :test #'equal))
+ ;; Allow envvar TEST_MH_PATH to control mh-variants.
+ (mh-variants mh-test-utils-variants)
+ ;; remember the original value
+ (original-mh-test-variant-logged mh-test-variant-logged-already)
+ (original-mh-path mh-path)
+ (original-mh-sys-path mh-sys-path)
+ (original-exec-path exec-path)
+ (original-mh-variant-in-use mh-variant-in-use)
+ (original-mh-progs mh-progs)
+ (original-mh-lib mh-lib)
+ (original-mh-lib-progs mh-lib-progs)
+ (original-mh-envvar (getenv "MH")))
+ (unwind-protect
+ (progn
+ (setq temp-home-dir (mh-test-utils-setup))
+ ,@body)
+ (unless noninteractive
+ ;; If interactive, forget that we logged the variant and
+ ;; restore any changes TEST_MH_PATH made.
+ (setq mh-test-variant-logged-already original-mh-test-variant-logged
+ mh-path original-mh-path
+ mh-sys-path original-mh-sys-path
+ exec-path original-exec-path
+ mh-variant-in-use original-mh-variant-in-use
+ mh-progs original-mh-progs
+ mh-lib original-mh-lib
+ mh-lib-progs original-mh-lib-progs))
+ (if temp-home-dir (delete-directory temp-home-dir t))
+ (setenv "MH" original-mh-envvar))))
+
+(defun mh-test-utils-setup ()
+ "Set dynamically bound variables needed by mock and/or variants.
+Call `mh-variant-set' to look through the directories named by
+environment variable `TEST_MH_PATH' (default: `mh-path' and `mh-sys-path')
+to find the MH variant to use, if any.
+Return the name of the root of the created directory tree, if any."
+ (when (getenv "TEST_MH_PATH")
+ ;; force mh-variants to use only TEST_MH_PATH
+ (setq mh-path (split-string (getenv "TEST_MH_PATH") path-separator t)
+ mh-sys-path nil
+ exec-path '("/bin" "/usr/bin")))
+ (unless mh-test-variant-logged-already
+ (mh-variant-set mh-variant)
+ (setq mh-test-utils-variants mh-variants)
+ (setq mh-test-variant-logged-already t))
+ (when (native-comp-available-p)
+ ;; As `call-process'' and `file-directory-p' will be redefined, the
+ ;; native compiler will invoke `call-process' to compile the
+ ;; respective trampolines. To avoid interference with the
+ ;; `call-process' mocking, we build these ahead of time.
+ (mapc #'comp-subr-trampoline-install '(call-process file-directory-p)))
+ (if mh-variant-in-use
+ (mh-test-utils-setup-with-variant)
+ (mh-test-utils-setup-with-mocks)))
+
+(defun mh-test-utils-setup-with-mocks ()
+ "Set dynamically bound variables so that MH programs are mocked out.
+The tests use this method if no configured MH variant is found."
+ (setq mh-user-path "/testdir/Mail/")
+ (mh-populate-sub-folders-cache "+")
+ (mh-populate-sub-folders-cache "+rela-folder")
+ (mh-populate-sub-folders-cache "+rela-folder/bar")
+ (mh-populate-sub-folders-cache "+rela-folder/foo")
+ (mh-populate-sub-folders-cache "+rela-folder/food")
+ (fset 'call-process #'mh-test-utils-mock-call-process)
+ (fset 'file-directory-p #'mh-test-utils-mock-file-directory-p)
+ ;; no temp directory created
+ nil)
+
+(defun mh-test-utils-mock-call-process (program
+ &optional _infile _destination _display
+ &rest args)
+ "A mocked version of `call-process' that calls no processes."
+ (let ((argument-responses
+ ;; assoc list of program arguments and lines to output.
+ '((("folder" "-fast") . ("rela-folder"))
+ (("folders" "-noheader" "-norecurse" "-nototal") .
+ ("rela-folder has no messages."))
+ (("folders" "-noheader" "-norecurse" "-nototal" "+rela-folder") .
+ ("rela-folder+ has no messages."
+ "rela-folder/bar has no messages."
+ "rela-folder/foo has no messages."
+ "rela-folder/food has no messages."))
+ (("folders" "-noheader" "-norecurse" "-nototal" "+rela-folder/foo") .
+ ("rela-folder/foo+ has no messages."))
+ (("folders" "-noheader" "-norecurse" "-nototal" "+") .
+ ("+ has no messages."))
+ (("folders" "-noheader" "-norecurse" "-nototal" "+/abso-folder") .
+ ("/abso-folder+ has no messages."
+ "/abso-folder/bar has no messages."
+ "/abso-folder/foo has no messages."
+ "/abso-folder/food has no messages."))
+ (("folders" "-noheader" "-norecurse" "-nototal" "+/") .
+ ("/+ has no messages ; (others)."
+ "/abso-folder has no messages ; (others)."
+ "/tmp has no messages ; (others)."))
+ ))
+ (arglist (cons (file-name-base program) args)))
+ (let ((response-list-cons (assoc arglist argument-responses)))
+ (cond (response-list-cons
+ (let ((response-list (cdr response-list-cons)))
+ (when mh-test-utils-debug-mocks
+ (message "call-process mock arglist %s" arglist)
+ (message " -> response %S" response-list))
+ (while response-list
+ (insert (car response-list) "\n")
+ (setq response-list (cdr response-list))))
+ 0)
+ (t
+ (message "call-process mock unexpected arglist %s" arglist)
+ 1)))))
+
+(defun mh-test-utils-mock-file-directory-p (filename)
+ "A mocked version of `file-directory-p' that does not access the file system."
+ (let ((directories '("" "/" "/tmp" "/abso-folder" "/abso-folder/foo"
+ "/testdir/Mail" "/testdir/Mail/rela-folder"
+ "/testdir/Mail/rela-folder/foo"
+ "rela-folder" "rela-folder/foo"))
+ (non-directories '("/abso-folder/fo" "rela-folder/fo"
+ "/testdir/Mail/rela-folder/fo"
+ "/testdir/Mail/nosuchfolder"
+ "/nosuchfolder" "nosuchfolder")))
+ (cond ((member (directory-file-name filename) directories)
+ (when mh-test-utils-debug-mocks
+ (message "file-directory-p mock: %S -> t" filename))
+ t)
+ ((member (directory-file-name filename) non-directories)
+ (when mh-test-utils-debug-mocks
+ (message "file-directory-p mock: %S -> nil" filename))
+ nil)
+ (t
+ (message "file-directory-p mock unexpected filename: %S" filename)
+ nil))))
+
+(defun mh-test-utils-setup-with-variant ()
+ "Create a temporary directory structure for actual MH programs to read.
+Return the name of the root of the created directory tree.
+Set dynamically bound variables so that MH programs may log.
+The tests use this method if a configured MH variant is found."
+ (let* ((temp-home-dir
+ (make-temp-file "emacs-mh-e-unit-test-" t))
+ (profile (expand-file-name
+ ".mh_profile" temp-home-dir))
+ (mail-dir (expand-file-name "Mail" temp-home-dir))
+ (rela-folder (expand-file-name
+ "rela-folder" mail-dir))
+ (abso-folder (expand-file-name
+ "abso-folder" temp-home-dir)))
+ (with-temp-file profile
+ (insert "Path: " mail-dir "\n" "Welcome: disable\n"))
+ (setenv "MH" profile)
+ (make-directory (expand-file-name "bar" rela-folder) t)
+ (make-directory (expand-file-name "foo" rela-folder) t)
+ (make-directory (expand-file-name "food" rela-folder) t)
+ (setq mh-user-path (file-name-as-directory mail-dir))
+ (make-directory (expand-file-name "bar" abso-folder) t)
+ (make-directory (expand-file-name "foo" abso-folder) t)
+ (make-directory (expand-file-name "food" abso-folder) t)
+ (setq mh-test-abs-folder abso-folder)
+ (fset 'call-process #'mh-test-utils-log-call-process)
+ (fset 'file-directory-p #'mh-test-utils-log-file-directory-p)
+ temp-home-dir))
+
+(defun mh-test-utils-log-call-process (program
+ &optional infile destination display
+ &rest args)
+ "A wrapper around `call-process' that can log the program args and output.
+Both args and output are written with `message' if `mh-test-utils-debug-mocks'
+is non-nil."
+ (let (process-output)
+ (when mh-test-utils-debug-mocks
+ (message "call-process arglist %s" (cons program args)))
+ (with-temp-buffer
+ (apply mh-test-call-process-real program infile destination display args)
+ (setq process-output (buffer-string)))
+ (when mh-test-utils-debug-mocks
+ (message " -> response:\n%s" process-output))
+ (insert process-output)))
+
+(defun mh-test-utils-log-file-directory-p (filename)
+ "A wrapper around `file-directory-p' that can log calls.
+Both FILENAME and the return value are written with `message'
+if `mh-test-utils-debug-mocks' is non-nil."
+ (let ((result (funcall mh-test-file-directory-p-real filename)))
+ (when mh-test-utils-debug-mocks
+ (message "file-directory-p: %S -> %s" filename result))
+ result))
+
+(defun mh-test-variant-handles-plus-slash (variant)
+ "Returns non-nil if this MH variant handles \"folders +/\".
+Mailutils 3.5, 3.7, and 3.13 are known not to."
+ (cond ((not (stringp variant))) ;our mock handles it
+ ((string-search "GNU Mailutils" variant)
+ (let ((mu-version (string-remove-prefix "GNU Mailutils " variant)))
+ (version<= "3.13.91" mu-version)))
+ (t))) ;no other known failures
+
+
+(ert-deftest mh-sub-folders-actual ()
+ "Test `mh-sub-folders-actual'."
+ ;; Note that mh-sub-folders-actual expects the folder to have
+ ;; already been normalized with
+ ;; (mh-normalize-folder-name folder nil nil t)
+ (with-mh-test-env
+ (should (member
+ mh-test-rel-folder
+ (mapcar (lambda (x) (car x)) (mh-sub-folders-actual nil))))
+ ;; Empty string and "+" not tested since mh-normalize-folder-name
+ ;; would change them to nil.
+ (should (member "foo"
+ (mapcar (lambda (x) (car x))
+ (mh-sub-folders-actual
+ (format "+%s" mh-test-rel-folder)))))
+ ;; Folder with trailing slash not tested since
+ ;; mh-normalize-folder-name would strip it.
+ (should (equal
+ nil
+ (mh-sub-folders-actual (format "+%s/foo" mh-test-rel-folder))))
+
+ (should (equal
+ (list (list "bar") (list "foo") (list "food"))
+ (mh-sub-folders-actual (format "+%s" mh-test-abs-folder))))
+
+ (when (mh-test-variant-handles-plus-slash mh-variant-in-use)
+ (should (member "tmp" (mapcar (lambda (x) (car x))
+ (mh-sub-folders-actual "+/")))))
+
+ ;; FIXME: mh-sub-folders-actual doesn't (yet) expect to be given a
+ ;; nonexistent folder.
+ ;; (should (equal nil
+ ;; (mh-sub-folders-actual "+nosuchfolder")))
+ ;; (should (equal nil
+ ;; (mh-sub-folders-actual "+/nosuchfolder")))
+ ))
+
+(ert-deftest mh-sub-folders ()
+ "Test `mh-sub-folders'."
+ (with-mh-test-env
+ (should (member mh-test-rel-folder
+ (mapcar (lambda (x) (car x)) (mh-sub-folders nil))))
+ (should (member mh-test-rel-folder
+ (mapcar (lambda (x) (car x)) (mh-sub-folders ""))))
+ (should-not (member mh-test-no-such-folder
+ (mapcar (lambda (x) (car x)) (mh-sub-folders "+"))))
+ (should (equal (list (list "bar") (list "foo") (list "food"))
+ (mh-sub-folders (format "+%s" mh-test-rel-folder))))
+ (should (equal (list (list "bar") (list "foo") (list "food"))
+ (mh-sub-folders (format "+%s/" mh-test-rel-folder))))
+ (should (equal nil
+ (mh-sub-folders (format "+%s/foo/" mh-test-rel-folder))))
+ (should (equal nil
+ (mh-sub-folders (format "+%s/foo" mh-test-rel-folder))))
+ (should (equal (list (list "bar") (list "foo") (list "food"))
+ (mh-sub-folders (format "+%s" mh-test-abs-folder))))
+ (when (mh-test-variant-handles-plus-slash mh-variant-in-use)
+ (should (member "tmp"
+ (mapcar (lambda (x) (car x)) (mh-sub-folders "+/")))))
+
+ ;; FIXME: mh-sub-folders doesn't (yet) expect to be given a
+ ;; nonexistent folder.
+ ;; (should (equal nil
+ ;; (mh-sub-folders "+nosuchfolder")))
+ ;; (should (equal nil
+ ;; (mh-sub-folders "+/nosuchfolder")))
+ ))
+
+
+(defmacro mh-test-folder-completion-1 (name
+ nil-expected t-expected lambda-expected)
+ "Helper for testing `mh-folder-completion-function'.
+Ask for completion on NAME three times, with three different
+values for the FLAG argument of `mh-folder-completion-function'.
+NIL-EXPECTED is the expected value with FLAG nil.
+T-EXPECTED is the expected value with FLAG t.
+LAMBDA-EXPECTED is the expected value with FLAG lambda."
+ (declare (debug t))
+ `(with-mh-test-env
+ (mh-test-folder-completion-2 ,nil-expected ;case "a"
+ (mh-folder-completion-function ,name nil nil))
+ (mh-test-folder-completion-2 ,t-expected ;case "b"
+ (mh-folder-completion-function ,name nil t))
+ (mh-test-folder-completion-2 ,lambda-expected ;case "c"
+ (mh-folder-completion-function ,name nil
+ 'lambda))))
+
+(defmacro mh-test-folder-completion-2 (expected actual)
+ "Inner helper for testing `mh-folder-completion-function'.
+ACTUAL should evaluate to either EXPECTED or to a list containing EXPECTED.
+ACTUAL may be evaluated twice, but this gives a clearer error on failure,
+and the `should' macro requires idempotent evaluation anyway."
+ (declare (debug t))
+ `(if (and (not (consp ,expected)) (consp ,actual))
+ (should (member ,expected ,actual))
+ (should (equal ,expected ,actual))))
+
+
+(ert-deftest mh-folder-completion-function-02-empty ()
+ "Test `mh-folder-completion-function' with empty name."
+ (mh-test-folder-completion-1 "" "+" (format "%s/" mh-test-rel-folder) nil))
+
+(ert-deftest mh-folder-completion-function-03-plus ()
+ "Test `mh-folder-completion-function' with `+'."
+ (mh-test-folder-completion-1 "+" "+" (format "%s/" mh-test-rel-folder) nil))
+
+(ert-deftest mh-folder-completion-function-04-rel-folder ()
+ "Test `mh-folder-completion-function' with `+rela-folder'."
+ (mh-test-folder-completion-1 (format "+%s" mh-test-rel-folder)
+ (format "+%s/" mh-test-rel-folder)
+ (list (format "%s/" mh-test-rel-folder))
+ t))
+
+(ert-deftest mh-folder-completion-function-05-rel-folder-slash ()
+ "Test `mh-folder-completion-function' with `+rela-folder/'."
+ (mh-test-folder-completion-1 (format "+%s/" mh-test-rel-folder)
+ (format "+%s/" mh-test-rel-folder)
+ (list "bar" "foo" "food")
+ t))
+
+(ert-deftest mh-folder-completion-function-06-rel-folder-slash-foo ()
+ "Test `mh-folder-completion-function' with `+rela-folder/foo'."
+ (mh-test-folder-completion-1 (format "+%s/foo" mh-test-rel-folder)
+ (format "+%s/foo" mh-test-rel-folder)
+ (list "foo" "food")
+ t)
+ (with-mh-test-env
+ (should (equal nil
+ (mh-folder-completion-function
+ (format "+%s/fo" mh-test-rel-folder) nil 'lambda)))))
+
+(ert-deftest mh-folder-completion-function-07-rel-folder-slash-foo-slash ()
+ "Test `mh-folder-completion-function' with `+rela-folder/foo/'."
+ (mh-test-folder-completion-1 (format "+%s/foo/" mh-test-rel-folder)
+ nil
+ nil
+ t))
+
+(ert-deftest mh-folder-completion-function-08-plus-slash ()
+ "Test `mh-folder-completion-function' with `+/'."
+ (with-mh-test-env
+ (skip-unless (mh-test-variant-handles-plus-slash mh-variant-in-use)))
+ (mh-test-folder-completion-1 "+/" "+/" "tmp/" t)
+ ;; case "bb"
+ (with-mh-test-env
+ (should (equal nil
+ (member (format "+%s/" mh-test-rel-folder)
+ (mh-folder-completion-function "+/" nil t))))))
+
+(ert-deftest mh-folder-completion-function-09-plus-slash-tmp ()
+ "Test `mh-folder-completion-function' with `+/tmp'."
+ (with-mh-test-env
+ (skip-unless (mh-test-variant-handles-plus-slash mh-variant-in-use)))
+ (mh-test-folder-completion-1 "+/tmp" "+/tmp/" "tmp/" t))
+
+(ert-deftest mh-folder-completion-function-10-plus-slash-abs-folder ()
+ "Test `mh-folder-completion-function' with `+/abso-folder'."
+ (mh-test-folder-completion-1 (format "+%s/" mh-test-abs-folder)
+ (format "+%s/" mh-test-abs-folder)
+ (list "bar" "foo" "food")
+ t))
+
+(ert-deftest mh-folder-completion-function-11-plus-slash-abs-folder-slash-foo ()
+ "Test `mh-folder-completion-function' with `+/abso-folder/foo'."
+ (mh-test-folder-completion-1 (format "+%s/foo" mh-test-abs-folder)
+ (format "+%s/foo" mh-test-abs-folder)
+ (list "foo" "food")
+ t)
+ (with-mh-test-env
+ (should (equal nil
+ (mh-folder-completion-function
+ (format "+%s/fo" mh-test-abs-folder) nil 'lambda)))))
+
+(ert-deftest mh-folder-completion-function-12-plus-nosuchfolder ()
+ "Test `mh-folder-completion-function' with `+nosuchfolder'."
+ (mh-test-folder-completion-1 "+nosuchfolder" nil nil nil))
+
+(ert-deftest mh-folder-completion-function-13-plus-slash-nosuchfolder ()
+ "Test `mh-folder-completion-function' with `+/nosuchfolder'."
+ (mh-test-folder-completion-1 "+/nosuchfolder" nil nil nil))
+
+;;; mh-utils-tests.el ends here
diff --git a/test/lisp/mh-e/mh-xface-tests.el b/test/lisp/mh-e/mh-xface-tests.el
new file mode 100644
index 00000000000..6c9c7ea1bf1
--- /dev/null
+++ b/test/lisp/mh-e/mh-xface-tests.el
@@ -0,0 +1,50 @@
+;;; mh-xface-tests.el --- tests for mh-xface.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'mh-xface)
+
+(ert-deftest mh-x-image-url-sane-p ()
+ "Test that `mh-x-image-url-sane-p' accepts a URL exactly if it is sane."
+ (should (equal (mh-x-image-url-sane-p (concat "http://"
+ (make-string 101 ?a)))
+ nil)) ;too long
+ (should (equal (mh-x-image-url-sane-p "http") nil)) ;too short
+ (should (equal (mh-x-image-url-sane-p "http:") t))
+ (should (equal (mh-x-image-url-sane-p "https") nil)) ;too short
+ (should (equal (mh-x-image-url-sane-p "https:") t))
+ (should (equal (mh-x-image-url-sane-p "https://www.example.com/me.png") t))
+ (should (equal (mh-x-image-url-sane-p "abcde:") nil)))
+
+(ert-deftest mh-x-image-url-cache-canonicalize ()
+ "Test `mh-x-image-url-cache-canonicalize'."
+ (should (equal (format "%s/%s" mh-x-image-cache-directory "%21foo%21bar.png")
+ (mh-x-image-url-cache-canonicalize "/foo/bar")))
+ (should (equal (format "%s/%s" mh-x-image-cache-directory
+ "http%3A%21%21domain.com%21foo%21bar.png")
+ (mh-x-image-url-cache-canonicalize
+ "http://domain.com/foo/bar")))
+ ;; All Windows invalid characters.
+ (should (equal (format "%s/%s" mh-x-image-cache-directory
+ "%21%3C%3E%3A%2A%3F%22%5C%7C%21bar.png")
+ (mh-x-image-url-cache-canonicalize "/<>:*?\"\\|/bar"))))
+
+;;; mh-xface-tests.el ends here
diff --git a/test/lisp/mh-e/test-all-mh-variants.sh b/test/lisp/mh-e/test-all-mh-variants.sh
new file mode 100755
index 00000000000..3789a5fdedc
--- /dev/null
+++ b/test/lisp/mh-e/test-all-mh-variants.sh
@@ -0,0 +1,102 @@
+#! /bin/bash
+# Run the mh-utils-tests against all MH variants found on this system.
+
+# Copyright (C) 2021-2022 Free Software Foundation, Inc.
+
+# This file is part of GNU Emacs.
+
+# GNU Emacs is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+
+# GNU Emacs is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+# Commentary:
+
+# By default runs all tests; test names or Emacs-style regexps may be
+# given on the command line to run just those tests.
+#
+# Option -d turns on Emacs variable mh-test-utils-debug-mocks, which
+# causes the tests to output all interactions with the file system.
+
+# If you want to run the tests for only one MH variant, you don't need
+# to use this script, because "make" can do it. See the commentary at
+# the top of ./mh-utils-tests.el for the recipe.
+
+debug=
+if [[ "$1" = -* ]]; then
+ if [[ "$1" != -d ]]; then
+ echo "Usage: $(basename "$0") [-d] [test ...]" >&2
+ exit 2
+ fi
+ debug=t
+ shift
+fi
+
+shopt -s extglob
+ert_test_list=()
+for tst; do
+ # Guess the type the test spec
+ case $tst in
+ *[\[\].*+\\]*) # Regexp: put in string quotes
+ ert_test_list+=("\"$tst\"")
+ ;;
+ *) # Lisp expression, keyword, or symbol: use as is
+ ert_test_list+=("$tst")
+ ;;
+ esac
+done
+if [[ ${#ert_test_list[@]} -eq 0 ]]; then
+ # t means true for all tests, runs everything
+ ert_test_list=(t)
+fi
+
+# This script is 3 directories down in the Emacs source tree.
+cd "$(dirname "$0")"
+cd ../../..
+emacs=(src/emacs --batch -Q)
+
+# MH-E has a good list of directories where an MH variant might be installed,
+# so we look in each of those.
+read -r -a mh_sys_path \
+ < <("${emacs[@]}" -l mh-e --eval "(princ mh-sys-path)" | sed 's/[()]//g')
+
+have_done_mocked_variant=false
+declare -i tests_total=0 tests_passed=0
+
+for path in "${mh_sys_path[@]}"; do
+ if [[ ! -x "$path/mhparam" ]]; then
+ if [[ "$have_done_mocked_variant" = false ]]; then
+ have_done_mocked_variant=true
+ else
+ continue
+ fi
+ fi
+ echo "** Testing with PATH $path"
+ ((++tests_total))
+ TEST_MH_PATH=$path TEST_MH_DEBUG=$debug \
+ HOME=/nonexistent \
+ "${emacs[@]}" -l ert \
+ --eval "(setq load-prefer-newer t)" \
+ --eval "(load \"$PWD/test/lisp/mh-e/mh-utils-tests\" nil t)" \
+ --eval "(ert-run-tests-batch-and-exit '(or ${ert_test_list[*]}))" \
+ && ((++tests_passed))
+done
+
+if (( tests_total == 0 )); then
+ echo "NO tests run"
+ exit 1
+elif (( tests_total == tests_passed )); then
+ echo "All tested variants pass: $tests_passed/$tests_total"
+else
+ echo "Tested variants passing: $tests_passed/$tests_total," \
+ "FAILING: $((tests_total - tests_passed))/$tests_total"
+ exit 1
+fi
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-06 08:44:23 +0000