From 7fe9a04b6d57debafc881c8ced56dafc951d77cc Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Thu, 10 Dec 2015 12:28:07 -0800
Subject: [PATCH] add `check-txexprs-equal?`

---
 main.rkt                 | 25 ++++++++++++++++++++-----
 scribblings/txexpr.scrbl | 31 +++++++++++++++++++++++++++++--
 2 files changed, 49 insertions(+), 7 deletions(-)

diff --git a/main.rkt b/main.rkt
index dd6576c..1dd028a 100644
--- a/main.rkt
+++ b/main.rkt
@@ -50,7 +50,7 @@
 
 (define+provide+safe (txexpr-attrs? x)
   predicate/c
- (and (list? x) (andmap txexpr-attr? x)))
+  (and (list? x) (andmap txexpr-attr? x)))
 
 
 (define+provide+safe (txexpr-element? x)
@@ -60,7 +60,7 @@
 
 (define+provide+safe (txexpr-elements? x)
   predicate/c
- (and (list? x) (andmap txexpr-element? x)))
+  (and (list? x) (andmap txexpr-element? x)))
 
 
 (define+provide+safe (txexpr-attr-key? x)
@@ -245,8 +245,8 @@
 (define+provide+safe (attr-join tx key value)
   (txexpr? can-be-txexpr-attr-key? can-be-txexpr-attr-value? . -> . txexpr?)
   (define starting-values (string-split (if (attrs-have-key? tx key)
-                             (attr-ref tx key)
-                             "")))
+                                            (attr-ref tx key)
+                                            "")))
   (attr-set tx key (string-join `(,@starting-values ,value) " ")))      
 
 
@@ -340,4 +340,19 @@
                      [(txexpr? x) (if (member (get-tag x) '(script style))
                                       (make-txexpr (get-tag x) (get-attrs x) (map ->cdata (get-elements x)))
                                       (make-txexpr (get-tag x) (get-attrs x) (map loop (get-elements x))))]
-                     [else x]))))
\ No newline at end of file
+                     [else x]))))
+
+(require rackunit)
+(provide+safe check-txexprs-equal?)
+(define-simple-check (check-txexprs-equal? tx1 tx2)
+  ;; txexprs are deemed equal if they differ only in the ordering of attributes.
+  ;; therefore, to check them, 1) sort their attributes, 2) straight list comparison.
+  (define symbol<? (λ syms (apply string<? (map symbol->string syms))))
+  (define (sort-attrs x)
+    (if (txexpr? x)
+        (let-values ([(tag attr elements) (txexpr->values x)])
+          (make-txexpr tag (sort attr #:key car symbol<?) (map sort-attrs elements)))
+        x))
+  (equal? (sort-attrs tx1) (sort-attrs tx2)))
+
+(check-txexprs-equal? '(p ((b "foo")(a "bar")) (span ((d "foo")(c "bar")))) '(p ((a "bar")(b "foo")) (span ((c "bar")(d "foo")))))
diff --git a/scribblings/txexpr.scrbl b/scribblings/txexpr.scrbl
index b4ccdb2..fe081db 100644
--- a/scribblings/txexpr.scrbl
+++ b/scribblings/txexpr.scrbl
@@ -3,10 +3,10 @@
 @; for documentation purposes, use the xexpr? from xml.
 @; the one in txexpr is just to patch over an issue with
 @; `valid-char?` in Racket 6.
-@(require scribble/eval (for-label racket txexpr xml))
+@(require scribble/eval (for-label racket txexpr xml rackunit))
 
 @(define my-eval (make-base-eval))
-@(my-eval `(require txexpr xml))
+@(my-eval `(require txexpr xml rackunit))
 
 
 @title{txexpr: Tagged X-expressions}
@@ -516,6 +516,33 @@ Ordinarily, the result of the split operation is to remove the elements that mat
 ]
 
 
+@defproc[
+(check-txexprs-equal?
+[tx1 txexpr?]
+[tx2 txexpr?])
+void?]
+Designed to be used with @racketmodname[rackunit]. Check whether @racket[_tx1] and @racket[_tx2] are @racket[equal?] except for ordering of attributes (which ordinarily has no semantic significance). Return @racket[void] if so, otherwise raise a check failure.
+
+@examples[#:eval my-eval
+(define tx1 '(div ((attr-a "foo")(attr-z "bar"))))
+(define tx2 '(div ((attr-z "bar")(attr-a "foo"))))
+(parameterize ([current-check-handler (λ _ (display "not "))])
+  (display "txexprs are ")
+  (check-txexprs-equal? tx1 tx2)
+  (displayln "equal"))
+]
+
+If ordering of attributes is relevant to your test, then just use @racket[check-equal?] as usual.
+
+@examples[#:eval my-eval
+(define tx1 '(div ((attr-a "foo")(attr-z "bar"))))
+(define tx2 '(div ((attr-z "bar")(attr-a "foo"))))
+(parameterize ([current-check-handler (λ _ (display "not "))])
+  (display "txexprs are ")
+  (check-equal? tx1 tx2)
+  (displayln "equal"))
+]
+
 
 @section{License & source code}