test-html-template.rkt
#lang racket/base
;; For legal info, see file "info.rkt".

(require (planet neil/overeasy:2:0)
         "html-template.rkt")

(define-syntax %html-template-to-bytes
  (syntax-rules ()
    ((_ TEMPLATE)
     (let ((ob (open-output-bytes)))
       (html-template #:port ob
                      TEMPLATE)
       (get-output-bytes ob)))))

(define-namespace-anchor %anchor)

(define %expand-here-namespace
  (namespace-anchor->namespace %anchor))

(define (%expand-here top-level-form)
  (parameterize ((current-namespace %expand-here-namespace))
    (expand top-level-form)))

(define-syntax %html-template-expand-and-bytes
  (syntax-rules ()
    ((_ TEMPLATE ...)
     (values (syntax->datum (parameterize ((current-namespace %expand-here-namespace))
                              (expand-once
                               (quote (html-template TEMPLATE ...)))))
             (%html-template-to-bytes TEMPLATE ...)))))

(test-section 'html-template

  (test 'html-template-syntax-as-distinct-from-html-template-to-bytes
        (let ((ob (open-output-bytes)))
          (parameterize ((current-output-port ob))
            (html-template (p "Hi!")))
          (get-output-bytes ob))
        #"<p>Hi!</p>")

  (test 'simple-html-template
        (let ((my-title "All About Kittens & Puppies"))
          (%html-template-to-bytes
           (html (head (title (% my-title)))
                 (body (h1 (% my-title))
                       (p "Kittens claw." (br) "Puppies pee.")))))
        #"<html><head><title>All About Kittens &amp; Puppies</title></head><body><h1>All About Kittens &amp; Puppies</h1><p>Kittens claw.<br>Puppies pee.</p></body></html>")

  (test-section 'static

    (test-section 'elements

      (test 'empty-not-always-empty-element
            (%html-template-to-bytes (p))
            #"<p></p>")

      (test 'empty-always-empty-element
            (%html-template-to-bytes (br))
            #"<br>"))

    (test-section 'content

      (test 'no-content
            (%html-template-to-bytes (p))
            #"<p></p>")

      (test 'one-string
            (%html-template-to-bytes (p "CONTENT"))
            #"<p>CONTENT</p>")

      (test 'two-strings
            (%html-template-to-bytes (p "CON" "TENT"))
            #"<p>CONTENT</p>")

      (test 'characters-needing-escaping
            (%html-template-to-bytes (p "a&b<c>d"))
            #"<p>a&amp;b&lt;c&gt;d</p>")

      (test 'char-refs
            (%html-template-to-bytes (p "a" (& amp) "b" (& 141) "c" (& rArr) "d"))
            #"<p>a&amp;b&#141;c&rArr;d</p>"))

    (test-section 'attributes

      (test-section 'count-of-attributes

        (test #:id   'zero-attributes-without-at
              #:code (%expand-here '(%html-template-to-bytes (hr (@))))
              #:exn  "html-template: empty HTML attribute list in: (@)")

        (test 'zero-attributes-with-at
              (%html-template-to-bytes (hr))
              #"<hr>")

        (test 'one-attribute
              (%html-template-to-bytes (hr (@ (clear "all"))))
              #"<hr clear=\"all\">")

        (test 'two-attributes
              (%html-template-to-bytes (hr (@ (clear "all") (id "foo"))))
              #"<hr clear=\"all\" id=\"foo\">")

        (test 'three-attributes
              (%html-template-to-bytes (hr (@ (clear "all") (id "foo") (class "upper"))))
              #"<hr clear=\"all\" id=\"foo\" class=\"upper\">")

        (test #:id   'bad-char-ref-in-attributes
              #:code (%expand-here '(%html-template-to-bytes (p (@ (a "b") (& c)))))
              #:exn  "html-template: invalid inside attributes list in: (& c)"))

      (test-section 'values

        (test 'non-empty-value
              (%html-template-to-bytes (hr (@ (clear "all"))))
              #"<hr clear=\"all\">")

        (test 'empty-value
              (%html-template-to-bytes (hr (@ (noshade ""))))
              #"<hr noshade=\"\">")

        (test #:id   'unspecified-value
              #:code (%expand-here '(%html-template-to-bytes (hr (@ (noshade)))))
              #:exn  "html-template: HTML attribute is missing value expression in: (noshade)")

        (test 'multiple-strings-in-value
              (%html-template-to-bytes (p (@ (myattr "a" "b" "c")) "content"))
              #"<p myattr=\"abc\">content</p>")

        (test-section 'char-refs

          (test 'char-ref-as-value
                (%html-template-to-bytes (p (@ (myattr (& quot))) "content"))
                #"<p myattr=\"&quot;\">content</p>")

          (test 'char-entity-ref-in-value
                (%html-template-to-bytes (p (@ (myattr "a" (& quot) "b")) "content"))
                #"<p myattr=\"a&quot;b\">content</p>")

          (test 'numeric-char-ref-in-value
                (%html-template-to-bytes (p (@ (myattr "a" (& 42) "b")) "content"))
                #"<p myattr=\"a&#42;b\">content</p>"))

        (test-section 'funny-characters-in-value

          (test 'double-quote
                (%html-template-to-bytes (a (@ (href "a\"b")) "here"))
                #"<a href=\"a&#34;b\">here</a>")

          (test 'ampersand
                (%html-template-to-bytes (a (@ (href "a&b")) "here"))
                #"<a href=\"a&#38;b\">here</a>"
                #:notes "TODO: !!! Does encoding ampersand like this break any sites?")

          (test 'percent
                (%html-template-to-bytes (a (@ (href "a%42b")) "here"))
                #"<a href=\"a%42b\">here</a>")

          (test 'lessthan
                (%html-template-to-bytes (a (@ (href "a<b")) "here"))
                #"<a href=\"a&#60;b\">here</a>")

          (test 'lf
                (%html-template-to-bytes (a (@ (href "a\nb")) "here"))
                #"<a href=\"a&#10;b\">here</a>")

          (test 'cr
                (%html-template-to-bytes (a (@ (href "a\rb")) "here"))
                #"<a href=\"a&#13;b\">here</a>")

          (test 'nul
                (%html-template-to-bytes (a (@ (href "a\0b")) "here"))
                #"<a href=\"a&#0;b\">here</a>")))))

  (test-section 'escapes

    (test-section 'content-context

      (test-section '%format

        (test 'string
              (let ((str "con"))
                (%html-template-expand-and-bytes
                 (p "my " (% str) "tent")))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p>my " out)
                           (%html-template:format/content/write str out)
                           (write-bytes #"tent</p>" out)
                           (void)))
                      #"<p>my content</p>"))

        (test 'number
              (let ((num (+ 1 2)))
                (%html-template-to-bytes
                 (p "1 + 2 = " (% num) ", true")))
              #"<p>1 + 2 = 3, true</p>")

        (test 'symbol
              (let ((sym 'con))
                (%html-template-to-bytes
                 (p "my " (% sym) "tent")))
              #"<p>my content</p>")

        (test #:id   'bad-write-to-current-output-port
              #:code (let ((str "con"))
                       (%html-template-to-bytes
                        (p "my " (% (display str)) "tent")))
              #:exn  "html-template-error-catching-output-port: write-out attempted"))

      (test-section '%verbatim

        (test 'static-string
              (%html-template-expand-and-bytes
               (p "my " (%verbatim "con") "tent"))
              (values '(let-values (((out) (current-output-port)))
                         ;; TODO: Don't introduce "parameterize" when no actual dynamic part.
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p>my content</p>" out)
                           (void)))
                      #"<p>my content</p>"))

        (test 'static-string-one-space
              (%html-template-expand-and-bytes (%verbatim " "))
              (values '(let-values (((out) (current-output-port)))
                         ;; TODO: Don't introduce "parameterize" when no actual dynamic part.
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-char #\space out)
                           (void)))
                      #" "))

        (test 'bad-multiple-static-strings
              (%html-template-expand-and-bytes
               (p "my " (%verbatim "no" "con") "tent"))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p>my " out)
                           (%html-template:write-verbatim (begin "no" "con") out)
                           (write-bytes #"tent</p>" out)
                           (void)))
                      #"<p>my content</p>"))

        (test 'static-bytes
              (%html-template-expand-and-bytes
               (p "my " (%verbatim #"con") "tent"))
              (values '(let-values (((out) (current-output-port)))
                         ;; TODO: Don't introduce "parameterize" when no actual dynamic part.
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p>my content</p>" out)
                           (void)))
                      #"<p>my content</p>"))

        (test 'nonstatic
              (let ((str "con"))
                (%html-template-expand-and-bytes
                 (p "my " (%verbatim str) "tent")))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p>my " out)
                           (%html-template:write-verbatim str out)
                           (write-bytes #"tent</p>" out)
                           (void)))
                      #"<p>my content</p>"))

        (test #:id   'bad-write-to-current-output-port
              #:code (%html-template-expand-and-bytes
                      (p "my " (%verbatim (display "oops") "con") "tent"))
              #:exn  "html-template-error-catching-output-port: write-out attempted"))

      (test-section '%xexp

        (test 'string
              (let ((xexp "con"))
                (%html-template-expand-and-bytes
                 (p "my " (%xexp xexp) "tent")))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p>my " out)
                           (write-html xexp out)
                           (write-bytes #"tent</p>" out)
                           (void)))
                      #"<p>my content</p>"))

        (test 'element
              (let ((xexp '(b "con")))
                (%html-template-to-bytes
                 (p "my " (%xexp xexp) "tent")))
              #"<p>my <b>con</b>tent</p>")

        (test 'list-of-strings
              (let ((xexp '("c" "o" "n")))
                (%html-template-to-bytes
                 (p "my " (%xexp xexp) "tent")))
              #"<p>my content</p>")

        (test 'list-of-elements-and-strings
              (let ((xexp '((b "c") "o" (i "n"))))
                (%html-template-to-bytes
                 (p "my " (%xexp xexp) "tent")))
              #"<p>my <b>c</b>o<i>n</i>tent</p>")

        (test 'list-of-strings-and-elements
              (let ((xexp '("c" (b "o") "n")))
                (%html-template-to-bytes
                 (p "my " (%xexp xexp) "tent")))
              #"<p>my c<b>o</b>ntent</p>")

        (test #:id   'bad-write-to-current-output-port
              #:code (let ((xexp "con"))
                       (%html-template-expand-and-bytes
                        (p "my " (%xexp (display "oops") xexp) "tent")))
              #:exn  "html-template-error-catching-output-port: write-out attempted"))

      (test '%write
            (%html-template-expand-and-bytes
             (p "my " (%write (display "con")) "tent"))
            (values '(let-values (((out) (current-output-port)))
                       (parameterize ((current-output-port html-template-error-catching-output-port))
                         (write-bytes #"<p>my " out)
                         (parameterize ((current-output-port out))
                           (display "con"))
                         (write-bytes #"tent</p>" out)
                         (void)))
                    #"<p>my content</p>"))

      (test '%write/port
            (%html-template-expand-and-bytes
             (p "my " (%write/port p (display "con" p)) "tent"))
            (values '(let-values (((out) (current-output-port)))
                       (parameterize ((current-output-port html-template-error-catching-output-port))
                         (write-bytes #"<p>my " out)
                         (let ((p out))
                           (display "con" p))
                         (write-bytes #"tent</p>" out)
                         (void)))
                    #"<p>my content</p>"))

      (test-section '%void

        (test 'one-expression
              (%html-template-expand-and-bytes
               (p "my " (%void (+ 1 2)) "content"))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p>my " out)
                           (+ 1 2)
                           (write-bytes #"content</p>" out)
                           (void)))
                      #"<p>my content</p>"))

        (test 'two-expressions
              (%html-template-expand-and-bytes
               (p "my " (%void (+ 1 2) (+ 3 4)) "content"))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p>my " out)
                           (+ 1 2)
                           (+ 3 4)
                           (write-bytes #"content</p>" out)
                           (void)))
                      #"<p>my content</p>"))

        (test #:id   'bad-write-to-current-output-port
              #:code (%html-template-expand-and-bytes
                      (p "my " (%void (display "oops") (+ 1 2)) "content"))
              #:exn  "html-template-error-catching-output-port: write-out attempted")))

    (test-section 'attributes-context

      (test-section '%format

        (test #:id   'string
              #:code (%expand-here '(let ((str "y=\2\""))
                                      (%html-template-expand-and-bytes
                                       (p (@ (x "1") (% str)) "content"))))
              #:exn "html-template: % is invalid in attributes context in: (% str)"))

      (test-section '%verbatim

        (test 'static-string
              (%html-template-expand-and-bytes
               (p (@ (x "1")
                     (%verbatim "y=\"2\""))
                  "content"))
              (values '(let-values (((out) (current-output-port)))
                         ;; TODO: Don't introduce "parameterize" when no actual dynamic part.
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"1\" y=\"2\">content</p>" out)
                           (void)))
                      #"<p x=\"1\" y=\"2\">content</p>"))

        (test 'static-bytes
              (%html-template-expand-and-bytes
               (p (@ (x "1")
                     (%verbatim #"y=\"2\""))
                  "content"))
              (values '(let-values (((out) (current-output-port)))
                         ;; TODO: Don't introduce "parameterize" when no actual dynamic part.
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"1\" y=\"2\">content</p>" out)
                           (void)))
                      #"<p x=\"1\" y=\"2\">content</p>"))

        (test 'one-nonstatic
              (let ((str "y=\"2\""))
                (%html-template-expand-and-bytes
                 (p (@ (x "1")
                       (%verbatim str))
                    "content")))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"1\" " out)
                           (%html-template:write-verbatim str out)
                           (write-bytes #">content</p>" out)
                           (void)))
                      #"<p x=\"1\" y=\"2\">content</p>"))

        (test 'two-nonstatic
              (let ((str1 "y=\"2\"")
                    (str2 "z=\"3\""))
                (%html-template-expand-and-bytes
                 (p (@ (x "1")
                       (%verbatim str1)
                       (%verbatim str2))
                    "content")))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"1\" " out)
                           (%html-template:write-verbatim str1 out)
                           (write-char #\space out)
                           (%html-template:write-verbatim str2 out)
                           (write-bytes #">content</p>" out)
                           (void)))
                      #"<p x=\"1\" y=\"2\" z=\"3\">content</p>"))

        (test 'empty-one-nonstatic
              (let ((str ""))
                (%html-template-expand-and-bytes
                 (p (@ (x "1")
                       (%verbatim str))
                    "content")))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"1\" " out)
                           (%html-template:write-verbatim str out)
                           (write-bytes #">content</p>" out)
                           (void)))
                      #"<p x=\"1\" >content</p>")
              #:notes "We expect the extraneous space, even though it's suboptimal output."))

      (test-section '%xexp

        (test 'one-without-enclosing-list
              (let ((y '(y "2")))
                (%html-template-expand-and-bytes
                 (p (@ (x "1")
                       (%xexp y)
                       (z "3"))
                    "content")))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"1\"" out)
                           (write-html-attributes y out)
                           (write-bytes #" z=\"3\">content</p>" out)
                           (void)))
                      #"<p x=\"1\" y=\"2\" z=\"3\">content</p>"))

        (test 'one-with-enclosing-list
              (let ((y '((y "2"))))
                (%html-template-expand-and-bytes
                 (p (@ (x "1")
                       (%xexp y)
                       (z "3"))
                    "content")))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"1\"" out)
                           (write-html-attributes y out)
                           (write-bytes #" z=\"3\">content</p>" out)
                           (void)))
                      #"<p x=\"1\" y=\"2\" z=\"3\">content</p>"))

        (test 'two
              (let ((yz '((y "2") (z "3"))))
                (%html-template-expand-and-bytes
                 (p (@ (x "1")
                       (%xexp yz))
                    "content")))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"1\"" out)
                           (write-html-attributes yz out)
                           (write-bytes #">content</p>" out)
                           (void)))
                      #"<p x=\"1\" y=\"2\" z=\"3\">content</p>"))

        (test 'null-list
              (let ((y '()))
                (%html-template-expand-and-bytes
                 (p (@ (x "1")
                       (%xexp y)
                       (z "3"))
                    "content")))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"1\"" out)
                           (write-html-attributes y out)
                           (write-bytes #" z=\"3\">content</p>" out)
                           (void)))
                      #"<p x=\"1\" z=\"3\">content</p>")))

      (test-section '%write

        (test 'one
              (%html-template-expand-and-bytes
               (p (@ (x "1")
                     (%write (display "y=\"2\""))
                     (z "3"))
                  "content"))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"1\" " out)
                           (parameterize ((current-output-port out))
                             (display "y=\"2\""))
                           (write-bytes #" z=\"3\">content</p>" out)
                           (void)))
                      #"<p x=\"1\" y=\"2\" z=\"3\">content</p>")))

      (test-section '%write/port

        (test 'one
              (%html-template-expand-and-bytes
               (p (@ (x "1")
                     (%write/port o (display "y=\"2\"" o))
                     (z "3"))
                  "content"))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"1\" " out)
                           (let ((o out))
                             (display "y=\"2\"" o))
                           (write-bytes #" z=\"3\">content</p>" out)
                           (void)))
                      #"<p x=\"1\" y=\"2\" z=\"3\">content</p>")))

      (test-section '%void

        (test 'one
              (%html-template-expand-and-bytes
               (p (@ (x "1")
                     (%void (+ 1 2) (+ 3 4)))
                  "content"))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"1\"" out)
                           (+ 1 2)
                           (+ 3 4)
                           (write-bytes #">content</p>" out)
                           (void)))
                      #"<p x=\"1\">content</p>"))))

    (test-section 'attribute-value-context

      (test-section '%format

        (test 'string
              (let ((v "1"))
                (%html-template-expand-and-bytes
                 (p (@ (x (%format v)))
                    "content")))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"" out)
                           (%html-template:format/attribute-value/write v out)
                           (write-bytes #"\">content</p>" out)
                           (void)))
                      #"<p x=\"1\">content</p>"))

        (test 'string-with-double-quote
              (let ((v "a\"b"))
                (%html-template-expand-and-bytes
                 (p (@ (x (%format v)))
                    "content")))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"" out)
                           (%html-template:format/attribute-value/write v out)
                           (write-bytes #"\">content</p>" out)
                           (void)))
                      #"<p x=\"a&#34;b\">content</p>"))

        (test 'number
              (let ((v 1))
                (%html-template-expand-and-bytes
                 (p (@ (x (%format v)))
                    "content")))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"" out)
                           (%html-template:format/attribute-value/write v out)
                           (write-bytes #"\">content</p>" out)
                           (void)))
                      #"<p x=\"1\">content</p>"))

        (test 'symbol
              (let ((v 'abc))
                (%html-template-expand-and-bytes
                 (p (@ (x (%format v)))
                    "content")))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"" out)
                           (%html-template:format/attribute-value/write v out)
                           (write-bytes #"\">content</p>" out)
                           (void)))
                      #"<p x=\"abc\">content</p>"))

        (test 'symbol-with-ampersand
              (let ((v (string->symbol "a&b")))
                (%html-template-expand-and-bytes
                 (p (@ (x (%format v)))
                    "content")))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"" out)
                           (%html-template:format/attribute-value/write v out)
                           (write-bytes #"\">content</p>" out)
                           (void)))
                      #"<p x=\"a&#38;b\">content</p>")))

      (test-section '%verbatim

        (test 'nonstatic-string
              (let ((v "1"))
                (%html-template-expand-and-bytes
                 (p (@ (x (%verbatim v)))
                    "content")))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"" out)
                           (%html-template:write-verbatim v out)
                           (write-bytes #"\">content</p>" out)
                           (void)))
                      #"<p x=\"1\">content</p>"))

        (test 'nonstatic-string-with-ampersand
              (let ((v "a&b"))
                (%html-template-expand-and-bytes
                 (p (@ (x (%verbatim v)))
                    "content")))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"" out)
                           (%html-template:write-verbatim v out)
                           (write-bytes #"\">content</p>" out)
                           (void)))
                      #"<p x=\"a&b\">content</p>")
              #:notes "We intentionally let %verbatim be used for invalid HTML.")

        (test 'static-string
              (%html-template-expand-and-bytes
               (p (@ (x (%verbatim "1")))
                  "content"))
              (values '(let-values (((out) (current-output-port)))
                         ;; TODO: Don't introduce "parameterize" when no actual dynamic part.
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"1\">content</p>" out)
                           (void)))
                      #"<p x=\"1\">content</p>"))

        (test 'static-string-with-ampersand
              (%html-template-expand-and-bytes
               (p (@ (x (%verbatim "a&b")))
                  "content"))
              (values '(let-values (((out) (current-output-port)))
                         ;; TODO: Don't introduce "parameterize" when no actual dynamic part.
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"a&b\">content</p>" out)
                           (void)))
                      #"<p x=\"a&b\">content</p>")
              #:notes "We intentionally let %verbatim be used for invalid HTML."))

      (test-section '%xexp

        (test 'string
              (let ((v "1"))
                (%html-template-expand-and-bytes
                 (p (@ (x (%xexp v)))
                    "content")))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"" out)
                           (write-html-attribute-value-part v out)
                           (write-bytes #"\">content</p>" out)
                           (void)))
                      #"<p x=\"1\">content</p>"))

        (test 'string-with-ampersand
              (let ((v "a&b"))
                (%html-template-expand-and-bytes
                 (p (@ (x (%xexp v)))
                    "content")))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"" out)
                           (write-html-attribute-value-part v out)
                           (write-bytes #"\">content</p>" out)
                           (void)))
                      #"<p x=\"a&#38;b\">content</p>"))

        (test 'nested-list-of-strings
              (let ((v '("a" ("b" () "c"))))
                (%html-template-expand-and-bytes
                 (p (@ (x (%xexp v)))
                    "content")))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"" out)
                           (write-html-attribute-value-part v out)
                           (write-bytes #"\">content</p>" out)
                           (void)))
                      #"<p x=\"abc\">content</p>")))

      (test-section '%write

        (test 'one
              (%html-template-expand-and-bytes
               (p (@ (x (%write (display "1"))))
                  "content"))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"" out)
                           (parameterize ((current-output-port out))
                             (display "1"))
                           (write-bytes #"\">content</p>" out)
                           (void)))
                      #"<p x=\"1\">content</p>")))

      (test-section '%write/port

        (test 'one
              (%html-template-expand-and-bytes
               (p (@ (x (%write/port o (display "1" o))))
                  "content"))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"" out)
                           (let ((o out))
                             (display "1" o))
                           (write-bytes #"\">content</p>" out)
                           (void)))
                      #"<p x=\"1\">content</p>")))

      (test-section '%void

        (test 'null-list
              (%html-template-expand-and-bytes
               (p (@ (x "1")
                     (%void (+ 1 2) (+ 3 4))
                     (z "3"))
                  "content"))
              (values '(let-values (((out) (current-output-port)))
                         (parameterize ((current-output-port html-template-error-catching-output-port))
                           (write-bytes #"<p x=\"1\"" out)
                           (+ 1 2)
                           (+ 3 4)
                           (write-bytes #" z=\"3\">content</p>" out)
                           (void)))
                      #"<p x=\"1\" z=\"3\">content</p>")))))

  ;; TODO: !!! add html comment (!-- ...) form.  and/or *comment* ?

  ;; TODO: !!! CDATA?

  ;; TODO: !!! processing instructions and such?

  ;; TODO: !!! script forms?  javascript?

  ;; TODO: !!! implement a "*verbatim*" (use the commented-out code previously
  ;; from "%verbatim" as a starting point.

  ;; TODO: !!! test with and without #:port argument, and compare expansions.
  ;; Can't use normal expand test macro for that.

  ;; TODO: For %format, decide what to do about byte strings, and test it.
  ;; Probably leave as-is, which does a (format "~S").
  )