The cond special form misclassified Clojure-style as scheme-style when the first test was a 2-element list like (nil? x) — treating it as a scheme clause ((test body)) instead of a function call. Define cond-scheme? using every? to check ALL clauses, fix eval.sx sf-cond and render.sx eval-cond, rewrite engine.sx parse-time/filter-params as nested if to avoid the ambiguity, add regression tests across eval/ render/aser specs. 378/378 tests pass. Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
273 lines
9.8 KiB
Plaintext
273 lines
9.8 KiB
Plaintext
;; ==========================================================================
|
|
;; 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.
|
|
;; ==========================================================================
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Basic serialization
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "aser-basics"
|
|
(deftest "number literal passes through"
|
|
(assert-equal "42"
|
|
(render-sx "42")))
|
|
|
|
(deftest "string literal passes through"
|
|
;; aser returns the raw string value; render-sx concatenates it directly
|
|
(assert-equal "hello"
|
|
(render-sx "\"hello\"")))
|
|
|
|
(deftest "boolean true passes through"
|
|
(assert-equal "true"
|
|
(render-sx "true")))
|
|
|
|
(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\")))"))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; 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))")))
|
|
(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
|
|
(assert-true (not (nil? result))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; and/or short-circuit in aser mode
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "aser-logic"
|
|
(deftest "and short-circuits on false"
|
|
(assert-equal "false"
|
|
(render-sx "(and true false true)")))
|
|
|
|
(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)"))))
|