diff options
Diffstat (limited to 'test/lisp/mail')
| -rw-r--r-- | test/lisp/mail/footnote-tests.el | 2 | ||||
| -rw-r--r-- | test/lisp/mail/ietf-drums-date-tests.el | 172 | ||||
| -rw-r--r-- | test/lisp/mail/ietf-drums-tests.el | 178 | ||||
| -rw-r--r-- | test/lisp/mail/mail-extr-tests.el | 41 | ||||
| -rw-r--r-- | test/lisp/mail/mail-utils-tests.el | 3 | ||||
| -rw-r--r-- | test/lisp/mail/undigest-tests.el | 359 | ||||
| -rw-r--r-- | test/lisp/mail/uudecode-tests.el | 26 |
7 files changed, 763 insertions, 18 deletions
diff --git a/test/lisp/mail/footnote-tests.el b/test/lisp/mail/footnote-tests.el index e33b59bc416..f3a35e3dfc6 100644 --- a/test/lisp/mail/footnote-tests.el +++ b/test/lisp/mail/footnote-tests.el @@ -40,7 +40,7 @@ (footnote-back-to-message) (should (equal (buffer-substring (point-min) (point)) "hello[1]")) - (should (equal (buffer-substring (point-min) (line-end-position)) + (should (equal (buffer-substring (point-min) (pos-eol)) "hello[1][2] world")))) (provide 'footnote-tests) diff --git a/test/lisp/mail/ietf-drums-date-tests.el b/test/lisp/mail/ietf-drums-date-tests.el new file mode 100644 index 00000000000..781d72d3529 --- /dev/null +++ b/test/lisp/mail/ietf-drums-date-tests.el @@ -0,0 +1,172 @@ +;;; ietf-drums-date-tests.el --- Test suite for ietf-drums-date.el -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Bob Rogers <rogers@rgrjr.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'ietf-drums) +(require 'ietf-drums-date) + +(ert-deftest ietf-drums-date-tests () + "Test basic ietf-drums-parse-date-string functionality." + + ;; Test tokenization. + (should (equal (ietf-drums-date--tokenize-string " ") '())) + (should (equal (ietf-drums-date--tokenize-string " a b") '("a" "b"))) + (should (equal (ietf-drums-date--tokenize-string "a bbc dde") + '("a" "bbc" "dde"))) + (should (equal (ietf-drums-date--tokenize-string " , a 27 b,, c 14:32 ") + '("a" 27 "b" "c" "14:32"))) + ;; Some folding whitespace tests. + (should (equal (ietf-drums-date--tokenize-string " a b (end) c" t) + '("a" "b"))) + (should (equal (ietf-drums-date--tokenize-string "(quux)a (foo (bar)) b(baz)") + '("a" "b"))) + (should (equal (ietf-drums-date--tokenize-string "a b\\cde") + ;; Strictly incorrect, but strictly unnecessary syntax. + '("a" "b\\cde"))) + (should (equal (ietf-drums-date--tokenize-string "a b\\ de") + '("a" "b\\ de"))) + (should (equal (ietf-drums-date--tokenize-string "a \\de \\(f") + '("a" "\\de" "\\(f"))) + + ;; Start with some compatible RFC822 dates. + (dolist (case '(("Mon, 22 Feb 2016 19:35:42 +0100" + (42 35 19 22 2 2016 1 -1 3600)) + ("22 Feb 2016 19:35:42 +0100" + (42 35 19 22 2 2016 nil -1 3600)) + ("Mon, 22 February 2016 19:35:42 +0100" + (42 35 19 22 2 2016 1 -1 3600)) + ("Mon, 22 feb 2016 19:35:42 +0100" + (42 35 19 22 2 2016 1 -1 3600)) + ("Monday, 22 february 2016 19:35:42 +0100" + (42 35 19 22 2 2016 1 -1 3600)) + ("Monday, 22 february 2016 19:35:42 PST" + (42 35 19 22 2 2016 1 nil -28800)) + ("Friday, 21 Sep 2018 13:47:58 PDT" + (58 47 13 21 9 2018 5 t -25200)) + ("Friday, 21 Sep 2018 13:47:58 EDT" + (58 47 13 21 9 2018 5 t -14400)) + ("Mon, 22 Feb 2016 19:35:42" + (42 35 19 22 2 2016 1 -1 nil)) + ("Friday, 21 Sep 2018 13:47:58" + (58 47 13 21 9 2018 5 -1 nil)))) + (let* ((input (car case)) + (parsed (cadr case))) + ;; The input should parse the same without RFC822. + (should (equal (ietf-drums-parse-date-string input) parsed)) + (should (equal (ietf-drums-parse-date-string input nil t) parsed)) + ;; Check the encoded date (the official output, though the + ;; decoded-time is easier to debug). + (should (time-equal-p (ietf-drums-parse-date input) + (encode-time parsed))))) + + ;; Two-digit years are not allowed by the "modern" format. + (should (equal (ietf-drums-parse-date-string "22 Feb 16 19:35:42 +0100") + '(42 35 19 22 2 2016 nil -1 3600))) + (should (equal (ietf-drums-parse-date-string "22 Feb 16 19:35:42 +0100" nil t) + '(nil nil nil 22 2 nil nil -1 nil))) + (should (equal (should-error (ietf-drums-parse-date-string + "22 Feb 16 19:35:42 +0100" t t)) + '(date-parse-error "Four-digit years are required" 16))) + (should (equal (ietf-drums-parse-date-string "22 Feb 96 19:35:42 +0100") + '(42 35 19 22 2 1996 nil -1 3600))) + (should (equal (ietf-drums-parse-date-string "22 Feb 96 19:35:42 +0100" nil t) + '(nil nil nil 22 2 nil nil -1 nil))) + (should (equal (should-error (ietf-drums-parse-date-string + "22 Feb 96 19:35:42 +0100" t t)) + '(date-parse-error "Four-digit years are required" 96))) + + ;; Try some dates with comments. + (should (equal (ietf-drums-parse-date-string + "22 Feb (today) 16 19:35:42 +0100") + '(42 35 19 22 2 2016 nil -1 3600))) + (should (equal (ietf-drums-parse-date-string + "22 Feb (today) 16 19:35:42 +0100" nil t) + '(nil nil nil 22 2 nil nil -1 nil))) + (should (equal (should-error (ietf-drums-parse-date-string + "22 Feb (today) 16 19:35:42 +0100" t t)) + '(date-parse-error "Expected a year" nil))) + (should (equal (ietf-drums-parse-date-string + "22 Feb 96 (long ago) 19:35:42 +0100") + '(42 35 19 22 2 1996 nil -1 3600))) + (should (equal (ietf-drums-parse-date-string + "Friday, 21 Sep(comment \\) with \\( parens)18 19:35:42") + '(42 35 19 21 9 2018 5 -1 nil))) + (should (equal (ietf-drums-parse-date-string + "Friday, 21 Sep 18 19:35:42 (unterminated comment") + '(42 35 19 21 9 2018 5 -1 nil))) + + ;; Test some RFC822 error cases + (dolist (test '(("33 1 2022" ("Slot out of range" day 33 1 31)) + ("0 1 2022" ("Slot out of range" day 0 1 31)) + ("1 1 2020 2021" ("Expected an alphabetic month" 1)) + ("1 Jan 2020 2021" ("Expected a time" 2021)) + ("1 Jan 2020 20:21 2000" ("Expected a timezone" 2000)) + ("1 Jan 2020 20:21 +0200 33" ("Extra token(s)" 33)))) + (should (equal (should-error (ietf-drums-parse-date-string (car test) t)) + (cons 'date-parse-error (cadr test))))) + + (dolist (test '(("22 Feb 196" nil ;; bad year + ("Four-digit years are required" 196)) + ("22 Feb 16 19:35:24" t ;; two-digit year + ("Four-digit years are required" 16)) + ("22 Feb 96 19:35:42" t ;; two-digit year + ("Four-digit years are required" 96)) + ("2 Feb 2021 1996" nil + ("Expected a time" 1996)) + ("22 Fub 1996" nil + ("Expected an alphabetic month" "fub")) + ("1 Jan 2020 30" nil + ("Expected a time" 30)) + ("1 Jan 2020 16:47 15:15" nil + ("Expected a timezone" "15:15")) + ("1 Jan 2020 16:47 +0800 -0800" t + ("Extra token(s)" "-0800")) + ;; Range tests + ("32 Dec 2021" nil + ("Slot out of range" day 32 1 31)) + ("0 Dec 2021" nil + ("Slot out of range" day 0 1 31)) + ("3 13 2021" nil + ("Expected an alphabetic month" 13)) + ("3 Dec 0000" t + ("Four-digit years are required" 0)) + ("3 Dec 20021" nil + ("Slot out of range" year 20021 1 9999)) + ("1 Jan 2020 24:21:14" nil + ("Slot out of range" hour "24:21:14" 0 23)) + ("1 Jan 2020 14:60:21" nil + ("Slot out of range" minute "14:60:21" 0 59)) + ("1 Jan 2020 14:21:61" nil + ("Slot out of range" second "14:21:61" 0 60)))) + (should (equal (should-error + (ietf-drums-parse-date-string (car test) t (cadr test))) + (cons 'date-parse-error (caddr test))))) + (should (equal (ietf-drums-parse-date-string + "1 Jan 2020 14:21:60") ;; a leap second! + '(60 21 14 1 1 2020 nil -1 nil)))) + +(provide 'ietf-drums-date-tests) + +;;; ietf-drums-date-tests.el ends here diff --git a/test/lisp/mail/ietf-drums-tests.el b/test/lisp/mail/ietf-drums-tests.el new file mode 100644 index 00000000000..b13937bf736 --- /dev/null +++ b/test/lisp/mail/ietf-drums-tests.el @@ -0,0 +1,178 @@ +;;; ietf-drums-tests.el --- Test suite for ietf-drums.el -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Bob Rogers <rogers@rgrjr.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'ietf-drums) + +(ert-deftest ietf-drums-tests () + "Test ietf-drums functionality." + + ;; ietf-drums-remove-comments + (should (equal (ietf-drums-remove-comments "random string") "random string")) + (should (equal (ietf-drums-remove-comments "random \"non comment\" string") + "random \"non comment\" string")) + (should (equal (ietf-drums-remove-comments "random (comment) string") + "random string")) + (should (equal (ietf-drums-remove-comments "random (comment) (string)") + "random ")) + (should (equal (ietf-drums-remove-comments + "random (first) (second (and)) (third) not fourth") + "random not fourth")) + ;; Test some unterminated comments. + (should (equal (ietf-drums-remove-comments "test an (unterminated comment") + "test an ")) + (should (equal (ietf-drums-remove-comments "test an \"unterminated quote") + ;; returns the string unchanged (and doesn't barf). + "test an \"unterminated quote")) + (should (equal (ietf-drums-remove-comments + ;; note that double-quote is not special. + "test (unterminated comments with \"quoted (\" )stuff") + "test ")) + + ;; ietf-drums-remove-whitespace + (should (equal (ietf-drums-remove-whitespace "random string") + "randomstring")) + (should (equal (ietf-drums-remove-whitespace "random (comment) string") + "random(comment)string")) + (should (equal (ietf-drums-remove-whitespace "random \"non comment\" string") + "random\"non comment\"string")) + (should (equal (ietf-drums-remove-whitespace "random (comment)\r\n(string)") + "random(comment)(string)")) + (should (equal (ietf-drums-remove-whitespace + "random (first) (second (and)) (third) not fourth") + "random(first)(second (and))(third)notfourth")) + ;; Test some unterminated comments and quotes. + (should (equal (ietf-drums-remove-whitespace + "random (first) (second (and)) (third unterminated") + "random(first)(second (and))(third unterminated")) + (should (equal (ietf-drums-remove-whitespace "random \"non terminated string") + "random\"non terminated string")) + + ;; ietf-drums-strip + (should (equal (ietf-drums-strip "random string") "randomstring")) + (should (equal (ietf-drums-strip "random \"non comment\" string") + "random\"non comment\"string")) + (should (equal (ietf-drums-strip "random (comment) string") + "randomstring")) + (should (equal (ietf-drums-strip "random (comment) (string)") + "random")) + (should (equal (ietf-drums-strip + "random (first) (second (and)) (third) not fourth") + "randomnotfourth")) + + ;; ietf-drums-strip-cte + (should (equal (ietf-drums-strip-cte "random \"non comment\" string") + ;; [the " " is still in there because it was quoted + ;; through the "strip". -- rgr, 5-Feb-22.] + "randomnon commentstring")) + (should (equal (ietf-drums-strip-cte "ran(d)do<m@>[s;t:r],,in=g") + "randomstring")) + + ;; ietf-drums-quote-string + (should (equal (ietf-drums-quote-string "Bob") "Bob")) + (should (equal (ietf-drums-quote-string "Foo Bar") "\"Foo Bar\"")) + + ;; ietf-drums-get-comment + (should (equal (ietf-drums-get-comment "random string") nil)) + (should (equal (ietf-drums-get-comment "random (comment) string") "comment")) + (should (equal (ietf-drums-get-comment "random \"non comment\" string") nil)) + (should (equal (ietf-drums-get-comment "\"still (non) comment\" string") + nil)) + (should (equal (ietf-drums-get-comment "random (comment)\r\nstring") + "comment")) + (should (equal (ietf-drums-get-comment "random (comment) (string)") "string")) + (should (equal (ietf-drums-get-comment + "random (first) (second (and)) (third) not fourth") + "third")) + + ;; ietf-drums-make-address + (should (equal (ietf-drums-make-address "Bob Rogers" "rogers@rgrjr.com") + "\"Bob Rogers\" <rogers@rgrjr.com>")) + (should (equal (ietf-drums-make-address nil "rogers@rgrjr.com") + "rogers@rgrjr.com")) + + ;; ietf-drums-parse-address + (should (equal (ietf-drums-parse-address "foo@example.com") + '("foo@example.com"))) + (should (equal (ietf-drums-parse-address "<foo@example.com>") + '("foo@example.com"))) + (should (equal (ietf-drums-parse-address "'foo' <foo@example.com>") + '("foo@example.com" . "'foo'"))) + (should (equal (ietf-drums-parse-address "foo <foo@example.com>") + '("foo@example.com" . "foo"))) + (should (equal (ietf-drums-parse-address "foo <foo@example.com> bar") + ;; [contrary to RFC2822, which wants the display-name + ;; before the address. -- rgr, 5-Feb-22.] + '("foo@example.com" . "foo bar"))) + (should (equal (ietf-drums-parse-address " <foo@example.com> foo ") + ;; [ditto. -- rgr, 5-Feb-22.] + '("foo@example.com" . "foo"))) + (should (equal (ietf-drums-parse-address "foo@example.com (foo)") + '("foo@example.com" . "foo"))) + (should (equal (ietf-drums-parse-address "Bar Baz <barbaz@example.com>") + '("barbaz@example.com" . "Bar Baz"))) + (should (equal (ietf-drums-parse-address "barbaz@example.com (Bar Baz)") + '("barbaz@example.com" . "Bar Baz"))) + (should (equal (ietf-drums-parse-address + "Bar Baz (ignored) <barbaz@example.com>") + '("barbaz@example.com" . "Bar Baz"))) + (should (equal (ietf-drums-parse-address "<barbaz@example.com> Bar Baz") + '("barbaz@example.com" . "Bar Baz"))) + (should (equal (ietf-drums-parse-address + "(Bar Baz not ignored) barbaz@example.com") + ;; [not strictly RFC2822, which expects the name + ;; comment after the address. -- rgr, 5-Feb-22.] + '("barbaz@example.com" . "Bar Baz not ignored"))) + (should (equal (ietf-drums-parse-address + "(ignored) <barbaz@example.com> (Bar Baz not ignored)") + '("barbaz@example.com" . "Bar Baz not ignored"))) + (should (equal (ietf-drums-parse-address + "(ignored) barbaz@example.com (Bar Baz not ignored)") + '("barbaz@example.com" . "Bar Baz not ignored"))) + ;; Test for RFC2047 token decoding. + (should (equal (ietf-drums-parse-address + "=?utf-8?B?0JfQtNGA0LDMgdCy0YHRgtCy0YPQudGC0LUh?= <foo@goo.ru>" + t) + '("foo@goo.ru" . "Здра́вствуйте!"))) + + ;; ietf-drums-parse-addresses + ;; Note that it's not worth getting too elaborate here, as the heavy + ;; lifting is all done by ietf-drums-parse-address. + (should (equal (ietf-drums-parse-addresses "foo@example.com") + '(("foo@example.com")))) + (should (equal (ietf-drums-parse-addresses + "foo@example.com, bar@example.com") + '(("foo@example.com") ("bar@example.com")))) + (should (equal (ietf-drums-parse-addresses + "foo@example.com, quux, bar@example.com") + '(("foo@example.com") ("bar@example.com")))) + (should (equal (ietf-drums-parse-addresses + "foo@example.com, Quux Dude <quux@noop.org>, bar@example.com") + '(("foo@example.com") ("quux@noop.org" . "Quux Dude") + ("bar@example.com"))))) + +(provide 'ietf-drums-tests) + +;;; ietf-drums-tests.el ends here diff --git a/test/lisp/mail/mail-extr-tests.el b/test/lisp/mail/mail-extr-tests.el new file mode 100644 index 00000000000..a8f0c605cb0 --- /dev/null +++ b/test/lisp/mail/mail-extr-tests.el @@ -0,0 +1,41 @@ +;;; mail-extr-tests.el --- Tests for mail-extr.el -*- lexical-binding: t -*- + +;; Copyright (C) 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 'mail-extr) + +(defconst mail-extract-test-cases + '(("foo@example.org" . (nil "foo@example.org")) + ("J. Random Hacker <foo@example.org>" . ("J. Random Hacker" "foo@example.org")) + ("\"J. Random Hacker\" <foo@example.org>" . ("J. Random Hacker" "foo@example.org")) + ("Ååå Äää <foo@example.org>" . ("Ååå Äää" "foo@example.org")))) + +(ert-deftest mail-extract-address-components () + (dolist (test mail-extract-test-cases) + (should (equal (mail-extract-address-components (car test)) (cdr test))))) + +(ert-deftest what-domain () + (should (equal (what-domain "cu") "CU: Cuba"))) + +(provide 'mail-extr-tests) +;;; mail-extr-tests.el ends here diff --git a/test/lisp/mail/mail-utils-tests.el b/test/lisp/mail/mail-utils-tests.el index 4b2d2d7e005..29a9b9eeb96 100644 --- a/test/lisp/mail/mail-utils-tests.el +++ b/test/lisp/mail/mail-utils-tests.el @@ -85,7 +85,8 @@ "foo@example.org\\|bar@example.org\\|baz@example.org"))) (ert-deftest mail-utils-tests-mail-rfc822-time-zone () - (should (stringp (mail-rfc822-time-zone (current-time))))) + (with-suppressed-warnings ((obsolete mail-rfc822-time-zone)) + (should (stringp (mail-rfc822-time-zone (current-time)))))) (ert-deftest mail-utils-test-mail-rfc822-date/contains-year () (should (string-match (rx " 20" digit digit " ") diff --git a/test/lisp/mail/undigest-tests.el b/test/lisp/mail/undigest-tests.el new file mode 100644 index 00000000000..d52c9f9c5ab --- /dev/null +++ b/test/lisp/mail/undigest-tests.el @@ -0,0 +1,359 @@ +;;; undigest-tests.el --- Tests for undigest.el -*- lexical-binding:t -*- + +;; Copyright (C) 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 'ert-x) +(require 'rmail) +(require 'undigest) + +;;; Variables: +;; Some digests for testing. +(defvar rmail-rfc934-digest "From tester Fri Jan 24 00:00:00 2022 +From: Digester <digester@digester.com> +To: Undigester <undigester@undigester.com> +Date: ddd, dd mmm yy hh:mm:ss zzz +Subject: Testing you + +Testing the undigester. + +------- Message sep + +From: NN1 <nn1@nn1.com> +To: Digester <digester@digester.com> +Date: ddd, dd mmm yy hh:mm:ss zzz +Subject: Message one + +This is message one. + +------- Message sep + +From: NN2 <nn2@nn2.com> +To: Digester <digester@digester.com> +Date: ddd, dd mmm yy hh:mm:ss zzz +Subject: Message two + +This is message two. +" + + "RFC 934 digest.") + +(defvar rmail-rfc1153-digest-strict "From tester Fri Jan 24 00:00:00 2022 +Date: ddd, dd mmm yy hh:mm:ss zzz +From: Digester <digester@digester.com> +To: Undigester <undigester@undigester.com> +Date: ddd, dd mmm yy hh:mm:ss zzz +Subject: Testing you + +Some mailing list information. + +Today's Topics: + + 1. Message One Subject (Sender) + 2. Message Two Subject (Sender) + +---------------------------------------------------------------------- + +Date: ddd, dd mmm yy hh:mm:ss zzz +From: NN1 <nn1@nn1.com> +Subject: Message One Subject + +This is message one. + +------------------------------ + +Date: ddd, dd mmm yy hh:mm:ss zzz +From: NN2 <nn2@nn2.com> +Subject: Message Two Subject + +This is message two. + +------------------------------ + +End of Digest. +************************************ +" + "RFC 1153 strict style digest.") + +(defvar rmail-rfc1153-digest-less-strict "From tester Fri Jan 24 00:00:00 2022 +From: Digester <digester@digester.com> +To: Undigester <undigester@undigester.com> +Date: ddd, dd mmm yy hh:mm:ss zzz +Subject: Testing you + +Some mailing list information. + +Today's Topics: + + 1. Message One Subject (Sender) + 2. Message Two Subject (Sender) + +---------------------------------------------------------------------- + +Date: ddd, dd mmm yy hh:mm:ss zzz +From: NN1 <nn1@nn1.com> +Subject: Message One Subject + +This is message one. + +------------------------------ + +Date: ddd, dd mmm yy hh:mm:ss zzz +From: NN2 <nn2@nn2.com> +Subject: Message Two Subject + +This is message two. + +------------------------------ + +Subject: Digest Footer + +End of Sbcl-help Digest, Vol 158, Issue 4 +***************************************** +" + "RFC 1153 style digest, with a Subject header.") + +(defvar rmail-rfc1153-digest-sloppy "From tester Fri Jan 24 00:00:00 2022 +From: Digester <digester@digester.com> +To: Undigester <undigester@undigester.com> +Date: ddd, dd mmm yy hh:mm:ss zzz +Subject: Testing you + +Some mailing list information. + +Today's Topics: + + 1. Message One Subject (Sender) + 2. Message Two Subject (Sender) + +---------------------------------------------------------------------- + +Date: ddd, dd mmm yy hh:mm:ss zzz +From: NN1 <nn1@nn1.com> +Subject: Message One Subject + +This is message one. + +------------------------------ + +Date: ddd, dd mmm yy hh:mm:ss zzz +From: NN2 <nn2@nn2.com> +Subject: Message Two Subject + +This is message two. + +------------------------------ + +Subject: Digest Footer + +______________________________________________ +Some blurb. + +End of Digest. +************************************ +" + "RFC 1153 sloppy style digest.") + +(defvar rmail-rfc1521-mime-digest "From tester Fri Jan 24 00:00:00 2022 +From: Digester <digester@digester.com> +To: Undigester <undigester@undigester.com> +Date: ddd, dd mmm yy hh:mm:ss zzz +Subject: Test digest +MIME-Version: 1.0 +Content-Type: multipart/digest; boundary=\"----- =_aaaaaaaaaa0\" + +------- =_aaaaaaaaaa0 +Content-Type: message/rfc822 + +From: NN1 <nn1@nn1.com> +To: Digester <digester@digester.com> +Date: ddd, dd mmm yy hh:mm:ss zzz +Subject: Message one + +Message one. + +------- =_aaaaaaaaaa0 + +From: NN2 <nn2@nn2.com> +To: Digester <digester@digester.com> +Date: ddd, dd mmm yy hh:mm:ss zzz +Subject: Message two + +Message two. + +------- =_aaaaaaaaaa0 +" + "RFC 1521 style MIME digest.") + +(defvar rmail-multipart-mixed-digest + "From tester Fri Jan 24 00:00:00 2022 +From: Digester <digester@digester.com> +To: Undigester <undigester@undigester.com> +Date: ddd, dd mmm yy hh:mm:ss zzz +Subject: Test digest +Content-Type: multipart/mixed; boundary=\"===============2529375068597856000==\" +MIME-Version: 1.0 + +--===============2529375068597856000== +Content-Type: text/plain; +MIME-Version: 1.0 +Content-Description: Today's Topics + +Some message. + +--===============2529375068597856000== +Content-Type: multipart/digest; boundary=\"===============6060050777038710134==\" +MIME-Version: 1.0 + +--===============6060050777038710134== +Content-Type: message/rfc822 +MIME-Version: 1.0 + +From: NN1 <nn1@nn1.com> +To: Digester <digester@digester.com> +Date: ddd, dd mmm yy hh:mm:ss zzz +Subject: Message one + +Message one. + +--===============6060050777038710134== +Content-Type: message/rfc822 +MIME-Version: 1.0 + +From: NN2 <nn2@nn2.com> +To: Digester <digester@digester.com> +Date: ddd, dd mmm yy hh:mm:ss zzz +Subject: Message two + +Message two. + +--===============6060050777038710134==-- + +--===============2529375068597856000== +Content-Type: text/plain; +MIME-Version: 1.0 +Content-Description: Digest Footer + +The footer. + +--===============2529375068597856000==--" + "RFC 1521 digest inside a multipart/mixed message.") + +;;; Utils: +(defun rmail-message-content (message) + "Return the content of the message numbered MESSAGE." + (rmail-show-message message) + (let ((beg (rmail-msgbeg rmail-current-message)) + (end (rmail-msgend rmail-current-message))) + (with-current-buffer rmail-view-buffer + (save-excursion + (goto-char beg) + (search-forward "\n\n" end nil) + (buffer-substring-no-properties (match-end 0) end))))) + +;;; Tests: +(ert-deftest rmail-undigest-test-rfc934-digest () + "Test that we can undigest a RFC 934 digest." + (ert-with-temp-file file + :text rmail-rfc934-digest + ;; Rmail reads mbox files literally, so we must make sure the + ;; temporary mbox file has Unix-style EOLs. + :coding 'undecided-unix + (rmail file) + (undigestify-rmail-message) + (should (= rmail-total-messages 4)) + (should (string= (rmail-message-content 2) "Testing the undigester.\n\n")) + (should (string= (rmail-message-content 3) "This is message one.\n\n")) + (should (string= (rmail-message-content 4) "This is message two.\n")))) + +(ert-deftest rmail-undigest-test-rfc1153-digest-strict () + "Test that we can undigest a strict RFC 1153 digest." + :expected-result :failed + (ert-with-temp-file file + :text rmail-rfc1153-digest-strict + ;; Rmail reads mbox files literally, so we must make sure the + ;; temporary mbox file has Unix-style EOLs. + :coding 'undecided-unix + (rmail file) + (should + (ignore-errors + ;; This throws an error, because the Trailer is not recognized + ;; as a valid RFC 822 (or later) message. + (undigestify-rmail-message) + (should (string= (rmail-message-content 2) "Testing the undigester.\n\n")) + (should (string= (rmail-message-content 3) "This is message one.\n\n")) + (should (string= (rmail-message-content 4) "This is message two.\n")) + t)))) + +(ert-deftest rmail-undigest-test-rfc1153-less-strict-digest () + "Test that we can undigest a RFC 1153 with a Subject header in its footer." + (ert-with-temp-file file + :text rmail-rfc1153-digest-less-strict + ;; Rmail reads mbox files literally, so we must make sure the + ;; temporary mbox file has Unix-style EOLs. + :coding 'undecided-unix + (rmail file) + (undigestify-rmail-message) + (should (= rmail-total-messages 5)) + (should (string= (rmail-message-content 3) "This is message one.\n\n")) + (should (string= (rmail-message-content 4) "This is message two.\n\n")))) + +(ert-deftest rmail-undigest-test-rfc1153-sloppy-digest () + "Test that we can undigest a sloppy RFC 1153 digest." + (ert-with-temp-file file + :text rmail-rfc1153-digest-sloppy + ;; Rmail reads mbox files literally, so we must make sure the + ;; temporary mbox file has Unix-style EOLs. + :coding 'undecided-unix + (rmail file) + (undigestify-rmail-message) + (should (= rmail-total-messages 5)) + (should (string= (rmail-message-content 3) "This is message one.\n\n")) + (should (string= (rmail-message-content 4) "This is message two.\n\n")))) + +;; This fails because `rmail-digest-parse-mime' combines the preamble with the +;; first message of the digest. And then, it doesn't get rid of the last +;; separator. +(ert-deftest rmail-undigest-test-rfc1521-mime-digest () + "Test that we can undigest a RFC 1521 MIME digest." + :expected-result :failed + (ert-with-temp-file file + :text rmail-rfc1521-mime-digest + ;; Rmail reads mbox files literally, so we must make sure the + ;; temporary mbox file has Unix-style EOLs. + :coding 'undecided-unix + (rmail file) + (undigestify-rmail-message) + (should (= rmail-total-messages 3)) + (should (string= (rmail-message-content 2) "Message one.\n\n")) + (should (string= (rmail-message-content 3) "Message two.\n\n")))) + +(ert-deftest rmail-undigest-test-multipart-mixed-digest () + "Test that we can undigest a digest inside a multipart/mixed digest." + (ert-with-temp-file file + :text rmail-multipart-mixed-digest + ;; Rmail reads mbox files literally, so we must make sure the + ;; temporary mbox file has Unix-style EOLs. + :coding 'undecided-unix + (rmail file) + (undigestify-rmail-message) + (should (= rmail-total-messages 4)) + (should (string= (rmail-message-content 2) "Message one.\n\n")) + (should (string= (rmail-message-content 3) "Message two.\n\n")))) diff --git a/test/lisp/mail/uudecode-tests.el b/test/lisp/mail/uudecode-tests.el index a58a4d9e6f6..7946e99dbc9 100644 --- a/test/lisp/mail/uudecode-tests.el +++ b/test/lisp/mail/uudecode-tests.el @@ -50,14 +50,11 @@ Same as `uudecode-tests-encoded-str' but plain text.") (should (equal (buffer-string) uudecode-tests-decoded-str))) ;; Write to file (with-temp-buffer - (let ((tmpfile (make-temp-file "uudecode-tests-"))) - (unwind-protect - (progn - (insert uudecode-tests-encoded-str) - (uudecode-decode-region-internal (point-min) (point-max) tmpfile) - (should (equal (uudecode-tests-read-file tmpfile) - uudecode-tests-decoded-str))) - (delete-file tmpfile))))) + (ert-with-temp-file tmpfile + (insert uudecode-tests-encoded-str) + (uudecode-decode-region-internal (point-min) (point-max) tmpfile) + (should (equal (uudecode-tests-read-file tmpfile) + uudecode-tests-decoded-str))))) (ert-deftest uudecode-tests-decode-region-external () ;; Write to buffer @@ -68,14 +65,11 @@ Same as `uudecode-tests-encoded-str' but plain text.") (should (equal (buffer-string) uudecode-tests-decoded-str))) ;; Write to file (with-temp-buffer - (let ((tmpfile (make-temp-file "uudecode-tests-"))) - (unwind-protect - (progn - (insert uudecode-tests-encoded-str) - (uudecode-decode-region-external (point-min) (point-max) tmpfile) - (should (equal (uudecode-tests-read-file tmpfile) - uudecode-tests-decoded-str))) - (delete-file tmpfile)))))) + (ert-with-temp-file tmpfile + (insert uudecode-tests-encoded-str) + (uudecode-decode-region-external (point-min) (point-max) tmpfile) + (should (equal (uudecode-tests-read-file tmpfile) + uudecode-tests-decoded-str)))))) (provide 'uudecode-tests) ;;; uudecode-tests.el ends here |