Test runner: SSR fix, cek-try primitive, HTML entity handling

- render-html-island wraps body SSR in cek-try (graceful fallback to
  empty container when island body has DOM/signal code)
- defcomp placeholder pattern: server renders safe placeholder div
  with data-sx-island, browser hydrates the actual island
- cek-try primitive added to both server and browser OCaml kernels
- assert/assert= added to spec/harness.sx for standalone use
- Test source stored in <script type="text/sx-test" data-for="...">
  with HTML entity decoding via host-call replaceAll

Temperature converter: 5 tests embedded in demo page. Test runner
hydrates and finds tests but body render is empty — needs debugging
of the specific construct that silently fails in render-to-dom.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-03-26 01:38:10 +00:00
parent 5754a9ff9f
commit 7a8a166326
4 changed files with 20 additions and 643 deletions

View File

@@ -2,7 +2,7 @@
(defcomp ~reactive-islands/demo/example-counter () (~docs/page :title "Signal + Computed + Effect" (p "A signal holds a value. A computed derives from it. Click the buttons — the counter and doubled value update instantly, no server round-trip.") (~reactive-islands/index/demo-counter :initial 0) (~docs/code :src (highlight "(defisland ~reactive-islands/demo/counter (&key initial)\n (let ((count (signal (or initial 0)))\n (doubled (computed (fn () (* 2 (deref count))))))\n (div :class \"...\"\n (button :on-click (fn (e) (swap! count dec)) \"\")\n (span (deref count))\n (button :on-click (fn (e) (swap! count inc)) \"+\")\n (p \"doubled: \" (deref doubled)))))" "lisp")) (p (code "(deref count)") " in a text position creates a reactive text node. When " (code "count") " changes, " (em "only that text node") " updates. " (code "doubled") " recomputes automatically. No diffing.")))
(defcomp ~reactive-islands/demo/example-temperature () (~docs/page :title "Temperature Converter" (p "Two derived values from one signal. Click to change Celsius — Fahrenheit updates reactively.") (~reactive-islands/index/demo-temperature) (~docs/code :src (highlight "(defisland ~reactive-islands/demo/temperature ()\n (let ((celsius (signal 20)))\n (div :class \"...\"\n (button :on-click (fn (e) (swap! celsius (fn (c) (- c 5)))) \"5\")\n (span (deref celsius))\n (button :on-click (fn (e) (swap! celsius (fn (c) (+ c 5)))) \"+5\")\n (span \"°C = \")\n (span (+ (* (deref celsius) 1.8) 32))\n (span \"°F\"))))" "lisp")) (p "The actual implementation uses " (code "computed") " for Fahrenheit: " (code "(computed (fn () (+ (* (deref celsius) 1.8) 32)))") ". The " (code "(deref fahrenheit)") " in the span creates a reactive text node that updates when celsius changes.") (~reactive-islands/test-runner :test-src (str "(defsuite \"temperature converter\"\n" " (deftest \"initial celsius is 20\"\n" " (let ((celsius (signal 20)))\n" " (assert-signal-value celsius 20)))\n" " (deftest \"computed fahrenheit derives from celsius\"\n" " (let ((celsius (signal 20))\n" " (fahrenheit (computed (fn () (+ (* (deref celsius) 1.8) 32)))))\n" " (assert-signal-value fahrenheit 68)\n" " (assert-computed-depends-on fahrenheit celsius)))\n" " (deftest \"+5 increments celsius\"\n" " (let ((celsius (signal 20))\n" " (btn (mock-element \"button\")))\n" " (mock-add-listener! btn \"click\"\n" " (fn (e) (swap! celsius (fn (c) (+ c 5)))))\n" " (simulate-click btn)\n" " (assert-signal-value celsius 25)))\n" " (deftest \"5 decrements celsius\"\n" " (let ((celsius (signal 20))\n" " (btn (mock-element \"button\")))\n" " (mock-add-listener! btn \"click\"\n" " (fn (e) (swap! celsius (fn (c) (- c 5)))))\n" " (simulate-click btn)\n" " (assert-signal-value celsius 15)))\n" " (deftest \"fahrenheit updates on celsius change\"\n" " (let ((celsius (signal 20))\n" " (fahrenheit (computed (fn () (+ (* (deref celsius) 1.8) 32)))))\n" " (reset! celsius 0)\n" " (assert-signal-value fahrenheit 32)\n" " (reset! celsius 100)\n" " (assert-signal-value fahrenheit 212)))\n" " (deftest \"multiple clicks accumulate\"\n" " (let ((celsius (signal 20))\n" " (fahrenheit (computed (fn () (+ (* (deref celsius) 1.8) 32))))\n" " (btn (mock-element \"button\")))\n" " (mock-add-listener! btn \"click\"\n" " (fn (e) (swap! celsius (fn (c) (+ c 5)))))\n" " (simulate-click btn)\n" " (simulate-click btn)\n" " (simulate-click btn)\n" " (assert-signal-value celsius 35)\n" " (assert-signal-value fahrenheit 95))))"))))
(defcomp ~reactive-islands/demo/example-temperature () (~docs/page :title "Temperature Converter" (p "Two derived values from one signal. Click to change Celsius — Fahrenheit updates reactively.") (~reactive-islands/index/demo-temperature) (~docs/code :src (highlight "(defisland ~reactive-islands/demo/temperature ()\n (let ((celsius (signal 20)))\n (div :class \"...\"\n (button :on-click (fn (e) (swap! celsius (fn (c) (- c 5)))) \"5\")\n (span (deref celsius))\n (button :on-click (fn (e) (swap! celsius (fn (c) (+ c 5)))) \"+5\")\n (span \"°C = \")\n (span (+ (* (deref celsius) 1.8) 32))\n (span \"°F\"))))" "lisp")) (p "The actual implementation uses " (code "computed") " for Fahrenheit: " (code "(computed (fn () (+ (* (deref celsius) 1.8) 32)))") ". The " (code "(deref fahrenheit)") " in the span creates a reactive text node that updates when celsius changes.") (div :class "mt-6" (~reactive-islands/test-runner-placeholder) (script :type "text/sx-test" :data-for "temperature" "(defsuite \"temperature converter\" (deftest \"initial celsius is 20\" (let ((celsius (signal 20))) (assert-signal-value celsius 20))) (deftest \"computed fahrenheit = celsius * 1.8 + 32\" (let ((celsius (signal 20)) (fahrenheit (computed (fn () (+ (* (deref celsius) 1.8) 32))))) (assert-signal-value fahrenheit 68) (assert-computed-depends-on fahrenheit celsius))) (deftest \"+5 increments celsius\" (let ((celsius (signal 20)) (btn (mock-element \"button\"))) (mock-add-listener! btn \"click\" (fn (e) (swap! celsius (fn (c) (+ c 5))))) (simulate-click btn) (assert-signal-value celsius 25))) (deftest \"fahrenheit updates on celsius change\" (let ((celsius (signal 20)) (fahrenheit (computed (fn () (+ (* (deref celsius) 1.8) 32))))) (reset! celsius 0) (assert-signal-value fahrenheit 32) (reset! celsius 100) (assert-signal-value fahrenheit 212))) (deftest \"multiple clicks accumulate\" (let ((celsius (signal 20)) (fahrenheit (computed (fn () (+ (* (deref celsius) 1.8) 32)))) (btn (mock-element \"button\"))) (mock-add-listener! btn \"click\" (fn (e) (swap! celsius (fn (c) (+ c 5))))) (simulate-click btn) (simulate-click btn) (simulate-click btn) (assert-signal-value celsius 35) (assert-signal-value fahrenheit 95))))"))))
(defcomp ~reactive-islands/demo/example-stopwatch () (~docs/page :title "Effect + Cleanup: Stopwatch" (p "Effects can return cleanup functions. This stopwatch starts a " (code "set-interval") " — the cleanup clears it when the running signal toggles off.") (~reactive-islands/index/demo-stopwatch) (~docs/code :src (highlight "(defisland ~reactive-islands/demo/stopwatch ()\n (let ((running (signal false))\n (elapsed (signal 0))\n (time-text (create-text-node \"0.0s\"))\n (btn-text (create-text-node \"Start\")))\n ;; Timer: effect creates interval, cleanup clears it\n (effect (fn ()\n (when (deref running)\n (let ((id (set-interval (fn () (swap! elapsed inc)) 100)))\n (fn () (clear-interval id))))))\n ;; Display: updates text node when elapsed changes\n (effect (fn ()\n (let ((e (deref elapsed)))\n (dom-set-text-content time-text\n (str (floor (/ e 10)) \".\" (mod e 10) \"s\")))))\n ;; Button label\n (effect (fn ()\n (dom-set-text-content btn-text\n (if (deref running) \"Stop\" \"Start\"))))\n (div :class \"...\"\n (span time-text)\n (button :on-click (fn (e) (swap! running not)) btn-text)\n (button :on-click (fn (e)\n (reset! running false) (reset! elapsed 0)) \"Reset\"))))" "lisp")) (p "Three effects, each tracking different signals. The timer effect's cleanup fires before each re-run — toggling " (code "running") " off clears the interval. No hook rules: effects can appear anywhere, in any order.")))

