coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Phase 4: Move web framework files to web/ and web/tests/

Browse Source 
signals.sx, engine.sx, orchestration.sx, boot.sx, router.sx, deps.sx,
forms.sx, page-helpers.sx, adapters, boundary files → web/
Web tests → web/tests/
Test runners updated with _SPEC_TESTS and _WEB_TESTS paths.
All 89 tests pass (20 signal + 43 CEK + 26 CEK reactive).
Both bootstrappers build fully (5993 Python lines, 387KB JS).

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-15 02:26:18 +00:00
parent 7036621be8
commit 72eaefac13
15 changed files with 2111 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files

346
web/tests/test-aser.sx Normal file
View File

@@ -0,0 +1,346 @@
;; ==========================================================================
;; 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)"))))
;; --------------------------------------------------------------------------
;; 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\"))"))))

279
web/tests/test-cek-reactive.sx Normal file
View File

@@ -0,0 +1,279 @@
;; ==========================================================================
;; test-cek-reactive.sx — Tests for deref-as-shift reactive rendering
;;
;; Tests that (deref signal) inside a reactive-reset boundary performs
;; continuation capture: the rest of the expression becomes the subscriber.
;;
;; Requires: test-framework.sx, frames.sx, cek.sx, signals.sx loaded first.
;; ==========================================================================
;; --------------------------------------------------------------------------
;; Basic deref behavior through CEK
;; --------------------------------------------------------------------------
(defsuite "deref pass-through"
(deftest "deref non-signal passes through"
(let ((result (eval-expr-cek
(sx-parse-one "(deref 42)")
(test-env))))
(assert-equal 42 result)))
(deftest "deref nil passes through"
(let ((result (eval-expr-cek
(sx-parse-one "(deref nil)")
(test-env))))
(assert-nil result)))
(deftest "deref string passes through"
(let ((result (eval-expr-cek
(sx-parse-one "(deref \"hello\")")
(test-env))))
(assert-equal "hello" result))))
;; --------------------------------------------------------------------------
;; Deref signal without reactive-reset (no shift)
;; --------------------------------------------------------------------------
(defsuite "deref signal without reactive-reset"
(deftest "deref signal returns current value"
(let ((s (signal 99)))
(env-set! (test-env) "test-sig" s)
(let ((result (eval-expr-cek
(sx-parse-one "(deref test-sig)")
(test-env))))
(assert-equal 99 result))))
(deftest "deref signal in expression returns computed value"
(let ((s (signal 10)))
(env-set! (test-env) "test-sig" s)
(let ((result (eval-expr-cek
(sx-parse-one "(+ 5 (deref test-sig))")
(test-env))))
(assert-equal 15 result)))))
;; --------------------------------------------------------------------------
;; Reactive reset + deref: continuation capture
;; --------------------------------------------------------------------------
(defsuite "reactive-reset shift"
(deftest "deref signal with reactive-reset captures continuation"
(let ((s (signal 42))
(captured-val nil))
;; Run CEK with a ReactiveResetFrame
(let ((result (cek-run
(make-cek-state
(sx-parse-one "(deref test-sig)")
(let ((e (env-extend (test-env))))
(env-set! e "test-sig" s)
e)
(list (make-reactive-reset-frame
(test-env)
(fn (v) (set! captured-val v))
true))))))
;; Initial render: returns current value, update-fn NOT called (first-render)
(assert-equal 42 result)
(assert-nil captured-val))))
(deftest "signal change invokes subscriber with update-fn"
(let ((s (signal 10))
(update-calls (list)))
;; Set up reactive-reset with tracking update-fn
(scope-push! "sx-island-scope" nil)
(let ((e (env-extend (test-env))))
(env-set! e "test-sig" s)
(cek-run
(make-cek-state
(sx-parse-one "(deref test-sig)")
e
(list (make-reactive-reset-frame
e
(fn (v) (append! update-calls v))
true)))))
;; Change signal — subscriber should fire
(reset! s 20)
(assert-equal 1 (len update-calls))
(assert-equal 20 (first update-calls))
;; Change again
(reset! s 30)
(assert-equal 2 (len update-calls))
(assert-equal 30 (nth update-calls 1))
(scope-pop! "sx-island-scope")))
(deftest "expression with deref captures rest as continuation"
(let ((s (signal 5))
(update-calls (list)))
(scope-push! "sx-island-scope" nil)
(let ((e (env-extend (test-env))))
(env-set! e "test-sig" s)
;; (str "val=" (deref test-sig)) — continuation captures (str "val=" [HOLE])
(let ((result (cek-run
(make-cek-state
(sx-parse-one "(str \"val=\" (deref test-sig))")
e
(list (make-reactive-reset-frame
e
(fn (v) (append! update-calls v))
true))))))
(assert-equal "val=5" result)))
;; Change signal — should get updated string
(reset! s 42)
(assert-equal 1 (len update-calls))
(assert-equal "val=42" (first update-calls))
(scope-pop! "sx-island-scope"))))
;; --------------------------------------------------------------------------
;; Disposal and cleanup
;; --------------------------------------------------------------------------
(defsuite "disposal"
(deftest "scope cleanup unsubscribes continuation"
(let ((s (signal 1))
(update-calls (list))
(disposers (list)))
;; Create island scope with collector that accumulates disposers
(scope-push! "sx-island-scope" (fn (d) (append! disposers d)))
(let ((e (env-extend (test-env))))
(env-set! e "test-sig" s)
(cek-run
(make-cek-state
(sx-parse-one "(deref test-sig)")
e
(list (make-reactive-reset-frame
e
(fn (v) (append! update-calls v))
true)))))
;; Pop scope — call all disposers
(scope-pop! "sx-island-scope")
(for-each (fn (d) (cek-call d nil)) disposers)
;; Change signal — no update should fire
(reset! s 999)
(assert-equal 0 (len update-calls)))))
;; --------------------------------------------------------------------------
;; cek-call integration — computed/effect use cek-call dispatch
;; --------------------------------------------------------------------------
(defsuite "cek-call dispatch"
(deftest "cek-call invokes native function"
(let ((log (list)))
(cek-call (fn (x) (append! log x)) (list 42))
(assert-equal (list 42) log)))
(deftest "cek-call invokes zero-arg lambda"
(let ((result (cek-call (fn () (+ 1 2)) nil)))
(assert-equal 3 result)))
(deftest "cek-call with nil function returns nil"
(assert-nil (cek-call nil nil)))
(deftest "computed tracks deps via cek-call"
(let ((s (signal 10)))
(let ((c (computed (fn () (* 2 (deref s))))))
(assert-equal 20 (deref c))
(reset! s 5)
(assert-equal 10 (deref c)))))
(deftest "effect runs and re-runs via cek-call"
(let ((s (signal "a"))
(log (list)))
(effect (fn () (append! log (deref s))))
(assert-equal (list "a") log)
(reset! s "b")
(assert-equal (list "a" "b") log)))
(deftest "effect cleanup runs on re-trigger"
(let ((s (signal 0))
(log (list)))
(effect (fn ()
(let ((val (deref s)))
(append! log (str "run:" val))
;; Return cleanup function
(fn () (append! log (str "clean:" val))))))
(assert-equal (list "run:0") log)
(reset! s 1)
(assert-equal (list "run:0" "clean:0" "run:1") log)))
(deftest "batch coalesces via cek-call"
(let ((s (signal 0))
(count (signal 0)))
(effect (fn () (do (deref s) (swap! count inc))))
(assert-equal 1 (deref count))
(batch (fn ()
(reset! s 1)
(reset! s 2)
(reset! s 3)))
;; batch should coalesce — effect runs once, not three times
(assert-equal 2 (deref count)))))
;; --------------------------------------------------------------------------
;; CEK-native higher-order forms
;; --------------------------------------------------------------------------
(defsuite "CEK higher-order forms"
(deftest "map through CEK"
(let ((result (eval-expr-cek
(sx-parse-one "(map (fn (x) (* x 2)) (list 1 2 3))")
(test-env))))
(assert-equal (list 2 4 6) result)))
(deftest "map-indexed through CEK"
(let ((result (eval-expr-cek
(sx-parse-one "(map-indexed (fn (i x) (+ i x)) (list 10 20 30))")
(test-env))))
(assert-equal (list 10 21 32) result)))
(deftest "filter through CEK"
(let ((result (eval-expr-cek
(sx-parse-one "(filter (fn (x) (> x 2)) (list 1 2 3 4 5))")
(test-env))))
(assert-equal (list 3 4 5) result)))
(deftest "reduce through CEK"
(let ((result (eval-expr-cek
(sx-parse-one "(reduce (fn (acc x) (+ acc x)) 0 (list 1 2 3))")
(test-env))))
(assert-equal 6 result)))
(deftest "some through CEK"
(let ((result (eval-expr-cek
(sx-parse-one "(some (fn (x) (> x 3)) (list 1 2 3 4 5))")
(test-env))))
(assert-true result)))
(deftest "some returns false when none match"
(let ((result (eval-expr-cek
(sx-parse-one "(some (fn (x) (> x 10)) (list 1 2 3))")
(test-env))))
(assert-false result)))
(deftest "every? through CEK"
(let ((result (eval-expr-cek
(sx-parse-one "(every? (fn (x) (> x 0)) (list 1 2 3))")
(test-env))))
(assert-true result)))
(deftest "every? returns false on first falsy"
(let ((result (eval-expr-cek
(sx-parse-one "(every? (fn (x) (> x 2)) (list 1 2 3))")
(test-env))))
(assert-false result)))
(deftest "for-each through CEK"
(let ((log (list)))
(env-set! (test-env) "test-log" log)
(eval-expr-cek
(sx-parse-one "(for-each (fn (x) (append! test-log x)) (list 1 2 3))")
(test-env))
(assert-equal (list 1 2 3) log)))
(deftest "map on empty list"
(let ((result (eval-expr-cek
(sx-parse-one "(map (fn (x) x) (list))")
(test-env))))
(assert-equal (list) result))))

