From f54ddb0198640e38c1d34bf6031ff5117c117c85 Mon Sep 17 00:00:00 2001
From: Philipp Stephani
Date: Fri, 31 Jul 2020 23:50:04 +0200
Subject: ; * test/lisp/emacs-lisp/generator-tests.el: Style fixes.

---
 test/lisp/emacs-lisp/generator-tests.el | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

(limited to 'test')

diff --git a/test/lisp/emacs-lisp/generator-tests.el b/test/lisp/emacs-lisp/generator-tests.el
index 0d325f1485a..e0d9167118e 100644
--- a/test/lisp/emacs-lisp/generator-tests.el
+++ b/test/lisp/emacs-lisp/generator-tests.el
@@ -22,6 +22,10 @@
 
 ;;; Commentary:
 
+;; Unit tests for generator.el.
+
+;;; Code:
+
 (require 'generator)
 (require 'ert)
 (require 'cl-lib)
@@ -38,8 +42,7 @@
 `cps-testcase' defines an ERT testcase called NAME that evaluates
 BODY twice: once using ordinary `eval' and once using
 lambda-generators.  The test ensures that the two forms produce
-identical output.
-"
+identical output."
   `(progn
      (ert-deftest ,name ()
        (should
@@ -302,3 +305,5 @@ identical output.
                                             (lambda (it) (- it))
                                             (1+ it)))))))
                  -2)))
+
+;;; generator-tests.el ends here
-- 
cgit v1.2.1


From e6eb554b95327549992c3684910921db9181ffb6 Mon Sep 17 00:00:00 2001
From: Philipp Stephani
Date: Sun, 2 Aug 2020 16:01:47 +0200
Subject: Don’t generate duplicate symbols for secondary CL methods (Bug#42671)

* lisp/emacs-lisp/edebug.el
(edebug-match-cl-generic-method-qualifier): Add matcher for
‘cl-defmethod’ qualifier.

* lisp/emacs-lisp/cl-generic.el (cl-defmethod): Use it.

* test/lisp/emacs-lisp/edebug-tests.el
(edebug-cl-defmethod-qualifier): New unit test.
---
 test/lisp/emacs-lisp/edebug-tests.el | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

(limited to 'test')

diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el
index 41811c9dc07..89b1f293743 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -938,5 +938,27 @@ test and possibly others should be updated."
     "g"
     (should (equal edebug-tests-@-result '(0 1))))))
 
+(ert-deftest edebug-cl-defmethod-qualifier ()
+  "Check that secondary `cl-defmethod' forms don't stomp over
+primary ones (Bug#42671)."
+  (with-temp-buffer
+    (let* ((edebug-all-defs t)
+           (edebug-initial-mode 'Go-nonstop)
+           (defined-symbols ())
+           (edebug-new-definition-function
+            (lambda (def-name)
+              (push def-name defined-symbols)
+              (edebug-new-definition def-name))))
+      (dolist (form '((cl-defmethod edebug-cl-defmethod-qualifier ((_ number)))
+                      (cl-defmethod edebug-cl-defmethod-qualifier
+                        :around ((_ number)))))
+        (print form (current-buffer)))
+      (eval-buffer)
+      (should
+       (equal
+        defined-symbols
+        (list (intern "edebug-cl-defmethod-qualifier :around ((_ number))")
+              (intern "edebug-cl-defmethod-qualifier ((_ number))")))))))
+
 (provide 'edebug-tests)
 ;;; edebug-tests.el ends here
-- 
cgit v1.2.1


From d8ab98843edccd233c2354d3c518c7a4b18023bd Mon Sep 17 00:00:00 2001
From: Philipp Stephani
Date: Sun, 2 Aug 2020 17:17:00 +0200
Subject: Avoid duplicate Edebug symbols when using ‘cl-flet’ (Bug#41989)

* lisp/emacs-lisp/edebug.el (edebug-match-:unique): Add a new
‘:unique’ specifier to generate unique names.

* lisp/emacs-lisp/cl-macs.el (cl-flet): Use it.  This requires
inlining the ‘cl-defun’ specification.

* test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-cl-flet): New
unit test.

* doc/lispref/edebug.texi (Specification List): Document new ‘:unique’
construct.
---
 test/lisp/emacs-lisp/edebug-tests.el | 40 ++++++++++++++++++++++++++++++++++++
 1 file changed, 40 insertions(+)

(limited to 'test')

diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el
index 89b1f293743..be9f1503795 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -960,5 +960,45 @@ primary ones (Bug#42671)."
         (list (intern "edebug-cl-defmethod-qualifier :around ((_ number))")
               (intern "edebug-cl-defmethod-qualifier ((_ number))")))))))
 
