summaryrefslogtreecommitdiff
path: root/test/lisp/gnus
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2022-09-25 16:15:16 -0400
committerStefan Monnier <monnier@iro.umontreal.ca>2022-09-25 16:15:16 -0400
commit650c20f1ca4e07591a727e1cfcc74b3363d15985 (patch)
tree85d11f6437cde22f410c25e0e5f71a3131ebd07d /test/lisp/gnus
parent8869332684c2302b5ba1ead4568bbc7ba1c0183e (diff)
parent4b85ae6a24380fb67a3315eaec9233f17a872473 (diff)
downloademacs-650c20f1ca4e07591a727e1cfcc74b3363d15985.tar.gz
emacs-650c20f1ca4e07591a727e1cfcc74b3363d15985.tar.bz2
emacs-650c20f1ca4e07591a727e1cfcc74b3363d15985.zip
Merge 'master' into noverlay
Diffstat (limited to 'test/lisp/gnus')
-rw-r--r--test/lisp/gnus/gnus-group-tests.el52
-rw-r--r--test/lisp/gnus/gnus-icalendar-tests.el259
-rw-r--r--test/lisp/gnus/gnus-search-tests.el100
-rw-r--r--test/lisp/gnus/gnus-test-headers.el178
-rw-r--r--test/lisp/gnus/gnus-tests.el6
-rw-r--r--test/lisp/gnus/gnus-util-tests.el135
-rw-r--r--test/lisp/gnus/message-tests.el99
-rw-r--r--test/lisp/gnus/mm-decode-resources/8bit-multipart.bin20
-rw-r--r--test/lisp/gnus/mm-decode-resources/win1252-multipart.bin44
-rw-r--r--test/lisp/gnus/mm-decode-tests.el102
-rw-r--r--test/lisp/gnus/mml-sec-resources/.gpg-v21-migrated0
-rw-r--r--test/lisp/gnus/mml-sec-resources/gpg-agent.conf5
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.keybin0 -> 797 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.keybin0 -> 526 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.keybin0 -> 841 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.keybin0 -> 797 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.keybin0 -> 526 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.keybin0 -> 797 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.keybin0 -> 797 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.keybin0 -> 798 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.keybin0 -> 798 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.keybin0 -> 526 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.keybin0 -> 710 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.keybin0 -> 798 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.keybin0 -> 527 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.keybin0 -> 798 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.keybin0 -> 526 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.keybin0 -> 709 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.keybin0 -> 797 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.keybin0 -> 710 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.keybin0 -> 841 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.keybin0 -> 841 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.keybin0 -> 527 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.keybin0 -> 710 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.keybin0 -> 797 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.keybin0 -> 710 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.keybin0 -> 797 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.keybin0 -> 797 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.keybin0 -> 841 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/pubring.gpgbin0 -> 13883 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/pubring.kbxbin0 -> 3076 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/secring.gpgbin0 -> 17362 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/trustdb.gpgbin0 -> 1880 bytes
-rw-r--r--test/lisp/gnus/mml-sec-resources/trustlist.txt26
-rw-r--r--test/lisp/gnus/mml-sec-tests.el900
-rw-r--r--test/lisp/gnus/nnrss-tests.el45
46 files changed, 1958 insertions, 13 deletions
diff --git a/test/lisp/gnus/gnus-group-tests.el b/test/lisp/gnus/gnus-group-tests.el
new file mode 100644
index 00000000000..4ae5fea3eb7
--- /dev/null
+++ b/test/lisp/gnus/gnus-group-tests.el
@@ -0,0 +1,52 @@
+;;; gnus-group-tests.el --- Tests for gnus-group.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'gnus-group)
+(require 'ert)
+
+(ert-deftest gnus-short-group-name ()
+ (map-apply
+ (lambda (input expected)
+ (should (string-equal (gnus-short-group-name input) expected)))
+ '(("nnimap+email@example.com:archives/2020/03" . "email@example:a/2/03")
+ ("nndiary+diary:birthdays" . "diary:birthdays")
+ ("nnimap+email@example.com:test" . "email@example:test")
+ ("nnimap+email@example.com:234" . "email@example:234")
+
+ ;; This is a very aggressive shortening of the left hand side.
+ ("nnimap+email@banana.salesman.example.com:234" . "email@banana:234")
+ ("nntp+some.where.edu:soc.motss" . "some:s.motss")
+ ("nntp+news.gmane.org:gmane.emacs.gnus.general" . "news:g.e.g.general")
+ ("nntp+news.gnus.org:gmane.text.docbook.apps" . "news:g.t.d.apps")
+
+ ;; nnimap groups.
+ ("nnimap+email@example.com:[Invoices]/Bananas" . "email@example:I/Bananas")
+ ("nnimap+email@banana.salesman.example.com:[Invoices]/Bananas"
+ . "email@banana:I/Bananas")
+
+ ;; The "n" from "nnspool" is perhaps not optimal.
+ ("nnspool+alt.binaries.pictures.furniture" . "n.b.p.furniture"))))
+
+;;; gnus-group-tests.el ends here
diff --git a/test/lisp/gnus/gnus-icalendar-tests.el b/test/lisp/gnus/gnus-icalendar-tests.el
new file mode 100644
index 00000000000..348ddf9f056
--- /dev/null
+++ b/test/lisp/gnus/gnus-icalendar-tests.el
@@ -0,0 +1,259 @@
+;;; gnus-icalendar-tests.el --- tests -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
+
+;; Author: Jan Tatarik <jan.tatarik@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 'ert)
+(require 'gnus-icalendar)
+
+
+(defun gnus-icalendar-tests--get-ical-event (ical-string &optional participant)
+ "Return gnus-icalendar event for ICAL-STRING."
+ (let (event)
+ (with-temp-buffer
+ (insert ical-string)
+ (setq event (gnus-icalendar-event-from-buffer (buffer-name) participant)))
+ event))
+
+(ert-deftest gnus-icalendar-parse ()
+ "test"
+ (let ((tz (getenv "TZ"))
+ (event (gnus-icalendar-tests--get-ical-event "\
+BEGIN:VCALENDAR
+PRODID:-//Google Inc//Google Calendar 70.9054//EN
+VERSION:2.0
+CALSCALE:GREGORIAN
+METHOD:REQUEST
+BEGIN:VTIMEZONE
+TZID:America/New_York
+X-LIC-LOCATION:America/New_York
+BEGIN:DAYLIGHT
+TZOFFSETFROM:-0500
+TZOFFSETTO:-0400
+TZNAME:EDT
+DTSTART:19700308T020000
+RRULE:FREQ=YEARLY;BYMONTH=3;BYDAY=2SU
+END:DAYLIGHT
+BEGIN:STANDARD
+TZOFFSETFROM:-0400
+TZOFFSETTO:-0500
+TZNAME:EST
+DTSTART:19701101T020000
+RRULE:FREQ=YEARLY;BYMONTH=11;BYDAY=1SU
+END:STANDARD
+END:VTIMEZONE
+BEGIN:VEVENT
+DTSTART;TZID=America/New_York:20201208T090000
+DTEND;TZID=America/New_York:20201208T100000
+DTSTAMP:20200728T182853Z
+ORGANIZER;CN=Company Events:mailto:anoncompany.com_3bm6fh805bme9uoeliqcle1sa
+ g@group.calendar.google.com
+UID:iipdt88slddpeu7hheuu09sfmd@google.com
+X-MICROSOFT-CDO-OWNERAPPTID:-362490173
+RECURRENCE-ID;TZID=America/New_York:20201208T091500
+CREATED:20200309T134939Z
+DESCRIPTION:In this meeting\\, we will cover topics from product and enginee
+ ring presentations and demos to new hire announcements to watching the late
+LAST-MODIFIED:20200728T182852Z
+LOCATION:New York-22-Town Hall Space (250) [Chrome Box]
+SEQUENCE:4
+STATUS:CONFIRMED
+SUMMARY:Townhall | All Company Meeting
+TRANSP:OPAQUE
+END:VEVENT
+END:VCALENDAR
+")))
+
+ (unwind-protect
+ (progn
+ ;; Use this form so as not to rely on system tz database.
+ ;; Eg hydra.nixos.org.
+ (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3")
+ (should (eq (eieio-object-class event) 'gnus-icalendar-event-request))
+ (should (not (gnus-icalendar-event:recurring-p event)))
+ (should (string= (gnus-icalendar-event:start event) "2020-12-08 15:00"))
+ (with-slots (organizer summary description location end-time uid rsvp participation-type) event
+ (should (string= organizer "anoncompany.com_3bm6fh805bme9uoeliqcle1sag@group.calendar.google.com"))
+ (should (string= summary "Townhall | All Company Meeting"))
+ (should (string= description "In this meeting, we will cover topics from product and engineering presentations and demos to new hire announcements to watching the late"))
+ (should (string= location "New York-22-Town Hall Space (250) [Chrome Box]"))
+ (should (string= (format-time-string "%Y-%m-%d %H:%M" end-time) "2020-12-08 16:00"))
+ (should (string= uid "iipdt88slddpeu7hheuu09sfmd@google.com"))
+ (should (not rsvp))
+ (should (eq participation-type 'non-participant))))
+ (setenv "TZ" tz))))
+
+(ert-deftest gnus-icalendary-byday ()
+ ""
+ (let ((tz (getenv "TZ"))
+ (event (gnus-icalendar-tests--get-ical-event "\
+BEGIN:VCALENDAR
+PRODID:Zimbra-Calendar-Provider
+VERSION:2.0
+METHOD:REQUEST
+BEGIN:VTIMEZONE
+TZID:America/New_York
+BEGIN:STANDARD
+DTSTART:16010101T020000
+TZOFFSETTO:-0500
+TZOFFSETFROM:-0400
+RRULE:FREQ=YEARLY;WKST=MO;INTERVAL=1;BYMONTH=11;BYDAY=1SU
+TZNAME:EST
+END:STANDARD
+BEGIN:DAYLIGHT
+DTSTART:16010101T020000
+TZOFFSETTO:-0400
+TZOFFSETFROM:-0500
+RRULE:FREQ=YEARLY;WKST=MO;INTERVAL=1;BYMONTH=3;BYDAY=2SU
+TZNAME:EDT
+END:DAYLIGHT
+END:VTIMEZONE
+BEGIN:VEVENT
+UID:903a5415-9067-4f63-b499-1b6205f49c88
+RRULE:FREQ=DAILY;UNTIL=20200825T035959Z;INTERVAL=1;BYDAY=MO,TU,WE,TH,FR
+SUMMARY:appointment every weekday\\, start jul 24\\, 2020\\, end aug 24\\, 2020
+ATTENDEE;CN=Mark Hershberger;ROLE=REQ-PARTICIPANT;PARTSTAT=NEEDS-ACTION;RSVP
+ =TRUE:mailto:hexmode <at> gmail.com
+ORGANIZER;CN=Mark A. Hershberger:mailto:mah <at> nichework.com
+DTSTART;TZID=\"America/New_York\":20200724T090000
+DTEND;TZID=\"America/New_York\":20200724T093000
+STATUS:CONFIRMED
+CLASS:PUBLIC
+X-MICROSOFT-CDO-INTENDEDSTATUS:BUSY
+TRANSP:OPAQUE
+LAST-MODIFIED:20200719T150815Z
+DTSTAMP:20200719T150815Z
+SEQUENCE:0
+DESCRIPTION:The following is a new meeting request:
+BEGIN:VALARM
+ACTION:DISPLAY
+TRIGGER;RELATED=START:-PT5M
+DESCRIPTION:Reminder
+END:VALARM
+END:VEVENT
+END:VCALENDAR" (list "Mark Hershberger"))))
+
+ (unwind-protect
+ (progn
+ ;; Use this form so as not to rely on system tz database.
+ ;; Eg hydra.nixos.org.
+ (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3")
+ (should (eq (eieio-object-class event) 'gnus-icalendar-event-request))
+ (should (gnus-icalendar-event:recurring-p event))
+ (should (string= (gnus-icalendar-event:recurring-interval event) "1"))
+ (should (string= (gnus-icalendar-event:start event) "2020-07-24 15:00"))
+ (with-slots (organizer summary description location end-time uid rsvp participation-type) event
+ (should (string= organizer "mah <at> nichework.com"))
+ (should (string= summary "appointment every weekday, start jul 24, 2020, end aug 24, 2020"))
+ (should (string= description "The following is a new meeting request:"))
+ (should (null location))
+ (should (string= (format-time-string "%Y-%m-%d %H:%M" end-time) "2020-07-24 15:30"))
+ (should (string= uid "903a5415-9067-4f63-b499-1b6205f49c88"))
+ (should rsvp)
+ (should (eq participation-type 'required)))
+ (should (equal (gnus-icalendar-event:recurring-days event) '(1 2 3 4 5)))
+ (should (string= (gnus-icalendar-event:org-timestamp event) "<2020-07-24 15:00-15:30 +1w>
+<2020-07-27 15:00-15:30 +1w>
+<2020-07-28 15:00-15:30 +1w>
+<2020-07-29 15:00-15:30 +1w>
+<2020-07-30 15:00-15:30 +1w>")))
+ (setenv "TZ" tz))))
+
+(ert-deftest gnus-icalendary-weekly-byday ()
+ ""
+ (let ((tz (getenv "TZ"))
+ (event (gnus-icalendar-tests--get-ical-event "\
+BEGIN:VCALENDAR
+PRODID:-//Google Inc//Google Calendar 70.9054//EN
+VERSION:2.0
+CALSCALE:GREGORIAN
+METHOD:REQUEST
+BEGIN:VTIMEZONE
+TZID:Europe/Berlin
+X-LIC-LOCATION:Europe/Berlin
+BEGIN:DAYLIGHT
+TZOFFSETFROM:+0100
+TZOFFSETTO:+0200
+TZNAME:CEST
+DTSTART:19700329T020000
+RRULE:FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU
+END:DAYLIGHT
+BEGIN:STANDARD
+TZOFFSETFROM:+0200
+TZOFFSETTO:+0100
+TZNAME:CET
+DTSTART:19701025T030000
+RRULE:FREQ=YEARLY;BYMONTH=10;BYDAY=-1SU
+END:STANDARD
+END:VTIMEZONE
+BEGIN:VEVENT
+DTSTART;TZID=Europe/Berlin:20200915T140000
+DTEND;TZID=Europe/Berlin:20200915T143000
+RRULE:FREQ=WEEKLY;BYDAY=FR,MO,TH,TU,WE
+DTSTAMP:20200915T120627Z
+ORGANIZER;CN=anon@anoncompany.com:mailto:anon@anoncompany.com
+UID:7b6g3m7iftuo90ei4ul00feqn_R20200915T120000@google.com
+ATTENDEE;CUTYPE=INDIVIDUAL;PARTSTAT=ACCEPTED;RSVP=TRUE
+ ;CN=participant@anoncompany.com;X-NUM-GUESTS=0:mailto:participant@anoncompany.com
+CREATED:20200325T095723Z
+DESCRIPTION:Coffee talk
+LAST-MODIFIED:20200915T120623Z
+LOCATION:
+SEQUENCE:0
+STATUS:CONFIRMED
+SUMMARY:Casual coffee talk
+TRANSP:OPAQUE
+END:VEVENT
+END:VCALENDAR" (list "participant@anoncompany.com"))))
+
+ (unwind-protect
+ (progn
+ ;; Use this form so as not to rely on system tz database.
+ ;; Eg hydra.nixos.org.
+ (setenv "TZ" "CET-1CEST,M3.5.0/2,M10.5.0/3")
+ (should (eq (eieio-object-class event) 'gnus-icalendar-event-request))
+ (should (gnus-icalendar-event:recurring-p event))
+ (should (string= (gnus-icalendar-event:recurring-interval event) "1"))
+ (should (string= (gnus-icalendar-event:start event) "2020-09-15 14:00"))
+ (with-slots (organizer summary description location end-time uid rsvp participation-type) event
+ (should (string= organizer "anon@anoncompany.com"))
+ (should (string= summary "Casual coffee talk"))
+ (should (string= description "Coffee talk"))
+ (should (string= location ""))
+ (should (string= (format-time-string "%Y-%m-%d %H:%M" end-time) "2020-09-15 14:30"))
+ (should (string= uid "7b6g3m7iftuo90ei4ul00feqn_R20200915T120000@google.com"))
+ (should rsvp)
+ (should (eq participation-type 'required)))
+ (should (equal (sort (gnus-icalendar-event:recurring-days event) #'<) '(1 2 3 4 5)))
+ (should (string= (gnus-icalendar-event:org-timestamp event) "<2020-09-15 14:00-14:30 +1w>
+<2020-09-16 14:00-14:30 +1w>
+<2020-09-17 14:00-14:30 +1w>
+<2020-09-18 14:00-14:30 +1w>
+<2020-09-21 14:00-14:30 +1w>")))
+ (setenv "TZ" tz))))
+
+(provide 'gnus-icalendar-tests)
+;;; gnus-icalendar-tests.el ends here
diff --git a/test/lisp/gnus/gnus-search-tests.el b/test/lisp/gnus/gnus-search-tests.el
new file mode 100644
index 00000000000..4a5def97d3c
--- /dev/null
+++ b/test/lisp/gnus/gnus-search-tests.el
@@ -0,0 +1,100 @@
+;;; gnus-search-tests.el --- Tests for Gnus' search routines -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017, 2021-2022 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
+;; 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:
+
+;; Tests for the search parsing, search engines, and their
+;; transformations.
+
+;;; Code:
+
+(require 'ert)
+(require 'gnus-search)
+
+(ert-deftest gnus-s-parse ()
+ "Test basic structural parsing."
+ (let ((pairs
+ '(("string" . ("string"))
+ ("from:john" . ((from . "john")))
+ ("here and there" . ("here" and "there"))
+ ("here or there" . ((or "here" "there")))
+ ("here (there or elsewhere)" . ("here" ((or "there" "elsewhere"))))
+ ("here not there" . ("here" (not "there")))
+ ("from:boss or not vacation" . ((or (from . "boss") (not "vacation")))))))
+ (dolist (p pairs)
+ (should (equal (gnus-search-parse-query (car p)) (cdr p))))))
+
+(ert-deftest gnus-s-expand-keyword ()
+ "Test expansion of keywords"
+ (let ((gnus-search-expandable-keys
+ (default-value 'gnus-search-expandable-keys))
+ (pairs
+ '(("su" . "subject")
+ ("sin" . "since")
+ ("body" . "body")
+ ("list-id" . "list-id"))))
+ (dolist (p pairs)
+ (should (equal (gnus-search-query-expand-key (car p))
+ (cdr p))))
+ (should-error (gnus-search-query-expand-key "s")
+ :type 'gnus-search-parse-error)))
+
+(ert-deftest gnus-s-parse-date ()
+ "Test parsing of date expressions."
+ (let ((rel-date (encode-time 0 0 0 15 4 2017))
+ (pairs
+ '(("January" . (nil 1 nil))
+ ("2017" . (nil nil 2017))
+ ("15" . (15 nil nil))
+ ("January 15" . (15 1 nil))
+ ("tuesday" . (11 4 2017))
+ ("1d" . (14 4 2017))
+ ("1w" . (8 4 2017)))))
+ (dolist (p pairs)
+ (should (equal (gnus-search-query-parse-date (car p) rel-date)
+ (cdr p))))))
+
+(ert-deftest gnus-s-delimited-string ()
+ "Test proper functioning of `gnus-search-query-return-string'."
+ (with-temp-buffer
+ (insert "one\ntwo words\nthree \"words with quotes\"\n\"quotes at start\"\n/alternate \"quotes\"/\n(more bits)")
+ (goto-char (point-min))
+ (should (string= (gnus-search-query-return-string)
+ "one"))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string)
+ "two"))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string)
+ "three"))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string "\"")
+ "\"quotes at start\""))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string "/")
+ "/alternate \"quotes\"/"))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string ")" t)
+ "more bits"))))
+
+(provide 'gnus-search-tests)
+;;; gnus-search-tests.el ends here
diff --git a/test/lisp/gnus/gnus-test-headers.el b/test/lisp/gnus/gnus-test-headers.el
new file mode 100644
index 00000000000..730c10f9818
--- /dev/null
+++ b/test/lisp/gnus/gnus-test-headers.el
@@ -0,0 +1,178 @@
+;;; gnus-test-headers.el --- Tests for Gnus header-related functions -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018-2022 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
+
+;; 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:
+
+;; The tests her are for
+
+;;; Code:
+
+(require 'ert)
+(require 'gnus-sum)
+
+(defconst gnus-headers-test-data
+ '([2 "Re: [Emacs-devel] Emacs move" "Dave Love <d.love@dl.ac.uk>"
+ "Thu, 14 Sep 2000 11:10:46 +0100"
+ "<200009141010.LAA26351@djlvig.dl.ac.uk>"
+ "<20000913175943.A26093@sparky.nisa.net>"
+ 1882 16 "nnmaildir mails:2"
+ ((To . "Jeff Bailey <jbailey@nisa.net>")
+ (Cc . "emacs-devel@gnu.org, cvs-hackers@gnu.org"))]
+ [3 "Re: [Emacs-devel] Emacs move" "Sam Steingold <sds@gnu.org>"
+ "14 Sep 2000 10:21:56 -0400" "<upum7xddn.fsf@xchange.com>"
+ "<20000913175943.A26093@sparky.nisa.net>"
+ 2991 50 "nnmaildir mails:3"
+ ((To . "Jeff Bailey <jbailey@nisa.net>")
+ (Cc . "emacs-devel@gnu.org, cvs-hackers@gnu.org"))]
+ [4 "Re: [Emacs-devel] Emacs move" "Jeff Bailey <jbailey@nisa.net>"
+ "Thu, 14 Sep 2000 09:14:47 -0700"
+ "<20000914091447.G4827@sparky.nisa.net>"
+ "<20000913175943.A26093@sparky.nisa.net> <upum7xddn.fsf@xchange.com>"
+ 1780 15 "nnmaildir mails:4"
+ ((To . "sds@gnu.org, Jeff Bailey <jbailey@nisa.net>")
+ (Cc . "emacs-devel@gnu.org, cvs-hackers@gnu.org"))]
+ [5 "Re: [Emacs-devel] Emacs move" "Dave Love <d.love@dl.ac.uk>"
+ "Thu, 14 Sep 2000 18:24:36 +0100"
+ "<200009141724.SAA26807@djlvig.dl.ac.uk>"
+ "<20000913175943.A26093@sparky.nisa.net>"
+ 1343 9 "nnmaildir mails:5"
+ ((To . "Jeff Bailey <jbailey@nisa.net>")
+ (Cc . "emacs-devel@gnu.org, cvs-hackers@gnu.org"))]
+ [6 "Re: [Emacs-devel] Emacs move" "Karl Fogel <kfogel@galois.collab.net>"
+ "14 Sep 2000 10:37:35 -0500" "<87em2nyog0.fsf@galois.collab.net>"
+ "<20000913175943.A26093@sparky.nisa.net> <200009141724.SAA26807@djlvig.dl.ac.uk>"
+ 3740 124 "nnmaildir mails:6"
+ ((To . "Dave Love <d.love@dl.ac.uk>")
+ (Cc . "Jeff Bailey <jbailey@nisa.net>, emacs-devel@gnu.org, cvs-hackers@gnu.org"))]
+ [7 "Re: [Emacs-devel] Emacs move" "Jeff Bailey <jbailey@nisa.net>"
+ "Thu, 14 Sep 2000 10:55:12 -0700"
+ "<20000914105512.A29291@sparky.nisa.net>"
+ "<20000913175943.A26093@sparky.nisa.net> <200009141724.SAA26807@djlvig.dl.ac.uk> <87em2nyog0.fsf@galois.collab.net>"
+ 1687 16 "nnmaildir mails:7"
+ ((To . "kfogel@red-bean.com, Dave Love <d.love@dl.ac.uk>")
+ (Cc . "Jeff Bailey <jbailey@nisa.net>, emacs-devel@gnu.org, cvs-hackers@gnu.org"))]
+ [8 "Re: [Emacs-devel] Emacs move" "John Wiegley <johnw@gnu.org>"
+ "Thu, 14 Sep 2000 12:19:01 -0700"
+ "<200009141919.MAA05085@localhost.localdomain>"
+ "<20000913175943.A26093@sparky.nisa.net>"
+ 1978 27 "nnmaildir mails:8"
+ ((To . "emacs-devel@gnu.org"))]
+ [9 "Re: [Emacs-devel] Emacs move"
+ "\"Robert J. Chassell\" <bob@rattlesnake.com>"
+ "Thu, 14 Sep 2000 07:33:15 -0400 (EDT)"
+ "<m13ZXGV-000BCgC@megalith.rattlesnake.com>"
+ "<20000913175943.A26093@sparky.nisa.net>"
+ 3046 72 "nnmaildir mails:9"
+ ((To . "jbailey@nisa.net")
+ (Cc . "emacs-devel@gnu.org, cvs-hackers@gnu.org"))]
+ [10 "Re: [Emacs-devel] Emacs move"
+ "wmperry@aventail.com (William M. Perry)"
+ "14 Sep 2000 09:10:25 -0500"
+ "<86g0n3f4j2.fsf@megalith.bp.aventail.com>"
+ "<20000913175943.A26093@sparky.nisa.net> <m13ZXGV-000BCgC@megalith.rattlesnake.com>"
+ 3104 44 "nnmaildir mails:10"
+ ((To . "bob@rattlesnake.com")
+ (Cc . "jbailey@nisa.net, emacs-devel@gnu.org, cvs-hackers@gnu.org"))]
+ [11 "Re: [Emacs-devel] Emacs move" "Gerd Moellmann <gerd@gnu.org>"
+ "Thu, 14 Sep 2000 21:51:05 +0200 (CEST)"
+ "<200009141951.VAA06005@gerd.segv.de>"
+ "<20000913175943.A26093@sparky.nisa.net> <m13ZXGV-000BCgC@megalith.rattlesnake.com> <86g0n3f4j2.fsf@megalith.bp.aventail.com>"
+ 1884 6 "nnmaildir mails:11"
+ ((To . "wmvperry@aventail.com")
+ (Cc . "bob@rattlesnake.com, jbailey@nisa.net, emacs-devel@gnu.org, cvs-hackers@gnu.org"))]
+ [12 "Re: [Emacs-devel] Emacs move" "Gerd Moellmann <gerd@gnu.org>"
+ "Thu, 14 Sep 2000 21:49:03 +0200 (CEST)"
+ "<200009141949.VAA05998@gerd.segv.de>"
+ "<20000913175943.A26093@sparky.nisa.net> <m13ZXGV-000BCgC@megalith.rattlesnake.com>"
+ 2408 24 "nnmaildir mails:12"
+ ((To . "bob@rattlesnake.com")
+ (Cc . "jbailey@nisa.net, emacs-devel@gnu.org, cvs-hackers@gnu.org"))]
+ [13 "Re: [Emacs-devel] Emacs move"
+ "\"Robert J. Chassell\" <bob@rattlesnake.com>"
+ "Thu, 14 Sep 2000 17:50:01 -0400 (EDT)"
+ "<m13ZgtN-000BD3C@megalith.rattlesnake.com>"
+ "<20000913175943.A26093@sparky.nisa.net> <m13ZXGV-000BCgC@megalith.rattlesnake.com> <200009141949.VAA05998@gerd.segv.de>"
+ 1968 23 "nnmaildir mails:13"
+ ((To . "gerd@gnu.org")
+ (Cc . "bob@rattlesnake.com, jbailey@nisa.net, emacs-devel@gnu.org, cvs-hackers@gnu.org"))]
+ [14 "Re: [Emacs-devel] Emacs move" "Richard Stallman <rms@gnu.org>"
+ "Fri, 15 Sep 2000 16:28:12 -0600 (MDT)"
+ "<200009152228.QAA20526@wijiji.santafe.edu>"
+ "<20000913175943.A26093@sparky.nisa.net> <m13ZXGV-000BCgC@megalith.rattlesnake.com>"
+ 1288 2 "nnmaildir mails:14"
+ ((To . "jbailey@nisa.net, emacs-devel@gnu.org, cvs-hackers@gnu.org"))]
+ [15 "[Emacs-devel] Emacs move" "Jeff Bailey <jbailey@nisa.net>"
+ "Wed, 13 Sep 2000 17:59:43 -0700"
+ "<20000913175943.A26093@sparky.nisa.net>" ""
+ 1661 26 "nnmaildir mails:15"
+ ((To . "emacs-devel@gnu.org")
+ (Cc . "cvs-hackers@gnu.org"))]
+ [16 "Re: [Emacs-devel] Emacs move" "Jeff Bailey <jbailey@nisa.net>"
+ "Fri, 15 Sep 2000 22:00:12 -0700"
+ "<20000915220012.A3923@sparky.nisa.net>"
+ "<20000913175943.A26093@sparky.nisa.net> <m13ZXGV-000BCgC@megalith.rattlesnake.com> <200009141949.VAA05998@gerd.segv.de> <m13ZgtN-000BD3C@megalith.rattlesnake.com>"
+ 2857 51 "nnmaildir mails:16"
+ ((To . "bob@rattlesnake.com, gerd@gnu.org")
+ (Cc . "jbailey@nisa.net, emacs-devel@gnu.org, cvs-hackers@gnu.org"))])
+ "A pile of headers with potential interdependencies.")
+
+(ert-deftest gnus-headers-make-dependency-table ()
+ (let ((table (gnus-make-hashtable 20))
+ (data (copy-sequence gnus-headers-test-data))
+ ret)
+ (dolist (h data)
+ ;; `gnus-dependencies-add-header' returns nil if it fails to add
+ ;; the header.
+ (should (gnus-dependencies-add-header h table nil)))
+ ;; Pick a value to test.
+ (setq ret (gethash "<m13ZXGV-000BCgC@megalith.rattlesnake.com>"
+ table))
+ ;; The message has three children.
+ (should (= 3 (length (cdr ret))))
+ ;; The first of those children has one child.
+ (should (= 1 (length (cdr (nth 1 ret)))))))
+
+(ert-deftest gnus-headers-loop-dependencies ()
+ "Intentionally create a reference loop."
+ (let ((table (gnus-make-hashtable 20))
+ (data (copy-sequence gnus-headers-test-data))
+ (parent-id "<200009141724.SAA26807@djlvig.dl.ac.uk>")
+ (child-id "<87em2nyog0.fsf@galois.collab.net>")
+ parent)
+ (dolist (h data)
+ (gnus-dependencies-add-header h table nil))
+
+ (setq parent (gethash parent-id table))
+
+ ;; Put the parent header in the child references of one of its own
+ ;; children. `gnus-thread-loop-p' only checks if there's a loop
+ ;; between parent and immediate child, not parent and random
+ ;; descendant. At least, near as I can tell that's the case.
+
+ (push (list (car parent)) (cdr (gethash child-id table)))
+
+ (let ((gnus-newsgroup-dependencies table))
+ (should
+ (= 1 ; 1 indicates an infloop.
+ (gnus-thread-loop-p (car parent) (cadr parent)))))))
+
+(provide 'gnus-test-headers)
+;;; gnus-test-headers.el ends here
diff --git a/test/lisp/gnus/gnus-tests.el b/test/lisp/gnus/gnus-tests.el
index c2a41d717cf..4c5a6a8191c 100644
--- a/test/lisp/gnus/gnus-tests.el
+++ b/test/lisp/gnus/gnus-tests.el
@@ -1,6 +1,6 @@
-;;; gnus-tests.el --- Wrapper for the Gnus tests
+;;; gnus-tests.el --- Wrapper for the Gnus tests -*- lexical-binding:t -*-
-;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2022 Free Software Foundation, Inc.
;; Author: Teodor Zlatanov <tzz@lifelogs.com>
@@ -26,8 +26,6 @@
;;; Code:
;; registry.el is required by gnus-registry.el but this way we're explicit.
-(eval-when-compile (require 'cl))
-
(require 'registry)
(require 'gnus-registry)
diff --git a/test/lisp/gnus/gnus-util-tests.el b/test/lisp/gnus/gnus-util-tests.el
new file mode 100644
index 00000000000..464567061f6
--- /dev/null
+++ b/test/lisp/gnus/gnus-util-tests.el
@@ -0,0 +1,135 @@
+;;; gnus-util-tests.el --- Selectived tests only. -*- lexical-binding:t -*-
+;; Copyright (C) 2015-2022 Free Software Foundation, Inc.
+
+;; Author: Jens Lechtenbörger <jens.lechtenboerger@fsfe.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:
+
+;;; Code:
+
+(require 'ert)
+(require 'gnus-util)
+
+(ert-deftest gnus-string> ()
+ ;; Failure paths
+ (should-error (gnus-string> "" 1)
+ :type 'wrong-type-argument)
+ (should-error (gnus-string> "")
+ :type 'wrong-number-of-arguments)
+
+ ;; String tests
+ (should (gnus-string> "def" "abc"))
+ (should (gnus-string> 'def 'abc))
+ (should (gnus-string> "abc" "DEF"))
+ (should (gnus-string> "abc" 'DEF))
+ (should (gnus-string> "αβγ" "abc"))
+ (should (gnus-string> "×בג" "αβγ"))
+ (should (gnus-string> nil ""))
+ (should (gnus-string> "abc" ""))
+ (should (gnus-string> "abc" "ab"))
+ (should-not (gnus-string> "abc" "abc"))
+ (should-not (gnus-string> "abc" "def"))
+ (should-not (gnus-string> "DEF" "abc"))
+ (should-not (gnus-string> 'DEF "abc"))
+ (should-not (gnus-string> "123" "abc"))
+ (should-not (gnus-string> "" "")))
+
+(ert-deftest gnus-string< ()
+ ;; Failure paths
+ (should-error (gnus-string< "" 1)
+ :type 'wrong-type-argument)
+ (should-error (gnus-string< "")
+ :type 'wrong-number-of-arguments)
+
+ ;; String tests
+ (setq case-fold-search nil)
+ (should (gnus-string< "abc" "def"))
+ (should (gnus-string< 'abc 'def))
+ (should (gnus-string< "DEF" "abc"))
+ (should (gnus-string< "DEF" 'abc))
+ (should (gnus-string< "abc" "αβγ"))
+ (should (gnus-string< "αβγ" "×בג"))
+ (should (gnus-string< "" nil))
+ (should (gnus-string< "" "abc"))
+ (should (gnus-string< "ab" "abc"))
+ (should-not (gnus-string< "abc" "abc"))
+ (should-not (gnus-string< "def" "abc"))
+ (should-not (gnus-string< "abc" "DEF"))
+ (should-not (gnus-string< "abc" 'DEF))
+ (should-not (gnus-string< "abc" "123"))
+ (should-not (gnus-string< "" ""))
+
+ ;; gnus-string< checks case-fold-search
+ (setq case-fold-search t)
+ (should (gnus-string< "abc" "DEF"))
+ (should (gnus-string< "abc" 'GHI))
+ (should (gnus-string< 'abc "DEF"))
+ (should (gnus-string< 'GHI 'JKL))
+ (should (gnus-string< "abc" "ΑΒΓ"))
+ (should-not (gnus-string< "ABC" "abc"))
+ (should-not (gnus-string< "def" "ABC")))
+
+(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)))))
+
+;;; gnus-util-tests.el ends here
diff --git a/test/lisp/gnus/message-tests.el b/test/lisp/gnus/message-tests.el
index f905ba3e263..a724428ecb4 100644
--- a/test/lisp/gnus/message-tests.el
+++ b/test/lisp/gnus/message-tests.el
@@ -1,6 +1,6 @@
-;;; message-mode-tests.el --- Tests for message-mode -*- lexical-binding: t; -*-
+;;; message-tests.el --- Tests for message-mode -*- lexical-binding: t; -*-
-;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2022 Free Software Foundation, Inc.
;; Author: João Távora <joaotavora@gmail.com>
@@ -29,6 +29,8 @@
(require 'ert)
(require 'ert-x)
+(require 'cl-lib)
+
(ert-deftest message-mode-propertize ()
(with-temp-buffer
(unwind-protect
@@ -45,14 +47,10 @@
(setq-local parse-sexp-lookup-properties t)
(backward-sexp)
(should (string= "here's an opener "
- (buffer-substring-no-properties
- (line-beginning-position)
- (point))))
+ (buffer-substring-no-properties (pos-bol) (point))))
(forward-sexp)
(should (string= "and here's a closer )"
- (buffer-substring-no-properties
- (line-beginning-position)
- (point)))))
+ (buffer-substring-no-properties (pos-bol) (point)))))
(set-buffer-modified-p nil))))
@@ -97,7 +95,90 @@
(should (string= stripped-was
(message-strip-subject-trailing-was with-was)))))))
+(ert-deftest message-all-recipients ()
+ (ert-with-test-buffer (:name "message")
+ (insert "To: Person 1 <p1@p1.org>, Person 2 <p2@p2.org>\n")
+ (insert "Cc: Person 3 <p3@p3.org>, Person 4 <p4@p4.org>\n")
+ (insert "Bcc: Person 5 <p5@p5.org>, Person 6 <p6@p6.org>\n")
+ (should (equal (message-all-recipients)
+ '(("Person 1" "p1@p1.org")
+ ("Person 2" "p2@p2.org")
+ ("Person 3" "p3@p3.org")
+ ("Person 4" "p4@p4.org")
+ ("Person 5" "p5@p5.org")
+ ("Person 6" "p6@p6.org"))))))
+
+(ert-deftest message-all-epg-keys-available-p ()
+ (skip-unless (epg-check-configuration (epg-find-configuration 'OpenPGP)))
+ (let ((person1 '("Person 1" "p1@p1.org"))
+ (person2 '("Person 2" "p2@p2.org"))
+ (person3 '("Person 3" "p3@p3.org"))
+ (recipients nil)
+ (keyring '("p1@p1.org" "p2@p2.org")))
+ (cl-letf (((symbol-function 'epg-list-keys)
+ (lambda (_ email) (cl-find email keyring :test #'string=)))
+ ((symbol-function 'message-all-recipients)
+ (lambda () recipients)))
+
+ (setq recipients (list))
+ (should (message-all-epg-keys-available-p))
+
+ (setq recipients (list person1))
+ (should (message-all-epg-keys-available-p))
+
+ (setq recipients (list person1 person2))
+ (should (message-all-epg-keys-available-p))
+
+ (setq recipients (list person3))
+ (should-not (message-all-epg-keys-available-p))
+
+ (setq recipients (list person1 person3))
+ (should-not (message-all-epg-keys-available-p))
+
+ (setq recipients (list person3 person1))
+ (should-not (message-all-epg-keys-available-p))
+
+ (setq recipients (list person1 person2 person3))
+ (should-not (message-all-epg-keys-available-p)))))
+
+(ert-deftest message-alter-repeat-address ()
+ (should (equal (message--alter-repeat-address
+ "Lars Ingebrigtsen <larsi@gnus.org>")
+ "Lars Ingebrigtsen <larsi@gnus.org>"))
+
+ (should (equal (message--alter-repeat-address
+ "\"larsi@gnus.org\" <larsi@gnus.org>")
+ "larsi@gnus.org")))
+
+(ert-deftest message-replace-header ()
+ (with-temp-buffer
+ (save-excursion
+ (insert "From: dang@gnus.org
+To: user1,
+ user2
+Cc: user3,
+ user4
+--text follows this line--
+Hello.
+"))
+ (save-excursion
+ (message-replace-header "From" "ding@gnus.org")
+ (should (cl-search "ding" (message-field-value "From"))))
+ (save-excursion
+ (message-replace-header "From" "dong@gnus.org" "To")
+ (should (cl-search "dong" (message-field-value "From")))
+ (should (re-search-forward "From:"))
+ (should-error (re-search-forward "To:"))
+ (should (re-search-forward "Cc:")))
+ (save-excursion
+ (message-replace-header "From" "dang@gnus.org" (split-string "To Cc"))
+ (should (cl-search "dang" (message-field-value "From")))
+ (should (re-search-forward "From:"))
+ (should-error (re-search-forward "To:"))
+ ;; That this isn't so is probably a bug from 1997.
+ ;; (should-error (re-search-forward "Cc:"))
+ )))
(provide 'message-mode-tests)
-;;; message-mode-tests.el ends here
+;;; message-tests.el ends here
diff --git a/test/lisp/gnus/mm-decode-resources/8bit-multipart.bin b/test/lisp/gnus/mm-decode-resources/8bit-multipart.bin
new file mode 100644
index 00000000000..0b193a27234
--- /dev/null
+++ b/test/lisp/gnus/mm-decode-resources/8bit-multipart.bin
@@ -0,0 +1,20 @@
+From: example <example@example.org>
+To: example <example@example.org>
+Content-Type: multipart/alternative; boundary="===============2877195075946974246=="
+Date: Thu, 29 Oct 2020 14:47:55 +0100
+MIME-Version: 1.0
+Subject: test
+
+--===============2877195075946974246==
+Content-Type: text/plain; charset="utf-8"
+Content-Transfer-Encoding: 8bit
+
+ääää
+
+--===============2877195075946974246==
+Content-Type: text/html; charset="utf-8"
+Content-Transfer-Encoding: 8bit
+
+<!doctype html><html><head><meta http-equiv="content-type" content="text/html; charset=UTF-8"></head><body>ääää</body></html>
+
+--===============2877195075946974246==--
diff --git a/test/lisp/gnus/mm-decode-resources/win1252-multipart.bin b/test/lisp/gnus/mm-decode-resources/win1252-multipart.bin
new file mode 100644
index 00000000000..d3c5026dcce
--- /dev/null
+++ b/test/lisp/gnus/mm-decode-resources/win1252-multipart.bin
@@ -0,0 +1,44 @@
+To: example <example@example.org>
+From: example <example@example.org>
+Date: Tue, 5 Jan 2021 10:30:34 +0100
+MIME-Version: 1.0
+Content-Type: multipart/mixed; boundary="------------FB569A4368539497CC91D1DC"
+Content-Language: fr
+Subject: test
+
+--------------FB569A4368539497CC91D1DC
+Content-Type: multipart/alternative;
+ boundary="------------61C81A7DC7592E4C6F856A85"
+
+
+--------------61C81A7DC7592E4C6F856A85
+Content-Type: text/plain; charset=windows-1252; format=flowed
+Content-Transfer-Encoding: 8bit
+
+déjŕ raté
+
+--------------61C81A7DC7592E4C6F856A85
+Content-Type: text/html; charset=windows-1252
+Content-Transfer-Encoding: 8bit
+
+<html>
+ <head>
+ <meta http-equiv="content-type" content="text/html; charset=windows-1252">
+ </head>
+ <body>
+ déjŕ raté
+ </body>
+</html>
+
+--------------61C81A7DC7592E4C6F856A85--
+
+--------------FB569A4368539497CC91D1DC
+Content-Type: text/plain; charset="us-ascii"
+MIME-Version: 1.0
+Content-Transfer-Encoding: 7bit
+Content-Disposition: inline
+
+mailing list signature
+
+--------------FB569A4368539497CC91D1DC--
+
diff --git a/test/lisp/gnus/mm-decode-tests.el b/test/lisp/gnus/mm-decode-tests.el
new file mode 100644
index 00000000000..5f39a32b0de
--- /dev/null
+++ b/test/lisp/gnus/mm-decode-tests.el
@@ -0,0 +1,102 @@
+;;; mm-decode-tests.el --- -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(require 'mm-decode)
+
+(ert-deftest test-mm-dissect-buffer ()
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally (ert-resource-file "8bit-multipart.bin"))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n"))
+ (let ((handle (mm-dissect-buffer)))
+ (should (equal (mm-handle-media-type handle) "multipart/alternative"))
+ ;; Skip multipart type.
+ (pop handle)
+ (let ((part (pop handle)))
+ (should (equal (mm-handle-media-type part) "text/plain"))
+ (should (eq (mm-handle-encoding part) '8bit))
+ (with-current-buffer (mm-handle-buffer part)
+ (should (equal (decode-coding-string
+ (buffer-string)
+ (intern (mail-content-type-get (mm-handle-type part)
+ 'charset)))
+ "ääää\n"))))
+ (let ((part (pop handle)))
+ (should (equal (mm-handle-media-type part) "text/html"))
+ (should (eq (mm-handle-encoding part) '8bit))
+ (with-current-buffer (mm-handle-buffer part)
+ (should (equal (decode-coding-string
+ (buffer-string)
+ (intern (mail-content-type-get (mm-handle-type part)
+ 'charset)))
+ "<!doctype html><html><head><meta http-equiv=\"content-type\" content=\"text/html; charset=UTF-8\"></head><body>ääää</body></html>\n")))))))
+
+(ert-deftest test-mm-with-part-unibyte ()
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally (ert-resource-file "8bit-multipart.bin"))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n"))
+ (let ((handle (mm-dissect-buffer)))
+ (pop handle)
+ (let ((part (pop handle)))
+ (should (equal (decode-coding-string
+ (mm-with-part part
+ (buffer-string))
+ (intern (mail-content-type-get (mm-handle-type part)
+ 'charset)))
+ "ääää\n"))))))
+
+(ert-deftest test-mm-dissect-buffer-win1252 ()
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally (ert-resource-file "win1252-multipart.bin"))
+ (let ((handle (mm-dissect-buffer)))
+ (should (equal (mm-handle-media-type handle) "multipart/mixed"))
+ ;; Skip multipart type.
+ (pop handle)
+ (setq handle (car handle))
+ (pop handle)
+ (let ((part (pop handle)))
+ (should (equal (mm-handle-media-type part) "text/plain"))
+ (should (eq (mm-handle-encoding part) '8bit))
+ (with-current-buffer (mm-handle-buffer part)
+ (should (equal (decode-coding-string
+ (buffer-string)
+ (intern (mail-content-type-get (mm-handle-type part)
+ 'charset)))
+ "déjà raté\n"))))
+ (let ((part (pop handle)))
+ (should (equal (mm-handle-media-type part) "text/html"))
+ (should (eq (mm-handle-encoding part) '8bit))
+ (with-current-buffer (mm-handle-buffer part)
+ (should (equal (decode-coding-string
+ (buffer-string)
+ (intern (mail-content-type-get (mm-handle-type part)
+ 'charset)))
+ "<html>\n <head>\n <meta http-equiv=\"content-type\" content=\"text/html; charset=windows-1252\">\n </head>\n <body>\n déjà raté\n </body>\n</html>\n")))))))
+
+;;; mm-decode-tests.el ends here
diff --git a/test/lisp/gnus/mml-sec-resources/.gpg-v21-migrated b/test/lisp/gnus/mml-sec-resources/.gpg-v21-migrated
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/.gpg-v21-migrated
diff --git a/test/lisp/gnus/mml-sec-resources/gpg-agent.conf b/test/lisp/gnus/mml-sec-resources/gpg-agent.conf
new file mode 100644
index 00000000000..20192990caf
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/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/lisp/gnus/mml-sec-resources/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key
new file mode 100644
index 00000000000..58fd0b5edbc
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key
new file mode 100644
index 00000000000..62f4ab25a69
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key
new file mode 100644
index 00000000000..2a8ce135fb2
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key
new file mode 100644
index 00000000000..9f8de71c5e2
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key
new file mode 100644
index 00000000000..6e4a4e548fd
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key
new file mode 100644
index 00000000000..cff58edaa89
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key
new file mode 100644
index 00000000000..14af8662f79
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key
new file mode 100644
index 00000000000..207a7237d3a
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key
new file mode 100644
index 00000000000..85ca78da04d
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key
new file mode 100644
index 00000000000..79f3cd2b841
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key
new file mode 100644
index 00000000000..776ddf7e9e2
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key
new file mode 100644
index 00000000000..2b464f0ccbe
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key
new file mode 100644
index 00000000000..28a07668b21
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key
new file mode 100644
index 00000000000..137659693bd
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key
new file mode 100644
index 00000000000..c99824ccd43
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key
new file mode 100644
index 00000000000..49c2dc58bd8
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key
new file mode 100644
index 00000000000..ca128408952
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key
new file mode 100644
index 00000000000..3f14b40927a
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key
new file mode 100644
index 00000000000..06adc06c427
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key
new file mode 100644
index 00000000000..cf9a60d233b
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key
new file mode 100644
index 00000000000..0ed35172fe0
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key
new file mode 100644
index 00000000000..090059d9e81
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key
new file mode 100644
index 00000000000..9061f675121
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key
new file mode 100644
index 00000000000..89f6013100d
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key
new file mode 100644
index 00000000000..41dac37574e
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key
new file mode 100644
index 00000000000..5df7b4a5953
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key
new file mode 100644
index 00000000000..03daf80975b
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/pubring.gpg b/test/lisp/gnus/mml-sec-resources/pubring.gpg
new file mode 100644
index 00000000000..6bd169963df
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/pubring.gpg
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/pubring.kbx b/test/lisp/gnus/mml-sec-resources/pubring.kbx
new file mode 100644
index 00000000000..399a0414fd2
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/pubring.kbx
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/secring.gpg b/test/lisp/gnus/mml-sec-resources/secring.gpg
new file mode 100644
index 00000000000..b323c072c04
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/secring.gpg
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/trustdb.gpg b/test/lisp/gnus/mml-sec-resources/trustdb.gpg
new file mode 100644
index 00000000000..09ebd8db114
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/trustdb.gpg
Binary files differ
diff --git a/test/lisp/gnus/mml-sec-resources/trustlist.txt b/test/lisp/gnus/mml-sec-resources/trustlist.txt
new file mode 100644
index 00000000000..f886572d283
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-resources/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..f308a617645
--- /dev/null
+++ b/test/lisp/gnus/mml-sec-tests.el
@@ -0,0 +1,900 @@
+;;; mml-sec-tests.el --- Tests mml-sec.el, see README-mml-secure.txt. -*- lexical-binding:t -*-
+
+;; Copyright (C) 2015, 2020-2022 Free Software Foundation, Inc.
+
+;; Author: Jens Lechtenbörger <jens.lechtenboerger@fsfe.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:
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+
+(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 test-conf ()
+ ;; Emacs doesn't have support for finding the name of the PGP agent
+ ;; on MacOS, so disable the checks.
+ (and (not (eq system-type 'darwin))
+ (ignore-errors (epg-find-configuration 'OpenPGP))))
+
+(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)))
+
+(defvar mml-smime-use)
+
+(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 (ert-resource-directory))
+ (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)
+ (unwind-protect
+ (funcall body)
+ (mml-sec-test--kill-gpg-agent)))
+ (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."
+ (skip-unless (test-conf))
+ (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."
+ (skip-unless (test-conf))
+ (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."
+ (skip-unless (test-conf))
+ (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."
+ (skip-unless (test-conf))
+ (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."
+ (skip-unless (test-conf))
+ (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."
+ (skip-unless (test-conf))
+ (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."
+ (skip-unless (test-conf))
+ (skip-unless (ignore-errors (epg-find-configuration 'CMS)))
+ (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))
+
+(defvar mml-smime-cache-passphrase)
+(defvar mml2015-cache-passphrase)
+(defvar mml1991-cache-passphrase)
+
+(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."
+ (skip-unless (test-conf))
+ (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."
+ (skip-unless (test-conf))
+ (skip-unless (ignore-errors (epg-find-configuration 'CMS)))
+ ;; 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."
+ ;; Random failures with "wrong-type-argument stringp nil".
+ ;; Seems unlikely to be specific to hydra.nixos.org...
+ :tags (if (getenv "EMACS_HYDRA_CI") '(:unstable))
+ (skip-unless (test-conf))
+ (skip-unless (ignore-errors (epg-find-configuration 'CMS)))
+ ;; 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."
+ (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"))
+ (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-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 ()
+ (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)
+ )))))
+
+(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."
+ :tags '(:unstable)
+ (skip-unless (test-conf))
+ (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)))))))
+
+(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."
+ :tags '(:unstable)
+ (skip-unless (test-conf))
+ (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)
+ (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."
+ :tags '(:unstable)
+ (skip-unless (test-conf))
+ (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."
+ :tags '(:unstable)
+ (skip-unless (test-conf))
+ (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."
+ (skip-unless (test-conf))
+ (skip-unless (ignore-errors (epg-find-configuration 'CMS)))
+ (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-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 ()
+ (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."
+ (skip-unless (test-conf))
+ (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 invocations 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 (test-conf))
+ (skip-unless (string< (cdr (assq 'version (epg-find-configuration 'OpenPGP)))
+ "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
+ (skip-unless (test-conf))
+ (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-find-configuration 'OpenPGP))))
+ ;; 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)))
+
+(defun mml-sec-test--kill-gpg-agent ()
+ (dolist (pid (list-system-processes))
+ (let ((atts (process-attributes pid)))
+ (when (and (equal (cdr (assq 'user atts)) (user-login-name))
+ (or (equal (cdr (assq 'comm atts)) "gpg-agent")
+ (equal (cdr (assq 'comm atts)) "scdaemon"))
+ (string-match
+ (concat "homedir.*"
+ (regexp-quote (directory-file-name
+ (ert-resource-directory))))
+ (cdr (assq 'args atts))))
+ (call-process "kill" nil nil nil (format "%d" pid))))))
+
+;;; mml-sec-tests.el ends here
diff --git a/test/lisp/gnus/nnrss-tests.el b/test/lisp/gnus/nnrss-tests.el
new file mode 100644
index 00000000000..47d208cb160
--- /dev/null
+++ b/test/lisp/gnus/nnrss-tests.el
@@ -0,0 +1,45 @@
+;;; nnrss-tests.el --- tests for gnus/nnrss.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2019-2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'nnrss)
+
+(ert-deftest test-nnrss-normalize ()
+ (should (equal (nnrss-normalize-date "2004-09-17T05:09:49.001+00:00")
+ "Fri, 17 Sep 2004 05:09:49 +0000")))
+
+(defconst test-nnrss-xml
+ '((rss
+ ((version . "2.0")
+ (xmlns:dc . "http://purl.org/dc/elements/1.1/"))
+ (channel
+ ((xmlns:content . "http://purl.org/rss/1.0/modules/content/"))))))
+
+(ert-deftest test-nnrss-namespace-top ()
+ (should (equal (nnrss-get-namespace-prefix
+ test-nnrss-xml "http://purl.org/dc/elements/1.1/")
+ "dc:")))
+(ert-deftest test-nnrss-namespace-inner ()
+ (should (equal (nnrss-get-namespace-prefix
+ test-nnrss-xml "http://purl.org/rss/1.0/modules/content/")
+ "content:")))
+
+;;; nnrss-tests.el ends here