327
web/tests/test-deps.sx Normal file
View File

@@ -0,0 +1,327 @@
;; ==========================================================================
;; test-deps.sx — Tests for component dependency analysis (deps.sx)
;;
;; Requires: test-framework.sx loaded first.
;; Platform functions: scan-refs, transitive-deps, components-needed,
;; component-pure?, scan-io-refs, transitive-io-refs,
;; scan-components-from-source, test-env
;; (loaded from bootstrapped output by test runners)
;; ==========================================================================
;; --------------------------------------------------------------------------
;; Test component definitions — these exist in the test env for dep analysis
;; --------------------------------------------------------------------------
(defcomp ~dep-leaf ()
(span "leaf"))
(defcomp ~dep-branch ()
(div (~dep-leaf)))
(defcomp ~dep-trunk ()
(div (~dep-branch) (~dep-leaf)))
(defcomp ~dep-conditional (&key show?)
(if show?
(~dep-leaf)
(~dep-branch)))
(defcomp ~dep-nested-cond (&key mode)
(cond
(= mode "a") (~dep-leaf)
(= mode "b") (~dep-branch)
:else (~dep-trunk)))
(defcomp ~dep-island ()
(div "no deps"))
;; Islands with dependencies — defisland bodies must be scanned
(defisland ~dep-island-with-child ()
(div (~dep-leaf) "island content"))
(defisland ~dep-island-with-chain ()
(div (~dep-branch) "deep island"))
;; --------------------------------------------------------------------------
;; 1. scan-refs — finds component references in AST nodes
;; --------------------------------------------------------------------------
(defsuite "scan-refs"
(deftest "empty for string literal"
(assert-equal (list) (scan-refs "hello")))
(deftest "empty for number"
(assert-equal (list) (scan-refs 42)))
(deftest "finds component symbol"
(let ((refs (scan-refs (quote (~dep-leaf)))))
(assert-contains "~dep-leaf" refs)))
(deftest "finds in nested list"
(let ((refs (scan-refs (quote (div (span (~dep-leaf)))))))
(assert-contains "~dep-leaf" refs)))
(deftest "finds multiple refs"
(let ((refs (scan-refs (quote (div (~dep-leaf) (~dep-branch))))))
(assert-contains "~dep-leaf" refs)
(assert-contains "~dep-branch" refs)))
(deftest "deduplicates"
(let ((refs (scan-refs (quote (div (~dep-leaf) (~dep-leaf))))))
(assert-equal 1 (len refs))))
(deftest "walks if branches"
(let ((refs (scan-refs (quote (if true (~dep-leaf) (~dep-branch))))))
(assert-contains "~dep-leaf" refs)
(assert-contains "~dep-branch" refs)))
(deftest "walks cond branches"
(let ((refs (scan-refs (quote (cond (= x 1) (~dep-leaf) :else (~dep-trunk))))))
(assert-contains "~dep-leaf" refs)
(assert-contains "~dep-trunk" refs)))
(deftest "ignores non-component symbols"
(let ((refs (scan-refs (quote (div class "foo")))))
(assert-equal 0 (len refs)))))
;; --------------------------------------------------------------------------
;; 2. scan-components-from-source — regex-based source string scanning
;; --------------------------------------------------------------------------
(defsuite "scan-components-from-source"
(deftest "finds single component"
(let ((refs (scan-components-from-source "(~dep-leaf)")))
(assert-contains "~dep-leaf" refs)))
(deftest "finds multiple components"
(let ((refs (scan-components-from-source "(div (~dep-leaf) (~dep-branch))")))
(assert-contains "~dep-leaf" refs)
(assert-contains "~dep-branch" refs)))
(deftest "no false positives on plain text"
(let ((refs (scan-components-from-source "(div \"hello world\")")))
(assert-equal 0 (len refs))))
(deftest "handles hyphenated names"
(let ((refs (scan-components-from-source "(~my-component :key val)")))
(assert-contains "~my-component" refs))))
;; --------------------------------------------------------------------------
;; 3. transitive-deps — transitive dependency closure
;; --------------------------------------------------------------------------
(defsuite "transitive-deps"
(deftest "leaf has no deps"
(let ((deps (transitive-deps "~dep-leaf" (test-env))))
(assert-equal 0 (len deps))))
(deftest "direct dependency"
(let ((deps (transitive-deps "~dep-branch" (test-env))))
(assert-contains "~dep-leaf" deps)))
(deftest "transitive closure"
(let ((deps (transitive-deps "~dep-trunk" (test-env))))
(assert-contains "~dep-branch" deps)
(assert-contains "~dep-leaf" deps)))
(deftest "excludes self"
(let ((deps (transitive-deps "~dep-trunk" (test-env))))
(assert-false (contains? deps "~dep-trunk"))))
(deftest "walks conditional branches"
(let ((deps (transitive-deps "~dep-conditional" (test-env))))
(assert-contains "~dep-leaf" deps)
(assert-contains "~dep-branch" deps)))
(deftest "walks all cond branches"
(let ((deps (transitive-deps "~dep-nested-cond" (test-env))))
(assert-contains "~dep-leaf" deps)
(assert-contains "~dep-branch" deps)
(assert-contains "~dep-trunk" deps)))
(deftest "island has no deps"
(let ((deps (transitive-deps "~dep-island" (test-env))))
(assert-equal 0 (len deps))))
(deftest "accepts name without tilde"
(let ((deps (transitive-deps "dep-branch" (test-env))))
(assert-contains "~dep-leaf" deps)))
(deftest "island direct dep scanned"
(let ((deps (transitive-deps "~dep-island-with-child" (test-env))))
(assert-contains "~dep-leaf" deps)))
(deftest "island transitive deps scanned"
(let ((deps (transitive-deps "~dep-island-with-chain" (test-env))))
(assert-contains "~dep-branch" deps)
(assert-contains "~dep-leaf" deps))))
;; --------------------------------------------------------------------------
;; 4. components-needed — page bundle computation
;; --------------------------------------------------------------------------
(defsuite "components-needed"
(deftest "finds direct and transitive"
(let ((needed (components-needed "(~dep-trunk)" (test-env))))
(assert-contains "~dep-trunk" needed)
(assert-contains "~dep-branch" needed)
(assert-contains "~dep-leaf" needed)))
(deftest "deduplicates"
(let ((needed (components-needed "(div (~dep-leaf) (~dep-leaf))" (test-env))))
;; ~dep-leaf should appear only once
(assert-true (contains? needed "~dep-leaf"))))
(deftest "handles leaf page"
(let ((needed (components-needed "(~dep-island)" (test-env))))
(assert-contains "~dep-island" needed)
(assert-equal 1 (len needed))))
(deftest "handles multiple top-level components"
(let ((needed (components-needed "(div (~dep-leaf) (~dep-island))" (test-env))))
(assert-contains "~dep-leaf" needed)
(assert-contains "~dep-island" needed)))
(deftest "island deps included in page bundle"
(let ((needed (components-needed "(~dep-island-with-chain)" (test-env))))
(assert-contains "~dep-island-with-chain" needed)
(assert-contains "~dep-branch" needed)
(assert-contains "~dep-leaf" needed))))
;; --------------------------------------------------------------------------
;; 5. IO detection — scan-io-refs, component-pure?
;; --------------------------------------------------------------------------
;; Define components that reference "io" functions for testing
(defcomp ~dep-pure ()
(div (~dep-leaf) "static"))
(defcomp ~dep-io ()
(div (fetch-data "/api")))
(defcomp ~dep-io-indirect ()
(div (~dep-io)))
(defsuite "scan-io-refs"
(deftest "no IO in pure AST"
(let ((refs (scan-io-refs (quote (div "hello" (span "world"))) (list "fetch-data"))))
(assert-equal 0 (len refs))))
(deftest "finds IO reference"
(let ((refs (scan-io-refs (quote (div (fetch-data "/api"))) (list "fetch-data"))))
(assert-contains "fetch-data" refs)))
(deftest "multiple IO refs"
(let ((refs (scan-io-refs (quote (div (fetch-data "/a") (query-db "x"))) (list "fetch-data" "query-db"))))
(assert-contains "fetch-data" refs)
(assert-contains "query-db" refs)))
(deftest "ignores non-IO symbols"
(let ((refs (scan-io-refs (quote (div (map str items))) (list "fetch-data"))))
(assert-equal 0 (len refs)))))
(defsuite "component-pure?"
(deftest "pure component is pure"
(assert-true (component-pure? "~dep-pure" (test-env) (list "fetch-data"))))
(deftest "IO component is not pure"
(assert-false (component-pure? "~dep-io" (test-env) (list "fetch-data"))))
(deftest "indirect IO is not pure"
(assert-false (component-pure? "~dep-io-indirect" (test-env) (list "fetch-data"))))
(deftest "leaf component is pure"
(assert-true (component-pure? "~dep-leaf" (test-env) (list "fetch-data")))))
;; --------------------------------------------------------------------------
;; 6. render-target — boundary decision with affinity
;; --------------------------------------------------------------------------
;; Components with explicit affinity annotations
(defcomp ~dep-force-client (&key x)
:affinity :client
(div (fetch-data "/api") x))
(defcomp ~dep-force-server (&key x)
:affinity :server
(div x))
(defcomp ~dep-auto-pure (&key x)
(div x))
(defcomp ~dep-auto-io (&key x)
(div (fetch-data "/api")))
(defsuite "render-target"
(deftest "pure auto component targets client"
(assert-equal "client" (render-target "~dep-auto-pure" (test-env) (list "fetch-data"))))
(deftest "IO auto component targets server"
(assert-equal "server" (render-target "~dep-auto-io" (test-env) (list "fetch-data"))))
(deftest "affinity client overrides IO to client"
(assert-equal "client" (render-target "~dep-force-client" (test-env) (list "fetch-data"))))
(deftest "affinity server overrides pure to server"
(assert-equal "server" (render-target "~dep-force-server" (test-env) (list "fetch-data"))))
(deftest "leaf component targets client"
(assert-equal "client" (render-target "~dep-leaf" (test-env) (list "fetch-data"))))
(deftest "unknown name targets server"
(assert-equal "server" (render-target "~nonexistent" (test-env) (list "fetch-data")))))
;; --------------------------------------------------------------------------
;; 7. page-render-plan — per-page boundary plan
;; --------------------------------------------------------------------------
;; A page component that uses both pure and IO components
(defcomp ~plan-page (&key data)
(div
(~dep-auto-pure :x "hello")
(~dep-auto-io :x data)
(~dep-force-client :x "interactive")))
(defsuite "page-render-plan"
(deftest "plan classifies components correctly"
(let ((plan (page-render-plan "(~plan-page :data d)" (test-env) (list "fetch-data"))))
;; ~plan-page has transitive IO deps (via ~dep-auto-io) so targets server
(assert-equal "server" (dict-get (get plan :components) "~plan-page"))
(assert-equal "client" (dict-get (get plan :components) "~dep-auto-pure"))
(assert-equal "server" (dict-get (get plan :components) "~dep-auto-io"))
(assert-equal "client" (dict-get (get plan :components) "~dep-force-client"))))
(deftest "plan server list contains IO components"
(let ((plan (page-render-plan "(~plan-page :data d)" (test-env) (list "fetch-data"))))
(assert-true (contains? (get plan :server) "~dep-auto-io"))))
(deftest "plan client list contains pure components"
(let ((plan (page-render-plan "(~plan-page :data d)" (test-env) (list "fetch-data"))))
(assert-true (contains? (get plan :client) "~dep-auto-pure"))
(assert-true (contains? (get plan :client) "~dep-force-client"))))
(deftest "plan collects IO deps from server components"
(let ((plan (page-render-plan "(~plan-page :data d)" (test-env) (list "fetch-data"))))
(assert-true (contains? (get plan :io-deps) "fetch-data"))))
(deftest "pure-only page has empty server list"
(let ((plan (page-render-plan "(~dep-auto-pure :x 1)" (test-env) (list "fetch-data"))))
(assert-equal 0 (len (get plan :server)))
(assert-true (> (len (get plan :client)) 0)))))