+(ert-deftest edebug-tests-cl-flet ()
+  "Check what Edebug can instrument `cl-flet' forms without name
+clashes (Bug#41853)."
+  (with-temp-buffer
+    (dolist (form '((defun edebug-tests-cl-flet-1 ()
+                      (cl-flet ((inner () 0)) (message "Hi"))
+                      (cl-flet ((inner () 1)) (inner)))
+                    (defun edebug-tests-cl-flet-2 ()
+                      (cl-flet ((inner () 2)) (inner)))))
+      (print form (current-buffer)))
+    (let* ((edebug-all-defs t)
+           (edebug-initial-mode 'Go-nonstop)
+           (instrumented-names ())
+           (edebug-new-definition-function
+            (lambda (name)
+              (when (memq name instrumented-names)
+                (error "Duplicate definition of `%s'" name))
+              (push name instrumented-names)
+              (edebug-new-definition name)))
+           ;; Make generated symbols reproducible.
+           (gensym-counter 10000))
+      (eval-buffer)
+      (should (equal (reverse instrumented-names)
+                     ;; The outer definitions come after the inner
+                     ;; ones because their body ends later.
+                     ;; FIXME: There are twice as many inner
+                     ;; definitions as expected due to Bug#41988.
+                     ;; Once that bug is fixed, remove the duplicates.
+                     ;; FIXME: We'd rather have names such as
+                     ;; `edebug-tests-cl-flet-1@inner@cl-flet@10000',
+                     ;; but that requires further changes to Edebug.
+                     '(inner@cl-flet@10000
+                       inner@cl-flet@10001
+                       inner@cl-flet@10002
+                       inner@cl-flet@10003
+                       edebug-tests-cl-flet-1
+                       inner@cl-flet@10004
+                       inner@cl-flet@10005
+                       edebug-tests-cl-flet-2))))))
+
 (provide 'edebug-tests)
 ;;; edebug-tests.el ends here
-- 
cgit v1.2.1


From 0a65e060207def5d31fb7d96b8d3bb1441fd13c9 Mon Sep 17 00:00:00 2001
From: Philipp Stephani
Date: Sun, 2 Aug 2020 18:04:18 +0200
Subject: ; * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-cl-flet): Fix
 typo.

---
 test/lisp/emacs-lisp/edebug-tests.el | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'test')

diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el
index be9f1503795..1be68f6ff46 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -961,7 +961,7 @@ primary ones (Bug#42671)."
               (intern "edebug-cl-defmethod-qualifier ((_ number))")))))))
 
 (ert-deftest edebug-tests-cl-flet ()
-  "Check what Edebug can instrument `cl-flet' forms without name
+  "Check that Edebug can instrument `cl-flet' forms without name
 clashes (Bug#41853)."
   (with-temp-buffer
     (dolist (form '((defun edebug-tests-cl-flet-1 ()
-- 
cgit v1.2.1


From 3e0c3479b24e1978d30bbcc00faac7bdd6bdd170 Mon Sep 17 00:00:00 2001
From: Philipp Stephani
Date: Sun, 2 Aug 2020 18:05:36 +0200
Subject: Add a workaround for Bug#42672

* lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Work around Bug#42672
by uniquifying inline method names.

* test/lisp/emacs-lisp/cl-generic-tests.el
(cl-defgeneric/edebug/method): New regression test.
---
 test/lisp/emacs-lisp/cl-generic-tests.el | 36 ++++++++++++++++++++++++++++++++
 1 file changed, 36 insertions(+)

(limited to 'test')

diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el
index 51c9884ddc8..fc39e349523 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -24,6 +24,7 @@
 ;;; Code:
 
 (require 'cl-generic)
+(require 'edebug)
 
 ;; Don't indirectly require `cl-lib' at run-time.
 (eval-when-compile (require 'ert))
@@ -249,5 +250,40 @@
   (should-not (cl--generic-method-files 'cl-generic-tests--undefined-generic))
   (should-not (cl--generic-method-files 'cl-generic-tests--generic-without-methods)))
 
+(ert-deftest cl-defgeneric/edebug/method ()
+  "Check that `:method' forms in `cl-defgeneric' create unique
+Edebug symbols (Bug#42672)."
+  (with-temp-buffer
+    (dolist (form '((cl-defgeneric cl-defgeneric/edebug/method/1 (_)
+                      (:method ((_ number)) 1)
+                      (:method ((_ string)) 2))
+                    (cl-defgeneric cl-defgeneric/edebug/method/2 (_)
+                      (:method ((_ number)) 3))))
+      (print form (current-buffer)))
+    (let* ((edebug-all-defs t)
+           (edebug-initial-mode 'Go-nonstop)
+           (instrumented-names ())
+           (edebug-new-definition-function
+            (lambda (name)
+              (when (memq name instrumented-names)
+                (error "Duplicate definition of `%s'" name))
+              (push name instrumented-names)
+              (edebug-new-definition name)))
+           ;; Make generated symbols reproducible.
+           (gensym-counter 10000))
+      (eval-buffer)
+      (should (equal (reverse instrumented-names)
+                     ;; The generic function definitions come after
+                     ;; the method definitions because their body ends
+                     ;; later.
+                     ;; FIXME: We'd rather have names such as
+                     ;; `cl-defgeneric/edebug/method/1 ((_ number))',
+                     ;; but that requires further changes to Edebug.
+                     (list (intern "cl-generic-:method@10000 ((_ number))")
+                           (intern "cl-generic-:method@10001 ((_ string))")
+                           'cl-defgeneric/edebug/method/1
+                           (intern "cl-generic-:method@10002 ((_ number))")
+                           'cl-defgeneric/edebug/method/2))))))
+
 (provide 'cl-generic-tests)
 ;;; cl-generic-tests.el ends here
-- 
cgit v1.2.1


From a325584281c4d8552917fcb97caed449acb7ee65 Mon Sep 17 00:00:00 2001
From: Philipp Stephani
Date: Sun, 2 Aug 2020 22:07:27 +0200
Subject: Improve Edebug symbols for inlined secondary methods (Bug#42671)

* lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Include qualifiers in
Edebug symbol name.

* test/lisp/emacs-lisp/cl-generic-tests.el
(cl-defgeneric/edebug/method): Adapt unit test.
---
 test/lisp/emacs-lisp/cl-generic-tests.el | 28 +++++++++++++++-------------
 1 file changed, 15 insertions(+), 13 deletions(-)

(limited to 'test')

diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el
index fc39e349523..5aa58782f36 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -256,7 +256,8 @@ Edebug symbols (Bug#42672)."
   (with-temp-buffer
     (dolist (form '((cl-defgeneric cl-defgeneric/edebug/method/1 (_)
                       (:method ((_ number)) 1)
-                      (:method ((_ string)) 2))
+                      (:method ((_ string)) 2)
+                      (:method :around ((_ number)) 3))
                     (cl-defgeneric cl-defgeneric/edebug/method/2 (_)
                       (:method ((_ number)) 3))))
       (print form (current-buffer)))
@@ -272,18 +273,19 @@ Edebug symbols (Bug#42672)."
            ;; Make generated symbols reproducible.
            (gensym-counter 10000))
       (eval-buffer)
-      (should (equal (reverse instrumented-names)
-                     ;; The generic function definitions come after
-                     ;; the method definitions because their body ends
-                     ;; later.
-                     ;; FIXME: We'd rather have names such as
-                     ;; `cl-defgeneric/edebug/method/1 ((_ number))',
-                     ;; but that requires further changes to Edebug.
-                     (list (intern "cl-generic-:method@10000 ((_ number))")
-                           (intern "cl-generic-:method@10001 ((_ string))")
-                           'cl-defgeneric/edebug/method/1
-                           (intern "cl-generic-:method@10002 ((_ number))")
-                           'cl-defgeneric/edebug/method/2))))))
+      (should (equal
+               (reverse instrumented-names)
+               ;; The generic function definitions come after the
+               ;; method definitions because their body ends later.
+               ;; FIXME: We'd rather have names such as
+               ;; `cl-defgeneric/edebug/method/1 ((_ number))', but
+               ;; that requires further changes to Edebug.
+               (list (intern "cl-generic-:method@10000 ((_ number))")
+                     (intern "cl-generic-:method@10001 ((_ string))")
+                     (intern "cl-generic-:method@10002 :around ((_ number))")
+                     'cl-defgeneric/edebug/method/1
+                     (intern "cl-generic-:method@10003 ((_ number))")
+                     'cl-defgeneric/edebug/method/2))))))
 
 (provide 'cl-generic-tests)
 ;;; cl-generic-tests.el ends here
-- 
cgit v1.2.1


From ca419812d35f252fca2708ffdd132c223d094c0f Mon Sep 17 00:00:00 2001
From: Philipp Stephani
Date: Mon, 3 Aug 2020 21:07:32 +0200
Subject: Avoid duplicate Edebug symbols when backtracking (Bug#42701)

When Edebug backtracks, it nevertheless generates definitions for the
non-matching branches, see Bug#41988 and Bug#42701.  This should be
fixed eventually (probably by deferring the definition until a branch
is known to match), but for now add a band-aid to avoid these
duplicate symbols, at least for anonymous forms.

* lisp/emacs-lisp/edebug.el (edebug-make-enter-wrapper): Regenerate
anonymous names.

* test/lisp/emacs-lisp/edebug-tests.el
(edebug-tests-duplicate-symbol-backtrack): New regression test.
---
 test/lisp/emacs-lisp/edebug-tests.el | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)

(limited to 'test')

diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el
index 1be68f6ff46..04a7b2f5a0f 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -1000,5 +1000,37 @@ clashes (Bug#41853)."
                        inner@cl-flet@10005
                        edebug-tests-cl-flet-2))))))
 
+(ert-deftest edebug-tests-duplicate-symbol-backtrack ()
+  "Check that Edebug doesn't create duplicate symbols when
+backtracking (Bug#42701)."
+  (with-temp-buffer
+    (dolist (form '((require 'subr-x)
+                    (defun edebug-tests-duplicate-symbol-backtrack ()
+                      (if-let (x (funcall (lambda (y) 1) 2)) 3 4))))
+      (print form (current-buffer)))
+    (let* ((edebug-all-defs t)
+           (edebug-initial-mode 'Go-nonstop)
+           (instrumented-names ())
+           (edebug-new-definition-function
+            (lambda (name)
+              (when (memq name instrumented-names)
+                (error "Duplicate definition of `%s'" name))
+              (push name instrumented-names)
+              (edebug-new-definition name)))
+           ;; Make generated symbols reproducible.
+           (gensym-counter 10000))
+      (eval-buffer)
+      ;; The anonymous symbols are uninterned.  Use their names so we
+      ;; can perform the assertion.  The names should still be unique.
+      (should (equal (mapcar #'symbol-name (reverse instrumented-names))
+                     ;; The outer definition comes after the inner
+                     ;; ones because its body ends later.
+                     ;; FIXME: There are twice as many inner
+                     ;; definitions as expected due to Bug#42701.
+                     ;; Once that bug is fixed, remove the duplicates.
+                     '("edebug-anon10000"
+                       "edebug-anon10001"
+                       "edebug-tests-duplicate-symbol-backtrack"))))))
+
 (provide 'edebug-tests)
 ;;; edebug-tests.el ends here
-- 
cgit v1.2.1


From 83b1db043b44a8efb091ced873eab686e671c5ac Mon Sep 17 00:00:00 2001
From: Michael Albinus
Date: Tue, 4 Aug 2020 14:19:51 +0200
Subject: Add Tramp support of direct asynchronous process invocation

* doc/misc/tramp.texi (Predefined connection information):
Add "direct-async-process".
(Remote processes): New subsection "Improving performance of
asynchronous remote processes".

* lisp/net/tramp-adb.el (tramp-methods) <adb>: Add `tramp-login-program'
and `tramp-login-args'.
(tramp-adb-handle-make-process): Use `tramp-handle-make-process'.
(tramp-adb-maybe-open-connection): Add "set +o vi +o emacs" command.

* lisp/net/tramp-sh.el (tramp-sh-handle-make-process):
Use `tramp-handle-make-process'.
(tramp-sh-file-name-handler-p, tramp-multi-hop-p): New defuns.
(tramp-compute-multi-hops): Use `tramp-multi-hop-p'.

* lisp/net/tramp.el (tramp-dissect-file-name, tramp-dissect-hop-name):
Use `tramp-multi-hop-p'.
(tramp-handle-insert-file-contents, tramp-local-host-p):
Use `tramp-sh-file-name-handler-p'.
(tramp-handle-make-process): New defun.

* test/README: Add another example how to use SELECTOR.

* test/lisp/net/tramp-tests.el (tramp-test03-file-name-method-rules):
Adapt test.
(tramp--test-sh-p): Use `tramp-sh-file-name-handler-p'.
---
 test/README                  |  5 +++++
 test/lisp/net/tramp-tests.el | 18 +++++++++---------
 2 files changed, 14 insertions(+), 9 deletions(-)

(limited to 'test')

diff --git a/test/README b/test/README
index 1f69f7142c1..fe05b5403b1 100644
--- a/test/README
+++ b/test/README
@@ -64,6 +64,11 @@ protect against "make" variable expansion):
 
     make <filename> SELECTOR='"foo$$"'
 
+In case you want to use the symbol name of a test as selector, you can
+use it directly:
+
+    make <filename> SELECTOR='test-foo-remote'
+
 Note that although the test files are always compiled (unless they set
 no-byte-compile), the source files will be run when expensive or
 unstable tests are involved, to give nicer backtraces.  To run the
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index ac24fcf280a..05196e7e4a6 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2001,12 +2001,13 @@ is greater than 10.
   (skip-unless (tramp--test-enabled))
 
   ;; Multi hops are allowed for inline methods only.
-  (should-error
-   (file-remote-p "/ssh:user1@host1|method:user2@host2:/path/to/file")
-   :type 'user-error)
-  (should-error
-   (file-remote-p "/method:user1@host1|ssh:user2@host2:/path/to/file")
-   :type 'user-error)
+  (let (non-essential)
+    (should-error
+     (expand-file-name "/ssh:user1@host1|method:user2@host2:/path/to/file")
+     :type 'user-error)
+    (should-error
+     (expand-file-name "/method:user1@host1|ssh:user2@host2:/path/to/file")
+     :type 'user-error))
 
   ;; Samba does not support file names with periods followed by
   ;; spaces, and trailing periods or spaces.
@@ -5681,9 +5682,8 @@ This does not support special file names."
 
 (defun tramp--test-sh-p ()
   "Check, whether the remote host runs a based method from tramp-sh.el."
-  (eq
-   (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
-   'tramp-sh-file-name-handler))
+  (tramp-sh-file-name-handler-p
+   (tramp-dissect-file-name tramp-test-temporary-file-directory)))
 
 (defun tramp--test-sudoedit-p ()
   "Check, whether the sudoedit method is used."
-- 
cgit v1.2.1


From e208d67e8401b8e08d697273e6e162b1e4620005 Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen
Date: Tue, 4 Aug 2020 14:30:13 +0200
Subject: Fix wdired test for Macos

* test/lisp/wdired-tests.el (wdired-test-bug34915): Macos adds "@"
to the end of symlinks (bug#42537).
---
 test/lisp/wdired-tests.el | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

(limited to 'test')

diff --git a/test/lisp/wdired-tests.el b/test/lisp/wdired-tests.el
index 5b01c54cf24..fcd8b626404 100644
--- a/test/lisp/wdired-tests.el
+++ b/test/lisp/wdired-tests.el
@@ -132,7 +132,7 @@ wdired-mode."
 (declare-function dired-smart-shell-command "dired-x"
                   (command &optional output-buffer error-buffer))
 
-(ert-deftest wdired-test-bug34915 ()
+(defun wdired-test-bug34915 ()
   "Test editing when dired-listing-switches includes -F.
 Appended file indicators should not count as part of the file
 name, either before or after editing.  Since
@@ -143,6 +143,7 @@ wdired-get-filename before and after editing."
   (let* ((test-dir (make-temp-file "test-dir-" t))
          (server-socket-dir test-dir)
          (dired-listing-switches "-Fl")
+         (dired-ls-F-marks-symlinks (eq system-type 'darwin))
          (buf (find-file-noselect test-dir)))
     (unwind-protect
         (progn
-- 
cgit v1.2.1


From a3c870d7e2426bd401c2de60fa851176cf631f7c Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen
Date: Tue, 4 Aug 2020 14:48:33 +0200
Subject: Fix svn tests on Macos

* test/lisp/vc/vc-tests.el (vc-test--svn-enabled): Macos machines
may have a dummy svn program that helpfully just outputs "There's
no svn program here", so also test for the svnadmin program
(bug#42536).
---
 test/lisp/vc/vc-tests.el | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

(limited to 'test')

diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el
index 8e5cc95ec94..01d196565dd 100644
--- a/test/lisp/vc/vc-tests.el
+++ b/test/lisp/vc/vc-tests.el
@@ -554,7 +554,8 @@ This checks also `vc-backend' and `vc-responsible-backend'."
 
 (defvar vc-svn-program)
 (defun vc-test--svn-enabled ()
-  (executable-find vc-svn-program))
+  (and (executable-find "svnadmin")
+       (executable-find vc-svn-program)))
 
 (defun vc-test--sccs-enabled ()
   (executable-find "sccs"))
-- 
cgit v1.2.1


From 1432cfd485d33bb518ab6ac5667ae4e4faf7f6b5 Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen
Date: Tue, 4 Aug 2020 15:15:36 +0200
Subject: Fix debugging code checked in from wdired-tests

---
 test/lisp/wdired-tests.el | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'test')

diff --git a/test/lisp/wdired-tests.el b/test/lisp/wdired-tests.el
index fcd8b626404..2cfabd1ee2d 100644
--- a/test/lisp/wdired-tests.el
+++ b/test/lisp/wdired-tests.el
@@ -132,7 +132,7 @@ wdired-mode."
 (declare-function dired-smart-shell-command "dired-x"
                   (command &optional output-buffer error-buffer))
 
-(defun wdired-test-bug34915 ()
+(ert-deftest wdired-test-bug34915 ()
   "Test editing when dired-listing-switches includes -F.
 Appended file indicators should not count as part of the file
 name, either before or after editing.  Since
-- 
cgit v1.2.1


From 99e9bdcd4105ac70f8f7ee06f2450cdbb15dbf3b Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen
Date: Tue, 4 Aug 2020 17:25:36 +0200
Subject: Make a network-stream test more robust

* test/lisp/net/network-stream-tests.el
(network-test--resolve-system-name): New function.
(echo-server-with-dns): Skip test if (system-name) doesn't look
like it's going to resolve (bug#42535).
---
 test/lisp/net/network-stream-tests.el | 13 +++++++++++++
 1 file changed, 13 insertions(+)

(limited to 'test')

diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el
index 7a982548ae1..f44682e1edb 100644
--- a/test/lisp/net/network-stream-tests.el
+++ b/test/lisp/net/network-stream-tests.el
@@ -136,7 +136,20 @@
      (t
       ))))
 
+(defun network-test--resolve-system-name ()
+  (cl-loop for address in (network-lookup-address-info (system-name))
+           when (or (and (= (length address) 5)
+                         ;; IPv4 localhost addresses start with 127.
+                         (= (elt address 0) 127))
+                    (and (= (length address) 9)
+                         ;; IPv6 localhost addresses start with 0.
+                         (= (elt address 0) 0)))
+           return t))
+
 (ert-deftest echo-server-with-dns ()
+  (unless (network-test--resolve-system-name)
+    (ert-skip "Can't test resolver for (system-name)"))
+
   (let* ((server (make-server (system-name)))
          (port (aref (process-contact server :local) 4))
          (proc (make-network-process :name "foo"
-- 
cgit v1.2.1


From 89dbd0838b980f6ef58fa0f614bd743f86ec1c74 Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen
Date: Tue, 4 Aug 2020 17:34:21 +0200
Subject: Fix previous network stream test

* test/lisp/net/network-stream-tests.el
(network-test--resolve-system-name): There's only one ipv6
localhost address.
---
 test/lisp/net/network-stream-tests.el | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'test')

diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el
index f44682e1edb..cf416155e50 100644
--- a/test/lisp/net/network-stream-tests.el
+++ b/test/lisp/net/network-stream-tests.el
@@ -142,8 +142,8 @@
                          ;; IPv4 localhost addresses start with 127.
                          (= (elt address 0) 127))
                     (and (= (length address) 9)
-                         ;; IPv6 localhost addresses start with 0.
-                         (= (elt address 0) 0)))
+                         ;; IPv6 localhost address.
+                         (equal address [0 0 0 0 0 0 0 1 0])))
            return t))
 
 (ert-deftest echo-server-with-dns ()
-- 
cgit v1.2.1


From b0e828da4f55d0dddcd8f8fc2e21e4b02a12852e Mon Sep 17 00:00:00 2001
From: Stefan Kangas
Date: Fri, 31 Jul 2020 06:09:09 +0200
Subject: Add new cconv-tests (Bug#28557)

These tests are all written by Gemini Lasswell <gazally@runbox.com>.

* test/lisp/emacs-lisp/cconv-tests.el
(top-level): Add two commented out tests which the byte-compiler
can't handle.
(cconv-tests-lambda-:documentation)
(cconv-tests-pcase-lambda-:documentation)
(cconv-tests-defun-:documentation)
(cconv-tests-cl-defun-:documentation)
(cconv-tests-function-:documentation)
(cconv-tests-cl-defgeneric-literal-:documentation)
(cconv-tests-defsubst-:documentation)
(cconv-tests-cl-defsubst-:documentation): New tests.
(cconv-tests-cl-iter-defun-:documentation)
(cconv-tests-iter-defun-:documentation)
(cconv-tests-iter-lambda-:documentation)
(cconv-tests-cl-function-:documentation)
(cconv-tests-cl-defgeneric-:documentation): New failing tests.
---
 test/lisp/emacs-lisp/cconv-tests.el | 158 ++++++++++++++++++++++++++++++++++++
 1 file changed, 158 insertions(+)

(limited to 'test')

diff --git a/test/lisp/emacs-lisp/cconv-tests.el b/test/lisp/emacs-lisp/cconv-tests.el
index c8d46541ad4..148bcd69be1 100644
--- a/test/lisp/emacs-lisp/cconv-tests.el
+++ b/test/lisp/emacs-lisp/cconv-tests.el
@@ -20,6 +20,164 @@
 ;;; Commentary:
 
 (require 'ert)
+(require 'cl-lib)
+
+(ert-deftest cconv-tests-lambda-:documentation ()
+  "Docstring for lambda can be specified with :documentation."
+  (let ((fun (lambda ()
+               (:documentation (concat "lambda" " documentation"))
+               'lambda-result)))
+    (should (string= (documentation fun) "lambda documentation"))
+    (should (eq (funcall fun) 'lambda-result))))
+
+(ert-deftest cconv-tests-pcase-lambda-:documentation ()
+  "Docstring for pcase-lambda can be specified with :documentation."
+  (let ((fun (pcase-lambda (`(,a ,b))
+               (:documentation (concat "pcase-lambda" " documentation"))
+               (list b a))))
+    (should (string= (documentation fun) "pcase-lambda documentation"))
+    (should (equal '(2 1) (funcall fun '(1 2))))))
+
+(defun cconv-tests-defun ()
+  (:documentation (concat "defun" " documentation"))
+  'defun-result)
+(ert-deftest cconv-tests-defun-:documentation ()
+  "Docstring for defun can be specified with :documentation."
+  (should (string= (documentation 'cconv-tests-defun)
+                   "defun documentation"))
+  (should (eq (cconv-tests-defun) 'defun-result)))
+
+(cl-defun cconv-tests-cl-defun ()
+  (:documentation (concat "cl-defun" " documentation"))
+  'cl-defun-result)
+(ert-deftest cconv-tests-cl-defun-:documentation ()
+  "Docstring for cl-defun can be specified with :documentation."
+  (should (string= (documentation 'cconv-tests-cl-defun)
+                   "cl-defun documentation"))
+  (should (eq (cconv-tests-cl-defun) 'cl-defun-result)))
+
+;; FIXME: The byte-complier croaks on this.  See Bug#28557.
+;; (defmacro cconv-tests-defmacro ()
+;;   (:documentation (concat "defmacro" " documentation"))
+;;   '(quote defmacro-result))
+;; (ert-deftest cconv-tests-defmacro-:documentation ()
+;;   "Docstring for defmacro can be specified with :documentation."
+;;   (should (string= (documentation 'cconv-tests-defmacro)
+;;                    "defmacro documentation"))
+;;   (should (eq (cconv-tests-defmacro) 'defmacro-result)))
+
+;; FIXME: The byte-complier croaks on this.  See Bug#28557.
+;; (cl-defmacro cconv-tests-cl-defmacro ()
+;;   (:documentation (concat "cl-defmacro" " documentation"))
+;;   '(quote cl-defmacro-result))
+;; (ert-deftest cconv-tests-cl-defmacro-:documentation ()
+;;   "Docstring for cl-defmacro can be specified with :documentation."
+;;   (should (string= (documentation 'cconv-tests-cl-defmacro)
+;;                    "cl-defmacro documentation"))
+;;   (should (eq (cconv-tests-cl-defmacro) 'cl-defmacro-result)))
+
+(cl-iter-defun cconv-tests-cl-iter-defun ()
+  (:documentation (concat "cl-iter-defun" " documentation"))
+  (iter-yield 'cl-iter-defun-result))
+(ert-deftest cconv-tests-cl-iter-defun-:documentation ()
+  "Docstring for cl-iter-defun can be specified with :documentation."
+  ;; FIXME: See Bug#28557.
+  :expected-result :failed
+  (should (string= (documentation 'cconv-tests-cl-iter-defun)
+                   "cl-iter-defun documentation"))
+  (should (eq (iter-next (cconv-tests-cl-iter-defun))
+              'cl-iter-defun-result)))
+
+(iter-defun cconv-tests-iter-defun ()
+  (:documentation (concat "iter-defun" " documentation"))
+  (iter-yield 'iter-defun-result))
+(ert-deftest cconv-tests-iter-defun-:documentation ()
+  "Docstring for iter-defun can be specified with :documentation."
+  ;; FIXME: See Bug#28557.
+  :expected-result :failed
+  (should (string= (documentation 'cconv-tests-iter-defun)
+                   "iter-defun documentation"))
+  (should (eq (iter-next (cconv-tests-iter-defun)) 'iter-defun-result)))
+
+(ert-deftest cconv-tests-iter-lambda-:documentation ()
+  "Docstring for iter-lambda can be specified with :documentation."
+  ;; FIXME: See Bug#28557.
+  :expected-result :failed
+  (let ((iter-fun
+         (iter-lambda ()
+           (:documentation (concat "iter-lambda" " documentation"))
+           (iter-yield 'iter-lambda-result))))
+    (should (string= (documentation iter-fun) "iter-lambda documentation"))
+    (should (eq (iter-next (funcall iter-fun)) 'iter-lambda-result))))
+
+(ert-deftest cconv-tests-cl-function-:documentation ()
+  "Docstring for cl-function can be specified with :documentation."
+  ;; FIXME: See Bug#28557.
+  :expected-result :failed
+  (let ((fun (cl-function (lambda (&key arg)
+                            (:documentation (concat "cl-function"
+                                                    " documentation"))
+                            (list arg 'cl-function-result)))))
+    (should (string= (documentation fun) "cl-function documentation"))
+    (should (equal (funcall fun :arg t) '(t cl-function-result)))))
+
+(ert-deftest cconv-tests-function-:documentation ()
+  "Docstring for lambda inside function can be specified with :documentation."
+  (let ((fun #'(lambda (arg)
+                 (:documentation (concat "function" " documentation"))
+                 (list arg 'function-result))))
+    (should (string= (documentation fun) "function documentation"))
+    (should (equal (funcall fun t) '(t function-result)))))
+
+(fmakunbound 'cconv-tests-cl-defgeneric)
+(setplist 'cconv-tests-cl-defgeneric nil)
+(cl-defgeneric cconv-tests-cl-defgeneric (n)
+  (:documentation (concat "cl-defgeneric" " documentation")))
+(cl-defmethod cconv-tests-cl-defgeneric ((n integer))
+  (:documentation (concat "cl-defmethod" " documentation"))
+  (+ 1 n))
+(ert-deftest cconv-tests-cl-defgeneric-:documentation ()
+  "Docstring for cl-defgeneric can be specified with :documentation."
+  ;; FIXME: See Bug#28557.
+  :expected-result :failed
+  (let ((descr (describe-function 'cconv-tests-cl-defgeneric)))
+    (set-text-properties 0 (length descr) nil descr)
+    (should (string-match-p "cl-defgeneric documentation" descr))
+    (should (string-match-p "cl-defmethod documentation" descr)))
+  (should (= 11 (cconv-tests-cl-defgeneric 10))))
+
+(fmakunbound 'cconv-tests-cl-defgeneric-literal)
+(setplist 'cconv-tests-cl-defgeneric-literal nil)
+(cl-defgeneric cconv-tests-cl-defgeneric-literal (n)
+  (:documentation "cl-defgeneric-literal documentation"))
+(cl-defmethod cconv-tests-cl-defgeneric-literal ((n integer))
+  (:documentation "cl-defmethod-literal documentation")
+  (+ 1 n))
+(ert-deftest cconv-tests-cl-defgeneric-literal-:documentation ()
+  "Docstring for cl-defgeneric can be specified with :documentation."
+  (let ((descr (describe-function 'cconv-tests-cl-defgeneric-literal)))
+    (set-text-properties 0 (length descr) nil descr)
+    (should (string-match-p "cl-defgeneric-literal documentation" descr))
+    (should (string-match-p "cl-defmethod-literal documentation" descr)))
+  (should (= 11 (cconv-tests-cl-defgeneric-literal 10))))
+
+(defsubst cconv-tests-defsubst ()
+  (:documentation (concat "defsubst" " documentation"))
+  'defsubst-result)
+(ert-deftest cconv-tests-defsubst-:documentation ()
+  "Docstring for defsubst can be specified with :documentation."
+  (should (string= (documentation 'cconv-tests-defsubst)
+                   "defsubst documentation"))
+  (should (eq (cconv-tests-defsubst) 'defsubst-result)))
+
+(cl-defsubst cconv-tests-cl-defsubst ()
+  (:documentation (concat "cl-defsubst" " documentation"))
+  'cl-defsubst-result)
+(ert-deftest cconv-tests-cl-defsubst-:documentation ()
+  "Docstring for cl-defsubst can be specified with :documentation."
+  (should (string= (documentation 'cconv-tests-cl-defsubst)
+                   "cl-defsubst documentation"))
+  (should (eq (cconv-tests-cl-defsubst) 'cl-defsubst-result)))
 
 (ert-deftest cconv-convert-lambda-lifted ()
   "Bug#30872."
-- 
cgit v1.2.1


From fbfa70f486522e1b752ebf3d8590375508ea2a55 Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen
Date: Tue, 4 Aug 2020 18:53:47 +0200
Subject: Add test file lost when merged from Gnus in 2016

---
 test/lisp/gnus/gnus-util-tests.el | 76 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 76 insertions(+)
 create mode 100644 test/lisp/gnus/gnus-util-tests.el

(limited to 'test')

diff --git a/test/lisp/gnus/gnus-util-tests.el b/test/lisp/gnus/gnus-util-tests.el
new file mode 100644
index 00000000000..b01e2fc2966
--- /dev/null
+++ b/test/lisp/gnus/gnus-util-tests.el
@@ -0,0 +1,76 @@
+;;; gnus-util-tests.el --- Selectived tests only.
+;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+
+;; Author: Jens Lechtenbörger <jens.lechtenboerger@fsfe.org>
+
+;; This file is not 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, 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'gnus-util)
+
+(ert-deftest gnus-subsetp ()
+  ;; False for non-lists.
+  (should-not (gnus-subsetp "1" "1"))
+  (should-not (gnus-subsetp "1" '("1")))
+  (should-not (gnus-subsetp '("1") "1"))
+
+  ;; Real tests.
+  (should (gnus-subsetp '() '()))
+  (should (gnus-subsetp '() '("1")))
+  (should (gnus-subsetp '("1") '("1")))
+  (should (gnus-subsetp '(42) '("1" 42)))
+  (should (gnus-subsetp '(42) '(42 "1")))
+  (should (gnus-subsetp '(42) '("1" 42 2)))
+  (should-not (gnus-subsetp '("1") '()))
+  (should-not (gnus-subsetp '("1") '(2)))
+  (should-not (gnus-subsetp '("1" 2) '(2)))
+  (should-not (gnus-subsetp '(2 "1") '(2)))
+  (should-not (gnus-subsetp '("1" 2) '(2 3)))
+
+  ;; Duplicates don't matter for sets.
+  (should (gnus-subsetp '("1" "1") '("1")))
+  (should (gnus-subsetp '("1" 2 "1") '(2 "1")))
+  (should (gnus-subsetp '("1" 2 "1") '(2 "1" "1" 2)))
+  (should-not (gnus-subsetp '("1" 2 "1" 3) '(2 "1" "1" 2))))
+
+(ert-deftest gnus-setdiff ()
+  ;; False for non-lists.
+  (should-not (gnus-setdiff "1" "1"))
+  (should-not (gnus-setdiff "1" '()))
+  (should-not (gnus-setdiff '() "1"))
+
+  ;; Real tests.
+  (should-not (gnus-setdiff '() '()))
+  (should-not (gnus-setdiff '() '("1")))
+  (should-not (gnus-setdiff '("1") '("1")))
+  (should (equal '("1") (gnus-setdiff '("1") '())))
+  (should (equal '("1") (gnus-setdiff '("1") '(2))))
+  (should (equal '("1") (gnus-setdiff '("1" 2) '(2))))
+  (should (equal '("1") (gnus-setdiff '("1" 2 3) '(3 2))))
+  (should (equal '("1") (gnus-setdiff '(2 "1" 3) '(3 2))))
+  (should (equal '("1") (gnus-setdiff '(2 3 "1") '(3 2))))
+  (should (equal '(2 "1") (gnus-setdiff '(2 3 "1") '(3))))
+
+  ;; Duplicates aren't touched for sets if they are not removed.
+  (should-not (gnus-setdiff '("1" "1") '("1")))
+  (should (equal '("1") (gnus-setdiff '(2 "1" 2) '(2))))
+  (should (equal '("1" "1") (gnus-setdiff '(2 "1" 2 "1") '(2)))))
+
+;;; gnustest-gnus-util.el ends here
-- 
cgit v1.2.1


From 0c6d2f0ff51eb24938f4af4116855b5facee9d24 Mon Sep 17 00:00:00 2001
From: Jens Lechtenbörger
Date: Tue, 4 Aug 2020 19:28:41 +0200
Subject: Add tests for mml-sec.el

---
 test/data/mml-sec/.gpg-v21-migrated                |   0
 test/data/mml-sec/gpg-agent.conf                   |   5 +
 .../02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key   | Bin 0 -> 797 bytes
 .../171B444DE92BEF997229000D9784118A94EEC1C9.key   | Bin 0 -> 526 bytes
 .../19FFEBC04DF3E037E16F6A4474DCB7984406975D.key   | Bin 0 -> 841 bytes
 .../1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key   | Bin 0 -> 797 bytes
 .../293109315BE584AB2EFEFCFCAD64666221D8B36C.key   | Bin 0 -> 526 bytes
 .../335689599E1C0F66D73ADCF51E03EE36C97D121F.key   | Bin 0 -> 797 bytes
 .../40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key   | Bin 0 -> 797 bytes
 .../515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key   | Bin 0 -> 798 bytes
 .../5A11B1935C46D0B227A73978DCA1293A85604F1D.key   | Bin 0 -> 798 bytes
 .../62643CEBC7AEBE6817577A34399483700D76BD64.key   | Bin 0 -> 526 bytes
 .../680D01F368916A0021C14E3453B27B3C5F900683.key   | Bin 0 -> 710 bytes
 .../6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key   | Bin 0 -> 798 bytes
 .../78C17E134E86E691297F7B719B2F2CDF41976234.key   | Bin 0 -> 527 bytes
 .../7F714F4D9D9676638214991E96D45704E4FFC409.key   | Bin 0 -> 798 bytes
 .../854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key   | Bin 0 -> 526 bytes
 .../93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key   | Bin 0 -> 709 bytes
 .../A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key   | Bin 0 -> 797 bytes
 .../A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key   | Bin 0 -> 710 bytes
 .../AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key   | Bin 0 -> 841 bytes
 .../C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key   | Bin 0 -> 841 bytes
 .../C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key   | Bin 0 -> 527 bytes
 .../C67DAD345455EAD6D51368008FC3A53B8D195B5A.key   | Bin 0 -> 710 bytes
 .../CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key   | Bin 0 -> 797 bytes
 .../CC68630A06B048F5A91136C162C7A3273E20DE6F.key   | Bin 0 -> 710 bytes
 .../E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key   | Bin 0 -> 797 bytes
 .../F0117468BE801ED4B81972E159A98FDD4814DCEC.key   | Bin 0 -> 797 bytes
 .../F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key   | Bin 0 -> 841 bytes
 test/data/mml-sec/pubring.gpg                      | Bin 0 -> 13883 bytes
 test/data/mml-sec/pubring.kbx                      | Bin 0 -> 3076 bytes
 test/data/mml-sec/random_seed                      | Bin 0 -> 600 bytes
 test/data/mml-sec/secring.gpg                      | Bin 0 -> 17362 bytes
 test/data/mml-sec/trustdb.gpg                      | Bin 0 -> 1880 bytes
 test/data/mml-sec/trustlist.txt                    |  26 +
 test/lisp/gnus/mml-sec-tests.el                    | 859 +++++++++++++++++++++
 36 files changed, 890 insertions(+)
 create mode 100644 test/data/mml-sec/.gpg-v21-migrated
 create mode 100644 test/data/mml-sec/gpg-agent.conf
 create mode 100644 test/data/mml-sec/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key
 create mode 100644 test/data/mml-sec/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key
 create mode 100644 test/data/mml-sec/pubring.gpg
 create mode 100644 test/data/mml-sec/pubring.kbx
 create mode 100644 test/data/mml-sec/random_seed
 create mode 100644 test/data/mml-sec/secring.gpg
 create mode 100644 test/data/mml-sec/trustdb.gpg
 create mode 100644 test/data/mml-sec/trustlist.txt
 create mode 100644 test/lisp/gnus/mml-sec-tests.el

(limited to 'test')

diff --git a/test/data/mml-sec/.gpg-v21-migrated b/test/data/mml-sec/.gpg-v21-migrated
new file mode 100644
index 00000000000..e69de29bb2d
diff --git a/test/data/mml-sec/gpg-agent.conf b/test/data/mml-sec/gpg-agent.conf
new file mode 100644
index 00000000000..20192990caf
--- /dev/null
+++ b/test/data/mml-sec/gpg-agent.conf
@@ -0,0 +1,5 @@
+# pinentry-program /usr/bin/pinentry-gtk-2
+
+# verbose
+# log-file /tmp/gpg-agent.log
+# debug-all
diff --git a/test/data/mml-sec/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key b/test/data/mml-sec/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key
new file mode 100644
index 00000000000..58fd0b5edbc
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key b/test/data/mml-sec/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key
new file mode 100644
index 00000000000..62f4ab25a69
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key b/test/data/mml-sec/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key
new file mode 100644
index 00000000000..2a8ce135fb2
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key b/test/data/mml-sec/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key
new file mode 100644
index 00000000000..9f8de71c5e2
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key b/test/data/mml-sec/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key
new file mode 100644
index 00000000000..6e4a4e548fd
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key b/test/data/mml-sec/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key
new file mode 100644
index 00000000000..cff58edaa89
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key b/test/data/mml-sec/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key
new file mode 100644
index 00000000000..14af8662f79
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key b/test/data/mml-sec/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key
new file mode 100644
index 00000000000..207a7237d3a
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key b/test/data/mml-sec/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key
new file mode 100644
index 00000000000..85ca78da04d
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key b/test/data/mml-sec/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key
new file mode 100644
index 00000000000..79f3cd2b841
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key b/test/data/mml-sec/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key
new file mode 100644
index 00000000000..776ddf7e9e2
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key b/test/data/mml-sec/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key
new file mode 100644
index 00000000000..2b464f0ccbe
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key b/test/data/mml-sec/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key
new file mode 100644
index 00000000000..28a07668b21
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key b/test/data/mml-sec/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key
new file mode 100644
index 00000000000..137659693bd
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key b/test/data/mml-sec/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key
new file mode 100644
index 00000000000..c99824ccd43
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key b/test/data/mml-sec/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key
new file mode 100644
index 00000000000..49c2dc58bd8
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key b/test/data/mml-sec/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key
new file mode 100644
index 00000000000..ca128408952
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key b/test/data/mml-sec/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key
new file mode 100644
index 00000000000..3f14b40927a
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key b/test/data/mml-sec/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key
new file mode 100644
index 00000000000..06adc06c427
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key b/test/data/mml-sec/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key
new file mode 100644
index 00000000000..cf9a60d233b
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key b/test/data/mml-sec/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key
new file mode 100644
index 00000000000..0ed35172fe0
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key b/test/data/mml-sec/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key
new file mode 100644
index 00000000000..090059d9e81
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key b/test/data/mml-sec/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key
new file mode 100644
index 00000000000..9061f675121
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key b/test/data/mml-sec/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key
new file mode 100644
index 00000000000..89f6013100d
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key b/test/data/mml-sec/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key
new file mode 100644
index 00000000000..41dac37574e
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key b/test/data/mml-sec/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key
new file mode 100644
index 00000000000..5df7b4a5953
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key differ
diff --git a/test/data/mml-sec/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key b/test/data/mml-sec/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key
new file mode 100644
index 00000000000..03daf80975b
Binary files /dev/null and b/test/data/mml-sec/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key differ
diff --git a/test/data/mml-sec/pubring.gpg b/test/data/mml-sec/pubring.gpg
new file mode 100644
index 00000000000..6bd169963df
Binary files /dev/null and b/test/data/mml-sec/pubring.gpg differ
diff --git a/test/data/mml-sec/pubring.kbx b/test/data/mml-sec/pubring.kbx
new file mode 100644
index 00000000000..399a0414fd2
Binary files /dev/null and b/test/data/mml-sec/pubring.kbx differ
diff --git a/test/data/mml-sec/random_seed b/test/data/mml-sec/random_seed
new file mode 100644
index 00000000000..530fd76c1e5
Binary files /dev/null and b/test/data/mml-sec/random_seed differ
diff --git a/test/data/mml-sec/secring.gpg b/test/data/mml-sec/secring.gpg
new file mode 100644
index 00000000000..b323c072c04
Binary files /dev/null and b/test/data/mml-sec/secring.gpg differ
diff --git a/test/data/mml-sec/trustdb.gpg b/test/data/mml-sec/trustdb.gpg
new file mode 100644
index 00000000000..09ebd8db114
Binary files /dev/null and b/test/data/mml-sec/trustdb.gpg differ
diff --git a/test/data/mml-sec/trustlist.txt b/test/data/mml-sec/trustlist.txt
new file mode 100644
index 00000000000..f886572d283
--- /dev/null
+++ b/test/data/mml-sec/trustlist.txt
@@ -0,0 +1,26 @@
+# This is the list of trusted keys.  Comment lines, like this one, as
+# well as empty lines are ignored.  Lines have a length limit but this
+# is not a serious limitation as the format of the entries is fixed and
+# checked by gpg-agent.  A non-comment line starts with optional white
+# space, followed by the SHA-1 fingerpint in hex, followed by a flag
+# which may be one of 'P', 'S' or '*' and optionally followed by a list of
+# other flags.  The fingerprint may be prefixed with a '!' to mark the
+# key as not trusted.  You should give the gpg-agent a HUP or run the
+# command "gpgconf --reload gpg-agent" after changing this file.
+
+
+# Include the default trust list
+include-default
+
+
+# CN=No Expiry
+D0:6A:A1:18:65:3C:C3:8E:9D:0C:AF:56:ED:7A:21:35:E1:58:21:77 S relax
+
+# CN=Second Key Pair
+0E:58:22:9B:80:EE:33:95:9F:F7:18:FE:EF:25:40:2B:47:9D:C6:E2 S relax
+
+# CN=No Expiry two UIDs
+D4:CA:78:E1:47:0B:9F:C2:AE:45:D7:84:64:9B:8C:E6:4E:BB:32:0C S relax
+
+# CN=Different subkeys
+4F:96:2A:B7:F4:76:61:6A:78:3D:72:AA:40:35:D5:9B:5F:88:E9:FC S relax
diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el
new file mode 100644
index 00000000000..28be3b9bd46
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-tests.el
@@ -0,0 +1,859 @@
+;;; gnustest-mml-sec.el --- Tests mml-sec.el, see README-mml-secure.txt.
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Jens Lechtenbörger <jens.lechtenboerger@fsfe.org>
+
+;; This file is not 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, 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+
+(require 'message)
+(require 'epa)
+(require 'epg)
+(require 'mml-sec)
+(require 'gnus-sum)
+
+(defvar with-smime nil
+  "If nil, exclude S/MIME from tests as passphrases need to entered manually.
+Mostly, the empty passphrase is used.  However, the keys for
+ \"No Expiry two UIDs\" have the passphrase \"Passphrase\" (for OpenPGP as well
+ as S/MIME).")
+
+(defun enc-standards ()
+  (if with-smime '(enc-pgp enc-pgp-mime enc-smime)
+    '(enc-pgp enc-pgp-mime)))
+(defun enc-sign-standards ()
+  (if with-smime
+      '(enc-sign-pgp enc-sign-pgp-mime enc-sign-smime)
+    '(enc-sign-pgp enc-sign-pgp-mime)))
+(defun sign-standards ()
+  (if with-smime
+      '(sign-pgp sign-pgp-mime sign-smime)
+    '(sign-pgp sign-pgp-mime)))
+
+(defun mml-secure-test-fixture (body &optional interactive)
+  "Setup GnuPG home containing test keys and prepare environment for BODY.
+If optional INTERACTIVE is non-nil, allow questions to the user in case of
+key problems.
+This fixture temporarily unsets GPG_AGENT_INFO to enable passphrase tests,
+which will neither work with gpgsm nor GnuPG 2.1 any longer, I guess.
+Actually, I'm not sure why people would want to cache passwords in Emacs
+instead of gpg-agent."
+  (unwind-protect
+      (let ((agent-info (getenv "GPG_AGENT_INFO"))
+	    (gpghome (getenv "GNUPGHOME")))
+	(condition-case error
+	    (let ((epg-gpg-home-directory
+                   (expand-file-name "test/data/mml-sec" source-directory))
+                  (mml-secure-allow-signing-with-unknown-recipient t)
+		  (mml-smime-use 'epg)
+		  ;; Create debug output in empty epg-debug-buffer.
+		  (epg-debug t)
+		  (epg-debug-buffer (get-buffer-create " *epg-test*"))
+		  (mml-secure-fail-when-key-problem (not interactive)))
+	      (with-current-buffer epg-debug-buffer
+		(erase-buffer))
+	      ;; Unset GPG_AGENT_INFO to enable passphrase caching inside Emacs.
+	      ;; Just for testing.  Jens does not recommend this for daily use.
+	      (setenv "GPG_AGENT_INFO")
+	      ;; Set GNUPGHOME as gpg-agent started by gpgsm does
+	      ;; not look in the proper places otherwise, see:
+	      ;; https://bugs.gnupg.org/gnupg/issue2126
+	      (setenv "GNUPGHOME" epg-gpg-home-directory)
+	      (funcall body))
+	  (error
+	   (setenv "GPG_AGENT_INFO" agent-info)
+	   (setenv "GNUPGHOME" gpghome)
+	   (signal (car error) (cdr error))))
+	(setenv "GPG_AGENT_INFO" agent-info)
+	(setenv "GNUPGHOME" gpghome))))
+
+(defun mml-secure-test-message-setup (method to from &optional text bcc)
+  "Setup a buffer with MML METHOD, TO, and FROM headers.
+Optionally, a message TEXT and BCC header can be passed."
+  (with-temp-buffer
+    (when bcc (insert (format "Bcc: %s\n" bcc)))
+    (insert (format "To: %s
+From: %s
+Subject: Test
+%s\n" to from mail-header-separator))
+    (if text
+	(insert (format "%s" text))
+      (spook))
+    (cond ((eq method 'enc-pgp-mime)
+	   (mml-secure-message-encrypt-pgpmime 'nosig))
+	  ((eq method 'enc-sign-pgp-mime)
+	   (mml-secure-message-encrypt-pgpmime))
+	  ((eq method 'enc-pgp) (mml-secure-message-encrypt-pgp 'nosig))
+	  ((eq method 'enc-sign-pgp) (mml-secure-message-encrypt-pgp))
+	  ((eq method 'enc-smime) (mml-secure-message-encrypt-smime 'nosig))
+	  ((eq method 'enc-sign-smime) (mml-secure-message-encrypt-smime))
+	  ((eq method 'sign-pgp-mime) (mml-secure-message-sign-pgpmime))
+	  ((eq method 'sign-pgp) (mml-secure-message-sign-pgp))
+	  ((eq method 'sign-smime) (mml-secure-message-sign-smime))
+	  (t (error "Unknown method")))
+    (buffer-string)))
+
+(defun mml-secure-test-mail-fixture (method to from body2
+					    &optional interactive)
+  "Setup buffer encrypted using METHOD for TO from FROM, call BODY2.
+Pass optional INTERACTIVE to mml-secure-test-fixture."
+  (mml-secure-test-fixture
+   (lambda ()
+     (let ((context (if (memq method '(enc-smime enc-sign-smime sign-smime))
+			(epg-make-context 'CMS)
+		      (epg-make-context 'OpenPGP)))
+	   ;; Verify and decrypt by default.
+	   (mm-verify-option 'known)
+	   (mm-decrypt-option 'known)
+	   (plaintext "The Magic Words are Squeamish Ossifrage"))
+       (with-temp-buffer
+	 (insert (mml-secure-test-message-setup method to from plaintext))
+	 (message-options-set-recipient)
+	 (message-encode-message-body)
+	 ;; Replace separator line with newline.
+	 (goto-char (point-min))
+	 (re-search-forward
+	  (concat "^" (regexp-quote mail-header-separator) "\n"))
+	 (replace-match "\n")
+	 ;; The following treatment of handles, plainbuf, and multipart
+	 ;; resulted from trial-and-error.
+	 ;; Someone with more knowledge on how to decrypt messages and verify
+	 ;; signatures might know more appropriate functions to invoke
+	 ;; instead.
+	 (let* ((handles (or (mm-dissect-buffer)
+			     (mm-uu-dissect)))
+		(isplain (bufferp (car handles)))
+		(ismultipart (equal (car handles) "multipart/mixed"))
+		(plainbuf (if isplain
+			      (car handles)
+			    (if ismultipart
+				(car (cadadr handles))
+			      (caadr handles))))
+		(decrypted
+		 (with-current-buffer plainbuf (buffer-string)))
+		(gnus-info
+		 (if isplain
+		     nil
+		   (if ismultipart
+		       (or (mm-handle-multipart-ctl-parameter
+			    (cadr handles) 'gnus-details)
+			   (mm-handle-multipart-ctl-parameter
+			    (cadr handles) 'gnus-info))
+		     (mm-handle-multipart-ctl-parameter
+		      handles 'gnus-info)))))
+	   (funcall body2 gnus-info plaintext decrypted)))))
+   interactive))
+
+;; TODO If the variable BODY3 is renamed to BODY, an infinite recursion
+;; occurs.  Emacs bug?
+(defun mml-secure-test-key-fixture (body3)
+  "Customize unique keys for sub@example.org and call BODY3.
+For OpenPGP, we have:
+- 1E6B FA97 3D9E 3103 B77F  D399 C399 9CF1 268D BEA2
+  uid                  Different subkeys <sub@example.org>
+- 1463 2ECA B9E2 2736 9C8D  D97B F7E7 9AB7 AE31 D471
+  uid                  Second Key Pair <sub@example.org>
+
+For S/MIME:
+          ID: 0x479DC6E2
+      Subject: /CN=Second Key Pair
+          aka: sub@example.org
+  fingerprint: 0E:58:22:9B:80:EE:33:95:9F:F7:18:FE:EF:25:40:2B:47:9D:C6:E2
+
+           ID: 0x5F88E9FC
+      Subject: /CN=Different subkeys
+          aka: sub@example.org
+  fingerprint: 4F:96:2A:B7:F4:76:61:6A:78:3D:72:AA:40:35:D5:9B:5F:88:E9:FC
+
+In both cases, the first key is customized for signing and encryption."
+  (mml-secure-test-fixture
+   (lambda ()
+     (let* ((mml-secure-key-preferences
+	     '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt))))
+	    (pcontext (epg-make-context 'OpenPGP))
+	    (pkey (epg-list-keys pcontext "C3999CF1268DBEA2"))
+	    (scontext (epg-make-context 'CMS))
+	    (skey (epg-list-keys scontext "0x479DC6E2")))
+       (mml-secure-cust-record-keys pcontext 'encrypt "sub@example.org" pkey)
+       (mml-secure-cust-record-keys pcontext 'sign "sub@example.org" pkey)
+       (mml-secure-cust-record-keys scontext 'encrypt "sub@example.org" skey)
+       (mml-secure-cust-record-keys scontext 'sign "sub@example.org" skey)
+       (funcall body3)))))
+
+(ert-deftest mml-secure-key-checks ()
+  "Test mml-secure-check-user-id and mml-secure-check-sub-key on sample keys."
+  (mml-secure-test-fixture
+   (lambda ()
+     (let* ((context (epg-make-context 'OpenPGP))
+	    (keys1 (epg-list-keys context "expired@example.org"))
+	    (keys2 (epg-list-keys context "no-exp@example.org"))
+	    (keys3 (epg-list-keys context "sub@example.org"))
+	    (keys4 (epg-list-keys context "revoked-uid@example.org"))
+	    (keys5 (epg-list-keys context "disabled@example.org"))
+	    (keys6 (epg-list-keys context "sign@example.org"))
+	    (keys7 (epg-list-keys context "jens.lechtenboerger@fsfe"))
+	    )
+       (should (and (= 1 (length keys1)) (= 1 (length keys2))
+		    (= 2 (length keys3))
+		    (= 1 (length keys4)) (= 1 (length keys5))
+		    ))
+       ;; key1 is expired
+       (should-not (mml-secure-check-user-id (car keys1) "expired@example.org"))
+       (should-not (mml-secure-check-sub-key context (car keys1) 'encrypt))
+       (should-not (mml-secure-check-sub-key context (car keys1) 'sign))
+
+       ;; key2 does not expire, but does not have the UID expired@example.org
+       (should-not (mml-secure-check-user-id (car keys2) "expired@example.org"))
+       (should (mml-secure-check-user-id (car keys2) "no-exp@example.org"))
+       (should (mml-secure-check-sub-key context (car keys2) 'encrypt))
+       (should (mml-secure-check-sub-key context (car keys2) 'sign))
+
+       ;; Two keys exist for sub@example.org.
+       (should (mml-secure-check-user-id (car keys3) "sub@example.org"))
+       (should (mml-secure-check-sub-key context (car keys3) 'encrypt))
+       (should (mml-secure-check-sub-key context (car keys3) 'sign))
+       (should (mml-secure-check-user-id (cadr keys3) "sub@example.org"))
+       (should (mml-secure-check-sub-key context (cadr keys3) 'encrypt))
+       (should (mml-secure-check-sub-key context (cadr keys3) 'sign))
+
+       ;; The UID revoked-uid@example.org is revoked.  The key itself is
+       ;; usable, though (with the UID sub@example.org).
+       (should-not
+	(mml-secure-check-user-id (car keys4) "revoked-uid@example.org"))
+       (should (mml-secure-check-sub-key context (car keys4) 'encrypt))
+       (should (mml-secure-check-sub-key context (car keys4) 'sign))
+       (should (mml-secure-check-user-id (car keys4) "sub@example.org"))
+
+       ;; The next key is disabled and, thus, unusable.
+       (should (mml-secure-check-user-id (car keys5) "disabled@example.org"))
+       (should-not (mml-secure-check-sub-key context (car keys5) 'encrypt))
+       (should-not (mml-secure-check-sub-key context (car keys5) 'sign))
+
+       ;; The next key has multiple subkeys.
+       ;; 42466F0F is valid sign subkey, 501FFD98 is expired
+       (should (mml-secure-check-sub-key context (car keys6) 'sign "42466F0F"))
+       (should-not
+	(mml-secure-check-sub-key context (car keys6) 'sign "501FFD98"))
+       ;; DC7F66E7 is encrypt subkey
+       (should
+	(mml-secure-check-sub-key context (car keys6) 'encrypt "DC7F66E7"))
+       (should-not
+	(mml-secure-check-sub-key context (car keys6) 'sign "DC7F66E7"))
+       (should-not
+	(mml-secure-check-sub-key context (car keys6) 'encrypt "42466F0F"))
+
+       ;; The final key is just a public key.
+       (should (mml-secure-check-sub-key context (car keys7) 'encrypt))
+       (should-not (mml-secure-check-sub-key context (car keys7) 'sign))
+       ))))
+
+(ert-deftest mml-secure-find-usable-keys-1 ()
+  "Make sure that expired and disabled keys and revoked UIDs are not used."
+  (mml-secure-test-fixture
+   (lambda ()
+     (let ((context (epg-make-context 'OpenPGP)))
+       (should-not
+	(mml-secure-find-usable-keys context "expired@example.org" 'encrypt))
+       (should-not
+	(mml-secure-find-usable-keys context "expired@example.org" 'sign))
+
+       (should-not
+	(mml-secure-find-usable-keys context "disabled@example.org" 'encrypt))
+       (should-not
+	(mml-secure-find-usable-keys context "disabled@example.org" 'sign))
+
+       (should-not
+	(mml-secure-find-usable-keys
+	 context "<revoked-uid@example.org>" 'encrypt))
+       (should-not
+	(mml-secure-find-usable-keys
+	 context "<revoked-uid@example.org>" 'sign))
+       ;; Same test without ankles.  Will fail for Ma Gnus v0.14 and earlier.
+       (should-not
+	(mml-secure-find-usable-keys
+	 context "revoked-uid@example.org" 'encrypt))
+
+       ;; Expired key should not be usable.
+       ;; Will fail for Ma Gnus v0.14 and earlier.
+       ;; sign@example.org has the expired subkey 0x501FFD98.
+       (should-not
+	(mml-secure-find-usable-keys context "0x501FFD98" 'sign))
+
+       (should
+	(mml-secure-find-usable-keys context "no-exp@example.org" 'encrypt))
+       (should
+	(mml-secure-find-usable-keys context "no-exp@example.org" 'sign))
+       ))))
+
+(ert-deftest mml-secure-find-usable-keys-2 ()
+  "Test different ways to search for keys."
+  (mml-secure-test-fixture
+   (lambda ()
+     (let ((context (epg-make-context 'OpenPGP)))
+       ;; Plain substring search is not supported.
+       (should
+	(= 0 (length
+	      (mml-secure-find-usable-keys context "No Expiry" 'encrypt))))
+       (should
+	(= 0 (length
+	      (mml-secure-find-usable-keys context "No Expiry" 'sign))))
+
+       ;; Search for e-mail addresses works with and without ankle brackets.
+       (should
+	(= 1 (length (mml-secure-find-usable-keys
+		      context "<no-exp@example.org>" 'encrypt))))
+       (should
+	(= 1 (length (mml-secure-find-usable-keys
+		      context "<no-exp@example.org>" 'sign))))
+       (should
+	(= 1 (length (mml-secure-find-usable-keys
+		      context "no-exp@example.org" 'encrypt))))
+       (should
+	(= 1 (length (mml-secure-find-usable-keys
+		      context "no-exp@example.org" 'sign))))
+
+       ;; Use full UID string.
+       (should
+	(= 1 (length (mml-secure-find-usable-keys
+		      context "No Expiry <no-exp@example.org>" 'encrypt))))
+       (should
+	(= 1 (length (mml-secure-find-usable-keys
+		      context "No Expiry <no-exp@example.org>" 'sign))))
+
+       ;; If just the public key is present, only encryption is possible.
+       ;; Search works with key IDs, with and without prefix "0x".
+       (should
+	(= 1 (length (mml-secure-find-usable-keys
+		      context "A142FD84" 'encrypt))))
+       (should
+	(= 1 (length (mml-secure-find-usable-keys
+		      context "0xA142FD84" 'encrypt))))
+       (should
+	(= 0 (length (mml-secure-find-usable-keys
+		      context "A142FD84" 'sign))))
+       (should
+	(= 0 (length (mml-secure-find-usable-keys
+		      context "0xA142FD84" 'sign))))
+       ))))
+
+(ert-deftest mml-secure-select-preferred-keys-1 ()
+  "If only one key exists for an e-mail address, it is the preferred one."
+  (mml-secure-test-fixture
+   (lambda ()
+     (let ((context (epg-make-context 'OpenPGP)))
+       (should (equal "832F3CC6518D37BC658261B802372A42CA6D40FB"
+		      (mml-secure-fingerprint
+		       (car (mml-secure-select-preferred-keys
+			     context '("no-exp@example.org") 'encrypt)))))))))
+
+(ert-deftest mml-secure-select-preferred-keys-2 ()
+  "If multiple keys exists for an e-mail address, customization is necessary."
+  (mml-secure-test-fixture
+   (lambda ()
+     (let* ((context (epg-make-context 'OpenPGP))
+	    (mml-secure-key-preferences
+	     '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt))))
+	    (pref (car (mml-secure-find-usable-keys
+			context "sub@example.org" 'encrypt))))
+       (should-error (mml-secure-select-preferred-keys
+		      context '("sub@example.org") 'encrypt))
+       (mml-secure-cust-record-keys
+	context 'encrypt "sub@example.org" (list pref))
+       (should (mml-secure-select-preferred-keys
+		context '("sub@example.org") 'encrypt))
+       (should-error (mml-secure-select-preferred-keys
+		      context '("sub@example.org") 'sign))
+       (should (mml-secure-select-preferred-keys
+                context '("sub@example.org") 'encrypt))
+       (should
+	(equal (list (mml-secure-fingerprint pref))
+	       (mml-secure-cust-fpr-lookup context 'encrypt "sub@example.org")))
+       (should (mml-secure-cust-remove-keys context 'encrypt "sub@example.org"))
+       (should-error (mml-secure-select-preferred-keys
+                      context '("sub@example.org") 'encrypt))))))
+
+(ert-deftest mml-secure-select-preferred-keys-3 ()
+  "Expired customized keys are removed if multiple keys are available."
+  (mml-secure-test-fixture
+   (lambda ()
+     (let ((context (epg-make-context 'OpenPGP))
+	   (mml-secure-key-preferences
+	    '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt)))))
+       ;; sub@example.org has two keys (268DBEA2, AE31D471).
+       ;; Normal preference works.
+       (mml-secure-cust-record-keys
+        context 'encrypt "sub@example.org" (epg-list-keys context "268DBEA2"))
+       (should (mml-secure-select-preferred-keys
+		context '("sub@example.org") 'encrypt))
+       (mml-secure-cust-remove-keys context 'encrypt "sub@example.org")
+
+       ;; Fake preference for expired (unrelated) key CE15FAE7,
+       ;; results in error (and automatic removal of outdated preference).
+       (mml-secure-cust-record-keys
+        context 'encrypt "sub@example.org" (epg-list-keys context "CE15FAE7"))
+       (should-error (mml-secure-select-preferred-keys
+		      context '("sub@example.org") 'encrypt))
+       (should-not
+	(mml-secure-cust-remove-keys context 'encrypt "sub@example.org"))))))
+
+(ert-deftest mml-secure-select-preferred-keys-4 ()
+  "Multiple keys can be recorded per recipient or signature."
+  (mml-secure-test-fixture
+   (lambda ()
+     (let ((pcontext (epg-make-context 'OpenPGP))
+	   (scontext (epg-make-context 'CMS))
+	   (pkeys '("1E6BFA973D9E3103B77FD399C3999CF1268DBEA2"
+		    "14632ECAB9E227369C8DD97BF7E79AB7AE31D471"))
+	   (skeys  '("0x5F88E9FC" "0x479DC6E2"))
+	   (mml-secure-key-preferences
+	    '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt)))))
+
+       ;; OpenPGP preferences via pcontext
+       (dolist (key pkeys nil)
+	 (mml-secure-cust-record-keys
+	  pcontext 'encrypt "sub@example.org" (epg-list-keys pcontext key))
+	 (mml-secure-cust-record-keys
+	  pcontext 'sign "sub@example.org" (epg-list-keys pcontext key 'secret)))
+       (let ((p-e-fprs (mml-secure-cust-fpr-lookup
+			pcontext 'encrypt "sub@example.org"))
+	     (p-s-fprs (mml-secure-cust-fpr-lookup
+			pcontext 'sign "sub@example.org")))
+	 (should (= 2 (length p-e-fprs)))
+	 (should (= 2 (length p-s-fprs)))
+	 (should (member "1E6BFA973D9E3103B77FD399C3999CF1268DBEA2" p-e-fprs))
+	 (should (member "14632ECAB9E227369C8DD97BF7E79AB7AE31D471" p-e-fprs))
+	 (should (member "1E6BFA973D9E3103B77FD399C3999CF1268DBEA2" p-s-fprs))
+	 (should (member "14632ECAB9E227369C8DD97BF7E79AB7AE31D471" p-s-fprs)))
+       ;; Duplicate record does not change anything.
+       (mml-secure-cust-record-keys
+	pcontext 'encrypt "sub@example.org"
+	(epg-list-keys pcontext "1E6BFA973D9E3103B77FD399C3999CF1268DBEA2"))
+       (mml-secure-cust-record-keys
+	pcontext 'sign "sub@example.org"
+	(epg-list-keys pcontext "1E6BFA973D9E3103B77FD399C3999CF1268DBEA2"))
+       (let ((p-e-fprs (mml-secure-cust-fpr-lookup
+			pcontext 'encrypt "sub@example.org"))
+	     (p-s-fprs (mml-secure-cust-fpr-lookup
+			pcontext 'sign "sub@example.org")))
+	 (should (= 2 (length p-e-fprs)))
+	 (should (= 2 (length p-s-fprs))))
+
+       ;; S/MIME preferences via scontext
+       (dolist (key skeys nil)
+	 (mml-secure-cust-record-keys
+	  scontext 'encrypt "sub@example.org"
+	  (epg-list-keys scontext key))
+	 (mml-secure-cust-record-keys
+	  scontext 'sign "sub@example.org"
+	  (epg-list-keys scontext key 'secret)))
+       (let ((s-e-fprs (mml-secure-cust-fpr-lookup
+			scontext 'encrypt "sub@example.org"))
+	     (s-s-fprs (mml-secure-cust-fpr-lookup
+			scontext 'sign "sub@example.org")))
+	 (should (= 2 (length s-e-fprs)))
+	 (should (= 2 (length s-s-fprs))))
+       ))))
+
+(defun mml-secure-test-en-decrypt
+    (method to from
+	    &optional checksig checkplain enc-keys expectfail interactive)
+  "Encrypt message using METHOD, addressed to TO, from FROM.
+If optional CHECKSIG is non-nil, it must be a number, and a signature check is
+performed; the number indicates how many signatures are expected.
+If optional CHECKPLAIN is non-nil, the expected plaintext should be obtained
+via decryption.
+If optional ENC-KEYS is non-nil, it is a list of pairs of encryption keys (for
+OpenPGP and S/SMIME) expected in `epg-debug-buffer'.
+If optional EXPECTFAIL is non-nil, a decryption failure is expected.
+Pass optional INTERACTIVE to mml-secure-test-mail-fixture."
+  (mml-secure-test-mail-fixture method to from
+   (lambda (gnus-info plaintext decrypted)
+     (if expectfail
+	 (should-not (equal plaintext decrypted))
+       (when checkplain
+	 (should (equal plaintext decrypted)))
+       (let ((protocol (if (memq method
+				 '(enc-smime enc-sign-smime sign-smime))
+			   'CMS
+			 'OpenPGP)))
+	 (when checksig
+	   (let* ((context (epg-make-context protocol))
+		  (signer-names (mml-secure-signer-names protocol from))
+		  (signer-keys (mml-secure-signers context signer-names))
+		  (signer-fprs (mapcar 'mml-secure-fingerprint signer-keys)))
+	     (should (eq checksig (length signer-fprs)))
+	     (if (eq checksig 0)
+		 ;; First key in keyring
+		 (should (string-match-p
+			  (concat "Good signature from "
+				  (if (eq protocol 'CMS)
+				      "0E58229B80EE33959FF718FEEF25402B479DC6E2"
+				    "02372A42CA6D40FB"))
+			  gnus-info)))
+	     (dolist (fpr signer-fprs nil)
+	       ;; OpenPGP: "Good signature from 02372A42CA6D40FB No Expiry <no-exp@example.org> (trust undefined) created ..."
+	       ;; S/MIME:  "Good signature from D06AA118653CC38E9D0CAF56ED7A2135E1582177 /CN=No Expiry (trust full) ..."
+	       (should (string-match-p
+			(concat "Good signature from "
+				(if (eq protocol 'CMS)
+				    fpr
+				  (substring fpr -16 nil)))
+			gnus-info)))))
+	 (when enc-keys
+	   (with-current-buffer epg-debug-buffer
+	     (goto-char (point-min))
+	     ;; The following regexp does not necessarily match at the
+	     ;; start of the line as a path may or may not be present.
+	     ;; Also note that gpg.* matches gpg2 and gpgsm as well.
+	     (let* ((line (concat "gpg.*--encrypt.*$"))
+		    (end (re-search-forward line))
+		    (match (match-string 0)))
+	       (should (and end match))
+	       (dolist (pair enc-keys nil)
+		 (let ((fpr (if (eq protocol 'OpenPGP)
+				(car pair)
+			      (cdr pair))))
+		   (should (string-match-p (concat "-r " fpr) match))))
+	       (goto-char (point-max))
+	       ))))))
+   interactive))
+
+(defun mml-secure-test-en-decrypt-with-passphrase
+    (method to from checksig jl-passphrase do-cache
+	    &optional enc-keys expectfail)
+  "Call mml-secure-test-en-decrypt with changed passphrase caching.
+Args METHOD, TO, FROM, CHECKSIG are passed to mml-secure-test-en-decrypt.
+JL-PASSPHRASE is fixed as return value for `read-passwd',
+boolean DO-CACHE determines whether to cache the passphrase.
+If optional ENC-KEYS is non-nil, it is a list of encryption keys expected
+in `epg-debug-buffer'.
+If optional EXPECTFAIL is non-nil, a decryption failure is expected."
+  (let ((mml-secure-cache-passphrase do-cache)
+	(mml1991-cache-passphrase do-cache)
+	(mml2015-cache-passphrase do-cache)
+	(mml-smime-cache-passphrase do-cache)
+	)
+    (cl-letf (((symbol-function 'read-passwd)
+	       (lambda (prompt &optional confirm default) jl-passphrase)))
+      (mml-secure-test-en-decrypt method to from checksig t enc-keys expectfail)
+      )))
+
+(ert-deftest mml-secure-en-decrypt-1 ()
+  "Encrypt message; then decrypt and test for expected result.
+In this test, the single matching key is chosen automatically."
+  (dolist (method (enc-standards) nil)
+    ;; no-exp@example.org with single encryption key
+    (mml-secure-test-en-decrypt
+     method "no-exp@example.org" "sub@example.org" nil t
+     (list (cons "02372A42CA6D40FB" "ED7A2135E1582177")))))
+
+(ert-deftest mml-secure-en-decrypt-2 ()
+  "Encrypt message; then decrypt and test for expected result.
+In this test, the encryption key needs to fixed among multiple ones."
+  ;; sub@example.org with multiple candidate keys,
+  ;; fixture customizes preferred ones.
+  (mml-secure-test-key-fixture
+   (lambda ()
+     (dolist (method (enc-standards) nil)
+       (mml-secure-test-en-decrypt
+	method "sub@example.org" "no-exp@example.org" nil t
+	(list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2")))))))
+
+(ert-deftest mml-secure-en-decrypt-3 ()
+  "Encrypt message; then decrypt and test for expected result.
+In this test, encrypt-to-self variables are set to t."
+  ;; sub@example.org with multiple candidate keys,
+  ;; fixture customizes preferred ones.
+  (mml-secure-test-key-fixture
+   (lambda ()
+     (let ((mml-secure-openpgp-encrypt-to-self t)
+	   (mml-secure-smime-encrypt-to-self t))
+       (dolist (method (enc-standards) nil)
+	 (mml-secure-test-en-decrypt
+	  method "sub@example.org" "no-exp@example.org" nil t
+	  (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2")
+		(cons "02372A42CA6D40FB" "ED7A2135E1582177"))))))))
+
+(ert-deftest mml-secure-en-decrypt-4 ()
+  "Encrypt message; then decrypt and test for expected result.
+In this test, encrypt-to-self variables are set to lists."
+  ;; Send from sub@example.org, which has two keys; encrypt to both.
+  (let ((mml-secure-openpgp-encrypt-to-self
+	 '("C3999CF1268DBEA2" "F7E79AB7AE31D471"))
+	(mml-secure-smime-encrypt-to-self
+	 '("EF25402B479DC6E2" "4035D59B5F88E9FC")))
+    (dolist (method (enc-standards) nil)
+      (mml-secure-test-en-decrypt
+       method "no-exp@example.org" "sub@example.org" nil t
+       (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2")
+	     (cons "F7E79AB7AE31D471" "4035D59B5F88E9FC"))))))
+
+(ert-deftest mml-secure-en-decrypt-sign-1 ()
+  "Sign and encrypt message; then decrypt and test for expected result.
+In this test, just multiple encryption and signing keys may be available."
+  (mml-secure-test-key-fixture
+   (lambda ()
+     (let ((mml-secure-openpgp-sign-with-sender t)
+	   (mml-secure-smime-sign-with-sender t))
+       (dolist (method (enc-sign-standards) nil)
+	 ;; no-exp with just one key
+	 (mml-secure-test-en-decrypt
+	  method "no-exp@example.org" "no-exp@example.org" 1 t)
+	 ;; customized choice for encryption key
+	 (mml-secure-test-en-decrypt
+	  method "sub@example.org" "no-exp@example.org" 1 t)
+	 ;; customized choice for signing key
+	 (mml-secure-test-en-decrypt
+	  method "no-exp@example.org" "sub@example.org" 1 t)
+	 ;; customized choice for both keys
+	 (mml-secure-test-en-decrypt
+	  method "sub@example.org" "sub@example.org" 1 t)
+	 )
+
+       ;; Now use both keys to sign.  The customized one via sign-with-sender,
+       ;; the other one via the following setting.
+       (let ((mml-secure-openpgp-signers '("F7E79AB7AE31D471"))
+	     (mml-secure-smime-signers '("0x5F88E9FC")))
+	 (dolist (method (enc-sign-standards) nil)
+	   (mml-secure-test-en-decrypt
+	    method "no-exp@example.org" "sub@example.org" 2 t)
+	 )))
+
+     ;; Now use both keys for sub@example.org to sign an e-mail from
+     ;; a different address (without associated keys).
+     (let ((mml-secure-openpgp-sign-with-sender nil)
+	   (mml-secure-smime-sign-with-sender nil)
+	   (mml-secure-openpgp-signers
+	    '("F7E79AB7AE31D471" "C3999CF1268DBEA2"))
+	   (mml-secure-smime-signers '("0x5F88E9FC" "0x479DC6E2")))
+       (dolist (method (enc-sign-standards) nil)
+	 (mml-secure-test-en-decrypt
+	  method "no-exp@example.org" "no-keys@example.org" 2 t)
+	 )))))
+
+(ert-deftest mml-secure-en-decrypt-sign-2 ()
+  "Sign and encrypt message; then decrypt and test for expected result.
+In this test, lists of encryption and signing keys are customized."
+  (mml-secure-test-key-fixture
+   (lambda ()
+     (let ((mml-secure-key-preferences
+	    '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt))))
+	   (pcontext (epg-make-context 'OpenPGP))
+	   (scontext (epg-make-context 'CMS))
+	   (mml-secure-openpgp-sign-with-sender t)
+	   (mml-secure-smime-sign-with-sender t))
+       (dolist (key '("F7E79AB7AE31D471" "C3999CF1268DBEA2") nil)
+	 (mml-secure-cust-record-keys
+	  pcontext 'encrypt "sub@example.org" (epg-list-keys pcontext key))
+	 (mml-secure-cust-record-keys
+	  pcontext 'sign "sub@example.org" (epg-list-keys pcontext key t)))
+       (dolist (key '("0x5F88E9FC" "0x479DC6E2") nil)
+	 (mml-secure-cust-record-keys
+	  scontext 'encrypt "sub@example.org" (epg-list-keys scontext key))
+	 (mml-secure-cust-record-keys
+	  scontext 'sign "sub@example.org" (epg-list-keys scontext key t)))
+       (dolist (method (enc-sign-standards) nil)
+	 ;; customized choice for encryption key
+	 (mml-secure-test-en-decrypt
+	  method "sub@example.org" "no-exp@example.org" 1 t)
+	 ;; customized choice for signing key
+	 (mml-secure-test-en-decrypt
+	  method "no-exp@example.org" "sub@example.org" 2 t)
+	 ;; customized choice for both keys
+	 (mml-secure-test-en-decrypt
+	  method "sub@example.org" "sub@example.org" 2 t)
+	 )))))
+
+(ert-deftest mml-secure-en-decrypt-sign-3 ()
+  "Sign and encrypt message; then decrypt and test for expected result.
+Use sign-with-sender and encrypt-to-self."
+  (mml-secure-test-key-fixture
+   (lambda ()
+     (let ((mml-secure-openpgp-sign-with-sender t)
+	   (mml-secure-openpgp-encrypt-to-self t)
+	   (mml-secure-smime-sign-with-sender t)
+	   (mml-secure-smime-encrypt-to-self t))
+       (dolist (method (enc-sign-standards) nil)
+	 (mml-secure-test-en-decrypt
+	  method "sub@example.org" "no-exp@example.org" 1 t
+	  (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2")
+		(cons "02372A42CA6D40FB" "ED7A2135E1582177"))))
+       ))))
+
+(ert-deftest mml-secure-sign-verify-1 ()
+  "Sign message with sender; then verify and test for expected result."
+  (mml-secure-test-key-fixture
+   (lambda ()
+     (dolist (method (sign-standards) nil)
+       (let ((mml-secure-openpgp-sign-with-sender t)
+	     (mml-secure-smime-sign-with-sender t))
+	 ;; A single signing key for sender sub@example.org is customized
+	 ;; in the fixture.
+	 (mml-secure-test-en-decrypt
+	  method "uid1@example.org" "sub@example.org" 1 nil)
+
+	 ;; From sub@example.org, sign with two keys;
+	 ;; sign-with-sender and one from signers-variable:
+	 (let ((mml-secure-openpgp-signers '("02372A42CA6D40FB"))
+	       (mml-secure-smime-signers
+		'("D06AA118653CC38E9D0CAF56ED7A2135E1582177")))
+	   (mml-secure-test-en-decrypt
+	    method "no-exp@example.org" "sub@example.org" 2 nil))
+	 )))))
+
+(ert-deftest mml-secure-sign-verify-2 ()
+  "Sign message without sender; then verify and test for expected result."
+  (mml-secure-test-key-fixture
+   (lambda ()
+     (dolist (method (sign-standards) nil)
+       (let ((mml-secure-openpgp-sign-with-sender nil)
+	     (mml-secure-smime-sign-with-sender nil))
+	 ;; A single signing key for sender sub@example.org is customized
+	 ;; in the fixture, but not used here.
+	 ;; By default, gpg uses the first secret key in the keyring, which
+	 ;; is 02372A42CA6D40FB (OpenPGP) or
+	 ;; 0E58229B80EE33959FF718FEEF25402B479DC6E2 (S/MIME) here.
+	 (mml-secure-test-en-decrypt
+	  method "uid1@example.org" "sub@example.org" 0 nil)
+
+	 ;; From sub@example.org, sign with specified key:
+	 (let ((mml-secure-openpgp-signers '("02372A42CA6D40FB"))
+	       (mml-secure-smime-signers
+		'("D06AA118653CC38E9D0CAF56ED7A2135E1582177")))
+	   (mml-secure-test-en-decrypt
+	    method "no-exp@example.org" "sub@example.org" 1 nil))
+
+	 ;; From sub@example.org, sign with different specified key:
+	 (let ((mml-secure-openpgp-signers '("C3999CF1268DBEA2"))
+	       (mml-secure-smime-signers
+		'("0E58229B80EE33959FF718FEEF25402B479DC6E2")))
+	   (mml-secure-test-en-decrypt
+	    method "no-exp@example.org" "sub@example.org" 1 nil))
+	 )))))
+
+(ert-deftest mml-secure-sign-verify-3 ()
+  "Try to sign message with expired OpenPGP subkey, which raises an error.
+With Ma Gnus v0.14 and earlier a signature would be created with a wrong key."
+  (should-error
+   (mml-secure-test-key-fixture
+    (lambda ()
+      (let ((with-smime nil)
+	    (mml-secure-openpgp-sign-with-sender nil)
+	    (mml-secure-openpgp-signers '("501FFD98")))
+	(dolist (method (sign-standards) nil)
+	  (mml-secure-test-en-decrypt
+	   method "no-exp@example.org" "sign@example.org" 1 nil)
+	  ))))))
+
+;; TODO Passphrase passing and caching in Emacs does not seem to work
+;; with gpgsm at all.
+;; Independently of caching settings, a pinentry dialogue is displayed.
+;; Thus, the following tests require the user to enter the correct gpgsm
+;; passphrases at the correct points in time.  (Either empty string or
+;; "Passphrase".)
+(ert-deftest mml-secure-en-decrypt-passphrase-cache ()
+  "Encrypt message; then decrypt and test for expected result.
+In this test, a key is used that requires the passphrase \"Passphrase\".
+In the first decryption this passphrase is hardcoded, in the second one it
+ is taken from a cache."
+  (ert-skip "Requires passphrase")
+  (mml-secure-test-key-fixture
+   (lambda ()
+     (dolist (method (enc-standards) nil)
+       (mml-secure-test-en-decrypt-with-passphrase
+	method "uid1@example.org" "sub@example.org" nil
+	;; Beware!  For passphrases copy-sequence is necessary, as they may
+	;; be erased, which actually changes the function's code and causes
+	;; multiple invokations to fail.  I was surprised...
+	(copy-sequence "Passphrase") t)
+       (mml-secure-test-en-decrypt-with-passphrase
+	method "uid1@example.org" "sub@example.org" nil
+	(copy-sequence "Incorrect") t)))))
+
+(defun mml-secure-en-decrypt-passphrase-no-cache (method)
+  "Encrypt message with METHOD; then decrypt and test for expected result.
+In this test, a key is used that requires the passphrase \"Passphrase\".
+In the first decryption this passphrase is hardcoded, but caching disabled.
+So the second decryption fails."
+  (mml-secure-test-key-fixture
+   (lambda ()
+     (mml-secure-test-en-decrypt-with-passphrase
+      method "uid1@example.org" "sub@example.org" nil
+      (copy-sequence "Passphrase") nil)
+     (mml-secure-test-en-decrypt-with-passphrase
+      method "uid1@example.org" "sub@example.org" nil
+      (copy-sequence "Incorrect") nil nil t))))
+
+(ert-deftest mml-secure-en-decrypt-passphrase-no-cache-openpgp-todo ()
+  "Passphrase caching with OpenPGP only for GnuPG 1.x."
+  (skip-unless (string< (cdr (assq 'version (epg-configuration))) "2"))
+  (mml-secure-en-decrypt-passphrase-no-cache 'enc-pgp)
+  (mml-secure-en-decrypt-passphrase-no-cache 'enc-pgp-mime))
+
+(ert-deftest mml-secure-en-decrypt-passphrase-no-cache-smime-todo ()
+  "Passphrase caching does not work with S/MIME (and gpgsm)."
+  :expected-result :failed
+  (if with-smime
+      (mml-secure-en-decrypt-passphrase-no-cache 'enc-smime)
+    (should nil)))
+
+
+;; Test truncation of question in y-or-n-p.
+(defun mml-secure-select-preferred-keys-todo ()
+  "Manual customization with truncated question."
+  (mml-secure-test-key-fixture
+   (lambda ()
+     (mml-secure-test-en-decrypt
+      'enc-pgp-mime
+      "jens.lechtenboerger@informationelle-selbstbestimmung-im-internet.de"
+      "no-exp@example.org" nil t nil nil t))))
+
+(defun mml-secure-select-preferred-keys-ok ()
+  "Manual customization with entire question."
+  (mml-secure-test-fixture
+   (lambda ()
+     (mml-secure-select-preferred-keys
+      (epg-make-context 'OpenPGP)
+      '("jens.lechtenboerger@informationelle-selbstbestimmung-im-internet.de")
+      'encrypt))
+   t))
+
+
+;; ERT entry points
+(defun mml-secure-run-tests ()
+    "Run all tests with defaults."
+  (ert-run-tests-batch))
+
+(defun mml-secure-run-tests-with-gpg2 ()
+  "Run all tests with gpg2 instead of gpg."
+  (let* ((epg-gpg-program "gpg2"); ~/local/gnupg-2.1.9/PLAY/inst/bin/gpg2
+	 (gpg-version (cdr (assq 'version (epg-configuration))))
+	 ;; Empty passphrases do not seem to work with gpgsm in 2.1.x:
+	 ;; https://lists.gnupg.org/pipermail/gnupg-users/2015-October/054575.html
+	 (with-smime (string< gpg-version "2.1")))
+    (ert-run-tests-batch)))
+
+(defun mml-secure-run-tests-without-smime ()
+    "Skip S/MIME tests (as they require manual passphrase entry)."
+  (let ((with-smime nil))
+    (ert-run-tests-batch)))
+
+;;; gnustest-mml-sec.el ends here
-- 
cgit v1.2.1


From 34229d3915f3205324eeab1ade37bb5eccc468b1 Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen
Date: Tue, 4 Aug 2020 19:47:06 +0200
Subject: Tweak mml-sec test that sometimes fails

* test/lisp/gnus/mml-sec-tests.el
(mml-first-secure-en-decrypt-sign-1): mml-secure-en-decrypt-sign-1
fail sometimes, on some machines, unless it's the first test.  I'm
guessing there's a race condition somewhere in the test, but put
it first now to avoid build reports.
---
 test/lisp/gnus/mml-sec-tests.el | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'test')

diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el
index 28be3b9bd46..50bb6e6b278 100644
--- a/test/lisp/gnus/mml-sec-tests.el
+++ b/test/lisp/gnus/mml-sec-tests.el
@@ -606,7 +606,7 @@ In this test, encrypt-to-self variables are set to lists."
        (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2")
 	     (cons "F7E79AB7AE31D471" "4035D59B5F88E9FC"))))))
 
-(ert-deftest mml-secure-en-decrypt-sign-1 ()
+(ert-deftest mml-first-secure-en-decrypt-sign-1 ()
   "Sign and encrypt message; then decrypt and test for expected result.
 In this test, just multiple encryption and signing keys may be available."
   (mml-secure-test-key-fixture
-- 
cgit v1.2.1


From cc41b36af9372e6396d10198bbf286b49d8a5255 Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen
Date: Tue, 4 Aug 2020 19:48:12 +0200
Subject: Remove mistakenly checked-in random_seed file

---
 test/data/mml-sec/random_seed | Bin 600 -> 0 bytes
 1 file changed, 0 insertions(+), 0 deletions(-)
 delete mode 100644 test/data/mml-sec/random_seed

(limited to 'test')

diff --git a/test/data/mml-sec/random_seed b/test/data/mml-sec/random_seed
deleted file mode 100644
index 530fd76c1e5..00000000000
Binary files a/test/data/mml-sec/random_seed and /dev/null differ
-- 
cgit v1.2.1


From 1f3e2ac4b62e38af2d9424f2a4fcc1515a4c0b30 Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen
Date: Wed, 5 Aug 2020 10:07:13 +0200
Subject: Add new function decoded-time-period

* lisp/calendar/time-date.el (decoded-time-period): New function.
---
 test/lisp/calendar/time-date-tests.el | 14 ++++++++++++++
 1 file changed, 14 insertions(+)

(limited to 'test')

diff --git a/test/lisp/calendar/time-date-tests.el b/test/lisp/calendar/time-date-tests.el
index 3eecc67eb53..fe1460cf29e 100644
--- a/test/lisp/calendar/time-date-tests.el
+++ b/test/lisp/calendar/time-date-tests.el
@@ -109,4 +109,18 @@
 (ert-deftest test-time-since ()
   (should (time-equal-p 0 (time-since nil))))
 
+(ert-deftest test-time-decoded-period ()
+  (should (equal (decoded-time-period '(nil nil 1 nil nil nil nil nil nil))
+                 3600))
+
+  (should (equal (decoded-time-period '(1 0 0 0 0 0 nil nil nil)) 1))
+  (should (equal (decoded-time-period '(0 1 0 0 0 0 nil nil nil)) 60))
+  (should (equal (decoded-time-period '(0 0 1 0 0 0 nil nil nil)) 3600))
+  (should (equal (decoded-time-period '(0 0 0 1 0 0 nil nil nil)) 86400))
+  (should (equal (decoded-time-period '(0 0 0 0 1 0 nil nil nil)) 2592000))
+  (should (equal (decoded-time-period '(0 0 0 0 0 1 nil nil nil)) 31536000))
+
+  (should (equal (decoded-time-period '((135 . 10) 0 0 0 0 0 nil nil nil))
+                 13.5)))
+
 ;;; time-date-tests.el ends here
-- 
cgit v1.2.1


From a59296d9984023960453322ff7d664ec79250f7a Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen
Date: Wed, 5 Aug 2020 10:27:40 +0200
Subject: Make the erc /ignore command prompt for a timeout

* lisp/erc/erc.el (erc--unignore-user): Separate into own function
(bug#40137).
(erc-cmd-IGNORE): Ask if the user wants a timeout.
(erc--read-time-period): New function.
---
 test/lisp/erc/erc-tests.el | 47 ++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 47 insertions(+)
 create mode 100644 test/lisp/erc/erc-tests.el

(limited to 'test')

diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
new file mode 100644
index 00000000000..27f48fa8131
--- /dev/null
+++ b/test/lisp/erc/erc-tests.el
@@ -0,0 +1,47 @@
+;;; erc-tests.el --- Tests for erc.  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Lars Ingebrigtsen <larsi@gnus.org>
+
+;; 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 'erc)
+
+(ert-deftest erc--read-time-period ()
+  (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "")))
+    (should (equal (erc--read-time-period "foo: ") nil)))
+
+  (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "   ")))
+    (should (equal (erc--read-time-period "foo: ") nil)))
+
+  (cl-letf (((symbol-function 'read-string) (lambda (&rest _) " 432 ")))
+    (should (equal (erc--read-time-period "foo: ") 432)))
+
+  (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "432")))
+    (should (equal (erc--read-time-period "foo: ") 432)))
+
+  (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1h")))
+    (should (equal (erc--read-time-period "foo: ") 3600)))
+
+  (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1h10s")))
+    (should (equal (erc--read-time-period "foo: ") 3610)))
+
+  (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1d")))
+    (should (equal (erc--read-time-period "foo: ") 86400))))
-- 
cgit v1.2.1


From 1669cf2f286649ea62991371fd19bbc592ca21bb Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen
Date: Wed, 5 Aug 2020 21:17:55 +0200
Subject: Split sometimes-failing test into three tests to ease debugging

---
 test/lisp/gnus/mml-sec-tests.el | 22 ++++++++++++++++------
 1 file changed, 16 insertions(+), 6 deletions(-)

(limited to 'test')

diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el
index 50bb6e6b278..d9ed96ff1db 100644
--- a/test/lisp/gnus/mml-sec-tests.el
+++ b/test/lisp/gnus/mml-sec-tests.el
@@ -606,7 +606,7 @@ In this test, encrypt-to-self variables are set to lists."
        (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2")
 	     (cons "F7E79AB7AE31D471" "4035D59B5F88E9FC"))))))
 
-(ert-deftest mml-first-secure-en-decrypt-sign-1 ()
+(ert-deftest mml-secure-en-decrypt-sign-1-1-single ()
   "Sign and encrypt message; then decrypt and test for expected result.
 In this test, just multiple encryption and signing keys may be available."
   (mml-secure-test-key-fixture
@@ -626,17 +626,28 @@ In this test, just multiple encryption and signing keys may be available."
 	 ;; customized choice for both keys
 	 (mml-secure-test-en-decrypt
 	  method "sub@example.org" "sub@example.org" 1 t)
-	 )
+	 )))))
 
+(ert-deftest mml-secure-en-decrypt-sign-1-2-double ()
+  "Sign and encrypt message; then decrypt and test for expected result.
+In this test, just multiple encryption and signing keys may be available."
+  (mml-secure-test-key-fixture
+   (lambda ()
+     (let ((mml-secure-openpgp-sign-with-sender t)
+	   (mml-secure-smime-sign-with-sender t))
        ;; Now use both keys to sign.  The customized one via sign-with-sender,
        ;; the other one via the following setting.
        (let ((mml-secure-openpgp-signers '("F7E79AB7AE31D471"))
 	     (mml-secure-smime-signers '("0x5F88E9FC")))
 	 (dolist (method (enc-sign-standards) nil)
 	   (mml-secure-test-en-decrypt
-	    method "no-exp@example.org" "sub@example.org" 2 t)
-	 )))
+	    method "no-exp@example.org" "sub@example.org" 2 t)))))))
 
+(ert-deftest mml-secure-en-decrypt-sign-1-3-double ()
+  "Sign and encrypt message; then decrypt and test for expected result.
+In this test, just multiple encryption and signing keys may be available."
+  (mml-secure-test-key-fixture
+   (lambda ()
      ;; Now use both keys for sub@example.org to sign an e-mail from
      ;; a different address (without associated keys).
      (let ((mml-secure-openpgp-sign-with-sender nil)
@@ -646,8 +657,7 @@ In this test, just multiple encryption and signing keys may be available."
 	   (mml-secure-smime-signers '("0x5F88E9FC" "0x479DC6E2")))
        (dolist (method (enc-sign-standards) nil)
 	 (mml-secure-test-en-decrypt
-	  method "no-exp@example.org" "no-keys@example.org" 2 t)
-	 )))))
+	  method "no-exp@example.org" "no-keys@example.org" 2 t))))))
 
 (ert-deftest mml-secure-en-decrypt-sign-2 ()
   "Sign and encrypt message; then decrypt and test for expected result.
-- 
cgit v1.2.1


From 1a99697b4d8c11a10d5e6a306103740d92cc08a1 Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen
Date: Wed, 5 Aug 2020 21:30:12 +0200
Subject: Skip epg tests if gpg isn't installed

---
 test/lisp/gnus/mml-sec-tests.el | 25 +++++++++++++++++++++++++
 1 file changed, 25 insertions(+)

(limited to 'test')

diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el
index d9ed96ff1db..917e627c7ec 100644
--- a/test/lisp/gnus/mml-sec-tests.el
+++ b/test/lisp/gnus/mml-sec-tests.el
@@ -36,6 +36,9 @@ Mostly, the empty passphrase is used.  However, the keys for
  \"No Expiry two UIDs\" have the passphrase \"Passphrase\" (for OpenPGP as well
  as S/MIME).")
 
+(defun test-conf ()
+  (ignore-errors (epg-configuration)))
+
 (defun enc-standards ()
   (if with-smime '(enc-pgp enc-pgp-mime enc-smime)
     '(enc-pgp enc-pgp-mime)))
@@ -200,6 +203,7 @@ In both cases, the first key is customized for signing and encryption."
 
 (ert-deftest mml-secure-key-checks ()
   "Test mml-secure-check-user-id and mml-secure-check-sub-key on sample keys."
+  (skip-unless (test-conf))
   (mml-secure-test-fixture
    (lambda ()
      (let* ((context (epg-make-context 'OpenPGP))
@@ -267,6 +271,7 @@ In both cases, the first key is customized for signing and encryption."
 
 (ert-deftest mml-secure-find-usable-keys-1 ()
   "Make sure that expired and disabled keys and revoked UIDs are not used."
+  (skip-unless (test-conf))
   (mml-secure-test-fixture
    (lambda ()
      (let ((context (epg-make-context 'OpenPGP)))
@@ -305,6 +310,7 @@ In both cases, the first key is customized for signing and encryption."
 
 (ert-deftest mml-secure-find-usable-keys-2 ()
   "Test different ways to search for keys."
+  (skip-unless (test-conf))
   (mml-secure-test-fixture
    (lambda ()
      (let ((context (epg-make-context 'OpenPGP)))
@@ -356,6 +362,7 @@ In both cases, the first key is customized for signing and encryption."
 
 (ert-deftest mml-secure-select-preferred-keys-1 ()
   "If only one key exists for an e-mail address, it is the preferred one."
+  (skip-unless (test-conf))
   (mml-secure-test-fixture
    (lambda ()
      (let ((context (epg-make-context 'OpenPGP)))
@@ -366,6 +373,7 @@ In both cases, the first key is customized for signing and encryption."
 
 (ert-deftest mml-secure-select-preferred-keys-2 ()
   "If multiple keys exists for an e-mail address, customization is necessary."
+  (skip-unless (test-conf))
   (mml-secure-test-fixture
    (lambda ()
      (let* ((context (epg-make-context 'OpenPGP))
@@ -392,6 +400,7 @@ In both cases, the first key is customized for signing and encryption."
 
 (ert-deftest mml-secure-select-preferred-keys-3 ()
   "Expired customized keys are removed if multiple keys are available."
+  (skip-unless (test-conf))
   (mml-secure-test-fixture
    (lambda ()
      (let ((context (epg-make-context 'OpenPGP))
@@ -416,6 +425,7 @@ In both cases, the first key is customized for signing and encryption."
 
 (ert-deftest mml-secure-select-preferred-keys-4 ()
   "Multiple keys can be recorded per recipient or signature."
+  (skip-unless (test-conf))
   (mml-secure-test-fixture
    (lambda ()
      (let ((pcontext (epg-make-context 'OpenPGP))
@@ -559,6 +569,7 @@ If optional EXPECTFAIL is non-nil, a decryption failure is expected."
 (ert-deftest mml-secure-en-decrypt-1 ()
   "Encrypt message; then decrypt and test for expected result.
 In this test, the single matching key is chosen automatically."
+  (skip-unless (test-conf))
   (dolist (method (enc-standards) nil)
     ;; no-exp@example.org with single encryption key
     (mml-secure-test-en-decrypt
@@ -568,6 +579,7 @@ In this test, the single matching key is chosen automatically."
 (ert-deftest mml-secure-en-decrypt-2 ()
   "Encrypt message; then decrypt and test for expected result.
 In this test, the encryption key needs to fixed among multiple ones."
+  (skip-unless (test-conf))
   ;; sub@example.org with multiple candidate keys,
   ;; fixture customizes preferred ones.
   (mml-secure-test-key-fixture
@@ -580,6 +592,7 @@ In this test, the encryption key needs to fixed among multiple ones."
 (ert-deftest mml-secure-en-decrypt-3 ()
   "Encrypt message; then decrypt and test for expected result.
 In this test, encrypt-to-self variables are set to t."
+  (skip-unless (test-conf))
   ;; sub@example.org with multiple candidate keys,
   ;; fixture customizes preferred ones.
   (mml-secure-test-key-fixture
@@ -595,6 +608,7 @@ In this test, encrypt-to-self variables are set to t."
 (ert-deftest mml-secure-en-decrypt-4 ()
   "Encrypt message; then decrypt and test for expected result.
 In this test, encrypt-to-self variables are set to lists."
+  (skip-unless (test-conf))
   ;; Send from sub@example.org, which has two keys; encrypt to both.
   (let ((mml-secure-openpgp-encrypt-to-self
 	 '("C3999CF1268DBEA2" "F7E79AB7AE31D471"))
@@ -609,6 +623,7 @@ In this test, encrypt-to-self variables are set to lists."
 (ert-deftest mml-secure-en-decrypt-sign-1-1-single ()
   "Sign and encrypt message; then decrypt and test for expected result.
 In this test, just multiple encryption and signing keys may be available."
+  (skip-unless (test-conf))
   (mml-secure-test-key-fixture
    (lambda ()
      (let ((mml-secure-openpgp-sign-with-sender t)
@@ -631,6 +646,7 @@ In this test, just multiple encryption and signing keys may be available."
 (ert-deftest mml-secure-en-decrypt-sign-1-2-double ()
   "Sign and encrypt message; then decrypt and test for expected result.
 In this test, just multiple encryption and signing keys may be available."
+  (skip-unless (test-conf))
   (mml-secure-test-key-fixture
    (lambda ()
      (let ((mml-secure-openpgp-sign-with-sender t)
@@ -646,6 +662,7 @@ In this test, just multiple encryption and signing keys may be available."
 (ert-deftest mml-secure-en-decrypt-sign-1-3-double ()
   "Sign and encrypt message; then decrypt and test for expected result.
 In this test, just multiple encryption and signing keys may be available."
+  (skip-unless (test-conf))
   (mml-secure-test-key-fixture
    (lambda ()
      ;; Now use both keys for sub@example.org to sign an e-mail from
@@ -662,6 +679,7 @@ In this test, just multiple encryption and signing keys may be available."
 (ert-deftest mml-secure-en-decrypt-sign-2 ()
   "Sign and encrypt message; then decrypt and test for expected result.
 In this test, lists of encryption and signing keys are customized."
+  (skip-unless (test-conf))
   (mml-secure-test-key-fixture
    (lambda ()
      (let ((mml-secure-key-preferences
@@ -695,6 +713,7 @@ In this test, lists of encryption and signing keys are customized."
 (ert-deftest mml-secure-en-decrypt-sign-3 ()
   "Sign and encrypt message; then decrypt and test for expected result.
 Use sign-with-sender and encrypt-to-self."
+  (skip-unless (test-conf))
   (mml-secure-test-key-fixture
    (lambda ()
      (let ((mml-secure-openpgp-sign-with-sender t)
@@ -710,6 +729,7 @@ Use sign-with-sender and encrypt-to-self."
 
 (ert-deftest mml-secure-sign-verify-1 ()
   "Sign message with sender; then verify and test for expected result."
+  (skip-unless (test-conf))
   (mml-secure-test-key-fixture
    (lambda ()
      (dolist (method (sign-standards) nil)
@@ -731,6 +751,7 @@ Use sign-with-sender and encrypt-to-self."
 
 (ert-deftest mml-secure-sign-verify-2 ()
   "Sign message without sender; then verify and test for expected result."
+  (skip-unless (test-conf))
   (mml-secure-test-key-fixture
    (lambda ()
      (dolist (method (sign-standards) nil)
@@ -762,6 +783,7 @@ Use sign-with-sender and encrypt-to-self."
 (ert-deftest mml-secure-sign-verify-3 ()
   "Try to sign message with expired OpenPGP subkey, which raises an error.
 With Ma Gnus v0.14 and earlier a signature would be created with a wrong key."
+  (skip-unless (test-conf))
   (should-error
    (mml-secure-test-key-fixture
     (lambda ()
@@ -784,6 +806,7 @@ With Ma Gnus v0.14 and earlier a signature would be created with a wrong key."
 In this test, a key is used that requires the passphrase \"Passphrase\".
 In the first decryption this passphrase is hardcoded, in the second one it
  is taken from a cache."
+  (skip-unless (test-conf))
   (ert-skip "Requires passphrase")
   (mml-secure-test-key-fixture
    (lambda ()
@@ -814,6 +837,7 @@ So the second decryption fails."
 
 (ert-deftest mml-secure-en-decrypt-passphrase-no-cache-openpgp-todo ()
   "Passphrase caching with OpenPGP only for GnuPG 1.x."
+  (skip-unless (test-conf))
   (skip-unless (string< (cdr (assq 'version (epg-configuration))) "2"))
   (mml-secure-en-decrypt-passphrase-no-cache 'enc-pgp)
   (mml-secure-en-decrypt-passphrase-no-cache 'enc-pgp-mime))
@@ -821,6 +845,7 @@ So the second decryption fails."
 (ert-deftest mml-secure-en-decrypt-passphrase-no-cache-smime-todo ()
   "Passphrase caching does not work with S/MIME (and gpgsm)."
   :expected-result :failed
+  (skip-unless (test-conf))
   (if with-smime
       (mml-secure-en-decrypt-passphrase-no-cache 'enc-smime)
     (should nil)))
-- 
cgit v1.2.1


From 7a56e5a44a390aaa29711d63f125f4b802df07c1 Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen
Date: Thu, 6 Aug 2020 09:09:57 +0200
Subject: Mark two cconv tests as :unstable

* test/lisp/emacs-lisp/cconv-tests.el
(cconv-tests-cl-iter-defun-:documentation): Mark as unstable
(bug#42723).
(cconv-tests-iter-defun-:documentation): Ditto.
---
 test/lisp/emacs-lisp/cconv-tests.el | 2 ++
 1 file changed, 2 insertions(+)

(limited to 'test')

diff --git a/test/lisp/emacs-lisp/cconv-tests.el b/test/lisp/emacs-lisp/cconv-tests.el
index 148bcd69be1..0ea9742be49 100644
--- a/test/lisp/emacs-lisp/cconv-tests.el
+++ b/test/lisp/emacs-lisp/cconv-tests.el
@@ -82,6 +82,7 @@
 (ert-deftest cconv-tests-cl-iter-defun-:documentation ()
   "Docstring for cl-iter-defun can be specified with :documentation."
   ;; FIXME: See Bug#28557.
+  :tags '(:unstable)
   :expected-result :failed
   (should (string= (documentation 'cconv-tests-cl-iter-defun)
                    "cl-iter-defun documentation"))
@@ -94,6 +95,7 @@
 (ert-deftest cconv-tests-iter-defun-:documentation ()
   "Docstring for iter-defun can be specified with :documentation."
   ;; FIXME: See Bug#28557.
+  :tags '(:unstable)
   :expected-result :failed
   (should (string= (documentation 'cconv-tests-iter-defun)
                    "iter-defun documentation"))
-- 
cgit v1.2.1


From 204273c3b9f0a77459661790aa929f86067a9ab1 Mon Sep 17 00:00:00 2001
From: Mattias Engdegård
Date: Mon, 3 Aug 2020 15:29:41 +0200
Subject: Fix byte-compilation of (+ -0.0) (bug#42597)

* lisp/emacs-lisp/bytecomp.el (byte-compile-associative):
Translate numerical identity expressions, such as (+ x) and (* x),
into (* x 1) since the previous translation (+ x 0) gets it wrong
for x = -0.0.
* test/lisp/emacs-lisp/bytecomp-tests.el
(byte-opt-testsuite-arith-data): Add test cases.
---
 test/lisp/emacs-lisp/bytecomp-tests.el | 5 +++++
 1 file changed, 5 insertions(+)

(limited to 'test')

diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index c235dd43fcc..894914300ae 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -47,6 +47,11 @@
     (let ((a 1.0))				   (/ 3 a 2))
     (let ((a most-positive-fixnum) (b 2.0))	   (* a 2 b))
     (let ((a 3) (b 2))				   (/ a b 1.0))
+    (let ((a -0.0)) (+ a))
+    (let ((a -0.0)) (- a))
+    (let ((a -0.0)) (* a))
+    (let ((a -0.0)) (min a))
+    (let ((a -0.0)) (max a))
     (/ 3 -1)
     (+ 4 3 2 1)
     (+ 4 3 2.0 1)
-- 
cgit v1.2.1


From 7196abecb5f5c3cc1282280d2d337b6a86761656 Mon Sep 17 00:00:00 2001
From: Simen Heggestøyl
Date: Tue, 16 Jun 2020 21:32:58 +0200
Subject: Use lexical-binding in browse-url.el and add tests

* lisp/net/browse-url.el: Turn on lexical-binding.
(browse-url--mailto, browse-url--man, browse-url--browser): Use
imperative form in docstrings.
(browse-url-delete-temp-file): Turn comment into a proper docstring.

* test/lisp/net/browse-url-tests.el: New file with tests for
browse-url.el.
---
 test/lisp/net/browse-url-tests.el | 119 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 119 insertions(+)
 create mode 100644 test/lisp/net/browse-url-tests.el

(limited to 'test')

diff --git a/test/lisp/net/browse-url-tests.el b/test/lisp/net/browse-url-tests.el
new file mode 100644
index 00000000000..b2b27d2ae7b
--- /dev/null
+++ b/test/lisp/net/browse-url-tests.el
@@ -0,0 +1,119 @@
+;;; browse-url-tests.el --- Tests for browse-url.el  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <simenheg@gmail.com>
+;; Keywords:
+
+;; 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:
+
+;;
+
+;;; Code:
+
+(require 'browse-url)
+(require 'ert)
+
+(ert-deftest browse-url-tests-browser-kind ()
+  (should (eq (browse-url--browser-kind #'browse-url-w3 "gnu.org")
+              'internal))
+  (should
+   (eq (browse-url--browser-kind #'browse-url-firefox "gnu.org")
+       'external)))
+
+(ert-deftest browse-url-tests-non-html-file-url-p ()
+  (should (browse-url--non-html-file-url-p "file://foo.txt"))
+  (should-not (browse-url--non-html-file-url-p "file://foo.html")))
+
+(ert-deftest browse-url-tests-select-handler-mailto ()
+  (should (eq (browse-url-select-handler "mailto:foo@bar.org")
+              'browse-url--mailto))
+  (should (eq (browse-url-select-handler "mailto:foo@bar.org"
+                                         'internal)
+              'browse-url--mailto))
+  (should-not (browse-url-select-handler "mailto:foo@bar.org"
+                                         'external)))
+
+(ert-deftest browse-url-tests-select-handler-man ()
+  (should (eq (browse-url-select-handler "man:ls") 'browse-url--man))
+  (should (eq (browse-url-select-handler "man:ls" 'internal)
+              'browse-url--man))
+  (should-not (browse-url-select-handler "man:ls" 'external)))
+
+(ert-deftest browse-url-tests-select-handler-file ()
+  (should (eq (browse-url-select-handler "file://foo.txt")
+              'browse-url-emacs))
+  (should (eq (browse-url-select-handler "file://foo.txt" 'internal)
+              'browse-url-emacs))
+  (should-not (browse-url-select-handler "file://foo.txt" 'external)))
+
+(ert-deftest browse-url-tests-url-encode-chars ()
+  (should (equal (browse-url-url-encode-chars "foobar" "[ob]")
+                 "f%6F%6F%62ar")))
+
+(ert-deftest browse-url-tests-encode-url ()
+  (should (equal (browse-url-encode-url "") ""))
+  (should (equal (browse-url-encode-url "a b c") "a b c"))
+  (should (equal (browse-url-encode-url "\"a\" \"b\"")
+                 "\"a%22\"b\""))
+  (should (equal (browse-url-encode-url "(a) (b)") "(a%29(b)"))
+  (should (equal (browse-url-encode-url "a$ b$") "a%24b$")))
+
+(ert-deftest browse-url-tests-url-at-point ()
+  (with-temp-buffer
+    (insert "gnu.org")
+    (should (equal (browse-url-url-at-point) "http://gnu.org"))))
+
+(ert-deftest browse-url-tests-file-url ()
+  (should (equal (browse-url-file-url "/foo") "file:///foo"))
+  (should (equal (browse-url-file-url "/foo:") "ftp://foo/"))
+  (should (equal (browse-url-file-url "/ftp@foo:") "ftp://foo/"))
+  (should (equal (browse-url-file-url "/anonymous@foo:")
+                 "ftp://foo/")))
+
+(ert-deftest browse-url-tests-delete-temp-file ()
+  (let ((browse-url-temp-file-name
+         (make-temp-file "browse-url-tests-")))
+    (browse-url-delete-temp-file)
+    (should-not (file-exists-p browse-url-temp-file-name)))
+  (let ((file (make-temp-file "browse-url-tests-")))
+    (browse-url-delete-temp-file file)
+    (should-not (file-exists-p file))))
+
+(ert-deftest browse-url-tests-add-buttons ()
+  (with-temp-buffer
+    (insert "Visit https://gnu.org")
+    (goto-char (point-min))
+    (browse-url-add-buttons)
+    (goto-char (- (point-max) 1))
+    (should (eq (get-text-property (point) 'face)
+                'browse-url-button))
+    (should (get-text-property (point) 'browse-url-data))))
+
+(ert-deftest browse-url-tests-button-copy ()
+  (with-temp-buffer
+    (insert "Visit https://gnu.org")
+    (goto-char (point-min))
+    (browse-url-add-buttons)
+    (should-error (browse-url-button-copy))
+    (goto-char (- (point-max) 1))
+    (browse-url-button-copy)
+    (should (equal (car kill-ring) "https://gnu.org"))))
+
+(provide 'browse-url-tests)
+;;; browse-url-tests.el ends here
-- 
cgit v1.2.1


From cdbbc2081ed2da3a641926e76341ed413fb5b9f9 Mon Sep 17 00:00:00 2001
From: Stefan Kangas
Date: Sat, 8 Aug 2020 01:20:01 +0200
Subject: Use lexical-binding in saveplace.el and add tests

* lisp/saveplace.el: Use lexical-binding.
(save-place-to-alist): Doc fix.
* test/lisp/saveplace-tests.el:
* test/lisp/saveplace-resources/saveplace: New files.
---
 test/lisp/saveplace-resources/saveplace |   4 ++
 test/lisp/saveplace-tests.el            | 103 ++++++++++++++++++++++++++++++++
 2 files changed, 107 insertions(+)
 create mode 100644 test/lisp/saveplace-resources/saveplace
 create mode 100644 test/lisp/saveplace-tests.el

(limited to 'test')

diff --git a/test/lisp/saveplace-resources/saveplace b/test/lisp/saveplace-resources/saveplace
new file mode 100644
index 00000000000..3f3f6d501d6
--- /dev/null
+++ b/test/lisp/saveplace-resources/saveplace
@@ -0,0 +1,4 @@
+;;; -*- coding: utf-8 -*-
+(("/home/skangas/.emacs.d/cache/recentf" . 1306)
+ ("/home/skangas/wip/emacs/"
+  (dired-filename . "/home/skangas/wip/emacs/COPYING")))
diff --git a/test/lisp/saveplace-tests.el b/test/lisp/saveplace-tests.el
new file mode 100644
index 00000000000..ae7749fe930
--- /dev/null
+++ b/test/lisp/saveplace-tests.el
@@ -0,0 +1,103 @@
+;;; saveplace-tests.el --- Tests for saveplace.el  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+
+;; Author: Stefan Kangas <stefankangas@gmail.com>
+
+;; 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:
+
+(require 'ert)
+(require 'saveplace)
+
+(defvar saveplace-tests-dir
+  (file-truename
+   (expand-file-name "saveplace-resources"
+                     (file-name-directory (or load-file-name
+                                              buffer-file-name)))))
+
+(ert-deftest saveplace-test-save-place-to-alist/dir ()
+  (save-place-mode)
+  (let* ((save-place-alist nil)
+         (save-place-loaded t)
+         (loc saveplace-tests-dir))
+    (save-window-excursion
+      (dired loc)
+      (save-place-to-alist)
+      (should (equal save-place-alist
+                     `((,(concat loc "/")
+                        (dired-filename . ,(concat loc "/saveplace")))))))))
+
+(ert-deftest saveplace-test-save-place-to-alist/file ()
+  (save-place-mode)
+  (let* ((tmpfile (make-temp-file "emacs-test-saveplace-"))
+         (save-place-alist nil)
+         (save-place-loaded t)
+         (loc tmpfile)
+         (pos 4))
+    (unwind-protect
+        (save-window-excursion
+          (find-file loc)
+          (insert "abc") ; must insert something
+          (save-place-to-alist)
+          (should (equal save-place-alist (list (cons tmpfile pos)))))
+      (delete-file tmpfile))))
+
+(ert-deftest saveplace-test-forget-unreadable-files ()
+  (save-place-mode)
+  (let* ((save-place-loaded t)
+         (tmpfile (make-temp-file "emacs-test-saveplace-"))
+         (alist-orig (list (cons "/this/file/does/not/exist" 10)
+                           (cons tmpfile 1917)))
+         (save-place-alist alist-orig))
+    (unwind-protect
+        (progn
+          (save-place-forget-unreadable-files)
+          (should (equal save-place-alist (cdr alist-orig))))
+      (delete-file tmpfile))))
+
+(ert-deftest saveplace-test-place-alist-to-file ()
+  (save-place-mode)
+  (let* ((tmpfile (make-temp-file "emacs-test-saveplace-"))
+         (tmpfile2 (make-temp-file "emacs-test-saveplace-"))
+         (save-place-file tmpfile)
+         (save-place-alist (list (cons tmpfile2 99))))
+    (unwind-protect
+        (progn (save-place-alist-to-file)
+               (setq save-place-alist nil)
+               (save-window-excursion
+                 (find-file save-place-file)
+                 (unwind-protect
+                     (should (string-match tmpfile2 (buffer-string)))
+                   (kill-buffer))))
+      (delete-file tmpfile)
+      (delete-file tmpfile2))))
+
+(ert-deftest saveplace-test-load-alist-from-file ()
+  (save-place-mode)
+  (let ((save-place-loaded nil)
+        (save-place-file
+         (expand-file-name "saveplace" saveplace-tests-dir))
+        (save-place-alist nil))
+    (load-save-place-alist-from-file)
+    (should (equal save-place-alist
+                   '(("/home/skangas/.emacs.d/cache/recentf" . 1306)
+                     ("/home/skangas/wip/emacs/"
+                      (dired-filename . "/home/skangas/wip/emacs/COPYING")))))))
+
+(provide 'saveplace-tests)
+;;; saveplace-tests.el ends here
-- 
cgit v1.2.1


From 119c34cc0aa3d7c814dff4f5b78dd589f0e2a75a Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen
Date: Sat, 8 Aug 2020 12:00:57 +0200
Subject: Mark an mml-sec test as unstable

* test/lisp/gnus/mml-sec-tests.el
(mml-secure-en-decrypt-sign-1-1-single): Mark the test as unstable
(bug#42720).  It sometimes fails on some systems (Fedora?) when
run with "-j5", so there may be a race condition in the code somewhere.
---
 test/lisp/gnus/mml-sec-tests.el | 1 +
 1 file changed, 1 insertion(+)

(limited to 'test')

diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el
index 917e627c7ec..8f78a66f616 100644
--- a/test/lisp/gnus/mml-sec-tests.el
+++ b/test/lisp/gnus/mml-sec-tests.el
@@ -623,6 +623,7 @@ In this test, encrypt-to-self variables are set to lists."
 (ert-deftest mml-secure-en-decrypt-sign-1-1-single ()
   "Sign and encrypt message; then decrypt and test for expected result.
 In this test, just multiple encryption and signing keys may be available."
+  :tags '(:unstable)
   (skip-unless (test-conf))
   (mml-secure-test-key-fixture
    (lambda ()
-- 
cgit v1.2.1


From 8e82baf5a730ff542118ddba5b76afdc1db643f6 Mon Sep 17 00:00:00 2001
From: Damien Cassou
Date: Sun, 9 Aug 2020 14:48:22 +0200
Subject: Add the new library hierarchy.el

* lisp/emacs-lisp/hierarchy.el: New file.
---
 test/lisp/emacs-lisp/hierarchy-tests.el | 556 ++++++++++++++++++++++++++++++++
 1 file changed, 556 insertions(+)
 create mode 100644 test/lisp/emacs-lisp/hierarchy-tests.el

(limited to 'test')

diff --git a/test/lisp/emacs-lisp/hierarchy-tests.el b/test/lisp/emacs-lisp/hierarchy-tests.el
new file mode 100644
index 00000000000..23cfc79d848
--- /dev/null
+++ b/test/lisp/emacs-lisp/hierarchy-tests.el
@@ -0,0 +1,556 @@
+;;; hierarchy-tests.el --- Tests for hierarchy.el
+
+;; Copyright (C) 2017-2019 Damien Cassou
+
+;; Author: Damien Cassou <damien@cassou.me>
+;; Maintainer: emacs-devel@gnu.org
+
+;; 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:
+
+;; Tests for hierarchy.el
+
+;;; Code:
+
+(require 'ert)
+(require 'hierarchy)
+
+(defun hierarchy-animals ()
+  "Create a sorted animal hierarchy."
+  (let ((parentfn (lambda (item) (cl-case item
+                              (dove 'bird)
+                              (pigeon 'bird)
+                              (bird 'animal)
+                              (dolphin 'animal)
+                              (cow 'animal))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 'dove parentfn)
+    (hierarchy-add-tree hierarchy 'pigeon parentfn)
+    (hierarchy-add-tree hierarchy 'dolphin parentfn)
+    (hierarchy-add-tree hierarchy 'cow parentfn)
+    (hierarchy-sort hierarchy)
+    hierarchy))
+
+(ert-deftest hierarchy-add-one-root ()
+  (let ((parentfn (lambda (_) nil))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 'animal parentfn)
+    (should (equal (hierarchy-roots hierarchy) '(animal)))))
+
+(ert-deftest hierarchy-add-one-item-with-parent ()
+  (let ((parentfn (lambda (item)
+                    (cl-case item
+                      (bird 'animal))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 'bird parentfn)
+    (should (equal (hierarchy-roots hierarchy) '(animal)))
+    (should (equal (hierarchy-children hierarchy 'animal) '(bird)))))
+
+(ert-deftest hierarchy-add-one-item-with-parent-and-grand-parent ()
+  (let ((parentfn (lambda (item)
+                    (cl-case item
+                      (dove 'bird)
+                      (bird 'animal))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 'dove parentfn)
+    (should (equal (hierarchy-roots hierarchy) '(animal)))
+    (should (equal (hierarchy-children hierarchy 'animal) '(bird)))
+    (should (equal (hierarchy-children hierarchy 'bird) '(dove)))))
+
+(ert-deftest hierarchy-add-same-root-twice ()
+  (let ((parentfn (lambda (_) nil))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 'animal parentfn)
+    (hierarchy-add-tree hierarchy 'animal parentfn)
+    (should (equal (hierarchy-roots hierarchy) '(animal)))))
+
+(ert-deftest hierarchy-add-same-child-twice ()
+  (let ((parentfn (lambda (item)
+                    (cl-case item
+                      (bird 'animal))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 'bird parentfn)
+    (hierarchy-add-tree hierarchy 'bird parentfn)
+    (should (equal (hierarchy-roots hierarchy) '(animal)))
+    (should (equal (hierarchy-children hierarchy 'animal) '(bird)))))
+
+(ert-deftest hierarchy-add-item-and-its-parent ()
+  (let ((parentfn (lambda (item)
+                    (cl-case item
+                      (bird 'animal))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 'bird parentfn)
+    (hierarchy-add-tree hierarchy 'animal parentfn)
+    (should (equal (hierarchy-roots hierarchy) '(animal)))
+    (should (equal (hierarchy-children hierarchy 'animal) '(bird)))))
+
+(ert-deftest hierarchy-add-item-and-its-child ()
+  (let ((parentfn (lambda (item)
+                    (cl-case item
+                      (bird 'animal))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 'animal parentfn)
+    (hierarchy-add-tree hierarchy 'bird parentfn)
+    (should (equal (hierarchy-roots hierarchy) '(animal)))
+    (should (equal (hierarchy-children hierarchy 'animal) '(bird)))))
+
+(ert-deftest hierarchy-add-two-items-sharing-parent ()
+  (let ((parentfn (lambda (item)
+                    (cl-case item
+                      (dove 'bird)
+                      (pigeon 'bird))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 'dove parentfn)
+    (hierarchy-add-tree hierarchy 'pigeon parentfn)
+    (should (equal (hierarchy-roots hierarchy) '(bird)))
+    (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon)))))
+
+(ert-deftest hierarchy-add-two-hierarchies ()
+  (let ((parentfn (lambda (item)
+                    (cl-case item
+                      (dove 'bird)
+                      (circle 'shape))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 'dove parentfn)
+    (hierarchy-add-tree hierarchy 'circle parentfn)
+    (should (equal (hierarchy-roots hierarchy) '(bird shape)))
+    (should (equal (hierarchy-children hierarchy 'bird) '(dove)))
+    (should (equal (hierarchy-children hierarchy 'shape) '(circle)))))
+
+(ert-deftest hierarchy-add-with-childrenfn ()
+  (let ((childrenfn (lambda (item)
+                      (cl-case item
+                        (animal '(bird))
+                        (bird '(dove pigeon)))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 'animal nil childrenfn)
+    (should (equal (hierarchy-roots hierarchy) '(animal)))
+    (should (equal (hierarchy-children hierarchy 'animal) '(bird)))
+    (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon)))))
+
+(ert-deftest hierarchy-add-with-parentfn-and-childrenfn ()
+  (let ((parentfn (lambda (item)
+                    (cl-case item
+                      (bird 'animal)
+                      (animal 'life-form))))
+        (childrenfn (lambda (item)
+                      (cl-case item
+                        (bird '(dove pigeon))
+                        (pigeon '(ashy-wood-pigeon)))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 'bird parentfn childrenfn)
+    (should (equal (hierarchy-roots hierarchy) '(life-form)))
+    (should (equal (hierarchy-children hierarchy 'life-form) '(animal)))
+    (should (equal (hierarchy-children hierarchy 'animal) '(bird)))
+    (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon)))
+    (should (equal (hierarchy-children hierarchy 'pigeon) '(ashy-wood-pigeon)))))
+
+(ert-deftest hierarchy-add-twice-with-parentfn-and-childrenfn ()
+  (let* ((parentfn (lambda (item)
+                     (cl-case item
+                       (dove 'bird)
+                       (bird 'animal))))
+         (childrenfn (lambda (item)
+                       (cl-case item
+                         (animal '(bird))
+                         (bird '(dove)))))
+         (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 'bird parentfn childrenfn)
+    (should (equal (hierarchy-children hierarchy 'animal) '(bird)))
+    (should (equal (hierarchy-children hierarchy 'bird) '(dove)))))
+
+(ert-deftest hierarchy-add-trees ()
+  (let ((parentfn (lambda (item)
+                    (cl-case item
+                      (dove 'bird)
+                      (pigeon 'bird)
+                      (bird 'animal))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-trees hierarchy '(dove pigeon) parentfn)
+    (should (equal (hierarchy-roots hierarchy) '(animal)))
+    (should (equal (hierarchy-children hierarchy 'animal) '(bird)))
+    (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon)))))
+
+(ert-deftest hierarchy-from-list ()
+  (let ((hierarchy (hierarchy-from-list
+                    '(animal (bird (dove)
+                                   (pigeon))
+                             (cow)
+                             (dolphin)))))
+    (hierarchy-sort hierarchy (lambda (item1 item2)
+                                (string< (car item1)
+                                         (car item2))))
+    (should (equal (hierarchy-to-string hierarchy (lambda (item) (symbol-name (car item))))
+                   "animal\n  bird\n    dove\n    pigeon\n  cow\n  dolphin\n"))))
+
+(ert-deftest hierarchy-from-list-with-duplicates ()
+  (let ((hierarchy (hierarchy-from-list
+                    '(a (b) (b))
+                    t)))
+    (hierarchy-sort hierarchy (lambda (item1 item2)
+                                ;; sort by ID
+                                (< (car item1) (car item2))))
+    (should (equal (hierarchy-length hierarchy) 3))
+    (should (equal (hierarchy-to-string
+                    hierarchy
+                    (lambda (item)
+                      (format "%s(%s)"
+                              (cadr item)
+                              (car item))))
+                   "a(1)\n  b(2)\n  b(3)\n"))))
+
+(ert-deftest hierarchy-from-list-with-childrenfn ()
+  (let ((hierarchy (hierarchy-from-list
+                    "abc"
+                    nil
+                    (lambda (item)
+                      (when (string= item "abc")
+                        (split-string item "" t))))))
+    (hierarchy-sort hierarchy (lambda (item1 item2) (string< item1 item2)))
+    (should (equal (hierarchy-length hierarchy) 4))
+    (should (equal (hierarchy-to-string hierarchy)
+                   "abc\n  a\n  b\n  c\n"))))
+
+(ert-deftest hierarchy-add-relation-check-error-when-different-parent ()
+  (let ((parentfn (lambda (item)
+                    (cl-case item
+                      (bird 'animal))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 'bird parentfn)
+    (should-error
+     (hierarchy--add-relation hierarchy 'bird 'cow #'identity))))
+
+(ert-deftest hierarchy-empty-p-return-non-nil-for-empty ()
+  (should (hierarchy-empty-p (hierarchy-new))))
+
+(ert-deftest hierarchy-empty-p-return-nil-for-non-empty ()
+  (should-not (hierarchy-empty-p (hierarchy-animals))))
+
+(ert-deftest hierarchy-length-of-empty-is-0 ()
+  (should (equal (hierarchy-length (hierarchy-new)) 0)))
+
+(ert-deftest hierarchy-length-of-non-empty-counts-items ()
+  (let ((parentfn (lambda (item)
+                    (cl-case item
+                      (bird 'animal)
+                      (dove 'bird)
+                      (pigeon 'bird))))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 'dove parentfn)
+    (hierarchy-add-tree hierarchy 'pigeon parentfn)
+    (should (equal (hierarchy-length hierarchy) 4))))
+
+(ert-deftest hierarchy-has-root ()
+  (let ((parentfn (lambda (item)
+                    (cl-case item
+                      (bird 'animal)
+                      (dove 'bird)
+                      (pigeon 'bird))))
+        (hierarchy (hierarchy-new)))
+    (should-not (hierarchy-has-root hierarchy 'animal))
+    (should-not (hierarchy-has-root hierarchy 'bird))
+    (hierarchy-add-tree hierarchy 'dove parentfn)
+    (hierarchy-add-tree hierarchy 'pigeon parentfn)
+    (should (hierarchy-has-root hierarchy 'animal))
+    (should-not (hierarchy-has-root hierarchy 'bird))))
+
+(ert-deftest hierarchy-leafs ()
+  (let ((animals (hierarchy-animals)))
+    (should (equal (hierarchy-leafs animals)
+                   '(dove pigeon dolphin cow)))))
+
+(ert-deftest hierarchy-leafs-includes-lonely-roots ()
+  (let ((parentfn (lambda (item) nil))
+        (hierarchy (hierarchy-new)))
+    (hierarchy-add-tree hierarchy 'foo parentfn)
+    (should (equal (hierarchy-leafs hierarchy)
+                   '(foo)))))
+
+(ert-deftest hierarchy-leafs-of-node ()
+  (let ((animals (hierarchy-animals)))
+    (should (equal (hierarchy-leafs animals 'cow) '()))
+    (should (equal (hierarchy-leafs animals 'animal) '(dove pigeon dolphin cow)))
+    (should (equal (hierarchy-leafs animals 'bird) '(dove pigeon)))
+    (should (equal (hierarchy-leafs animals 'dove) '()))))
+
+(ert-deftest hierarchy-child-p ()
+  (let ((animals (hierarchy-animals)))
+    (should (hierarchy-child-p animals 'dove 'bird))
+    (should (hierarchy-child-p animals 'bird 'animal))
+    (should (hierarchy-child-p animals 'cow 'animal))
+    (should-not (hierarchy-child-p animals 'cow 'bird))
+    (should-not (hierarchy-child-p animals 'bird 'cow))
+    (should-not (hierarchy-child-p animals 'animal 'dove))
+    (should-not (hierarchy-child-p animals 'animal 'bird))))
+
+(ert-deftest hierarchy-descendant ()
+  (let ((animals (hierarchy-animals)))
+    (should (hierarchy-descendant-p animals 'dove 'animal))
+    (should (hierarchy-descendant-p animals 'dove 'bird))
+    (should (hierarchy-descendant-p animals 'bird 'animal))
+    (should (hierarchy-descendant-p animals 'cow 'animal))
+    (should-not (hierarchy-descendant-p animals 'cow 'bird))
+    (should-not (hierarchy-descendant-p animals 'bird 'cow))
+    (should-not (hierarchy-descendant-p animals 'animal 'dove))
+    (should-not (hierarchy-descendant-p animals 'animal 'bird))))
+
+(ert-deftest hierarchy-descendant-if-not-same ()
+  (let ((animals (hierarchy-animals)))
+    (should-not (hierarchy-descendant-p animals 'cow 'cow))
+    (should-not (hierarchy-descendant-p animals 'dove 'dove))
+    (should-not (hierarchy-descendant-p animals 'bird 'bird))
+    (should-not (hierarchy-descendant-p animals 'animal 'animal))))
+
+;; keywords supported: :test :key
+(ert-deftest hierarchy--set-equal ()
+  (should     (hierarchy--set-equal '(1 2 3) '(1 2 3)))
+  (should     (hierarchy--set-equal '(1 2 3) '(3 2 1)))
+  (should     (hierarchy--set-equal '(3 2 1) '(1 2 3)))
+  (should-not (hierarchy--set-equal '(2 3) '(3 2 1)))
+  (should-not (hierarchy--set-equal '(1 2 3) '(2 3)))
+  (should-not (hierarchy--set-equal '("1" "2") '("2" "1") :test #'eq))
+  (should     (hierarchy--set-equal '("1" "2") '("2" "1") :test #'equal))
+  (should-not (hierarchy--set-equal '(1 2) '(-1 -2)))
+  (should     (hierarchy--set-equal '(1 2) '(-1 -2) :key #'abs))
+  (should-not (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2))))
+  (should-not (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)) :key #'car))
+  (should-not (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)) :test #'equal))
+  (should     (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)) :key #'car :test #'equal)))
+
+(ert-deftest hierarchy-equal-returns-true-for-same-hierarchy ()
+  (let ((animals (hierarchy-animals)))
+    (should (hierarchy-equal animals animals))
+    (should (hierarchy-equal (hierarchy-animals) animals))))
+
+(ert-deftest hierarchy-equal-returns-true-for-hierarchy-copies ()
+  (let ((animals (hierarchy-animals)))
+    (should (hierarchy-equal animals (hierarchy-copy animals)))))
+
+(ert-deftest hierarchy-map-item-on-leaf ()
+  (let* ((animals (hierarchy-animals))
+         (result (hierarchy-map-item (lambda (item indent) (cons item indent))
+                                     'cow
+                                     animals)))
+    (should (equal result '((cow . 0))))))
+
+(ert-deftest hierarchy-map-item-on-leaf-with-indent ()
+  (let* ((animals (hierarchy-animals))
+         (result (hierarchy-map-item (lambda (item indent) (cons item indent))
+                                     'cow
+                                     animals
+                                     2)))
+    (should (equal result '((cow . 2))))))
+
+(ert-deftest hierarchy-map-item-on-parent ()
+  (let* ((animals (hierarchy-animals))
+         (result (hierarchy-map-item (lambda (item indent) (cons item indent))
+                                     'bird
+                                     animals)))
+    (should (equal result '((bird . 0) (dove . 1) (pigeon . 1))))))
+
+(ert-deftest hierarchy-map-item-on-grand-parent ()
+  (let* ((animals (hierarchy-animals))
+         (result (hierarchy-map-item (lambda (item indent) (cons item indent))
+                                     'animal
+                                     animals)))
+    (should (equal result '((animal . 0) (bird . 1) (dove . 2) (pigeon . 2)
+                            (cow . 1) (dolphin . 1))))))
+
+(ert-deftest hierarchy-map-conses ()
+  (let* ((animals (hierarchy-animals))
+         (result (hierarchy-map (lambda (item indent)
+                                  (cons item indent))
+                                animals)))
+    (should (equal result '((animal . 0)
+                            (bird . 1)
+                            (dove . 2)
+                            (pigeon . 2)
+                            (cow . 1)
+                            (dolphin . 1))))))
+
+(ert-deftest hierarchy-map-tree ()
+  (let ((animals (hierarchy-animals)))
+    (should (equal (hierarchy-map-tree (lambda (item indent children)
+                                         (list item indent children))
+                                       animals)
+                   '(animal
+                     0
+                     ((bird 1 ((dove 2 nil) (pigeon 2 nil)))
+                      (cow 1 nil)
+                      (dolphin 1 nil)))))))
+
+(ert-deftest hierarchy-map-hierarchy-keeps-hierarchy ()
+  (let* ((animals (hierarchy-animals))
+         (result (hierarchy-map-hierarchy (lambda (item _) (identity item))
+                                          animals)))
+    (should (hierarchy-equal animals result))))
+
+(ert-deftest hierarchy-map-applies-function ()
+  (let* ((animals (hierarchy-animals))
+         (parentfn (lambda (item)
+                     (cond
+                      ((equal item "bird") "animal")
+                      ((equal item "dove") "bird")
+                      ((equal item "pigeon") "bird")
+                      ((equal item "cow") "animal")
+                      ((equal item "dolphin") "animal"))))
+         (expected (hierarchy-new)))
+    (hierarchy-add-tree expected "dove" parentfn)
+    (hierarchy-add-tree expected "pigeon" parentfn)
+    (hierarchy-add-tree expected "cow" parentfn)
+    (hierarchy-add-tree expected "dolphin" parentfn)
+    (should (hierarchy-equal
+             (hierarchy-map-hierarchy (lambda (item _) (symbol-name item)) animals)
+             expected))))
+
+(ert-deftest hierarchy-extract-tree ()
+  (let* ((animals (hierarchy-animals))
+         (birds (hierarchy-extract-tree animals 'bird)))
+    (hierarchy-sort birds)
+    (should (equal (hierarchy-roots birds) '(animal)))
+    (should (equal (hierarchy-children birds 'animal) '(bird)))
+    (should (equal (hierarchy-children birds 'bird) '(dove pigeon)))))
+
+(ert-deftest hierarchy-extract-tree-nil-if-not-in-hierarchy ()
+  (let* ((animals (hierarchy-animals)))
+    (should-not (hierarchy-extract-tree animals 'foobar))))
+
+(ert-deftest hierarchy-items-of-empty-hierarchy-is-empty ()
+  (should (seq-empty-p (hierarchy-items (hierarchy-new)))))
+
+(ert-deftest hierarchy-items-returns-sequence-of-same-length ()
+  (let* ((animals (hierarchy-animals))
+         (result (hierarchy-items animals)))
+    (should (= (seq-length result) (hierarchy-length animals)))))
+
+(ert-deftest hierarchy-items-return-all-elements-of-hierarchy ()
+  (let* ((animals (hierarchy-animals))
+         (result (hierarchy-items animals)))
+    (should (equal (seq-sort #'string< result) '(animal bird cow dolphin dove pigeon)))))
+
+(ert-deftest hierarchy-labelfn-indent-no-indent-if-0 ()
+  (let* ((labelfn-base (lambda (_item _indent) (insert "foo")))
+         (labelfn (hierarchy-labelfn-indent labelfn-base)))
+    (should (equal
+             (with-temp-buffer
+               (funcall labelfn "bar" 0)
+               (buffer-substring (point-min) (point-max)))
+             "foo"))))
+
+(ert-deftest hierarchy-labelfn-indent-three-times-if-3 ()
+  (let* ((labelfn-base (lambda (_item _indent) (insert "foo")))
+         (labelfn (hierarchy-labelfn-indent labelfn-base)))
+    (should (equal
+             (with-temp-buffer
+               (funcall labelfn "bar" 3)
+               (buffer-substring (point-min) (point-max)))
+             "      foo"))))
+
+(ert-deftest hierarchy-labelfn-indent-default-indent-string ()
+  (let* ((labelfn-base (lambda (_item _indent) (insert "foo")))
+         (labelfn (hierarchy-labelfn-indent labelfn-base)))
+    (should (equal
+             (with-temp-buffer
+               (funcall labelfn "bar" 1)
+               (buffer-substring (point-min) (point-max)))
+             "  foo"))))
+
+(ert-deftest hierarchy-labelfn-indent-custom-indent-string ()
+  (let* ((labelfn-base (lambda (_item _indent) (insert "foo")))
+         (labelfn (hierarchy-labelfn-indent labelfn-base "###"))
+         (content (with-temp-buffer
+                    (funcall labelfn "bar" 1)
+                    (buffer-substring (point-min) (point-max)))))
+    (should (equal content "###foo"))))
+
+(ert-deftest hierarchy-labelfn-button-propertize ()
+  (let* ((labelfn-base (lambda (_item _indent) (insert "foo")))
+         (actionfn #'identity)
+         (labelfn (hierarchy-labelfn-button labelfn-base actionfn))
+         (properties (with-temp-buffer
+                       (funcall labelfn "bar" 1)
+                       (text-properties-at 1))))
+    (should (equal (car properties) 'action))))
+
+(ert-deftest hierarchy-labelfn-button-execute-labelfn ()
+  (let* ((labelfn-base (lambda (_item _indent) (insert "foo")))
+         (actionfn #'identity)
+         (labelfn (hierarchy-labelfn-button labelfn-base actionfn))
+         (content (with-temp-buffer
+                    (funcall labelfn "bar" 1)
+                    (buffer-substring-no-properties (point-min) (point-max)))))
+    (should (equal content "foo"))))
+
+(ert-deftest hierarchy-labelfn-button-if-does-not-button-unless-condition ()
+  (let ((labelfn-base (lambda (_item _indent) (insert "foo")))
+        (spy-count 0)
+        (condition (lambda (_item _indent) nil)))
+    (cl-letf (((symbol-function 'hierarchy-labelfn-button) (lambda (_labelfn _actionfn) (lambda (_item _indent) (cl-incf spy-count)))))
+      (funcall (hierarchy-labelfn-button-if labelfn-base condition #'identity) nil nil)
+      (should (equal spy-count 0)))))
+
+(ert-deftest hierarchy-labelfn-button-if-does-button-when-condition ()
+  (let ((labelfn-base (lambda (_item _indent) (insert "foo")))
+        (spy-count 0)
+        (condition (lambda (_item _indent) t)))
+    (cl-letf (((symbol-function 'hierarchy-labelfn-button) (lambda (_labelfn _actionfn) (lambda (_item _indent) (cl-incf spy-count)))))
+      (funcall (hierarchy-labelfn-button-if labelfn-base condition #'identity) nil nil)
+      (should (equal spy-count 1)))))
+
+(ert-deftest hierarchy-labelfn-to-string ()
+  (let ((labelfn (lambda (item _indent) (insert item))))
+    (should (equal (hierarchy-labelfn-to-string labelfn "foo" 1) "foo"))))
+
+(ert-deftest hierarchy-print ()
+  (let* ((animals (hierarchy-animals))
+         (result (with-temp-buffer
+                   (hierarchy-print animals)
+                   (buffer-substring-no-properties (point-min) (point-max)))))
+    (should (equal result "animal\n  bird\n    dove\n    pigeon\n  cow\n  dolphin\n"))))
+
+(ert-deftest hierarchy-to-string ()
+  (let* ((animals (hierarchy-animals))
+         (result (hierarchy-to-string animals)))
+    (should (equal result "animal\n  bird\n    dove\n    pigeon\n  cow\n  dolphin\n"))))
+
+(ert-deftest hierarchy-tabulated-display ()
+  (let* ((animals (hierarchy-animals))
+         (labelfn (lambda (item _indent) (insert (symbol-name item))))
+         (contents (with-temp-buffer
+                     (hierarchy-tabulated-display animals labelfn (current-buffer))
+                     (buffer-substring-no-properties (point-min) (point-max)))))
+    (should (equal contents "animal\nbird\ndove\npigeon\ncow\ndolphin\n"))))
+
+(ert-deftest hierarchy-sort-non-root-nodes ()
+  (let* ((animals (hierarchy-animals)))
+    (should (equal (hierarchy-roots animals) '(animal)))
+    (should (equal (hierarchy-children animals 'animal) '(bird cow dolphin)))
+    (should (equal (hierarchy-children animals 'bird) '(dove pigeon)))))
+
+(ert-deftest hierarchy-sort-roots ()
+  (let* ((organisms (hierarchy-new))
+         (parentfn (lambda (item)
+                     (cl-case item
+                       (oak 'plant)
+                       (bird 'animal)))))
+    (hierarchy-add-tree organisms 'oak parentfn)
+    (hierarchy-add-tree organisms 'bird parentfn)
+    (hierarchy-sort organisms)
+    (should (equal (hierarchy-roots organisms) '(animal plant)))))
+
+(provide 'hierarchy-tests)
+;;; hierarchy-tests.el ends here
-- 
cgit v1.2.1