Rename render-sx → render-to-sx in aser tests
79 occurrences renamed to match the actual function name in adapter-sx.sx. Tests still fail because render-to-sx takes an AST expression, not a source string — needs eval-string wrapper. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -1,468 +1,399 @@
|
||||
;; ==========================================================================
|
||||
;; test-aser.sx — Tests for the SX wire format (aser) adapter
|
||||
;;
|
||||
;; Requires: test-framework.sx loaded first.
|
||||
;; Modules tested: adapter-sx.sx (aser, aser-call, aser-fragment, aser-special)
|
||||
;;
|
||||
;; Platform functions required (beyond test framework):
|
||||
;; render-sx (sx-source) -> SX wire format string
|
||||
;; Parses the sx-source string, evaluates via aser in a
|
||||
;; fresh env, and returns the resulting SX wire format string.
|
||||
;; ==========================================================================
|
||||
(defsuite
|
||||
"aser-basics"
|
||||
(deftest
|
||||
"number literal passes through"
|
||||
(assert-equal "42" (render-to-sx "42")))
|
||||
(deftest
|
||||
"string literal passes through"
|
||||
(assert-equal "hello" (render-to-sx "\"hello\"")))
|
||||
(deftest
|
||||
"boolean true passes through"
|
||||
(assert-equal "true" (render-to-sx "true")))
|
||||
(deftest
|
||||
"boolean false passes through"
|
||||
(assert-equal "false" (render-to-sx "false")))
|
||||
(deftest "nil produces empty" (assert-equal "" (render-to-sx "nil"))))
|
||||
|
||||
(defsuite
|
||||
"aser-tags"
|
||||
(deftest
|
||||
"simple div"
|
||||
(assert-equal "(div \"hello\")" (render-to-sx "(div \"hello\")")))
|
||||
(deftest
|
||||
"nested tags"
|
||||
(assert-equal "(div (span \"hi\"))" (render-to-sx "(div (span \"hi\"))")))
|
||||
(deftest
|
||||
"multiple children"
|
||||
(assert-equal
|
||||
"(div (p \"a\") (p \"b\"))"
|
||||
(render-to-sx "(div (p \"a\") (p \"b\"))")))
|
||||
(deftest
|
||||
"attributes serialize"
|
||||
(assert-equal
|
||||
"(div :class \"foo\" \"bar\")"
|
||||
(render-to-sx "(div :class \"foo\" \"bar\")")))
|
||||
(deftest
|
||||
"multiple attributes"
|
||||
(assert-equal
|
||||
"(a :href \"/home\" :class \"link\" \"Home\")"
|
||||
(render-to-sx "(a :href \"/home\" :class \"link\" \"Home\")")))
|
||||
(deftest "void elements" (assert-equal "(br)" (render-to-sx "(br)")))
|
||||
(deftest
|
||||
"void element with attrs"
|
||||
(assert-equal
|
||||
"(img :src \"pic.jpg\")"
|
||||
(render-to-sx "(img :src \"pic.jpg\")"))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Basic serialization
|
||||
;; --------------------------------------------------------------------------
|
||||
(defsuite
|
||||
"aser-fragments"
|
||||
(deftest
|
||||
"simple fragment"
|
||||
(assert-equal
|
||||
"(<> (p \"a\") (p \"b\"))"
|
||||
(render-to-sx "(<> (p \"a\") (p \"b\"))")))
|
||||
(deftest "empty fragment" (assert-equal "" (render-to-sx "(<>)")))
|
||||
(deftest
|
||||
"single-child fragment"
|
||||
(assert-equal "(<> (div \"x\"))" (render-to-sx "(<> (div \"x\"))"))))
|
||||
|
||||
(defsuite "aser-basics"
|
||||
(deftest "number literal passes through"
|
||||
(assert-equal "42"
|
||||
(render-sx "42")))
|
||||
(defsuite
|
||||
"aser-control-flow"
|
||||
(deftest
|
||||
"if true branch"
|
||||
(assert-equal "(p \"yes\")" (render-to-sx "(if true (p \"yes\") (p \"no\"))")))
|
||||
(deftest
|
||||
"if false branch"
|
||||
(assert-equal "(p \"no\")" (render-to-sx "(if false (p \"yes\") (p \"no\"))")))
|
||||
(deftest
|
||||
"when true"
|
||||
(assert-equal "(p \"ok\")" (render-to-sx "(when true (p \"ok\"))")))
|
||||
(deftest
|
||||
"when false"
|
||||
(assert-equal "" (render-to-sx "(when false (p \"ok\"))")))
|
||||
(deftest
|
||||
"cond serializes matching branch"
|
||||
(assert-equal
|
||||
"(p \"two\")"
|
||||
(render-to-sx "(cond false (p \"one\") true (p \"two\") :else (p \"three\"))")))
|
||||
(deftest
|
||||
"cond with 2-element predicate test"
|
||||
(assert-equal
|
||||
"(p \"yes\")"
|
||||
(render-to-sx "(cond (nil? nil) (p \"yes\") :else (p \"no\"))"))
|
||||
(assert-equal
|
||||
"(p \"no\")"
|
||||
(render-to-sx "(cond (nil? \"x\") (p \"yes\") :else (p \"no\"))")))
|
||||
(deftest
|
||||
"let binds then serializes"
|
||||
(assert-equal "(p \"hello\")" (render-to-sx "(let ((x \"hello\")) (p x))")))
|
||||
(deftest
|
||||
"let preserves outer scope bindings"
|
||||
(assert-equal
|
||||
"(p \"outer\")"
|
||||
(render-to-sx "(do (define theme \"outer\") (let ((x 1)) (p theme)))")))
|
||||
(deftest
|
||||
"nested let preserves outer scope"
|
||||
(assert-equal
|
||||
"(div (span \"hello\") (span \"world\"))"
|
||||
(render-to-sx
|
||||
"(do (define a \"hello\")\n (define b \"world\")\n (div (let ((x 1)) (span a))\n (let ((y 2)) (span b))))")))
|
||||
(deftest
|
||||
"begin serializes last"
|
||||
(assert-equal
|
||||
"(p \"last\")"
|
||||
(render-to-sx "(begin (p \"first\") (p \"last\"))"))))
|
||||
|
||||
(deftest "string literal passes through"
|
||||
;; aser returns the raw string value; render-sx concatenates it directly
|
||||
(assert-equal "hello"
|
||||
(render-sx "\"hello\"")))
|
||||
(defsuite
|
||||
"aser-list-flattening"
|
||||
(deftest
|
||||
"map inside tag flattens children"
|
||||
(assert-equal
|
||||
"(div (span \"a\") (span \"b\") (span \"c\"))"
|
||||
(render-to-sx
|
||||
"(do (define items (list \"a\" \"b\" \"c\"))\n (div (map (fn (x) (span x)) items)))")))
|
||||
(deftest
|
||||
"map inside tag with other children"
|
||||
(assert-equal
|
||||
"(ul (li \"first\") (li \"a\") (li \"b\"))"
|
||||
(render-to-sx
|
||||
"(do (define items (list \"a\" \"b\"))\n (ul (li \"first\") (map (fn (x) (li x)) items)))")))
|
||||
(deftest
|
||||
"filter result via let binding as children"
|
||||
(assert-equal
|
||||
"(ul (li \"a\") (li \"b\"))"
|
||||
(render-to-sx
|
||||
"(do (define items (list \"a\" nil \"b\"))\n (define kept (filter (fn (x) (not (nil? x))) items))\n (ul (map (fn (x) (li x)) kept)))")))
|
||||
(deftest
|
||||
"map inside fragment flattens"
|
||||
(assert-equal
|
||||
"(<> (p \"a\") (p \"b\"))"
|
||||
(render-to-sx
|
||||
"(do (define items (list \"a\" \"b\"))\n (<> (map (fn (x) (p x)) items)))")))
|
||||
(deftest
|
||||
"nested map does not double-wrap"
|
||||
(assert-equal
|
||||
"(div (span \"1\") (span \"2\"))"
|
||||
(render-to-sx
|
||||
"(do (define nums (list 1 2))\n (div (map (fn (n) (span (str n))) nums)))")))
|
||||
(deftest
|
||||
"map with component-like output flattens"
|
||||
(assert-equal
|
||||
"(div (li \"x\") (li \"y\"))"
|
||||
(render-to-sx
|
||||
"(do (define items (list \"x\" \"y\"))\n (div (map (fn (x) (li x)) items)))"))))
|
||||
|
||||
(deftest "boolean true passes through"
|
||||
(assert-equal "true"
|
||||
(render-sx "true")))
|
||||
(defsuite
|
||||
"aser-components"
|
||||
(deftest
|
||||
"unknown component serializes as-is"
|
||||
(assert-equal "(~foo :title \"bar\")" (render-to-sx "(~foo :title \"bar\")")))
|
||||
(deftest
|
||||
"defcomp then unexpanded component call"
|
||||
(assert-equal
|
||||
"(~card :title \"Hi\")"
|
||||
(render-to-sx
|
||||
"(do (defcomp ~card (&key title) (h1 title)) (~card :title \"Hi\"))")))
|
||||
(deftest
|
||||
"component with children serializes unexpanded"
|
||||
(assert-equal
|
||||
"(~box (p \"inside\"))"
|
||||
(render-to-sx
|
||||
"(do (defcomp ~box (&key &rest children) (div children))\n (~box (p \"inside\")))")))
|
||||
(deftest
|
||||
"string keyword arg starting with paren is quoted"
|
||||
(assert-equal
|
||||
"(~info :text \"(hello world)\")"
|
||||
(render-to-sx
|
||||
"(do (defcomp ~info (&key text) (code text))\n (~info :text \"(hello world)\"))")))
|
||||
(deftest
|
||||
"string child starting with paren is quoted"
|
||||
(assert-equal
|
||||
"(p \"(not code)\")"
|
||||
(render-to-sx "(let ((x \"(not code)\")) (p x))"))))
|
||||
|
||||
(deftest "boolean false passes through"
|
||||
(assert-equal "false"
|
||||
(render-sx "false")))
|
||||
|
||||
(deftest "nil produces empty"
|
||||
(assert-equal ""
|
||||
(render-sx "nil"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; HTML tag serialization
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "aser-tags"
|
||||
(deftest "simple div"
|
||||
(assert-equal "(div \"hello\")"
|
||||
(render-sx "(div \"hello\")")))
|
||||
|
||||
(deftest "nested tags"
|
||||
(assert-equal "(div (span \"hi\"))"
|
||||
(render-sx "(div (span \"hi\"))")))
|
||||
|
||||
(deftest "multiple children"
|
||||
(assert-equal "(div (p \"a\") (p \"b\"))"
|
||||
(render-sx "(div (p \"a\") (p \"b\"))")))
|
||||
|
||||
(deftest "attributes serialize"
|
||||
(assert-equal "(div :class \"foo\" \"bar\")"
|
||||
(render-sx "(div :class \"foo\" \"bar\")")))
|
||||
|
||||
(deftest "multiple attributes"
|
||||
(assert-equal "(a :href \"/home\" :class \"link\" \"Home\")"
|
||||
(render-sx "(a :href \"/home\" :class \"link\" \"Home\")")))
|
||||
|
||||
(deftest "void elements"
|
||||
(assert-equal "(br)"
|
||||
(render-sx "(br)")))
|
||||
|
||||
(deftest "void element with attrs"
|
||||
(assert-equal "(img :src \"pic.jpg\")"
|
||||
(render-sx "(img :src \"pic.jpg\")"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Fragment serialization
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "aser-fragments"
|
||||
(deftest "simple fragment"
|
||||
(assert-equal "(<> (p \"a\") (p \"b\"))"
|
||||
(render-sx "(<> (p \"a\") (p \"b\"))")))
|
||||
|
||||
(deftest "empty fragment"
|
||||
(assert-equal ""
|
||||
(render-sx "(<>)")))
|
||||
|
||||
(deftest "single-child fragment"
|
||||
(assert-equal "(<> (div \"x\"))"
|
||||
(render-sx "(<> (div \"x\"))"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Control flow in aser mode
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "aser-control-flow"
|
||||
(deftest "if true branch"
|
||||
(assert-equal "(p \"yes\")"
|
||||
(render-sx "(if true (p \"yes\") (p \"no\"))")))
|
||||
|
||||
(deftest "if false branch"
|
||||
(assert-equal "(p \"no\")"
|
||||
(render-sx "(if false (p \"yes\") (p \"no\"))")))
|
||||
|
||||
(deftest "when true"
|
||||
(assert-equal "(p \"ok\")"
|
||||
(render-sx "(when true (p \"ok\"))")))
|
||||
|
||||
(deftest "when false"
|
||||
(assert-equal ""
|
||||
(render-sx "(when false (p \"ok\"))")))
|
||||
|
||||
(deftest "cond serializes matching branch"
|
||||
(assert-equal "(p \"two\")"
|
||||
(render-sx "(cond false (p \"one\") true (p \"two\") :else (p \"three\"))")))
|
||||
|
||||
(deftest "cond with 2-element predicate test"
|
||||
;; Regression: cond misclassifies (nil? x) as scheme-style clause.
|
||||
(assert-equal "(p \"yes\")"
|
||||
(render-sx "(cond (nil? nil) (p \"yes\") :else (p \"no\"))"))
|
||||
(assert-equal "(p \"no\")"
|
||||
(render-sx "(cond (nil? \"x\") (p \"yes\") :else (p \"no\"))")))
|
||||
|
||||
(deftest "let binds then serializes"
|
||||
(assert-equal "(p \"hello\")"
|
||||
(render-sx "(let ((x \"hello\")) (p x))")))
|
||||
|
||||
(deftest "let preserves outer scope bindings"
|
||||
;; Regression: process-bindings must preserve parent env scope chain.
|
||||
;; Using merge() instead of env-extend loses parent scope items.
|
||||
(assert-equal "(p \"outer\")"
|
||||
(render-sx "(do (define theme \"outer\") (let ((x 1)) (p theme)))")))
|
||||
|
||||
(deftest "nested let preserves outer scope"
|
||||
(assert-equal "(div (span \"hello\") (span \"world\"))"
|
||||
(render-sx "(do (define a \"hello\")
|
||||
(define b \"world\")
|
||||
(div (let ((x 1)) (span a))
|
||||
(let ((y 2)) (span b))))")))
|
||||
|
||||
(deftest "begin serializes last"
|
||||
(assert-equal "(p \"last\")"
|
||||
(render-sx "(begin (p \"first\") (p \"last\"))"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; THE BUG — map/filter list flattening in children (critical regression)
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "aser-list-flattening"
|
||||
(deftest "map inside tag flattens children"
|
||||
(assert-equal "(div (span \"a\") (span \"b\") (span \"c\"))"
|
||||
(render-sx "(do (define items (list \"a\" \"b\" \"c\"))
|
||||
(div (map (fn (x) (span x)) items)))")))
|
||||
|
||||
(deftest "map inside tag with other children"
|
||||
(assert-equal "(ul (li \"first\") (li \"a\") (li \"b\"))"
|
||||
(render-sx "(do (define items (list \"a\" \"b\"))
|
||||
(ul (li \"first\") (map (fn (x) (li x)) items)))")))
|
||||
|
||||
(deftest "filter result via let binding as children"
|
||||
;; Note: (filter ...) is treated as an SVG tag in aser dispatch (SVG has <filter>),
|
||||
;; so we evaluate filter via let binding + map to serialize children
|
||||
(assert-equal "(ul (li \"a\") (li \"b\"))"
|
||||
(render-sx "(do (define items (list \"a\" nil \"b\"))
|
||||
(define kept (filter (fn (x) (not (nil? x))) items))
|
||||
(ul (map (fn (x) (li x)) kept)))")))
|
||||
|
||||
(deftest "map inside fragment flattens"
|
||||
(assert-equal "(<> (p \"a\") (p \"b\"))"
|
||||
(render-sx "(do (define items (list \"a\" \"b\"))
|
||||
(<> (map (fn (x) (p x)) items)))")))
|
||||
|
||||
(deftest "nested map does not double-wrap"
|
||||
(assert-equal "(div (span \"1\") (span \"2\"))"
|
||||
(render-sx "(do (define nums (list 1 2))
|
||||
(div (map (fn (n) (span (str n))) nums)))")))
|
||||
|
||||
(deftest "map with component-like output flattens"
|
||||
(assert-equal "(div (li \"x\") (li \"y\"))"
|
||||
(render-sx "(do (define items (list \"x\" \"y\"))
|
||||
(div (map (fn (x) (li x)) items)))"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Component serialization (NOT expanded in basic aser mode)
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "aser-components"
|
||||
(deftest "unknown component serializes as-is"
|
||||
(assert-equal "(~foo :title \"bar\")"
|
||||
(render-sx "(~foo :title \"bar\")")))
|
||||
|
||||
(deftest "defcomp then unexpanded component call"
|
||||
(assert-equal "(~card :title \"Hi\")"
|
||||
(render-sx "(do (defcomp ~card (&key title) (h1 title)) (~card :title \"Hi\"))")))
|
||||
|
||||
(deftest "component with children serializes unexpanded"
|
||||
(assert-equal "(~box (p \"inside\"))"
|
||||
(render-sx "(do (defcomp ~box (&key &rest children) (div children))
|
||||
(~box (p \"inside\")))")))
|
||||
|
||||
(deftest "string keyword arg starting with paren is quoted"
|
||||
(assert-equal "(~info :text \"(hello world)\")"
|
||||
(render-sx "(do (defcomp ~info (&key text) (code text))
|
||||
(~info :text \"(hello world)\"))")))
|
||||
|
||||
(deftest "string child starting with paren is quoted"
|
||||
(assert-equal "(p \"(not code)\")"
|
||||
(render-sx "(let ((x \"(not code)\")) (p x))"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Definition forms in aser mode
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "aser-definitions"
|
||||
(deftest "define evaluates for side effects, returns nil"
|
||||
(assert-equal "(p 42)"
|
||||
(render-sx "(do (define x 42) (p x))")))
|
||||
|
||||
(deftest "defcomp evaluates and returns nil"
|
||||
(assert-equal "(~tag :x 1)"
|
||||
(render-sx "(do (defcomp ~tag (&key x) (span x)) (~tag :x 1))")))
|
||||
|
||||
(deftest "defisland evaluates AND serializes"
|
||||
(let ((result (render-sx "(defisland ~counter (&key count) (span count))")))
|
||||
(defsuite
|
||||
"aser-definitions"
|
||||
(deftest
|
||||
"define evaluates for side effects, returns nil"
|
||||
(assert-equal "(p 42)" (render-to-sx "(do (define x 42) (p x))")))
|
||||
(deftest
|
||||
"defcomp evaluates and returns nil"
|
||||
(assert-equal
|
||||
"(~tag :x 1)"
|
||||
(render-to-sx "(do (defcomp ~tag (&key x) (span x)) (~tag :x 1))")))
|
||||
(deftest
|
||||
"defisland evaluates AND serializes"
|
||||
(let
|
||||
((result (render-to-sx "(defisland ~counter (&key count) (span count))")))
|
||||
(assert-true (string-contains? result "defisland")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Function calls in aser mode
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "aser-function-calls"
|
||||
(deftest "named function call evaluates fully"
|
||||
(assert-equal "3"
|
||||
(render-sx "(do (define inc1 (fn (x) (+ x 1))) (inc1 2))")))
|
||||
|
||||
(deftest "define + call"
|
||||
(assert-equal "10"
|
||||
(render-sx "(do (define double (fn (x) (* x 2))) (double 5))")))
|
||||
|
||||
(deftest "native callable with multiple args"
|
||||
;; Regression: async-aser-eval-call passed evaled-args list to
|
||||
;; async-invoke (&rest), wrapping it in another list. apply(f, [list])
|
||||
;; calls f(list) instead of f(*list).
|
||||
(assert-equal "3"
|
||||
(render-sx "(do (define my-add +) (my-add 1 2))")))
|
||||
|
||||
(deftest "native callable with two args via alias"
|
||||
(assert-equal "hello world"
|
||||
(render-sx "(do (define my-join str) (my-join \"hello\" \" world\"))")))
|
||||
|
||||
(deftest "higher-order: map returns list"
|
||||
(let ((result (render-sx "(map (fn (x) (+ x 1)) (list 1 2 3))")))
|
||||
;; map at top level returns a list, not serialized tags
|
||||
(defsuite
|
||||
"aser-function-calls"
|
||||
(deftest
|
||||
"named function call evaluates fully"
|
||||
(assert-equal
|
||||
"3"
|
||||
(render-to-sx "(do (define inc1 (fn (x) (+ x 1))) (inc1 2))")))
|
||||
(deftest
|
||||
"define + call"
|
||||
(assert-equal
|
||||
"10"
|
||||
(render-to-sx "(do (define double (fn (x) (* x 2))) (double 5))")))
|
||||
(deftest
|
||||
"native callable with multiple args"
|
||||
(assert-equal "3" (render-to-sx "(do (define my-add +) (my-add 1 2))")))
|
||||
(deftest
|
||||
"native callable with two args via alias"
|
||||
(assert-equal
|
||||
"hello world"
|
||||
(render-to-sx "(do (define my-join str) (my-join \"hello\" \" world\"))")))
|
||||
(deftest
|
||||
"higher-order: map returns list"
|
||||
(let
|
||||
((result (render-to-sx "(map (fn (x) (+ x 1)) (list 1 2 3))")))
|
||||
(assert-true (not (nil? result))))))
|
||||
|
||||
(defsuite
|
||||
"aser-logic"
|
||||
(deftest
|
||||
"and short-circuits on false"
|
||||
(assert-equal "false" (render-to-sx "(and true false true)")))
|
||||
(deftest
|
||||
"and returns last truthy"
|
||||
(assert-equal "3" (render-to-sx "(and 1 2 3)")))
|
||||
(deftest
|
||||
"or short-circuits on true"
|
||||
(assert-equal "1" (render-to-sx "(or 1 2 3)")))
|
||||
(deftest
|
||||
"or returns last falsy"
|
||||
(assert-equal "false" (render-to-sx "(or false false)"))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; and/or short-circuit in aser mode
|
||||
;; --------------------------------------------------------------------------
|
||||
(defsuite
|
||||
"aser-spreads"
|
||||
(deftest
|
||||
"spread in element merges attrs"
|
||||
(assert-equal
|
||||
"(div :class \"card\" \"hello\")"
|
||||
(render-to-sx "(div (make-spread {:class \"card\"}) \"hello\")")))
|
||||
(deftest
|
||||
"multiple spreads merge into element"
|
||||
(assert-equal
|
||||
"(div :class \"card\" :style \"color:red\" \"hello\")"
|
||||
(render-to-sx
|
||||
"(div (make-spread {:class \"card\"}) (make-spread {:style \"color:red\"}) \"hello\")")))
|
||||
(deftest
|
||||
"spread in fragment is silently dropped"
|
||||
(assert-equal
|
||||
"(<> \"hello\")"
|
||||
(render-to-sx "(<> (make-spread {:class \"card\"}) \"hello\")")))
|
||||
(deftest
|
||||
"stored spread in let binding"
|
||||
(assert-equal
|
||||
"(div :class \"card\" \"hello\")"
|
||||
(render-to-sx
|
||||
"(let ((card (make-spread {:class \"card\"})))\n (div card \"hello\"))")))
|
||||
(deftest
|
||||
"spread in nested element"
|
||||
(assert-equal
|
||||
"(div (span :class \"inner\" \"hi\"))"
|
||||
(render-to-sx "(div (span (make-spread {:class \"inner\"}) \"hi\"))")))
|
||||
(deftest
|
||||
"spread in non-element context silently drops"
|
||||
(assert-equal
|
||||
"hello"
|
||||
(render-to-sx "(do (make-spread {:class \"card\"}) \"hello\")"))))
|
||||
|
||||
(defsuite "aser-logic"
|
||||
(deftest "and short-circuits on false"
|
||||
(assert-equal "false"
|
||||
(render-sx "(and true false true)")))
|
||||
(defsuite
|
||||
"scope"
|
||||
(deftest
|
||||
"scope with value and context"
|
||||
(assert-equal
|
||||
"dark"
|
||||
(render-to-sx "(scope \"sc-theme\" :value \"dark\" (context \"sc-theme\"))")))
|
||||
(deftest
|
||||
"scope without value defaults to nil"
|
||||
(assert-equal
|
||||
""
|
||||
(render-to-sx "(scope \"sc-nil\" (str (context \"sc-nil\")))")))
|
||||
(deftest
|
||||
"scope with emit!/emitted"
|
||||
(assert-equal
|
||||
"a,b"
|
||||
(render-to-sx
|
||||
"(scope \"sc-emit\" (emit! \"sc-emit\" \"a\") (emit! \"sc-emit\" \"b\") (join \",\" (emitted \"sc-emit\")))")))
|
||||
(deftest
|
||||
"provide is equivalent to scope with value"
|
||||
(assert-equal
|
||||
"42"
|
||||
(render-to-sx "(provide \"sc-prov\" 42 (str (context \"sc-prov\")))")))
|
||||
(deftest
|
||||
"collect! works via scope (lazy root scope)"
|
||||
(assert-equal
|
||||
"x,y"
|
||||
(render-to-sx
|
||||
"(do (collect! \"sc-coll\" \"x\") (collect! \"sc-coll\" \"y\") (join \",\" (collected \"sc-coll\")))")))
|
||||
(deftest
|
||||
"collect! deduplicates"
|
||||
(assert-equal
|
||||
"a"
|
||||
(render-to-sx
|
||||
"(do (collect! \"sc-dedup\" \"a\") (collect! \"sc-dedup\" \"a\") (join \",\" (collected \"sc-dedup\")))")))
|
||||
(deftest
|
||||
"clear-collected! clears scope accumulator"
|
||||
(assert-equal
|
||||
""
|
||||
(render-to-sx
|
||||
"(do (collect! \"sc-clear\" \"x\") (clear-collected! \"sc-clear\") (join \",\" (collected \"sc-clear\")))")))
|
||||
(deftest
|
||||
"nested scope shadows outer"
|
||||
(assert-equal
|
||||
"inner"
|
||||
(render-to-sx
|
||||
"(scope \"sc-nest\" :value \"outer\" (scope \"sc-nest\" :value \"inner\" (context \"sc-nest\")))")))
|
||||
(deftest
|
||||
"scope pops correctly after body"
|
||||
(assert-equal
|
||||
"outer"
|
||||
(render-to-sx
|
||||
"(scope \"sc-pop\" :value \"outer\" (scope \"sc-pop\" :value \"inner\" \"ignore\") (context \"sc-pop\"))"))))
|
||||
|
||||
(deftest "and returns last truthy"
|
||||
(assert-equal "3"
|
||||
(render-sx "(and 1 2 3)")))
|
||||
|
||||
(deftest "or short-circuits on true"
|
||||
(assert-equal "1"
|
||||
(render-sx "(or 1 2 3)")))
|
||||
|
||||
(deftest "or returns last falsy"
|
||||
(assert-equal "false"
|
||||
(render-sx "(or false false)"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Spread serialization
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "aser-spreads"
|
||||
(deftest "spread in element merges attrs"
|
||||
(assert-equal "(div :class \"card\" \"hello\")"
|
||||
(render-sx "(div (make-spread {:class \"card\"}) \"hello\")")))
|
||||
|
||||
(deftest "multiple spreads merge into element"
|
||||
(assert-equal "(div :class \"card\" :style \"color:red\" \"hello\")"
|
||||
(render-sx "(div (make-spread {:class \"card\"}) (make-spread {:style \"color:red\"}) \"hello\")")))
|
||||
|
||||
(deftest "spread in fragment is silently dropped"
|
||||
(assert-equal "(<> \"hello\")"
|
||||
(render-sx "(<> (make-spread {:class \"card\"}) \"hello\")")))
|
||||
|
||||
(deftest "stored spread in let binding"
|
||||
(assert-equal "(div :class \"card\" \"hello\")"
|
||||
(render-sx "(let ((card (make-spread {:class \"card\"})))
|
||||
(div card \"hello\"))")))
|
||||
|
||||
(deftest "spread in nested element"
|
||||
(assert-equal "(div (span :class \"inner\" \"hi\"))"
|
||||
(render-sx "(div (span (make-spread {:class \"inner\"}) \"hi\"))")))
|
||||
|
||||
(deftest "spread in non-element context silently drops"
|
||||
(assert-equal "hello"
|
||||
(render-sx "(do (make-spread {:class \"card\"}) \"hello\")"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Scope tests — unified scope primitive
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "scope"
|
||||
|
||||
(deftest "scope with value and context"
|
||||
(assert-equal "dark"
|
||||
(render-sx "(scope \"sc-theme\" :value \"dark\" (context \"sc-theme\"))")))
|
||||
|
||||
(deftest "scope without value defaults to nil"
|
||||
(assert-equal ""
|
||||
(render-sx "(scope \"sc-nil\" (str (context \"sc-nil\")))")))
|
||||
|
||||
(deftest "scope with emit!/emitted"
|
||||
(assert-equal "a,b"
|
||||
(render-sx "(scope \"sc-emit\" (emit! \"sc-emit\" \"a\") (emit! \"sc-emit\" \"b\") (join \",\" (emitted \"sc-emit\")))")))
|
||||
|
||||
(deftest "provide is equivalent to scope with value"
|
||||
(assert-equal "42"
|
||||
(render-sx "(provide \"sc-prov\" 42 (str (context \"sc-prov\")))")))
|
||||
|
||||
(deftest "collect! works via scope (lazy root scope)"
|
||||
(assert-equal "x,y"
|
||||
(render-sx "(do (collect! \"sc-coll\" \"x\") (collect! \"sc-coll\" \"y\") (join \",\" (collected \"sc-coll\")))")))
|
||||
|
||||
(deftest "collect! deduplicates"
|
||||
(assert-equal "a"
|
||||
(render-sx "(do (collect! \"sc-dedup\" \"a\") (collect! \"sc-dedup\" \"a\") (join \",\" (collected \"sc-dedup\")))")))
|
||||
|
||||
(deftest "clear-collected! clears scope accumulator"
|
||||
(assert-equal ""
|
||||
(render-sx "(do (collect! \"sc-clear\" \"x\") (clear-collected! \"sc-clear\") (join \",\" (collected \"sc-clear\")))")))
|
||||
|
||||
(deftest "nested scope shadows outer"
|
||||
(assert-equal "inner"
|
||||
(render-sx "(scope \"sc-nest\" :value \"outer\" (scope \"sc-nest\" :value \"inner\" (context \"sc-nest\")))")))
|
||||
|
||||
(deftest "scope pops correctly after body"
|
||||
(assert-equal "outer"
|
||||
(render-sx "(scope \"sc-pop\" :value \"outer\" (scope \"sc-pop\" :value \"inner\" \"ignore\") (context \"sc-pop\"))"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Error propagation — errors in aser control flow must throw, not silently
|
||||
;; produce wrong output or fall through to :else branches.
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "aser-error-propagation"
|
||||
|
||||
;; --- case: matched branch errors must throw, not fall through to :else ---
|
||||
|
||||
(deftest "case — error in matched branch throws, not falls through"
|
||||
;; If the matched case body references an undefined symbol, the aser must
|
||||
;; throw an error — NOT silently skip to :else.
|
||||
(defsuite
|
||||
"aser-error-propagation"
|
||||
(deftest
|
||||
"case — error in matched branch throws, not falls through"
|
||||
(assert-throws
|
||||
(fn () (render-sx "(case \"x\" \"x\" undefined-symbol-xyz :else \"fallback\")"))))
|
||||
|
||||
(deftest "case — :else body error also throws"
|
||||
(fn
|
||||
()
|
||||
(render-to-sx "(case \"x\" \"x\" undefined-symbol-xyz :else \"fallback\")"))))
|
||||
(deftest
|
||||
"case — :else body error also throws"
|
||||
(assert-throws
|
||||
(fn () (render-sx "(case \"no-match\" \"x\" \"ok\" :else undefined-symbol-xyz)"))))
|
||||
|
||||
(deftest "case — matched branch with nested error throws"
|
||||
;; Error inside a tag within the matched body must propagate.
|
||||
(fn
|
||||
()
|
||||
(render-to-sx "(case \"no-match\" \"x\" \"ok\" :else undefined-symbol-xyz)"))))
|
||||
(deftest
|
||||
"case — matched branch with nested error throws"
|
||||
(assert-throws
|
||||
(fn () (render-sx "(case \"a\" \"a\" (div (p undefined-sym-abc)) :else (p \"index\"))"))))
|
||||
|
||||
;; --- cond: matched branch errors must throw ---
|
||||
|
||||
(deftest "cond — error in matched branch throws"
|
||||
(fn
|
||||
()
|
||||
(render-to-sx
|
||||
"(case \"a\" \"a\" (div (p undefined-sym-abc)) :else (p \"index\"))"))))
|
||||
(deftest
|
||||
"cond — error in matched branch throws"
|
||||
(assert-throws
|
||||
(fn () (render-sx "(cond true undefined-cond-sym :else \"fallback\")"))))
|
||||
|
||||
(deftest "cond — error in :else branch throws"
|
||||
(fn () (render-to-sx "(cond true undefined-cond-sym :else \"fallback\")"))))
|
||||
(deftest
|
||||
"cond — error in :else branch throws"
|
||||
(assert-throws
|
||||
(fn () (render-sx "(cond false \"skip\" :else undefined-cond-sym)"))))
|
||||
|
||||
;; --- if/when: body errors must throw ---
|
||||
|
||||
(deftest "if — error in true branch throws"
|
||||
(fn () (render-to-sx "(cond false \"skip\" :else undefined-cond-sym)"))))
|
||||
(deftest
|
||||
"if — error in true branch throws"
|
||||
(assert-throws
|
||||
(fn () (render-sx "(if true undefined-if-sym \"fallback\")"))))
|
||||
|
||||
(deftest "when — error in body throws"
|
||||
(fn () (render-to-sx "(if true undefined-if-sym \"fallback\")"))))
|
||||
(deftest
|
||||
"when — error in body throws"
|
||||
(assert-throws (fn () (render-to-sx "(when true undefined-when-sym)"))))
|
||||
(deftest
|
||||
"let — error in binding throws"
|
||||
(assert-throws
|
||||
(fn () (render-sx "(when true undefined-when-sym)"))))
|
||||
|
||||
;; --- let: binding or body errors must throw ---
|
||||
|
||||
(deftest "let — error in binding throws"
|
||||
(fn () (render-to-sx "(let ((x undefined-let-sym)) (p x))"))))
|
||||
(deftest
|
||||
"let — error in body throws"
|
||||
(assert-throws
|
||||
(fn () (render-sx "(let ((x undefined-let-sym)) (p x))"))))
|
||||
(fn () (render-to-sx "(let ((x 1)) (p undefined-let-body-sym))"))))
|
||||
(deftest
|
||||
"do — error in body throws"
|
||||
(assert-throws (fn () (render-to-sx "(do \"ok\" undefined-do-sym)"))))
|
||||
(deftest
|
||||
"case — component in matched branch serializes unexpanded"
|
||||
(assert-equal
|
||||
"(~broken :title \"test\")"
|
||||
(render-to-sx
|
||||
"(do (defcomp ~broken (&key title) (div (p title) (p no-such-helper)))\n (case \"slug\" \"slug\" (~broken :title \"test\") :else \"index\"))")))
|
||||
(deftest
|
||||
"case — unmatched falls through to :else correctly"
|
||||
(assert-equal
|
||||
"index"
|
||||
(render-to-sx
|
||||
"(do (defcomp ~page (&key x) (div x))\n (case \"miss\" \"hit\" (~page :x \"found\") :else \"index\"))"))))
|
||||
|
||||
(deftest "let — error in body throws"
|
||||
(assert-throws
|
||||
(fn () (render-sx "(let ((x 1)) (p undefined-let-body-sym))"))))
|
||||
|
||||
;; --- begin/do: body errors must throw ---
|
||||
|
||||
(deftest "do — error in body throws"
|
||||
(assert-throws
|
||||
(fn () (render-sx "(do \"ok\" undefined-do-sym)"))))
|
||||
|
||||
;; --- component expansion inside case: the production bug ---
|
||||
|
||||
;; --- sync aser serializes components without expansion ---
|
||||
|
||||
(deftest "case — component in matched branch serializes unexpanded"
|
||||
;; Sync aser serializes component calls as SX wire format.
|
||||
;; Expansion only happens in async path with expand-components.
|
||||
(assert-equal "(~broken :title \"test\")"
|
||||
(render-sx
|
||||
"(do (defcomp ~broken (&key title) (div (p title) (p no-such-helper)))
|
||||
(case \"slug\" \"slug\" (~broken :title \"test\") :else \"index\"))")))
|
||||
|
||||
(deftest "case — unmatched falls through to :else correctly"
|
||||
(assert-equal "index"
|
||||
(render-sx
|
||||
"(do (defcomp ~page (&key x) (div x))
|
||||
(case \"miss\" \"hit\" (~page :x \"found\") :else \"index\"))"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Dict mutation through lambda calls in aser body
|
||||
;; --------------------------------------------------------------------------
|
||||
;;
|
||||
;; Regression: aser's :else branch used call-lambda which re-evaluated
|
||||
;; args through eval_expr. The CEK evaluator copies Dict values during
|
||||
;; evaluation (treating them as dict literals), so mutations inside the
|
||||
;; lambda operated on a copy, not the original. This broke signal
|
||||
;; reset!/swap! in island SSR where aser processes multi-body let forms.
|
||||
|
||||
(defsuite "aser-dict-mutation"
|
||||
(deftest "lambda mutating dict arg in multi-body let"
|
||||
(assert-equal "99"
|
||||
(render-sx
|
||||
"(let ((mutate! (fn (d k v) (dict-set! d k v)))
|
||||
(d (dict \"x\" 1)))
|
||||
(mutate! d \"x\" 99)
|
||||
(get d \"x\"))")))
|
||||
|
||||
(deftest "signal reset! in multi-body let"
|
||||
(assert-equal "99"
|
||||
(render-sx
|
||||
"(let ((s (signal 42)))
|
||||
(reset! s 99)
|
||||
(deref s))")))
|
||||
|
||||
(deftest "signal reset! then len of deref in multi-body let"
|
||||
(assert-equal "3"
|
||||
(render-sx
|
||||
"(let ((s (signal (list))))
|
||||
(reset! s (list 1 2 3))
|
||||
(len (deref s)))"))))
|
||||
(defsuite
|
||||
"aser-dict-mutation"
|
||||
(deftest
|
||||
"lambda mutating dict arg in multi-body let"
|
||||
(assert-equal
|
||||
"99"
|
||||
(render-to-sx
|
||||
"(let ((mutate! (fn (d k v) (dict-set! d k v)))\n (d (dict \"x\" 1)))\n (mutate! d \"x\" 99)\n (get d \"x\"))")))
|
||||
(deftest
|
||||
"signal reset! in multi-body let"
|
||||
(assert-equal
|
||||
"99"
|
||||
(render-to-sx
|
||||
"(let ((s (signal 42)))\n (reset! s 99)\n (deref s))")))
|
||||
(deftest
|
||||
"signal reset! then len of deref in multi-body let"
|
||||
(assert-equal
|
||||
"3"
|
||||
(render-to-sx
|
||||
"(let ((s (signal (list))))\n (reset! s (list 1 2 3))\n (len (deref s)))"))))
|
||||
|
||||
Reference in New Issue
Block a user