212
web/tests/test-engine.sx Normal file
View File

@@ -0,0 +1,212 @@
;; ==========================================================================
;; test-engine.sx — Tests for SxEngine pure logic (engine.sx)
;;
;; Requires: test-framework.sx loaded first.
;; Platform functions: parse-time, parse-trigger-spec, default-trigger,
;; parse-swap-spec, parse-retry-spec, next-retry-ms, filter-params
;; (loaded from bootstrapped output by test runners)
;; ==========================================================================
;; --------------------------------------------------------------------------
;; 1. parse-time — time string parsing
;; --------------------------------------------------------------------------
(defsuite "parse-time"
(deftest "seconds to ms"
(assert-equal 2000 (parse-time "2s")))
(deftest "milliseconds"
(assert-equal 500 (parse-time "500ms")))
(deftest "nil returns 0"
(assert-equal 0 (parse-time nil)))
(deftest "plain number string"
(assert-equal 100 (parse-time "100")))
(deftest "one second"
(assert-equal 1000 (parse-time "1s")))
(deftest "large seconds"
(assert-equal 30000 (parse-time "30s"))))
;; --------------------------------------------------------------------------
;; 2. parse-trigger-spec — trigger attribute parsing
;; --------------------------------------------------------------------------
(defsuite "parse-trigger-spec"
(deftest "nil returns nil"
(assert-nil (parse-trigger-spec nil)))
(deftest "single event"
(let ((triggers (parse-trigger-spec "click")))
(assert-equal 1 (len triggers))
(assert-equal "click" (get (first triggers) "event"))))
(deftest "event with once modifier"
(let ((triggers (parse-trigger-spec "click once")))
(assert-equal 1 (len triggers))
(assert-equal "click" (get (first triggers) "event"))
(assert-true (get (get (first triggers) "modifiers") "once"))))
(deftest "event with delay modifier"
(let ((triggers (parse-trigger-spec "click delay:500ms")))
(assert-equal 1 (len triggers))
(assert-equal 500 (get (get (first triggers) "modifiers") "delay"))))
(deftest "multiple triggers comma-separated"
(let ((triggers (parse-trigger-spec "click,change")))
(assert-equal 2 (len triggers))
(assert-equal "click" (get (first triggers) "event"))
(assert-equal "change" (get (nth triggers 1) "event"))))
(deftest "polling trigger"
(let ((triggers (parse-trigger-spec "every 3s")))
(assert-equal 1 (len triggers))
(assert-equal "every" (get (first triggers) "event"))
(assert-equal 3000 (get (get (first triggers) "modifiers") "interval"))))
(deftest "event with from modifier"
(let ((triggers (parse-trigger-spec "click from:body")))
(assert-equal "body" (get (get (first triggers) "modifiers") "from"))))
(deftest "event with changed modifier"
(let ((triggers (parse-trigger-spec "keyup changed")))
(assert-equal "keyup" (get (first triggers) "event"))
(assert-true (get (get (first triggers) "modifiers") "changed")))))
;; --------------------------------------------------------------------------
;; 3. default-trigger — default trigger by element tag
;; --------------------------------------------------------------------------
(defsuite "default-trigger"
(deftest "form submits"
(let ((triggers (default-trigger "FORM")))
(assert-equal "submit" (get (first triggers) "event"))))
(deftest "input changes"
(let ((triggers (default-trigger "INPUT")))
(assert-equal "change" (get (first triggers) "event"))))
(deftest "select changes"
(let ((triggers (default-trigger "SELECT")))
(assert-equal "change" (get (first triggers) "event"))))
(deftest "textarea changes"
(let ((triggers (default-trigger "TEXTAREA")))
(assert-equal "change" (get (first triggers) "event"))))
(deftest "div clicks"
(let ((triggers (default-trigger "DIV")))
(assert-equal "click" (get (first triggers) "event"))))
(deftest "button clicks"
(let ((triggers (default-trigger "BUTTON")))
(assert-equal "click" (get (first triggers) "event")))))
;; --------------------------------------------------------------------------
;; 4. parse-swap-spec — swap specification parsing
;; --------------------------------------------------------------------------
(defsuite "parse-swap-spec"
(deftest "default swap"
(let ((spec (parse-swap-spec nil false)))
(assert-equal "outerHTML" (get spec "style"))
(assert-false (get spec "transition"))))
(deftest "innerHTML"
(let ((spec (parse-swap-spec "innerHTML" false)))
(assert-equal "innerHTML" (get spec "style"))))
(deftest "with transition true"
(let ((spec (parse-swap-spec "innerHTML transition:true" false)))
(assert-equal "innerHTML" (get spec "style"))
(assert-true (get spec "transition"))))
(deftest "transition false overrides global"
(let ((spec (parse-swap-spec "outerHTML transition:false" true)))
(assert-equal "outerHTML" (get spec "style"))
(assert-false (get spec "transition"))))
(deftest "global transition when not overridden"
(let ((spec (parse-swap-spec "innerHTML" true)))
(assert-equal "innerHTML" (get spec "style"))
(assert-true (get spec "transition")))))
;; --------------------------------------------------------------------------
;; 5. parse-retry-spec — retry specification parsing
;; --------------------------------------------------------------------------
(defsuite "parse-retry-spec"
(deftest "nil returns nil"
(assert-nil (parse-retry-spec nil)))
(deftest "exponential backoff"
(let ((spec (parse-retry-spec "exponential:1000:30000")))
(assert-equal "exponential" (get spec "strategy"))
(assert-equal 1000 (get spec "start-ms"))
(assert-equal 30000 (get spec "cap-ms"))))
(deftest "linear strategy"
(let ((spec (parse-retry-spec "linear:2000:60000")))
(assert-equal "linear" (get spec "strategy"))
(assert-equal 2000 (get spec "start-ms"))
(assert-equal 60000 (get spec "cap-ms")))))
;; --------------------------------------------------------------------------
;; 6. next-retry-ms — exponential backoff calculation
;; --------------------------------------------------------------------------
(defsuite "next-retry-ms"
(deftest "doubles current"
(assert-equal 2000 (next-retry-ms 1000 30000)))
(deftest "caps at maximum"
(assert-equal 30000 (next-retry-ms 20000 30000)))
(deftest "exact cap"
(assert-equal 30000 (next-retry-ms 15000 30000)))
(deftest "small initial"
(assert-equal 200 (next-retry-ms 100 30000))))
;; --------------------------------------------------------------------------
;; 7. filter-params — form parameter filtering
;; --------------------------------------------------------------------------
(defsuite "filter-params"
(deftest "nil passes all through"
(let ((params (list (list "a" "1") (list "b" "2"))))
(assert-equal 2 (len (filter-params nil params)))))
(deftest "none returns empty"
(let ((params (list (list "a" "1") (list "b" "2"))))
(assert-equal 0 (len (filter-params "none" params)))))
(deftest "star passes all"
(let ((params (list (list "a" "1") (list "b" "2"))))
(assert-equal 2 (len (filter-params "*" params)))))
(deftest "whitelist"
(let ((params (list (list "name" "Jo") (list "age" "30") (list "secret" "x"))))
(let ((filtered (filter-params "name,age" params)))
(assert-equal 2 (len filtered)))))
(deftest "blacklist with not"
(let ((params (list (list "name" "Jo") (list "csrf" "tok") (list "age" "30"))))
(let ((filtered (filter-params "not csrf" params)))
(assert-equal 2 (len filtered))))))

