PLaneT Package Repository : Home > neil > html-writing.plt

Home > neil > html-writing.plt > package version 1.0
test-html-writing.rkt
#lang racket/base
;; See file "html-writing.rkt" for legal info.
;; $Id: test-html-writing.rkt,v 1.15 2011/03/04 07:52:42 neilpair Exp $

(require (planet neil/testeez:1:2)
         (planet neil/xexp:1:0)
         "html-writing.rkt")

(testeez
 "test-html-writing.rkt"

 (test/equal "element with no content"
             (xexp->html '(p))            "<p></p>")
 (test/equal "element with single string content"
             (xexp->html '(p "CONTENT"))  "<p>CONTENT</p>")
 (test/equal "element with multiple string content"
             (xexp->html '(p "A" "B" "C"))  "<p>ABC</p>")
 (test/equal "element with string and char content"
             (xexp->html '(p "A" #\B "C"))  "<p>A&#66;C</p>")

 (test/equal "always-empty element"
             (xexp->html '(br))           "<br />")
 (test/equal "always-empty element with ignored content (TODO: !!! ERROR THIS?)"
             (xexp->html '(br "CONTENT")) "<br />")
 (test/equal ""
             (xexp->html '(hr (@ (clear "all"))))
             "<hr clear=\"all\" />")

 (test/equal "boolean attribute with no value given"
             (xexp->html `(hr (@ (noshade))))
             "<hr noshade=\"noshade\" />")

 (test/equal "boolen attribute with standard value given"
             (xexp->html `(hr (@ (noshade "noshade"))))
             "<hr noshade=\"noshade\" />")

 (test/equal "boolean attribute with nonstandard value given"
             (xexp->html `(hr (@ (noshade "foo"))))
             "<hr noshade=\"foo\" />")

 (test/equal "baseline attribute"
             (xexp->html `(hr (@ (aaa "bbbccc"))))
             "<hr aaa=\"bbbccc\" />")

 (test/equal "attribute value with single-quote"
             (xexp->html `(hr (@ (aaa "bbb'ccc"))))
             "<hr aaa=\"bbb'ccc\" />")

 (test/equal "attribute value with double-quote"
             (xexp->html `(hr (@ (aaa "bbb\"ccc"))))
             "<hr aaa=\"bbb&#34;ccc\" />")

 (test/equal "attribute value with double-quote and single-quote"
             (xexp->html `(hr (@ (aaa "bbb\"ccc'ddd"))))
             "<hr aaa=\"bbb&#34;ccc'ddd\" />")

 (test/equal "attribute value with two strings"
             (xexp->html `(hr (@ (y "a" "b"))))
             "<hr y=\"ab\" />")

 (test/equal "attribute value with three strings"
             (xexp->html `(hr (@ (y "a" "b" "c"))))
             "<hr y=\"abc\" />")

 (test/equal "attribute value with printable char"
             (xexp->html `(hr (@ (y "a" #\b "c"))))
             "<hr y=\"abc\" />")

 (test/equal "attribute value with entity reference"
             (xexp->html `(hr (@ (y "a" (& copy) "c"))))
             "<hr y=\"a&copy;c\" />")

 (test/equal "attribute value with special characters"
             (xexp->html `(hr (@ (y "a\"b<c>d&e'f"))))
             "<hr y=\"a&#34;b&#60;c&#62;d&#38;e'f\" />")

 (test/equal "character entity reference"
             (xexp->html '(& copy))
             "&copy;")

 (test/equal "character entity reference with mixed-case"
             (xexp->html '(& rArr))
             "&rArr;")

 (test/equal ""
             (xexp->html
              `(*PI* xml "version=\"1.0\" encoding=\"UTF-8\""))
             "<?xml version=\"1.0\" encoding=\"UTF-8\"?>")

 (test/equal ""
             (xexp->html
              `(*DECL*
                DOCTYPE
                html
                PUBLIC
                "-//W3C//DTD XHTML 1.0 Strict//EN"
                "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"))
             (string-append
              "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\""
              " \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"))

 (test/equal "attributes with splice"
             (xexp->html '(e (@ (a1 "69")
                                (*splice* (p "42")
                                          (q "42"))
                                (a4 "7"))))
             "<e a1=\"69\" p=\"42\" q=\"42\" a2=\"7\"></e>")

 (test/equal "content with splice"
             (xexp->html '(html (p "a") (*splice* (p "b") (p "c"))  (p "d")))
             "<html><p \"a\"><p \"b\"><p \"c\"><p \"d\"></html>")

 (test-define "foreign filter #1"
              ff1
              (lambda (c o)
                (if (integer? o)
                    (let ((name
                           (string-append (symbol->string c)
                                          "-"
                                          (number->string o))))
                      (case c
                        ((attribute) (list (string->symbol name) o))
                        (else name)))
                    (error-html-writing-foreign-filter o c))))

 (test/equal "attribute value foreign filter"
             (let ((os (open-output-string)))
               (write-html '(td (@ (colspan 1))) os ff1)
               (let ((str (get-output-string os)))
                 (close-output-port os)
                 str))
             "<td colspan=\"attribute-value-1\"></td>")

 (test/equal "attribute foreign filter"
             (let ((os (open-output-string)))
               (write-html '(x (@ 1)) os ff1)
               (let ((str (get-output-string os)))
                 (close-output-port os)
                 str))
             "<x attribute-1=\"attribute-value-1\"></x>")

 (test/equal "attribute foreign filter with splice"
             (parameterize ((current-html-writing-foreign-filter
                             (lambda (c o)
                               (case c
                                 ((attribute)
                                  (let ((v (number->string o)))
                                    `(*splice* (p ,v) (q ,v))))
                                 (else
                                  (error-html-writing-foreign-filter o c))))))
               (xexp->html '(e (@ (a1 "69") 42))))
             "<e a1=\"69\" p=\"42\" q=\"42\"></e>")

 (test/equal "content foreign-filter with splice"
             (parameterize ((current-html-writing-foreign-filter
                             (lambda (c o)
                               (if (and (eq? c 'content) (number? o))
                                   `(*splice* (p "b") (p "c"))
                                   (error-html-writing-foreign-filter o c)))))
               (xexp->html '(html (p "a") 42 (p "d"))))
             "<html><p \"a\"><p \"b\"><p \"c\"><p \"d\"></html>")

  ;; TODO: !!! Test different attribute value foreign filter results, including
 ;; ones that return lists, strings, chars, entities, and other foreign
 ;; objects.

 (test/equal "content foreign filter"
             (let ((os (open-output-string)))
               (write-html '(p 1) os ff1)
               (let ((str (get-output-string os)))
                 (close-output-port os)
                 str))
             "<p>content-1</p>")


 ;; TODO: Write more test cases for HTML encoding.

 ;; TODO: Write test cases for foreign-filter of HTML writing.

 ;; TODO: Write test cases for attribute values that aren't simple strings.

 ;; TODO: Document this.
 ;;
 ;; (define html-1 "<myelem myattr=\"&\">")
 ;; (define xexp   (html->xexp html-1))
 ;; xexp
 ;; (define html-2 (xexp->html xexp))
 ;; html-2

 )