giles
284572c7a9
sx_server.ml: sx_render_to_html() calls the SX adapter-html.sx render-to-html via CEK eval, falling back to Sx_render.render_to_html if adapter not loaded. CLI --render mode now loads render.sx + adapter-html.sx. sx_primitives.ml: Added ~25 primitives needed by adapter-html.sx: scope-push!/pop!/peek/emit!, emitted, provide-push!/pop! (hashtable stack), lambda?/island?/component?/macro?, component-closure/name/params/body/ has-children?, lambda-closure/params/body, is-else-clause?, for-each-indexed, empty-dict?, make-raw-html, raw-html-content run_tests.ml: Loads render.sx + adapter-html.sx for test-render-html.sx. Registers trampoline, eval-expr, scope stubs, expand-macro, cond-scheme?. Status: 1105/1114 OCaml tests pass. 8 remaining failures are env-merge edge cases in render-lambda-html/component-children/island rendering — same adapter code works in JS (143/143). Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
766 lines
26 KiB
Plaintext
766 lines
26 KiB
Plaintext
;; ==========================================================================
|
|
;; test-render-html.sx — Exhaustive tests for HTML rendering
|
|
;;
|
|
;; Tests render-to-html against the HTML serialization specification.
|
|
;; Every test verifies the SX renderer produces correct HTML strings.
|
|
;;
|
|
;; Requires: test-framework.sx, adapter-html.sx loaded.
|
|
;; ==========================================================================
|
|
|
|
|
|
;; Helper: render a QUOTED SX expression to HTML string.
|
|
;; The expression is first evaluated in the env (to resolve symbols),
|
|
;; then the result is passed to render-to-html.
|
|
;; For simple values (strings, numbers), use rh-val instead.
|
|
(define rh
|
|
(fn (expr)
|
|
(let ((env (env-extend (test-env))))
|
|
(render-to-html expr env))))
|
|
|
|
;; Helper: render a literal value (no evaluation needed).
|
|
;; Uses render-value-to-html which skips the eval-expr dispatch.
|
|
(define rh-val
|
|
(fn (val)
|
|
(render-value-to-html val (env-extend (test-env)))))
|
|
|
|
;; Helper: render with a pre-built env
|
|
(define rh-env
|
|
(fn (expr env)
|
|
(render-to-html expr env)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 1. Text content and literals
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-text"
|
|
(deftest "string renders as escaped text"
|
|
(assert-equal "hello" (rh-val "hello")))
|
|
|
|
(deftest "number renders as string"
|
|
(assert-equal "42" (rh-val 42)))
|
|
|
|
(deftest "float renders as string"
|
|
(assert-equal "3.14" (rh-val 3.14)))
|
|
|
|
(deftest "boolean true renders as text"
|
|
(assert-equal "true" (rh-val true)))
|
|
|
|
(deftest "boolean false renders as text"
|
|
(assert-equal "false" (rh-val false)))
|
|
|
|
(deftest "nil renders as empty string"
|
|
(assert-equal "" (rh-val nil)))
|
|
|
|
(deftest "keyword renders as text"
|
|
(assert-equal "hello" (rh-val :hello))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 2. HTML escaping — content
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-escaping-content"
|
|
(deftest "ampersand escaped in text"
|
|
(assert-equal "a & b" (rh-val "a & b")))
|
|
|
|
(deftest "less-than escaped in text"
|
|
(assert-equal "a < b" (rh-val "a < b")))
|
|
|
|
(deftest "greater-than escaped in text"
|
|
(assert-equal "a > b" (rh-val "a > b")))
|
|
|
|
(deftest "multiple special chars escaped"
|
|
(assert-equal "<b>tag</b>"
|
|
(rh-val "<b>tag</b>")))
|
|
|
|
(deftest "text inside element is escaped"
|
|
(assert-equal "<p>a & b</p>"
|
|
(rh '(p "a & b")))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 3. HTML escaping — attributes
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-escaping-attrs"
|
|
(deftest "ampersand escaped in attribute value"
|
|
(assert-equal "<div title=\"a & b\"></div>"
|
|
(rh '(div :title "a & b"))))
|
|
|
|
(deftest "angle brackets escaped in attribute value"
|
|
(assert-equal "<div title=\"<b>\"></div>"
|
|
(rh '(div :title "<b>")))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 4. Normal elements — open tag, children, close tag
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-normal-elements"
|
|
(deftest "div with text"
|
|
(assert-equal "<div>hello</div>" (rh '(div "hello"))))
|
|
|
|
(deftest "p with text"
|
|
(assert-equal "<p>paragraph</p>" (rh '(p "paragraph"))))
|
|
|
|
(deftest "span with text"
|
|
(assert-equal "<span>inline</span>" (rh '(span "inline"))))
|
|
|
|
(deftest "empty div"
|
|
(assert-equal "<div></div>" (rh '(div))))
|
|
|
|
(deftest "nested elements"
|
|
(assert-equal "<div><p>inner</p></div>"
|
|
(rh '(div (p "inner")))))
|
|
|
|
(deftest "multiple children"
|
|
(assert-equal "<div><p>a</p><p>b</p></div>"
|
|
(rh '(div (p "a") (p "b")))))
|
|
|
|
(deftest "deep nesting"
|
|
(assert-equal "<div><section><article><p>deep</p></article></section></div>"
|
|
(rh '(div (section (article (p "deep")))))))
|
|
|
|
(deftest "mixed text and element children"
|
|
(assert-equal "<p>hello <strong>world</strong></p>"
|
|
(rh '(p "hello " (strong "world"))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 5. Void elements — self-closing, no children
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-void-elements"
|
|
(deftest "br"
|
|
(assert-equal "<br />" (rh '(br))))
|
|
|
|
(deftest "hr"
|
|
(assert-equal "<hr />" (rh '(hr))))
|
|
|
|
(deftest "img with src"
|
|
(assert-equal "<img src=\"photo.jpg\" />"
|
|
(rh '(img :src "photo.jpg"))))
|
|
|
|
(deftest "input with type"
|
|
(assert-equal "<input type=\"text\" />"
|
|
(rh '(input :type "text"))))
|
|
|
|
(deftest "meta with charset"
|
|
(assert-equal "<meta charset=\"utf-8\" />"
|
|
(rh '(meta :charset "utf-8"))))
|
|
|
|
(deftest "link with rel and href"
|
|
(assert-equal "<link rel=\"stylesheet\" href=\"style.css\" />"
|
|
(rh '(link :rel "stylesheet" :href "style.css"))))
|
|
|
|
(deftest "source with src"
|
|
(assert-equal "<source src=\"video.mp4\" />"
|
|
(rh '(source :src "video.mp4"))))
|
|
|
|
(deftest "col"
|
|
(assert-equal "<col />" (rh '(col))))
|
|
|
|
(deftest "wbr"
|
|
(assert-equal "<wbr />" (rh '(wbr)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 6. Boolean attributes — name only when truthy
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-boolean-attrs"
|
|
(deftest "checked true"
|
|
(assert-equal "<input checked />"
|
|
(rh '(input :checked true))))
|
|
|
|
(deftest "checked false omitted"
|
|
(assert-equal "<input />"
|
|
(rh '(input :checked false))))
|
|
|
|
(deftest "disabled true"
|
|
(assert-equal "<button disabled>click</button>"
|
|
(rh '(button :disabled true "click"))))
|
|
|
|
(deftest "disabled false omitted"
|
|
(assert-equal "<button>click</button>"
|
|
(rh '(button :disabled false "click"))))
|
|
|
|
(deftest "readonly"
|
|
(assert-equal "<input readonly />"
|
|
(rh '(input :readonly true))))
|
|
|
|
(deftest "required"
|
|
(assert-equal "<input required />"
|
|
(rh '(input :required true))))
|
|
|
|
(deftest "multiple"
|
|
(assert-equal "<select multiple></select>"
|
|
(rh '(select :multiple true))))
|
|
|
|
(deftest "hidden"
|
|
(assert-equal "<div hidden></div>"
|
|
(rh '(div :hidden true))))
|
|
|
|
(deftest "autofocus"
|
|
(assert-equal "<input autofocus />"
|
|
(rh '(input :autofocus true))))
|
|
|
|
(deftest "autoplay"
|
|
(assert-equal "<video autoplay></video>"
|
|
(rh '(video :autoplay true))))
|
|
|
|
(deftest "loop"
|
|
(assert-equal "<video loop></video>"
|
|
(rh '(video :loop true))))
|
|
|
|
(deftest "muted"
|
|
(assert-equal "<video muted></video>"
|
|
(rh '(video :muted true))))
|
|
|
|
(deftest "controls"
|
|
(assert-equal "<audio controls></audio>"
|
|
(rh '(audio :controls true))))
|
|
|
|
(deftest "selected"
|
|
(assert-equal "<option selected>yes</option>"
|
|
(rh '(option :selected true "yes"))))
|
|
|
|
(deftest "open (details)"
|
|
(assert-equal "<details open></details>"
|
|
(rh '(details :open true))))
|
|
|
|
(deftest "defer"
|
|
(assert-equal "<script defer></script>"
|
|
(rh '(script :defer true))))
|
|
|
|
(deftest "async"
|
|
(assert-equal "<script async></script>"
|
|
(rh '(script :async true))))
|
|
|
|
(deftest "novalidate"
|
|
(assert-equal "<form novalidate></form>"
|
|
(rh '(form :novalidate true)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 7. Regular attributes
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-regular-attrs"
|
|
(deftest "class attribute"
|
|
(assert-equal "<div class=\"container\"></div>"
|
|
(rh '(div :class "container"))))
|
|
|
|
(deftest "id attribute"
|
|
(assert-equal "<div id=\"main\"></div>"
|
|
(rh '(div :id "main"))))
|
|
|
|
(deftest "style attribute"
|
|
(assert-equal "<div style=\"color: red\"></div>"
|
|
(rh '(div :style "color: red"))))
|
|
|
|
(deftest "data-* attribute"
|
|
(assert-equal "<div data-value=\"42\"></div>"
|
|
(rh '(div :data-value "42"))))
|
|
|
|
(deftest "aria-* attribute"
|
|
(assert-equal "<div aria-label=\"close\"></div>"
|
|
(rh '(div :aria-label "close"))))
|
|
|
|
(deftest "multiple attributes"
|
|
(assert-equal "<a href=\"/\" class=\"link\">home</a>"
|
|
(rh '(a :href "/" :class "link" "home"))))
|
|
|
|
(deftest "nil attribute omitted"
|
|
(assert-equal "<div></div>"
|
|
(rh '(div :class nil))))
|
|
|
|
(deftest "numeric attribute value"
|
|
(assert-equal "<input maxlength=\"10\" />"
|
|
(rh '(input :maxlength 10)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 8. Fragments — children without wrapper
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-fragments"
|
|
(deftest "fragment renders children without wrapper"
|
|
(assert-equal "<p>a</p><p>b</p>"
|
|
(rh '(<> (p "a") (p "b")))))
|
|
|
|
(deftest "empty fragment"
|
|
(assert-equal "" (rh '(<>))))
|
|
|
|
(deftest "fragment with text"
|
|
(assert-equal "hello world"
|
|
(rh '(<> "hello " "world"))))
|
|
|
|
(deftest "nested fragment"
|
|
(assert-equal "<p>a</p><p>b</p>"
|
|
(rh '(<> (<> (p "a")) (p "b"))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 9. Raw HTML — unescaped passthrough
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-raw"
|
|
(deftest "raw! passes through unescaped"
|
|
(assert-equal "<b>bold</b>"
|
|
(rh '(raw! "<b>bold</b>"))))
|
|
|
|
(deftest "raw! with multiple args"
|
|
(assert-equal "<em>a</em><em>b</em>"
|
|
(rh '(raw! "<em>a</em>" "<em>b</em>")))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 10. Heading levels
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-headings"
|
|
(deftest "h1" (assert-equal "<h1>title</h1>" (rh '(h1 "title"))))
|
|
(deftest "h2" (assert-equal "<h2>sub</h2>" (rh '(h2 "sub"))))
|
|
(deftest "h3" (assert-equal "<h3>sec</h3>" (rh '(h3 "sec"))))
|
|
(deftest "h4" (assert-equal "<h4>sub</h4>" (rh '(h4 "sub"))))
|
|
(deftest "h5" (assert-equal "<h5>sub</h5>" (rh '(h5 "sub"))))
|
|
(deftest "h6" (assert-equal "<h6>sub</h6>" (rh '(h6 "sub")))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 11. Lists (HTML)
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-lists"
|
|
(deftest "unordered list"
|
|
(assert-equal "<ul><li>a</li><li>b</li></ul>"
|
|
(rh '(ul (li "a") (li "b")))))
|
|
|
|
(deftest "ordered list"
|
|
(assert-equal "<ol><li>1</li><li>2</li></ol>"
|
|
(rh '(ol (li "1") (li "2")))))
|
|
|
|
(deftest "definition list"
|
|
(assert-equal "<dl><dt>term</dt><dd>def</dd></dl>"
|
|
(rh '(dl (dt "term") (dd "def"))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 12. Tables
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-tables"
|
|
(deftest "basic table"
|
|
(assert-equal "<table><tr><td>cell</td></tr></table>"
|
|
(rh '(table (tr (td "cell"))))))
|
|
|
|
(deftest "table with header"
|
|
(assert-equal "<table><thead><tr><th>col</th></tr></thead><tbody><tr><td>val</td></tr></tbody></table>"
|
|
(rh '(table (thead (tr (th "col"))) (tbody (tr (td "val"))))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 13. Forms
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-forms"
|
|
(deftest "form with action"
|
|
(assert-equal "<form action=\"/submit\"></form>"
|
|
(rh '(form :action "/submit"))))
|
|
|
|
(deftest "input types"
|
|
(assert-equal "<input type=\"email\" />"
|
|
(rh '(input :type "email"))))
|
|
|
|
(deftest "textarea"
|
|
(assert-equal "<textarea>content</textarea>"
|
|
(rh '(textarea "content"))))
|
|
|
|
(deftest "select with options"
|
|
(assert-equal "<select><option>a</option><option>b</option></select>"
|
|
(rh '(select (option "a") (option "b")))))
|
|
|
|
(deftest "button"
|
|
(assert-equal "<button type=\"submit\">go</button>"
|
|
(rh '(button :type "submit" "go"))))
|
|
|
|
(deftest "label with for"
|
|
(assert-equal "<label for=\"name\">Name</label>"
|
|
(rh '(label :for "name" "Name"))))
|
|
|
|
(deftest "fieldset and legend"
|
|
(assert-equal "<fieldset><legend>group</legend></fieldset>"
|
|
(rh '(fieldset (legend "group"))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 14. Media elements
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-media"
|
|
(deftest "video with src"
|
|
(assert-equal "<video src=\"v.mp4\"></video>"
|
|
(rh '(video :src "v.mp4"))))
|
|
|
|
(deftest "audio with controls"
|
|
(assert-equal "<audio controls></audio>"
|
|
(rh '(audio :controls true))))
|
|
|
|
(deftest "iframe"
|
|
(assert-equal "<iframe src=\"page.html\"></iframe>"
|
|
(rh '(iframe :src "page.html"))))
|
|
|
|
(deftest "canvas"
|
|
(assert-equal "<canvas width=\"100\" height=\"100\"></canvas>"
|
|
(rh '(canvas :width 100 :height 100))))
|
|
|
|
(deftest "picture with source and img"
|
|
(assert-equal "<picture><source srcset=\"photo.webp\" /><img src=\"photo.jpg\" /></picture>"
|
|
(rh '(picture (source :srcset "photo.webp") (img :src "photo.jpg"))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 15. Semantic elements
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-semantic"
|
|
(deftest "header" (assert-equal "<header>h</header>" (rh '(header "h"))))
|
|
(deftest "nav" (assert-equal "<nav>n</nav>" (rh '(nav "n"))))
|
|
(deftest "main" (assert-equal "<main>m</main>" (rh '(main "m"))))
|
|
(deftest "section" (assert-equal "<section>s</section>" (rh '(section "s"))))
|
|
(deftest "article" (assert-equal "<article>a</article>" (rh '(article "a"))))
|
|
(deftest "aside" (assert-equal "<aside>a</aside>" (rh '(aside "a"))))
|
|
(deftest "footer" (assert-equal "<footer>f</footer>" (rh '(footer "f"))))
|
|
(deftest "details and summary"
|
|
(assert-equal "<details><summary>more</summary><p>info</p></details>"
|
|
(rh '(details (summary "more") (p "info")))))
|
|
(deftest "figure and figcaption"
|
|
(assert-equal "<figure><img src=\"x.jpg\" /><figcaption>cap</figcaption></figure>"
|
|
(rh '(figure (img :src "x.jpg") (figcaption "cap"))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 16. SVG elements
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-svg"
|
|
(deftest "svg container"
|
|
(assert-equal "<svg viewBox=\"0 0 100 100\"></svg>"
|
|
(rh '(svg :viewBox "0 0 100 100"))))
|
|
|
|
(deftest "circle"
|
|
(let ((html (rh '(circle :cx 50 :cy 50 :r 40))))
|
|
(assert-true (string-contains? html "cx=\"50\""))
|
|
(assert-true (string-contains? html "cy=\"50\""))
|
|
(assert-true (string-contains? html "r=\"40\""))))
|
|
|
|
(deftest "rect"
|
|
(assert-equal "<rect width=\"100\" height=\"50\"></rect>"
|
|
(rh '(rect :width 100 :height 50))))
|
|
|
|
(deftest "path"
|
|
(assert-equal "<path d=\"M0 0 L100 100\"></path>"
|
|
(rh '(path :d "M0 0 L100 100"))))
|
|
|
|
(deftest "g with transform"
|
|
(assert-equal "<g transform=\"translate(10,20)\"></g>"
|
|
(rh '(g :transform "translate(10,20)"))))
|
|
|
|
(deftest "text element"
|
|
(assert-equal "<text x=\"10\" y=\"20\">label</text>"
|
|
(rh '(text :x 10 :y 20 "label")))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 17. Control flow in templates
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-control-flow"
|
|
(deftest "if true renders then-branch"
|
|
(assert-equal "<p>yes</p>"
|
|
(rh '(if true (p "yes") (p "no")))))
|
|
|
|
(deftest "if false renders else-branch"
|
|
(assert-equal "<p>no</p>"
|
|
(rh '(if false (p "yes") (p "no")))))
|
|
|
|
(deftest "if false without else renders empty"
|
|
(assert-equal "" (rh '(if false (p "x")))))
|
|
|
|
(deftest "when true renders body"
|
|
(assert-equal "<p>ok</p>"
|
|
(rh '(when true (p "ok")))))
|
|
|
|
(deftest "when false renders empty"
|
|
(assert-equal "" (rh '(when false (p "x")))))
|
|
|
|
(deftest "cond renders matching branch"
|
|
(assert-equal "<p>b</p>"
|
|
(rh '(cond false (p "a") true (p "b")))))
|
|
|
|
(deftest "cond else branch"
|
|
(assert-equal "<p>c</p>"
|
|
(rh '(cond false (p "a") :else (p "c"))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 18. Let bindings in templates
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-let"
|
|
(deftest "let binding used in template"
|
|
(assert-equal "<p>hello</p>"
|
|
(rh '(let ((x "hello")) (p x)))))
|
|
|
|
(deftest "let with multiple bindings"
|
|
(assert-equal "<p>helloworld</p>"
|
|
(rh '(let ((a "hello") (b "world")) (p a b)))))
|
|
|
|
(deftest "nested let"
|
|
(assert-equal "<div><p>inner</p></div>"
|
|
(rh '(let ((x "inner")) (div (let ((y x)) (p y))))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 19. Map / for-each in templates
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-iteration"
|
|
(deftest "map over items"
|
|
(assert-equal "<li>a</li><li>b</li><li>c</li>"
|
|
(rh '(map (fn (x) (li x)) (list "a" "b" "c")))))
|
|
|
|
(deftest "for-each renders items"
|
|
(assert-equal "<p>1</p><p>2</p>"
|
|
(rh '(for-each (fn (x) (p (str x))) (list 1 2)))))
|
|
|
|
(deftest "map-indexed"
|
|
(assert-equal "<li>0: a</li><li>1: b</li>"
|
|
(rh '(map-indexed (fn (i x) (li (str i ": " x))) (list "a" "b"))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 20. Components
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-components"
|
|
(deftest "simple component"
|
|
(let ((env (env-extend (test-env))))
|
|
(eval-expr '(defcomp ~card (&key title) (div :class "card" (h2 title))) env)
|
|
(assert-equal "<div class=\"card\"><h2>hello</h2></div>"
|
|
(rh-env '(~card :title "hello") env))))
|
|
|
|
(deftest "component with children"
|
|
(let ((env (env-extend (test-env))))
|
|
(eval-expr '(defcomp ~box (&rest children) (div :class "box" children)) env)
|
|
(assert-equal "<div class=\"box\"><p>inner</p></div>"
|
|
(rh-env '(~box (p "inner")) env))))
|
|
|
|
(deftest "component with keyword and children"
|
|
(let ((env (env-extend (test-env))))
|
|
(eval-expr '(defcomp ~panel (&key title &rest children)
|
|
(section (h2 title) children)) env)
|
|
(assert-equal "<section><h2>Title</h2><p>body</p></section>"
|
|
(rh-env '(~panel :title "Title" (p "body")) env))))
|
|
|
|
(deftest "nested components"
|
|
(let ((env (env-extend (test-env))))
|
|
(eval-expr '(defcomp ~inner (&key text) (em text)) env)
|
|
(eval-expr '(defcomp ~outer (&key text) (div (~inner :text text))) env)
|
|
(assert-equal "<div><em>hi</em></div>"
|
|
(rh-env '(~outer :text "hi") env)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 21. Macros
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-macros"
|
|
(deftest "macro expands and renders"
|
|
(let ((env (env-extend (test-env))))
|
|
(eval-expr '(defmacro ~wrap (body)
|
|
`(div :class "wrapped" ,body)) env)
|
|
(assert-equal "<div class=\"wrapped\"><p>hello</p></div>"
|
|
(rh-env '(~wrap (p "hello")) env)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 22. Begin/do — multi-expression body
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-begin"
|
|
(deftest "do renders all expressions"
|
|
(assert-equal "<p>a</p><p>b</p>"
|
|
(rh '(do (p "a") (p "b")))))
|
|
|
|
(deftest "begin renders all expressions"
|
|
(assert-equal "<h1>title</h1><p>body</p>"
|
|
(rh '(begin (h1 "title") (p "body"))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 23. Letrec in templates
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-letrec"
|
|
(deftest "letrec with side-effect rendering"
|
|
(assert-equal "<li>a</li><li>b</li>"
|
|
(rh '(letrec ((items (list "a" "b")))
|
|
(do (map (fn (x) (li x)) items)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 24. Scope/provide in templates
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-scope"
|
|
(deftest "scope renders body"
|
|
(assert-equal "<ul><li>inside</li></ul>"
|
|
(rh '(scope "items"
|
|
(ul (li "inside"))))))
|
|
|
|
(deftest "provide renders body"
|
|
(assert-equal "<div>content</div>"
|
|
(rh '(provide "theme" "dark"
|
|
(div "content"))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 25. Other elements
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-other-elements"
|
|
(deftest "pre preserves structure"
|
|
(assert-equal "<pre>code here</pre>"
|
|
(rh '(pre "code here"))))
|
|
|
|
(deftest "code element"
|
|
(assert-equal "<code>x = 1</code>"
|
|
(rh '(code "x = 1"))))
|
|
|
|
(deftest "blockquote"
|
|
(assert-equal "<blockquote>quote</blockquote>"
|
|
(rh '(blockquote "quote"))))
|
|
|
|
(deftest "abbr with title"
|
|
(assert-equal "<abbr title=\"HyperText Markup Language\">HTML</abbr>"
|
|
(rh '(abbr :title "HyperText Markup Language" "HTML"))))
|
|
|
|
(deftest "time with datetime"
|
|
(assert-equal "<time datetime=\"2026-01-01\">New Year</time>"
|
|
(rh '(time :datetime "2026-01-01" "New Year"))))
|
|
|
|
(deftest "dialog"
|
|
(assert-equal "<dialog open>content</dialog>"
|
|
(rh '(dialog :open true "content"))))
|
|
|
|
(deftest "template"
|
|
(assert-equal "<template>inner</template>"
|
|
(rh '(template "inner"))))
|
|
|
|
(deftest "slot with name"
|
|
(assert-equal "<slot name=\"header\"></slot>"
|
|
(rh '(slot :name "header"))))
|
|
|
|
(deftest "noscript"
|
|
(assert-equal "<noscript>fallback</noscript>"
|
|
(rh '(noscript "fallback")))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 26. Islands — defisland with hydration markers
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-islands"
|
|
(deftest "island renders with data-sx-island attribute"
|
|
(let ((env (env-extend (test-env))))
|
|
(eval-expr '(defisland ~counter (&key start)
|
|
(span (str "count: " start))) env)
|
|
(let ((html (rh-env '(~counter :start 0) env)))
|
|
;; Should contain the island marker
|
|
(assert-true (string-contains? html "data-sx-island"))
|
|
;; Should contain rendered content
|
|
(assert-true (string-contains? html "count: 0")))))
|
|
|
|
(deftest "island name appears in marker"
|
|
(let ((env (env-extend (test-env))))
|
|
(eval-expr '(defisland ~toggle (&key label)
|
|
(button label)) env)
|
|
(let ((html (rh-env '(~toggle :label "click") env)))
|
|
(assert-true (string-contains? html "toggle"))
|
|
(assert-true (string-contains? html "click")))))
|
|
|
|
(deftest "island with children"
|
|
(let ((env (env-extend (test-env))))
|
|
(eval-expr '(defisland ~wrapper (&rest children)
|
|
(div :class "island" children)) env)
|
|
(let ((html (rh-env '(~wrapper (p "inside")) env)))
|
|
(assert-true (string-contains? html "data-sx-island"))
|
|
(assert-true (string-contains? html "<p>inside</p>"))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 27. Lakes — server-morphable slots within islands
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-lakes"
|
|
(deftest "lake renders with data-sx-lake attribute"
|
|
(let ((env (env-extend (test-env))))
|
|
(let ((html (rh-env '(lake :id "content" (p "hello")) env)))
|
|
(assert-true (string-contains? html "data-sx-lake"))
|
|
(assert-true (string-contains? html "content"))
|
|
(assert-true (string-contains? html "<p>hello</p>")))))
|
|
|
|
(deftest "lake with custom tag"
|
|
(let ((env (env-extend (test-env))))
|
|
(let ((html (rh-env '(lake :id "nav" :tag "nav" (a "link")) env)))
|
|
(assert-true (starts-with? html "<nav"))
|
|
(assert-true (string-contains? html "<a>link</a>"))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 28. Marshes — reactive server-morphable slots
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-marshes"
|
|
(deftest "marsh renders with data-sx-marsh attribute"
|
|
(let ((env (env-extend (test-env))))
|
|
(let ((html (rh-env '(marsh :id "feed" (li "item")) env)))
|
|
(assert-true (string-contains? html "data-sx-marsh"))
|
|
(assert-true (string-contains? html "feed"))
|
|
(assert-true (string-contains? html "<li>item</li>")))))
|
|
|
|
(deftest "marsh with custom tag"
|
|
(let ((env (env-extend (test-env))))
|
|
(let ((html (rh-env '(marsh :id "list" :tag "ul" (li "a") (li "b")) env)))
|
|
(assert-true (starts-with? html "<ul"))
|
|
(assert-true (string-contains? html "<li>a</li>"))
|
|
(assert-true (string-contains? html "<li>b</li>"))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 29. Thread macro in templates
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-threading"
|
|
(deftest "thread-first in template context"
|
|
(assert-equal "<p>HELLO</p>"
|
|
(rh '(p (-> "hello" upper))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 30. Define in templates
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "html-define-in-template"
|
|
(deftest "define then use in same template"
|
|
(assert-equal "<p>42</p>"
|
|
(rh '(do (define x 42) (p (str x))))))
|
|
|
|
(deftest "defcomp then use"
|
|
(assert-equal "<em>hi</em>"
|
|
(rh '(do (defcomp ~tag (&key text) (em text))
|
|
(~tag :text "hi"))))))
|