summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/email.scm54
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)