View File

@@ -1,76 +1,3 @@
;; ~reactive-islands/test-runner — inline test runner island
;;
;; Displays test results for a test suite. Runs tests on mount and
;; shows pass/fail with details.
(defcomp ~reactive-islands/test-runner-placeholder () (div :class "rounded border border-stone-200 bg-stone-50 p-4" :data-sx-island "reactive-islands/test-runner" (p :class "text-stone-400 text-sm italic" "Loading tests...")))
(defisland ~reactive-islands/test-runner (&key test-src)
(let ((results (signal nil))
(running (signal false)))
(letrec
((run-tests (fn ()
(reset! running true)
(let ((parsed (sx-parse test-src))
(test-results (list)))
;; Walk parsed expressions looking for deftest/defsuite
(for-each (fn (expr)
(when (and (list? expr) (not (empty? expr))
(= (type-of (first expr)) "symbol"))
(let ((head (symbol-name (first expr))))
(cond
(= head "defsuite")
;; Process each deftest in the suite
(for-each (fn (child)
(when (and (list? child) (not (empty? child))
(= (type-of (first child)) "symbol")
(= (symbol-name (first child)) "deftest"))
(let ((test-name (nth child 1))
(test-body (last child)))
(let ((result (try-test test-name test-body)))
(append! test-results result)))))
(slice expr 2))
(= head "deftest")
(let ((test-name (nth expr 1))
(test-body (last expr)))
(append! test-results (try-test test-name test-body)))))))
parsed)
(reset! results test-results)
(reset! running false))))
(try-test (fn (name body)
(let ((error-msg nil))
;; Evaluate the test body, catch assertion failures
(let ((ok (cek-try
(fn () (cek-eval (sx-serialize body)) true)
(fn (err) (set! error-msg (str err)) false))))
{:name name :pass ok :error error-msg})))))
;; Run on mount
(run-tests)
(div :class "mt-6 rounded border border-stone-200 bg-stone-50 p-4"
(div :class "flex items-center justify-between mb-3"
(h4 :class "text-sm font-semibold text-stone-700" "Tests")
(button :class "px-2 py-1 text-xs rounded bg-stone-200 hover:bg-stone-300"
:on-click (fn (e) (run-tests))
"Re-run"))
(if (deref running)
(p :class "text-stone-400 text-sm italic" "Running...")
(if (nil? (deref results))
(p :class "text-stone-400 text-sm italic" "No results")
(let ((r (deref results))
(pass-count (len (filter (fn (t) (get t "pass")) r)))
(fail-count (len (filter (fn (t) (not (get t "pass"))) r))))
(div :class "space-y-2"
(div :class "text-sm font-mono"
(span :class (if (= fail-count 0) "text-emerald-600" "text-red-600")
(str pass-count "/" (len r) " passed")))
(map (fn (t)
(div :class "flex items-start gap-2 text-xs font-mono py-0.5"
(span :class (if (get t "pass") "text-emerald-500" "text-red-500")
(if (get t "pass") "✓" "✗"))
(span :class "text-stone-600" (get t "name"))
(when (get t "error")
(span :class "text-red-400 ml-2" (get t "error")))))
r)))))))))
(defisland ~reactive-islands/test-runner () (let ((results (signal nil)) (running (signal false))) (letrec ((run-tests (fn () (reset! running true) (let ((script-el (dom-query "script[data-for]")) (test-results (list))) (when script-el (let ((test-src (host-get script-el "textContent")) (parsed (let ((raw (host-get script-el "textContent")) (decoded (host-call raw "replaceAll" "&quot;" "\""))) (sx-parse (host-call decoded "replaceAll" "&amp;" "&"))))) (for-each (fn (expr) (when (and (list? expr) (not (empty? expr)) (= (type-of (first expr)) "symbol")) (let ((head (symbol-name (first expr)))) (cond (= head "defsuite") (for-each (fn (child) (when (and (list? child) (not (empty? child)) (= (type-of (first child)) "symbol") (= (symbol-name (first child)) "deftest")) (append! test-results (try-test (nth child 1) (last child))))) (slice expr 2)) (= head "deftest") (append! test-results (try-test (nth expr 1) (last expr))))))) parsed))) (reset! results test-results) (reset! running false)))) (try-test (fn (name body) (let ((result (cek-try (fn () (eval-expr body (global-env)) true) (fn (err) err)))) (if (= result true) {:pass true :error nil :name name} {:pass false :error (str result) :name name}))))) (run-tests) (div :class "rounded border border-stone-200 bg-stone-50 p-4" (div :class "flex items-center justify-between mb-3" (h4 :class "text-sm font-semibold text-stone-700" "Tests") (button :class "px-2 py-1 text-xs rounded bg-stone-200 hover:bg-stone-300 transition" :on-click (fn (e) (run-tests)) "Re-run")) (if (deref running) (p :class "text-stone-400 text-sm italic" "Running...") (if (nil? (deref results)) (p :class "text-stone-400 text-sm italic" "No test source found") (let ((r (deref results)) (pass-count (len (filter (fn (t) (get t "pass")) r))) (fail-count (len (filter (fn (t) (not (get t "pass"))) r)))) (div :class "space-y-2" (div :class "text-sm font-mono" (span :class (if (= fail-count 0) "text-emerald-600 font-semibold" "text-red-600 font-semibold") (str pass-count "/" (len r) " passed"))) (map (fn (t) (div :class "flex items-start gap-2 text-xs font-mono py-0.5" (span :class (if (get t "pass") "text-emerald-500" "text-red-500") (if (get t "pass") "✓" "✗")) (span :class "text-stone-600" (get t "name")) (when (get t "error") (span :class "text-red-400 ml-2" (get t "error"))))) r)))))))))