170
web/tests/test-orchestration.sx Normal file
View File

@@ -0,0 +1,170 @@
;; ==========================================================================
;; test-orchestration.sx — Tests for orchestration.sx Phase 7c + 7d
;;
;; Requires: test-framework.sx loaded first.
;; Platform functions mocked by test runner:
;; now-ms, log-info, log-warn, execute-action, try-rerender-page
;; ==========================================================================
;; --------------------------------------------------------------------------
;; 1. page-data-cache — basic cache operations
;; --------------------------------------------------------------------------
(defsuite "page-data-cache"
(deftest "cache-key bare page name"
(assert-equal "my-page" (page-data-cache-key "my-page" nil)))
(deftest "cache-key with params"
(let ((key (page-data-cache-key "my-page" {"id" "42"})))
(assert-equal "my-page:id=42" key)))
(deftest "cache-set then get"
(let ((key "test-cache-1"))
(page-data-cache-set key {"items" (list 1 2 3)})
(let ((result (page-data-cache-get key)))
(assert-equal (list 1 2 3) (get result "items")))))
(deftest "cache miss returns nil"
(assert-nil (page-data-cache-get "nonexistent-key"))))
;; --------------------------------------------------------------------------
;; 2. optimistic-cache-update — predicted mutation with snapshot
;; --------------------------------------------------------------------------
(defsuite "optimistic-cache-update"
(deftest "applies mutator to cached data"
(let ((key "opt-test-1"))
;; Seed the cache
(page-data-cache-set key {"count" 10})
;; Apply optimistic mutation
(let ((predicted (optimistic-cache-update key
(fn (data) (merge data {"count" 11})))))
(assert-equal 11 (get predicted "count")))))
(deftest "updates cache with prediction"
(let ((key "opt-test-2"))
(page-data-cache-set key {"count" 5})
(optimistic-cache-update key (fn (data) (merge data {"count" 6})))
;; Cache now has predicted value
(let ((cached (page-data-cache-get key)))
(assert-equal 6 (get cached "count")))))
(deftest "returns nil when no cached data"
(let ((result (optimistic-cache-update "no-such-key"
(fn (data) (merge data {"x" 1})))))
(assert-nil result))))
;; --------------------------------------------------------------------------
;; 3. optimistic-cache-revert — restore from snapshot
;; --------------------------------------------------------------------------
(defsuite "optimistic-cache-revert"
(deftest "reverts to original data"
(let ((key "revert-test-1"))
(page-data-cache-set key {"count" 10})
(optimistic-cache-update key (fn (data) (merge data {"count" 99})))
;; Cache now has 99
(assert-equal 99 (get (page-data-cache-get key) "count"))
;; Revert
(let ((restored (optimistic-cache-revert key)))
(assert-equal 10 (get restored "count"))
;; Cache is back to original
(assert-equal 10 (get (page-data-cache-get key) "count")))))
(deftest "returns nil when no snapshot"
(assert-nil (optimistic-cache-revert "never-mutated"))))
;; --------------------------------------------------------------------------
;; 4. optimistic-cache-confirm — discard snapshot
;; --------------------------------------------------------------------------
(defsuite "optimistic-cache-confirm"
(deftest "confirm clears snapshot"
(let ((key "confirm-test-1"))
(page-data-cache-set key {"val" "a"})
(optimistic-cache-update key (fn (data) (merge data {"val" "b"})))
;; Confirm — accepts the optimistic value
(optimistic-cache-confirm key)
;; Revert should now return nil (no snapshot)
(assert-nil (optimistic-cache-revert key))
;; Cache still has optimistic value
(assert-equal "b" (get (page-data-cache-get key) "val")))))
;; --------------------------------------------------------------------------
;; 5. offline-is-online? / offline-set-online! — connectivity tracking
;; --------------------------------------------------------------------------
(defsuite "offline-connectivity"
(deftest "initially online"
(assert-true (offline-is-online?)))
(deftest "set offline"
(offline-set-online! false)
(assert-false (offline-is-online?)))
(deftest "set back online"
(offline-set-online! true)
(assert-true (offline-is-online?))))
;; --------------------------------------------------------------------------
;; 6. offline-queue-mutation — queue entries when offline
;; --------------------------------------------------------------------------
(defsuite "offline-queue-mutation"
(deftest "queues an entry"
;; Seed cache so optimistic update works
(let ((key (page-data-cache-key "notes" nil)))
(page-data-cache-set key {"items" (list "a" "b")})
(let ((entry (offline-queue-mutation "add-note"
{"text" "c"}
"notes" nil
(fn (data) (merge data {"items" (list "a" "b" "c")})))))
(assert-equal "add-note" (get entry "action"))
(assert-equal "pending" (get entry "status")))))
(deftest "pending count increases"
;; Previous test queued 1 entry; count should be >= 1
(assert-true (> (offline-pending-count) 0))))
;; --------------------------------------------------------------------------
;; 7. offline-aware-mutation — routes by connectivity
;; --------------------------------------------------------------------------
(defsuite "offline-aware-mutation"
(deftest "when online calls submit-mutation path"
(offline-set-online! true)
(let ((key (page-data-cache-key "test-page" nil)))
(page-data-cache-set key {"v" 1})
;; This will trigger execute-action (mocked) which calls success cb
(let ((status nil))
(offline-aware-mutation "test-page" nil "do-thing" {"x" 1}
(fn (data) (merge data {"v" 2}))
(fn (s) (set! status s)))
;; Mock execute-action calls success immediately
(assert-equal "confirmed" status))))
(deftest "when offline queues mutation"
(offline-set-online! false)
(let ((key (page-data-cache-key "test-page-2" nil)))
(page-data-cache-set key {"v" 1})
(let ((status nil))
(offline-aware-mutation "test-page-2" nil "do-thing" {"x" 1}
(fn (data) (merge data {"v" 2}))
(fn (s) (set! status s)))
(assert-equal "queued" status)))
;; Clean up: go back online
(offline-set-online! true)))

