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

Home > neil > html-writing.plt > package version 2.0
test-html-writing.rkt
#lang racket/base
;; For legal info, see file "info.rkt".

;; TODO: Adapt the test suite from "html-template".

(require (planet neil/overeasy:2)
         "html-writing.rkt"
         "planet-neil-xexp.rkt")

(test-section 'html-writing

  (test 'element-with-no-content
        (xexp->html '(p))
        "<p></p>")

  (test 'element-with-single-string-content
        (xexp->html '(p "CONTENT"))
        "<p>CONTENT</p>")

  (test 'element-with-multiple-string-content
        (xexp->html '(p "A" "B" "C"))
        "<p>ABC</p>")

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

  (test 'always-empty-element
        (xexp->html '(br))
        "<br>")

  (test 'always-empty-element-with-ignored-content
        ;; TODO: !!! We should do what they say and write the content.
        (xexp->html '(br "CONTENT"))
        "<br>")

  (test (xexp->html '(hr (@ (clear "all"))))
        "<hr clear=\"all\">")

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

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

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

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

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

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

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

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

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

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

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

  (test '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 'character-entity-reference
        (xexp->html '(& copy))
        "&copy;")

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

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

  (test (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\">"))

  ;; TODO: Convert the splice test cases to SXML nested lists.

  ;; (test '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 '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>")

  (define (%ff1 c o)
    (if (integer? o)
        (let ((name
               (string-append (symbol->string c)
                              "-"
                              (number->string o))))
          (case c
            ((attributes) (list (string->symbol name) o))
            (else name)))
        (error-html-writing-foreign-filter o c)))

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

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

  ;; (test '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 '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 'content-foreign-filter
        (parameterize ((current-html-writing-foreign-filter %ff1))
          (let ((os (open-output-string)))
            (write-html '(p 1) os)
            (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

  )