Files
rose-ash/lib/content/tests/render.sx
giles 9c1c8f6b75
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 58s
content: asSx wire string-escaping (String>>sxEscaped) + 5 tests (243/243)
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 01:03:45 +00:00

136 lines
4.8 KiB
Plaintext

;; Phase 1 — render boundary. asHTML / asSx are polymorphic message sends on
;; blocks and the document. Escaping happens at the boundary.
(st-bootstrap-classes!)
(content-bootstrap-blocks!)
(content-bootstrap-doc!)
(content-bootstrap-render!)
(define h (mk-heading "h" 2 "Title"))
(define p (mk-text "p" "Hello"))
(define code (mk-code "c" "sx" "(+ 1 2)"))
(define q (mk-quote "q" "Ada" "to err"))
(define img (mk-image "i" "/c.png" "cat"))
(define em (mk-embed "e" "https://v/1" "vimeo"))
(define dv (mk-divider "d"))
(define ul (mk-list "u" false (list "a" "b")))
(define ol (mk-list "o" true (list "x" "y")))
;; ── per-block asHTML ──
(content-test "heading html" (asHTML h) "<h2>Title</h2>")
(content-test "text html" (asHTML p) "<p>Hello</p>")
(content-test
"code html"
(asHTML code)
"<pre><code class=\"language-sx\">(+ 1 2)</code></pre>")
(content-test "quote html" (asHTML q) "<blockquote>to err</blockquote>")
(content-test "image html" (asHTML img) "<img src=\"/c.png\" alt=\"cat\">")
(content-test "embed html" (asHTML em) "<iframe src=\"https://v/1\"></iframe>")
(content-test "divider html" (asHTML dv) "<hr>")
(content-test "ul html" (asHTML ul) "<ul><li>a</li><li>b</li></ul>")
(content-test "ol html" (asHTML ol) "<ol><li>x</li><li>y</li></ol>")
;; ── per-block asSx ──
(content-test "heading sx" (asSx h) "(h2 \"Title\")")
(content-test "text sx" (asSx p) "(p \"Hello\")")
(content-test "code sx" (asSx code) "(pre (code \"(+ 1 2)\"))")
(content-test "quote sx" (asSx q) "(blockquote \"to err\")")
(content-test "image sx" (asSx img) "(img :src \"/c.png\" :alt \"cat\")")
(content-test "embed sx" (asSx em) "(iframe :src \"https://v/1\")")
(content-test "divider sx" (asSx dv) "(hr)")
(content-test "ul sx" (asSx ul) "(ul (li \"a\")(li \"b\"))")
(content-test "ol sx" (asSx ol) "(ol (li \"x\")(li \"y\"))")
;; ── document folds children (pure message dispatch) ──
(define d (doc-append (doc-append (doc-append (doc-empty "doc") h) p) dv))
(content-test "doc html" (asHTML d) "<h2>Title</h2><p>Hello</p><hr>")
(content-test "doc sx" (asSx d) "(article (h2 \"Title\")(p \"Hello\")(hr))")
(content-test "empty doc html" (asHTML (doc-empty "e")) "")
(content-test "empty doc sx" (asSx (doc-empty "e")) "(article )")
;; ── render-* / block-* aliases ──
(content-test "render-html alias" (render-html d) (asHTML d))
(content-test "render-sx alias" (render-sx d) (asSx d))
(content-test "block-html alias" (block-html h) "<h2>Title</h2>")
;; ── render reflects edits (immutability: each render is of a version) ──
(define d2 (doc-update d "p" "text" "Edited"))
(content-test
"render after update"
(asHTML d2)
"<h2>Title</h2><p>Edited</p><hr>")
(content-test
"original render unchanged"
(asHTML d)
"<h2>Title</h2><p>Hello</p><hr>")
(content-test
"render after move"
(asHTML (doc-move d "h" 2))
"<p>Hello</p><hr><h2>Title</h2>")
(content-test
"render after delete"
(asHTML (doc-delete d "p"))
"<h2>Title</h2><hr>")
;; ── HTML escaping at the boundary ──
(define xh (mk-heading "xh" 2 "A < B & \"C\""))
(define xp (mk-text "xp" "<script>alert(1)</script>"))
(define xi (mk-image "xi" "/a.png?x=1&y=2" "tag <b>"))
(define xl (mk-list "xl" false (list "a<1" "b&2")))
(content-test
"escape heading text"
(asHTML xh)
"<h2>A &lt; B &amp; &quot;C&quot;</h2>")
(content-test
"escape paragraph"
(asHTML xp)
"<p>&lt;script&gt;alert(1)&lt;/script&gt;</p>")
(content-test
"escape image attrs"
(asHTML xi)
"<img src=\"/a.png?x=1&amp;y=2\" alt=\"tag &lt;b&gt;\">")
(content-test
"escape list items"
(asHTML xl)
"<ul><li>a&lt;1</li><li>b&amp;2</li></ul>")
(content-test
"escape ampersand once"
(asHTML (mk-text "amp" "a & b"))
"<p>a &amp; b</p>")
(content-test
"escape in document"
(asHTML (doc-append (doc-empty "e") xp))
"<p>&lt;script&gt;alert(1)&lt;/script&gt;</p>")
(content-test
"no over-escape plain"
(asHTML (mk-text "plain" "hello world"))
"<p>hello world</p>")
(content-test
"escape code body"
(asHTML (mk-code "xc" "html" "<div> & </div>"))
"<pre><code class=\"language-html\">&lt;div&gt; &amp; &lt;/div&gt;</code></pre>")
;; ── asSx string-escaping (build expected via q/bs to avoid miscounts) ──
(define q1 (str "\""))
(define bs (str "\\"))
(content-test
"asSx escapes quote"
(asSx (mk-text "qt" (str "say " q1 "hi" q1)))
(str "(p " q1 "say " bs q1 "hi" bs q1 q1 ")"))
(content-test
"asSx escapes backslash"
(asSx (mk-text "qb" (str "a" bs "b")))
(str "(p " q1 "a" bs bs "b" q1 ")"))
(content-test
"asSx plain unchanged"
(asSx (mk-text "pp" "plain"))
"(p \"plain\")")
(content-test
"asSx escapes image attr"
(asSx (mk-image "im" (str "/a" q1) "x"))
(str "(img :src " q1 "/a" bs q1 q1 " :alt " q1 "x" q1 ")"))
(content-test
"asSx escapes list item"
(asSx (mk-list "lq" false (list (str "i" q1) "j")))
(str "(ul (li " q1 "i" bs q1 q1 ")(li " q1 "j" q1 "))"))