708
web/tests/test-router.sx Normal file
View File

@@ -0,0 +1,708 @@
;; ==========================================================================
;; test-router.sx — Tests for client-side route matching & SX URL algebra
;;
;; Requires: test-framework.sx loaded first.
;; Modules tested: router.sx
;;
;; No additional platform functions needed — router.sx is pure.
;; ==========================================================================
;; --------------------------------------------------------------------------
;; split-path-segments
;; --------------------------------------------------------------------------
(defsuite "split-path-segments"
(deftest "root path"
(assert-equal (list) (split-path-segments "/")))
(deftest "single segment"
(assert-equal (list "docs") (split-path-segments "/docs")))
(deftest "multiple segments"
(assert-equal (list "docs" "hello") (split-path-segments "/docs/hello")))
(deftest "trailing slash stripped"
(assert-equal (list "docs") (split-path-segments "/docs/")))
(deftest "deep path"
(assert-equal (list "a" "b" "c" "d") (split-path-segments "/a/b/c/d"))))
;; --------------------------------------------------------------------------
;; parse-route-pattern
;; --------------------------------------------------------------------------
(defsuite "parse-route-pattern"
(deftest "static pattern"
(let ((segs (parse-route-pattern "/docs/intro")))
(assert-length 2 segs)
(assert-equal "literal" (get (first segs) "type"))
(assert-equal "docs" (get (first segs) "value"))
(assert-equal "literal" (get (nth segs 1) "type"))
(assert-equal "intro" (get (nth segs 1) "value"))))
(deftest "pattern with param"
(let ((segs (parse-route-pattern "/docs/<slug>")))
(assert-length 2 segs)
(assert-equal "literal" (get (first segs) "type"))
(assert-equal "docs" (get (first segs) "value"))
(assert-equal "param" (get (nth segs 1) "type"))
(assert-equal "slug" (get (nth segs 1) "value"))))
(deftest "multiple params"
(let ((segs (parse-route-pattern "/users/<uid>/posts/<pid>")))
(assert-length 4 segs)
(assert-equal "param" (get (nth segs 1) "type"))
(assert-equal "uid" (get (nth segs 1) "value"))
(assert-equal "param" (get (nth segs 3) "type"))
(assert-equal "pid" (get (nth segs 3) "value"))))
(deftest "root pattern"
(assert-equal (list) (parse-route-pattern "/"))))
;; --------------------------------------------------------------------------
;; match-route
;; --------------------------------------------------------------------------
(defsuite "match-route"
(deftest "exact match returns empty params"
(let ((result (match-route "/docs/intro" "/docs/intro")))
(assert-true (not (nil? result)))
(assert-length 0 (keys result))))
(deftest "param match extracts value"
(let ((result (match-route "/docs/hello" "/docs/<slug>")))
(assert-true (not (nil? result)))
(assert-equal "hello" (get result "slug"))))
(deftest "no match returns nil"
(assert-nil (match-route "/docs/hello" "/essays/<slug>"))
(assert-nil (match-route "/docs" "/docs/<slug>")))
(deftest "segment count mismatch returns nil"
(assert-nil (match-route "/a/b/c" "/a/<b>"))
(assert-nil (match-route "/a" "/a/b")))
(deftest "root matches root"
(let ((result (match-route "/" "/")))
(assert-true (not (nil? result)))))
(deftest "multiple params extracted"
(let ((result (match-route "/users/42/posts/99" "/users/<uid>/posts/<pid>")))
(assert-true (not (nil? result)))
(assert-equal "42" (get result "uid"))
(assert-equal "99" (get result "pid")))))
;; --------------------------------------------------------------------------
;; find-matching-route
;; --------------------------------------------------------------------------
(defsuite "find-matching-route"
(deftest "finds first matching route"
(let ((routes (list
{:pattern "/docs/" :parsed (parse-route-pattern "/docs/") :name "docs-index"}
{:pattern "/docs/<slug>" :parsed (parse-route-pattern "/docs/<slug>") :name "docs-page"})))
(let ((result (find-matching-route "/docs/hello" routes)))
(assert-true (not (nil? result)))
(assert-equal "docs-page" (get result "name"))
(assert-equal "hello" (get (get result "params") "slug")))))
(deftest "returns nil for no match"
(let ((routes (list
{:pattern "/docs/<slug>" :parsed (parse-route-pattern "/docs/<slug>") :name "docs-page"})))
(assert-nil (find-matching-route "/essays/hello" routes))))
(deftest "matches exact routes before param routes"
(let ((routes (list
{:pattern "/docs/" :parsed (parse-route-pattern "/docs/") :name "docs-index"}
{:pattern "/docs/<slug>" :parsed (parse-route-pattern "/docs/<slug>") :name "docs-page"})))
(let ((result (find-matching-route "/docs/" routes)))
(assert-true (not (nil? result)))
(assert-equal "docs-index" (get result "name")))))
(deftest "propagates stream flag from route"
(let ((routes (list
{:pattern "/demo/streaming"
:parsed (parse-route-pattern "/demo/streaming")
:name "streaming-demo"
:stream true
:has-data true})))
(let ((result (find-matching-route "/demo/streaming" routes)))
(assert-true (not (nil? result)))
(assert-equal true (get result "stream"))
(assert-equal true (get result "has-data")))))
(deftest "non-streaming route has no stream flag"
(let ((routes (list
{:pattern "/about"
:parsed (parse-route-pattern "/about")
:name "about"
:has-data false})))
(let ((result (find-matching-route "/about" routes)))
(assert-true (not (nil? result)))
(assert-nil (get result "stream"))))))
;; --------------------------------------------------------------------------
;; sx-url-to-path — SX expression URL → old-style path
;; --------------------------------------------------------------------------
(defsuite "sx-url-to-path"
(deftest "simple two-level"
(assert-equal "/language/docs/introduction"
(sx-url-to-path "/(language.(doc.introduction))")))
(deftest "deep nesting"
(assert-equal "/geography/hypermedia/reference/attributes"
(sx-url-to-path "/(geography.(hypermedia.(reference.attributes)))")))
(deftest "section index"
(assert-equal "/language"
(sx-url-to-path "/(language)")))
(deftest "function name mapping — doc to docs"
(assert-equal "/language/docs/getting-started"
(sx-url-to-path "/(language.(doc.getting-started))")))
(deftest "function name mapping — spec to specs"
(assert-equal "/language/specs/core"
(sx-url-to-path "/(language.(spec.core))")))
(deftest "function name mapping — example to examples"
(assert-equal "/geography/hypermedia/examples/click-to-load"
(sx-url-to-path "/(geography.(hypermedia.(example.click-to-load)))")))
(deftest "function name mapping — essay to essays"
(assert-equal "/etc/essays/sx-sucks"
(sx-url-to-path "/(etc.(essay.sx-sucks))")))
(deftest "function name mapping — plan to plans"
(assert-equal "/etc/plans/spec-explorer"
(sx-url-to-path "/(etc.(plan.spec-explorer))")))
(deftest "function name mapping — test to testing"
(assert-equal "/language/testing/eval"
(sx-url-to-path "/(language.(test.eval))")))
(deftest "function name mapping — bootstrapper to bootstrappers"
(assert-equal "/language/bootstrappers/python"
(sx-url-to-path "/(language.(bootstrapper.python))")))
(deftest "function name mapping — protocol to protocols"
(assert-equal "/applications/protocols/wire-format"
(sx-url-to-path "/(applications.(protocol.wire-format))")))
(deftest "function name mapping — reference-detail to reference"
(assert-equal "/geography/hypermedia/reference/attributes"
(sx-url-to-path "/(geography.(hypermedia.(reference-detail.attributes)))")))
(deftest "non-SX URL returns nil"
(assert-nil (sx-url-to-path "/language/docs/introduction"))
(assert-nil (sx-url-to-path "https://example.com"))))
;; --------------------------------------------------------------------------
;; find-matching-route with SX URLs
;; --------------------------------------------------------------------------
(defsuite "find-matching-route-sx-urls"
(deftest "SX URL auto-converts for matching"
(let ((routes (list
{:pattern "/language/docs/<slug>"
:parsed (parse-route-pattern "/language/docs/<slug>")
:name "docs-page"})))
(let ((result (find-matching-route "/(language.(doc.introduction))" routes)))
(assert-true (not (nil? result)))
(assert-equal "docs-page" (get result "name"))
(assert-equal "introduction" (get (get result "params") "slug"))))))
;; ==========================================================================
;; SX URL Resolution — Structural Navigation
;; ==========================================================================
(defsuite "relative-sx-url?"
(deftest "paren-form relative"
(assert-true (relative-sx-url? "(.slug)"))
(assert-true (relative-sx-url? "(..)"))
(assert-true (relative-sx-url? "(..reactive.demo)")))
(deftest "bare-dot relative"
(assert-true (relative-sx-url? ".slug"))
(assert-true (relative-sx-url? ".."))
(assert-true (relative-sx-url? "..."))
(assert-true (relative-sx-url? ".:page.4")))
(deftest "absolute URLs are not relative"
(assert-false (relative-sx-url? "/(language.(doc.intro))"))
(assert-false (relative-sx-url? "/"))
(assert-false (relative-sx-url? "/language/docs/intro")))
(deftest "special form URLs are not relative"
(assert-false (relative-sx-url? "/(!source.(~essay))"))))
;; --------------------------------------------------------------------------
;; Structural: append at current level (1 dot)
;; --------------------------------------------------------------------------
(defsuite "resolve-relative-url: append (.slug)"
(deftest "append to deep URL"
(assert-equal "/(geography.(hypermedia.(example.progress-bar)))"
(resolve-relative-url
"/(geography.(hypermedia.(example)))"
"(.progress-bar)")))
(deftest "append to single-level URL"
(assert-equal "/(language.intro)"
(resolve-relative-url "/(language)" "(.intro)")))
(deftest "append with multi-token body"
(assert-equal "/(geography.(hypermedia.(example.progress-bar.v2)))"
(resolve-relative-url
"/(geography.(hypermedia.(example)))"
"(.progress-bar.v2)")))
(deftest "bare-dot shorthand"
(assert-equal "/(geography.(hypermedia.(example.progress-bar)))"
(resolve-relative-url
"/(geography.(hypermedia.(example)))"
".progress-bar"))))
;; --------------------------------------------------------------------------
;; Structural: go up one level (2 dots)
;; --------------------------------------------------------------------------
(defsuite "resolve-relative-url: up one (..slug)"
(deftest "sibling call"
(assert-equal "/(geography.(hypermedia.(reactive.demo)))"
(resolve-relative-url
"/(geography.(hypermedia.(example)))"
"(..reactive.demo)")))
(deftest "just go up — no new content"
(assert-equal "/(geography.(hypermedia))"
(resolve-relative-url
"/(geography.(hypermedia.(example)))"
"(..)")))
(deftest "bare-dot shorthand for up"
(assert-equal "/(geography.(hypermedia))"
(resolve-relative-url
"/(geography.(hypermedia.(example)))"
"..")))
(deftest "up from two-level URL"
(assert-equal "/(language)"
(resolve-relative-url "/(language.(doc))" "(..)")))
(deftest "up from single-level pops to root"
(assert-equal "/"
(resolve-relative-url "/(language)" "(..)"))))
;; --------------------------------------------------------------------------
;; Structural: go up two levels (3 dots)
;; --------------------------------------------------------------------------
(defsuite "resolve-relative-url: up two (...slug)"
(deftest "up two and push"
(assert-equal "/(geography.(marshes))"
(resolve-relative-url
"/(geography.(hypermedia.(example)))"
"(...marshes)")))
(deftest "just up two — no content"
(assert-equal "/(geography)"
(resolve-relative-url
"/(geography.(hypermedia.(example)))"
"(...)")))
(deftest "bare-dot shorthand for up two"
(assert-equal "/(geography)"
(resolve-relative-url
"/(geography.(hypermedia.(example)))"
"...")))
(deftest "up two from two-level pops to root"
(assert-equal "/"
(resolve-relative-url "/(language.(doc))" "(...)")))
(deftest "up two and push from deep URL"
;; 4-level URL, ... = 3 dots = pop 2 levels → at hypermedia level
(assert-equal "/(geography.(hypermedia.(reactive.demo)))"
(resolve-relative-url
"/(geography.(hypermedia.(reference.(attributes))))"
"(...reactive.demo)"))))
;; --------------------------------------------------------------------------
;; Structural: up N levels (N+1 dots)
;; --------------------------------------------------------------------------
(defsuite "resolve-relative-url: up N"
(deftest "up three levels (4 dots) from 4-level URL"
;; 4-level URL, .... = 4 dots = pop 3 levels → at geography level
(assert-equal "/(geography)"
(resolve-relative-url
"/(geography.(hypermedia.(reference.(attributes))))"
"(....)")))
(deftest "up three and push from 4-level URL"
;; 4 dots = pop 3 → at geography, then push new-section
(assert-equal "/(geography.(new-section))"
(resolve-relative-url
"/(geography.(hypermedia.(reference.(attributes))))"
"(....new-section)")))
(deftest "up four levels (5 dots) pops to root"
(assert-equal "/"
(resolve-relative-url
"/(geography.(hypermedia.(reference.(attributes))))"
"(.....)"))))
;; --------------------------------------------------------------------------
;; Structural: current (1 dot, no body) = no-op
;; --------------------------------------------------------------------------
(defsuite "resolve-relative-url: current level no-op"
(deftest "dot with no body is identity"
;; (.): dots=1, body="" → no positional, no keywords → current unchanged
(assert-equal "/(language.(doc.intro))"
(resolve-relative-url "/(language.(doc.intro))" "(.)")))
(deftest "bare dot shorthand"
(assert-equal "/(language.(doc.intro))"
(resolve-relative-url "/(language.(doc.intro))" "."))))
;; ==========================================================================
;; SX URL Resolution — Keyword Operations
;; ==========================================================================
;; --------------------------------------------------------------------------
;; Keyword set: absolute value
;; --------------------------------------------------------------------------
(defsuite "resolve-relative-url: keyword set"
(deftest "set keyword on URL without keywords"
(assert-equal "/(language.(spec.(explore.signals.:page.4)))"
(resolve-relative-url
"/(language.(spec.(explore.signals)))"
"(.:page.4)")))
(deftest "replace existing keyword"
(assert-equal "/(language.(spec.(explore.signals.:page.4)))"
(resolve-relative-url
"/(language.(spec.(explore.signals.:page.3)))"
"(.:page.4)")))
(deftest "set keyword with bare-dot shorthand"
(assert-equal "/(language.(spec.(explore.signals.:page.4)))"
(resolve-relative-url
"/(language.(spec.(explore.signals.:page.3)))"
".:page.4")))
(deftest "set keyword on single-level URL"
(assert-equal "/(language.:page.1)"
(resolve-relative-url "/(language)" "(.:page.1)")))
(deftest "set multiple keywords"
(assert-equal "/(language.(spec.(explore.signals.:page.4.:section.batch)))"
(resolve-relative-url
"/(language.(spec.(explore.signals.:page.3)))"
"(.:page.4.:section.batch)")))
(deftest "add new keyword preserving existing"
(assert-equal "/(language.(spec.(explore.signals.:page.3.:section.batch)))"
(resolve-relative-url
"/(language.(spec.(explore.signals.:page.3)))"
"(.:section.batch)"))))
;; --------------------------------------------------------------------------
;; Keyword delta: +N / -N
;; --------------------------------------------------------------------------
(defsuite "resolve-relative-url: keyword delta"
(deftest "increment by 1"
(assert-equal "/(language.(spec.(explore.signals.:page.4)))"
(resolve-relative-url
"/(language.(spec.(explore.signals.:page.3)))"
"(.:page.+1)")))
(deftest "decrement by 1"
(assert-equal "/(language.(spec.(explore.signals.:page.2)))"
(resolve-relative-url
"/(language.(spec.(explore.signals.:page.3)))"
"(.:page.-1)")))
(deftest "increment by larger amount"
(assert-equal "/(language.(spec.(explore.signals.:page.13)))"
(resolve-relative-url
"/(language.(spec.(explore.signals.:page.3)))"
"(.:page.+10)")))
(deftest "delta with bare-dot shorthand"
(assert-equal "/(language.(spec.(explore.signals.:page.4)))"
(resolve-relative-url
"/(language.(spec.(explore.signals.:page.3)))"
".:page.+1")))
(deftest "delta on missing keyword uses literal"
;; If :page doesn't exist, +1 is used as-is (not numeric delta)
(assert-equal "/(language.(spec.(explore.signals.:page.+1)))"
(resolve-relative-url
"/(language.(spec.(explore.signals)))"
"(.:page.+1)"))))
;; --------------------------------------------------------------------------
;; Composed: structural + keyword
;; --------------------------------------------------------------------------
(defsuite "resolve-relative-url: composed structural + keyword"
(deftest "append slug + set keyword"
(assert-equal "/(language.(spec.(explore.signals.batch.:page.1)))"
(resolve-relative-url
"/(language.(spec.(explore.signals)))"
"(.batch.:page.1)")))
(deftest "sibling + set keyword"
(assert-equal "/(language.(spec.(eval.:page.1)))"
(resolve-relative-url
"/(language.(spec.(explore.signals.:page.3)))"
"(..eval.:page.1)")))
(deftest "up two + set keyword"
(assert-equal "/(geography.(reactive.demo.:page.1))"
(resolve-relative-url
"/(geography.(hypermedia.(example.progress-bar)))"
"(...reactive.demo.:page.1)")))
(deftest "bare-dot composed"
(assert-equal "/(language.(spec.(eval.:page.1)))"
(resolve-relative-url
"/(language.(spec.(explore.signals.:page.3)))"
"..eval.:page.1"))))
;; ==========================================================================
;; SX URL Parsing — parse-sx-url
;; ==========================================================================
(defsuite "parse-sx-url"
(deftest "home URL"
(let ((parsed (parse-sx-url "/")))
(assert-equal "home" (get parsed "type"))
(assert-equal "/" (get parsed "raw"))))
(deftest "absolute SX URL"
(let ((parsed (parse-sx-url "/(language.(doc.intro))")))
(assert-equal "absolute" (get parsed "type"))))
(deftest "relative paren-form"
(let ((parsed (parse-sx-url "(.slug)")))
(assert-equal "relative" (get parsed "type"))))
(deftest "relative bare-dot"
(let ((parsed (parse-sx-url ".slug")))
(assert-equal "relative" (get parsed "type"))))
(deftest "relative double-dot"
(let ((parsed (parse-sx-url "..")))
(assert-equal "relative" (get parsed "type"))))
(deftest "direct component"
(let ((parsed (parse-sx-url "/(~essay-sx-sucks)")))
(assert-equal "direct-component" (get parsed "type"))
(assert-equal "~essay-sx-sucks" (get parsed "name"))))
(deftest "old-style path"
(let ((parsed (parse-sx-url "/language/docs/intro")))
(assert-equal "path" (get parsed "type")))))
;; ==========================================================================
;; URL Special Forms (! prefix)
;; ==========================================================================
(defsuite "url-special-form?"
(deftest "known special forms"
(assert-true (url-special-form? "!source"))
(assert-true (url-special-form? "!inspect"))
(assert-true (url-special-form? "!diff"))
(assert-true (url-special-form? "!search"))
(assert-true (url-special-form? "!raw"))
(assert-true (url-special-form? "!json")))
(deftest "unknown bang-prefix is not a special form"
(assert-false (url-special-form? "!unknown"))
(assert-false (url-special-form? "!foo")))
(deftest "non-bang names are not special forms"
(assert-false (url-special-form? "source"))
(assert-false (url-special-form? "language"))
(assert-false (url-special-form? "~essay"))))
(defsuite "parse-sx-url: special forms"
(deftest "source special form"
(let ((parsed (parse-sx-url "/(!source.(~essay-sx-sucks))")))
(assert-equal "special-form" (get parsed "type"))
(assert-equal "!source" (get parsed "form"))
(assert-equal "(~essay-sx-sucks)" (get parsed "inner"))))
(deftest "inspect special form"
(let ((parsed (parse-sx-url "/(!inspect.(language.(doc.primitives)))")))
(assert-equal "special-form" (get parsed "type"))
(assert-equal "!inspect" (get parsed "form"))
(assert-equal "(language.(doc.primitives))" (get parsed "inner"))))
(deftest "diff special form with two args"
(let ((parsed (parse-sx-url "/(!diff.(language.(spec.signals)).(language.(spec.eval)))")))
(assert-equal "special-form" (get parsed "type"))
(assert-equal "!diff" (get parsed "form"))
(assert-equal "(language.(spec.signals)).(language.(spec.eval))" (get parsed "inner"))))
(deftest "raw special form"
(let ((parsed (parse-sx-url "/(!raw.(~some-component))")))
(assert-equal "special-form" (get parsed "type"))
(assert-equal "!raw" (get parsed "form"))
(assert-equal "(~some-component)" (get parsed "inner"))))
(deftest "json special form"
(let ((parsed (parse-sx-url "/(!json.(language.(doc.primitives)))")))
(assert-equal "special-form" (get parsed "type"))
(assert-equal "!json" (get parsed "form"))
(assert-equal "(language.(doc.primitives))" (get parsed "inner")))))
(defsuite "url-special-form-name"
(deftest "extracts form name"
(assert-equal "!source"
(url-special-form-name "/(!source.(~essay))")))
(deftest "returns nil for non-special-form"
(assert-nil (url-special-form-name "/(language.(doc.intro))"))
(assert-nil (url-special-form-name "/"))
(assert-nil (url-special-form-name "(.slug)"))))
(defsuite "url-special-form-inner"
(deftest "extracts inner expression"
(assert-equal "(~essay)"
(url-special-form-inner "/(!source.(~essay))")))
(deftest "extracts multi-arg inner"
(assert-equal "(a).(b)"
(url-special-form-inner "/(!diff.(a).(b))")))
(deftest "returns nil for non-special-form"
(assert-nil (url-special-form-inner "/(language.(doc.intro))"))))
;; ==========================================================================
;; Internal helpers — additional edge cases
;; ==========================================================================
(defsuite "internal: _pop-sx-url-level"
(deftest "pop three-level"
(assert-equal "/(a.(b))"
(_pop-sx-url-level "/(a.(b.(c)))")))
(deftest "pop two-level"
(assert-equal "/(a)"
(_pop-sx-url-level "/(a.(b))")))
(deftest "pop single-level to root"
(assert-equal "/"
(_pop-sx-url-level "/(a)")))
(deftest "pop root stays root"
(assert-equal "/"
(_pop-sx-url-level "/"))))
(defsuite "internal: _extract-innermost"
(deftest "single-level URL"
(let ((parts (_extract-innermost "/(language)")))
(assert-equal "/(" (get parts "before"))
(assert-equal "language" (get parts "content"))
(assert-equal ")" (get parts "suffix"))))
(deftest "two-level URL"
(let ((parts (_extract-innermost "/(language.(doc.intro))")))
(assert-equal "/(language.(" (get parts "before"))
(assert-equal "doc.intro" (get parts "content"))
(assert-equal "))" (get parts "suffix"))))
(deftest "three-level URL with keywords"
(let ((parts (_extract-innermost "/(a.(b.(c.d.:page.3)))")))
(assert-equal "/(a.(b.(" (get parts "before"))
(assert-equal "c.d.:page.3" (get parts "content"))
(assert-equal ")))" (get parts "suffix")))))
(defsuite "internal: _find-keyword-value"
(deftest "finds keyword"
(assert-equal "3"
(_find-keyword-value "explore.signals.:page.3" ":page")))
(deftest "returns nil when not found"
(assert-nil (_find-keyword-value "explore.signals" ":page")))
(deftest "finds among multiple keywords"
(assert-equal "batch"
(_find-keyword-value "explore.signals.:page.3.:section.batch" ":section"))))
(defsuite "internal: _set-keyword-in-content"
(deftest "replace existing"
(assert-equal "a.b.:page.4"
(_set-keyword-in-content "a.b.:page.3" ":page" "4")))
(deftest "append when missing"
(assert-equal "a.b.:page.1"
(_set-keyword-in-content "a.b" ":page" "1")))
(deftest "replace with multiple keywords present"
(assert-equal "a.:page.4.:section.batch"
(_set-keyword-in-content "a.:page.3.:section.batch" ":page" "4"))))
(defsuite "internal: _is-delta-value?"
(deftest "positive delta"
(assert-true (_is-delta-value? "+1"))
(assert-true (_is-delta-value? "+10")))
(deftest "negative delta"
(assert-true (_is-delta-value? "-1"))
(assert-true (_is-delta-value? "-10")))
(deftest "bare minus is not delta"
(assert-false (_is-delta-value? "-")))
(deftest "bare plus is not delta"
(assert-false (_is-delta-value? "+")))
(deftest "plain number is not delta"
(assert-false (_is-delta-value? "3"))
(assert-false (_is-delta-value? "0")))
(deftest "empty string is not delta"
(assert-false (_is-delta-value? ""))))
(defsuite "internal: _apply-delta"
(deftest "increment"
(assert-equal "4" (_apply-delta "3" "+1")))
(deftest "decrement"
(assert-equal "2" (_apply-delta "3" "-1")))
(deftest "large increment"
(assert-equal "13" (_apply-delta "3" "+10")))
(deftest "non-numeric current falls back"
(assert-equal "+1" (_apply-delta "abc" "+1"))))

