tests: Compare email headers disregarding order.

* tests/email.scm (alist=?, body=?, email=?, mime-entity=?): New
functions.
(test-alist=, test-email=): New macros.
("parse email headers", "tolerate invalid charset", "tolerate decoding
errors in body"): Use test-alist=.
("RFC5322 A.1.1. A message from one person to another with simple
addressing", "parse email headers", "RFC2046 5.1.1. Common syntax",
"decode MIME entity without headers", "multipart email with a 8 bit
encoding and non UTF-8 charset part", "decode utf-8 characters in
headers", "tolerate non-ascii non-utf-8 characters in headers",
"tolerate decoding errors in body"): Use test-email=.

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)