giles
d40a9c6796
Build tooling: updated OCaml bootstrapper, compile-modules, bundle.sh, sx-build-all. WASM browser: rebuilt sx_browser.bc.js/wasm, sx-platform-2.js, .sxbc bytecode files. CSSX/Tailwind: reworked cssx.sx templates and tw-layout, added tw-type support. Content: refreshed essays, plans, geography, reactive islands, docs, demos, handlers. New tools: bisect_sxbc.sh, test-spa.js, render-trace.sx, morph playwright spec. Tests: added test-match.sx, test-examples.sx, updated test-tw.sx and web tests. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
334 lines
8.7 KiB
Plaintext
334 lines
8.7 KiB
Plaintext
(define
|
|
test-set-attr-sep
|
|
(fn (el name val) (effect (fn () (dom-set-attr el name val)))))
|
|
|
|
(define
|
|
test-set-attr-mod
|
|
(fn (el name val) (effect (fn () (dom-set-attr el name val)))))
|
|
|
|
(define test-reactive-sig (signal "before"))
|
|
|
|
(defsuite
|
|
"wasm-basic"
|
|
(deftest "arithmetic" (assert-equal 3 (+ 1 2)))
|
|
(deftest
|
|
"div preserves keywords"
|
|
(assert-equal
|
|
"(div :class \"test\" \"hello\")"
|
|
(inspect (div :class "test" "hello"))))
|
|
(deftest
|
|
"render div+class"
|
|
(assert-equal
|
|
"<div class=\"card\">content</div>"
|
|
(render-to-html (div :class "card" "content")))))
|
|
|
|
(defsuite
|
|
"wasm-dom-rendering"
|
|
(deftest
|
|
"dom class attr"
|
|
(assert-equal
|
|
"test"
|
|
(dom-get-attr
|
|
(render-to-dom (div :class "test" "hello") (global-env) nil)
|
|
"class"))))
|
|
|
|
(defsuite
|
|
"wasm-scoped"
|
|
(deftest
|
|
"static class in island scope"
|
|
(assert-equal
|
|
"scoped"
|
|
(dom-get-attr
|
|
(let
|
|
((d (list)))
|
|
(with-island-scope
|
|
(fn (x) (append! d x))
|
|
(fn
|
|
()
|
|
(render-to-dom (div :class "scoped" "text") (global-env) nil))))
|
|
"class")))
|
|
(deftest
|
|
"signal attr initial value"
|
|
(assert-equal
|
|
"active"
|
|
(dom-get-attr
|
|
(let
|
|
((s (signal "active")) (d (list)))
|
|
(with-island-scope
|
|
(fn (x) (append! d x))
|
|
(fn
|
|
()
|
|
(render-to-dom
|
|
(div :class (deref s) "content")
|
|
(global-env)
|
|
nil))))
|
|
"class")))
|
|
(deftest
|
|
"signal text in scope"
|
|
(assert-true
|
|
(contains?
|
|
(host-get
|
|
(let
|
|
((s (signal 42)) (d (list)))
|
|
(with-island-scope
|
|
(fn (x) (append! d x))
|
|
(fn () (render-to-dom (div (deref s)) (global-env) nil))))
|
|
"outerHTML")
|
|
"42"))))
|
|
|
|
(defsuite
|
|
"wasm-define-effect"
|
|
(deftest
|
|
"define+effect+host-obj (same eval)"
|
|
(assert-equal
|
|
"from-define"
|
|
(do
|
|
(define
|
|
test-set-attr-inline
|
|
(fn (el name val) (effect (fn () (dom-set-attr el name val)))))
|
|
(let
|
|
((el (dom-create-element "div" nil)))
|
|
(test-set-attr-inline el "class" "from-define")
|
|
(dom-get-attr el "class")))))
|
|
(deftest
|
|
"define+effect body executes"
|
|
(assert-equal
|
|
"1:ran"
|
|
(do
|
|
(define
|
|
test-fx-log-inline
|
|
(fn
|
|
(el log)
|
|
(effect
|
|
(fn () (append! log "ran") (dom-set-attr el "class" "fx")))))
|
|
(let
|
|
((el (dom-create-element "div" nil)) (log (list)))
|
|
(test-fx-log-inline el log)
|
|
(str (len log) ":" (first log))))))
|
|
(deftest
|
|
"let+effect+host-obj"
|
|
(assert-equal
|
|
"from-let"
|
|
(let
|
|
((test-set-attr-let (fn (el name val) (effect (fn () (dom-set-attr el name val))))))
|
|
(let
|
|
((el (dom-create-element "div" nil)))
|
|
(test-set-attr-let el "class" "from-let")
|
|
(dom-get-attr el "class"))))))
|
|
|
|
(defsuite
|
|
"wasm-module-loaded"
|
|
(deftest
|
|
"define+effect+host-obj (separate eval)"
|
|
(assert-equal
|
|
"from-sep-define"
|
|
(let
|
|
((el (dom-create-element "div" nil)))
|
|
(test-set-attr-sep el "class" "from-sep-define")
|
|
(dom-get-attr el "class"))))
|
|
(deftest
|
|
"define+effect+host-obj (module-loaded)"
|
|
(assert-equal
|
|
"from-mod"
|
|
(let
|
|
((el (dom-create-element "div" nil)))
|
|
(test-set-attr-mod el "class" "from-mod")
|
|
(dom-get-attr el "class")))))
|
|
|
|
(defsuite
|
|
"wasm-reactive"
|
|
(deftest
|
|
"reactive-spread from module"
|
|
(assert-equal
|
|
"sx-text-center"
|
|
(let
|
|
((el (dom-create-element "div" nil)) (d (list)))
|
|
(with-island-scope
|
|
(fn (x) (append! d x))
|
|
(fn () (reactive-spread el (fn () (~tw :tokens "text-center")))))
|
|
(dom-get-attr el "class"))))
|
|
(deftest
|
|
"render-to-dom CSSX in island scope"
|
|
(assert-true
|
|
(contains?
|
|
(host-get
|
|
(let
|
|
((d (list)))
|
|
(with-island-scope
|
|
(fn (x) (append! d x))
|
|
(fn
|
|
()
|
|
(render-to-dom
|
|
(quote (div (~tw :tokens "text-center font-bold") "hello"))
|
|
(global-env)
|
|
nil))))
|
|
"outerHTML")
|
|
"sx-text-center"))))
|
|
|
|
(defsuite
|
|
"wasm-signals-core"
|
|
(deftest "signal create and deref" (assert-equal 42 (deref (signal 42))))
|
|
(deftest
|
|
"reset! changes value"
|
|
(let
|
|
((s (signal "old")))
|
|
(reset! s "new")
|
|
(assert-equal "new" (deref s))))
|
|
(deftest
|
|
"swap! applies function"
|
|
(let ((s (signal 10))) (swap! s + 5) (assert-equal 15 (deref s))))
|
|
(deftest
|
|
"computed derives from signal"
|
|
(let
|
|
((s (signal 3)))
|
|
(let
|
|
((c (computed (fn () (* (deref s) 2)))))
|
|
(assert-equal 6 (deref c)))))
|
|
(deftest
|
|
"effect runs immediately"
|
|
(let
|
|
((log (list)))
|
|
(effect (fn () (append! log "ran")))
|
|
(assert-equal 1 (len log))))
|
|
(deftest
|
|
"effect re-runs on signal change"
|
|
(let
|
|
((log (list)) (s (signal "a")))
|
|
(effect (fn () (append! log (deref s))))
|
|
(reset! s "b")
|
|
(assert-equal 2 (len log))
|
|
(assert-equal "b" (nth log 1))))
|
|
(deftest
|
|
"effect cleanup called on re-run"
|
|
(let
|
|
((log (list)) (s (signal 1)))
|
|
(effect
|
|
(fn
|
|
()
|
|
(let
|
|
((v (deref s)))
|
|
(append! log (str "run:" v))
|
|
(fn () (append! log (str "cleanup:" v))))))
|
|
(reset! s 2)
|
|
(assert-true (contains? log "cleanup:1"))))
|
|
(deftest
|
|
"batch delays notification"
|
|
(let
|
|
((count 0) (s (signal 0)))
|
|
(effect (fn () (deref s) (set! count (+ count 1))))
|
|
(batch (fn () (reset! s 1) (reset! s 2) (reset! s 3)))
|
|
(assert-equal 2 count))))
|
|
|
|
(defsuite
|
|
"wasm-conditional-rendering"
|
|
(deftest
|
|
"if renders then branch"
|
|
(assert-true
|
|
(contains?
|
|
(host-get
|
|
(let
|
|
((d (list)))
|
|
(with-island-scope
|
|
(fn (x) (append! d x))
|
|
(fn
|
|
()
|
|
(render-to-dom
|
|
(quote (if true (div "yes") (div "no")))
|
|
(global-env)
|
|
nil))))
|
|
"outerHTML")
|
|
"yes")))
|
|
(deftest
|
|
"when renders body on true"
|
|
(assert-true
|
|
(contains?
|
|
(host-get
|
|
(let
|
|
((d (list)))
|
|
(with-island-scope
|
|
(fn (x) (append! d x))
|
|
(fn
|
|
()
|
|
(render-to-dom
|
|
(quote (when true (div "visible")))
|
|
(global-env)
|
|
nil))))
|
|
"outerHTML")
|
|
"visible")))
|
|
(deftest
|
|
"cond selects correct branch"
|
|
(assert-true
|
|
(contains?
|
|
(host-get
|
|
(render-to-dom
|
|
(quote (cond false (div "a") true (div "b") :else (div "c")))
|
|
(global-env)
|
|
nil)
|
|
"outerHTML")
|
|
"b")))
|
|
(deftest
|
|
"render-to-dom with let bindings"
|
|
(assert-true
|
|
(contains?
|
|
(host-get
|
|
(render-to-dom
|
|
(quote (let ((x "hello")) (div x)))
|
|
(global-env)
|
|
nil)
|
|
"outerHTML")
|
|
"hello")))
|
|
(deftest
|
|
"render-to-dom with begin"
|
|
(assert-true
|
|
(contains?
|
|
(host-get
|
|
(render-to-dom (quote (do (div "only-this"))) (global-env) nil)
|
|
"outerHTML")
|
|
"only-this"))))
|
|
|
|
(defsuite
|
|
"wasm-signal-propagation"
|
|
(deftest
|
|
"reactive attr update"
|
|
(do
|
|
(set! test-reactive-sig (signal "before"))
|
|
(assert-equal
|
|
"after"
|
|
(let
|
|
((d (list)))
|
|
(let
|
|
((el (with-island-scope (fn (x) (append! d x)) (fn () (render-to-dom (quote (div :class (deref test-reactive-sig) "content")) (global-env) nil)))))
|
|
(reset! test-reactive-sig "after")
|
|
(dom-get-attr el "class")))))))
|
|
|
|
(defsuite
|
|
"wasm-scope-context"
|
|
(deftest
|
|
"scope-push + context reads value"
|
|
(scope-push! "test-scope" "hello")
|
|
(let
|
|
((v (context "test-scope" nil)))
|
|
(scope-pop! "test-scope")
|
|
(assert-equal "hello" v)))
|
|
(deftest
|
|
"context returns default when not pushed"
|
|
(assert-equal "default" (context "nonexistent-scope" "default")))
|
|
(deftest
|
|
"nested scope-push shadows outer"
|
|
(scope-push! "test-nest" "outer")
|
|
(scope-push! "test-nest" "inner")
|
|
(let
|
|
((v (context "test-nest" nil)))
|
|
(scope-pop! "test-nest")
|
|
(scope-pop! "test-nest")
|
|
(assert-equal "inner" v)))
|
|
(deftest
|
|
"scope-pop reveals outer"
|
|
(scope-push! "test-reveal" "outer")
|
|
(scope-push! "test-reveal" "inner")
|
|
(scope-pop! "test-reveal")
|
|
(let
|
|
((v (context "test-reveal" nil)))
|
|
(scope-pop! "test-reveal")
|
|
(assert-equal "outer" v))))
|