216
web/tests/test-signals.sx Normal file
View File

@@ -0,0 +1,216 @@
;; ==========================================================================
;; test-signals.sx — Tests for signals and reactive islands
;;
;; Requires: test-framework.sx loaded first.
;; Modules tested: signals.sx, eval.sx (defisland)
;;
;; Note: Multi-expression lambda bodies are wrapped in (do ...) for
;; compatibility with the hand-written evaluator which only supports
;; single-expression lambda bodies.
;; ==========================================================================
;; --------------------------------------------------------------------------
;; Signal creation and basic read/write
;; --------------------------------------------------------------------------
(defsuite "signal basics"
(deftest "signal creates a reactive container"
(let ((s (signal 42)))
(assert-true (signal? s))
(assert-equal 42 (deref s))))
(deftest "deref on non-signal passes through"
(assert-equal 5 (deref 5))
(assert-equal "hello" (deref "hello"))
(assert-nil (deref nil)))
(deftest "reset! changes value"
(let ((s (signal 0)))
(reset! s 10)
(assert-equal 10 (deref s))))
(deftest "reset! does not notify when value unchanged"
(let ((s (signal 5))
(count (signal 0)))
(effect (fn () (do (deref s) (swap! count inc))))
;; Effect runs once on creation → count=1
(let ((c1 (deref count)))
(reset! s 5) ;; same value — no notification
(assert-equal c1 (deref count)))))
(deftest "swap! applies function to current value"
(let ((s (signal 10)))
(swap! s inc)
(assert-equal 11 (deref s))))
(deftest "swap! passes extra args"
(let ((s (signal 10)))
(swap! s + 5)
(assert-equal 15 (deref s)))))
;; --------------------------------------------------------------------------
;; Computed signals
;; --------------------------------------------------------------------------
(defsuite "computed"
(deftest "computed derives initial value"
(let ((a (signal 3))
(b (signal 4))
(sum (computed (fn () (+ (deref a) (deref b))))))
(assert-equal 7 (deref sum))))
(deftest "computed updates when dependency changes"
(let ((a (signal 2))
(doubled (computed (fn () (* 2 (deref a))))))
(assert-equal 4 (deref doubled))
(reset! a 5)
(assert-equal 10 (deref doubled))))
(deftest "computed chains"
(let ((base (signal 1))
(doubled (computed (fn () (* 2 (deref base)))))
(quadrupled (computed (fn () (* 2 (deref doubled))))))
(assert-equal 4 (deref quadrupled))
(reset! base 3)
(assert-equal 12 (deref quadrupled)))))
;; --------------------------------------------------------------------------
;; Effects
;; --------------------------------------------------------------------------
(defsuite "effects"
(deftest "effect runs immediately"
(let ((ran (signal false)))
(effect (fn () (reset! ran true)))
(assert-true (deref ran))))
(deftest "effect re-runs when dependency changes"
(let ((source (signal "a"))
(log (signal (list))))
(effect (fn ()
(swap! log (fn (l) (append l (deref source))))))
;; Initial run logs "a"
(assert-equal (list "a") (deref log))
;; Change triggers re-run
(reset! source "b")
(assert-equal (list "a" "b") (deref log))))
(deftest "effect dispose stops tracking"
(let ((source (signal 0))
(count (signal 0)))
(let ((dispose (effect (fn () (do
(deref source)
(swap! count inc))))))
;; Effect ran once
(assert-equal 1 (deref count))
;; Trigger
(reset! source 1)
(assert-equal 2 (deref count))
;; Dispose
(dispose)
;; Should NOT trigger
(reset! source 2)
(assert-equal 2 (deref count)))))
(deftest "effect cleanup runs before re-run"
(let ((source (signal 0))
(cleanups (signal 0)))
(effect (fn () (do
(deref source)
(fn () (swap! cleanups inc))))) ;; return cleanup fn
;; No cleanup yet (first run)
(assert-equal 0 (deref cleanups))
;; Change triggers cleanup of previous run
(reset! source 1)
(assert-equal 1 (deref cleanups)))))
;; --------------------------------------------------------------------------
;; Batch
;; --------------------------------------------------------------------------
(defsuite "batch"
(deftest "batch defers notifications"
(let ((a (signal 0))
(b (signal 0))
(run-count (signal 0)))
(effect (fn () (do
(deref a) (deref b)
(swap! run-count inc))))
;; Initial run
(assert-equal 1 (deref run-count))
;; Without batch: 2 writes → 2 effect runs
;; With batch: 2 writes → 1 effect run
(batch (fn () (do
(reset! a 1)
(reset! b 2))))
;; Should be 2 (initial + 1 batched), not 3
(assert-equal 2 (deref run-count)))))
;; --------------------------------------------------------------------------
;; defisland
;; --------------------------------------------------------------------------
(defsuite "defisland"
(deftest "defisland creates an island"
(defisland ~test-island (&key value)
(list "island" value))
(assert-true (island? ~test-island)))
(deftest "island is callable like component"
(defisland ~greeting (&key name)
(str "Hello, " name "!"))
(assert-equal "Hello, World!" (~greeting :name "World")))
(deftest "island accepts children"
(defisland ~wrapper (&rest children)
(list "wrap" children))
(assert-equal (list "wrap" (list "a" "b"))
(~wrapper "a" "b"))))
;; --------------------------------------------------------------------------
;; Scope integration — reactive tracking uses scope-push!/scope-pop!
;; --------------------------------------------------------------------------
(defsuite "scope integration"
(deftest "deref outside reactive scope does not subscribe"
(let ((s (signal 42)))
;; Reading outside any reactive context should not add subscribers
(assert-equal 42 (deref s))
(assert-equal 0 (len (signal-subscribers s)))))
(deftest "computed uses scope for tracking"
(let ((a (signal 1))
(b (signal 2))
(sum (computed (fn () (+ (deref a) (deref b))))))
;; Each signal should have exactly 1 subscriber (the computed's recompute)
(assert-equal 1 (len (signal-subscribers a)))
(assert-equal 1 (len (signal-subscribers b)))
;; Verify computed value
(assert-equal 3 (deref sum))))
(deftest "nested effects with overlapping deps use scope correctly"
(let ((shared (signal 0))
(inner-only (signal 0))
(outer-count (signal 0))
(inner-count (signal 0)))
;; Outer effect tracks shared
(effect (fn () (do (deref shared) (swap! outer-count inc))))
;; Inner effect tracks shared AND inner-only
(effect (fn () (do (deref shared) (deref inner-only) (swap! inner-count inc))))
;; Both ran once
(assert-equal 1 (deref outer-count))
(assert-equal 1 (deref inner-count))
;; Changing shared triggers both
(reset! shared 1)
(assert-equal 2 (deref outer-count))
(assert-equal 2 (deref inner-count))
;; Changing inner-only triggers only inner
(reset! inner-only 1)
(assert-equal 2 (deref outer-count))
(assert-equal 3 (deref inner-count)))))