diff options
| -rw-r--r-- | tests/email.scm | 54 |
1 files changed, 43 insertions, 11 deletions
diff --git a/tests/email.scm b/tests/email.scm index 48056b7..fb7e618 100644 --- a/tests/email.scm +++ b/tests/email.scm @@ -53,12 +53,44 @@ (use-modules (email email) (ice-9 binary-ports) (ice-9 iconv) + (srfi srfi-1) (srfi srfi-19) (srfi srfi-64)) +(define (alist=? headers1 headers2) + (lset= equal? headers1 headers2)) + +(define (body=? body1 body2) + (cond + ((and (list? body1) (list? body2)) + (every mime-entity=? body1 body2)) + ((and (string? body1) (string? body2)) + (string=? body1 body2)) + (else #f))) + +(define (email=? email1 email2) + (and (alist=? (email-headers email1) + (email-headers email2)) + (body=? (email-body email1) + (email-body email2)))) + +(define (mime-entity=? entity1 entity2) + (and (alist=? (mime-entity-headers entity1) + (mime-entity-headers entity2)) + (body=? (mime-entity-body entity1) + (mime-entity-body entity2)))) + +(define-syntax-rule (test-alist= test-name actual expected) + (test-assert test-name + (alist=? actual expected))) + +(define-syntax-rule (test-email= test-name actual expected) + (test-assert test-name + (email=? actual expected))) + (test-begin "email") -(test-equal "parse email headers" +(test-alist= "parse email headers" (parse-email-headers "Received: by foo.bar.com id ZZZ55555; Thu, 31 May 2001 16:38:04 -1000 (HST) Received: from ooo.ooo.com (ooo.ooo.com [1.2.3.4]) @@ -102,7 +134,7 @@ Content-Length: 4349 (x-mailer . "FooMail 4.0 4.03 (SMT460B92F)") (content-length . "4349"))) -(test-equal "RFC5322 A.1.1. A message from one person to another with simple addressing" +(test-email= "RFC5322 A.1.1. A message from one person to another with simple addressing" (parse-email "From: John Doe <jdoe@machine.example> Sender: Michael Jones <mjones@machine.example> @@ -130,7 +162,7 @@ So, \"Hello\".") "This is a message just to say hello. So, \"Hello\".")) -(test-equal "RFC5322 A.1.2. Different types of mailboxes" +(test-email= "RFC5322 A.1.2. Different types of mailboxes" (parse-email "From: \"Joe Q. Public\" <john.q.public@example.com> To: Mary Smith <mary@x.test>, jdoe@example.org, Who? <one@y.test> @@ -158,7 +190,7 @@ Hi everyone.") (message-id . "5678.21-Nov-1997@example.com")) "Hi everyone.")) -(test-equal "RFC2046 5.1.1. Common syntax" +(test-email= "RFC2046 5.1.1. Common syntax" (parse-email (string->bytevector "From: Nathaniel Borenstein <nsb@bellcore.com> @@ -228,7 +260,7 @@ It does NOT end with a linebreak. "This is implicitly typed plain US-ASCII text. It does NOT end with a linebreak.")) -(test-equal "email with 8 bit encoding and non UTF-8 charset" +(test-email= "email with 8 bit encoding and non UTF-8 charset" (call-with-input-file "tests/email-with-8bit-encoding-and-non-utf8-charset" (compose parse-email get-bytevector-all)) (make-email @@ -245,7 +277,7 @@ It does NOT end with a linebreak.")) (content-transfer-encoding . 8bit)) "Hello Foo’.")) -(test-equal "multipart email with a 8 bit encoding and non UTF-8 charset part" +(test-email= "multipart email with a 8 bit encoding and non UTF-8 charset part" (call-with-input-file "tests/multipart-email-with-a-8bit-encoding-and-non-utf8-charset-part" (compose parse-email get-bytevector-all)) (make-email @@ -282,7 +314,7 @@ foo foo " "utf-8"))) -(test-equal "decode utf-8 characters in headers" +(test-email= "decode utf-8 characters in headers" (parse-email (string->bytevector "From: foo@bar.org (Foo Bãr) @@ -297,7 +329,7 @@ body" "utf-8")) (address . "foo@bar.org")))) "body")) -(test-equal "tolerate non-ascii non-utf-8 characters in headers" +(test-email= "tolerate non-ascii non-utf-8 characters in headers" (parse-email (string->bytevector "From: foo@bar.org (Foo Bãr) @@ -312,7 +344,7 @@ body" "iso-8859-1")) (address . "foo@bar.org")))) "body")) -(test-equal "tolerate invalid charset" +(test-alist= "tolerate invalid charset" (parse-email-headers "Content-Type: text/plain; charset=foo ") @@ -322,7 +354,7 @@ body" "iso-8859-1")) (charset . "utf-8") (charset . "foo")))) -(test-equal "tolerate decoding errors in body" +(test-email= "tolerate decoding errors in body" (parse-email "Content-Transfer-Encoding: quoted-printable @@ -364,7 +396,7 @@ copyright =A9") "=?iso-8859-1?Q?=A1Hola,_se=F1or!?= =?UTF-8?Q?B=C3=A3r?=") "¡Hola, señor! Bãr") -(test-equal "decode MIME encoded words in Subject header" +(test-alist= "decode MIME encoded words in Subject header" (parse-email-headers "Subject: Foo =?UTF-8?Q?B=C3=A3r?= ") `((content-type (type . text) |