giles
5754a9ff9f
Temperature converter tests (6 tests): initial value, computed fahrenheit derivation, +5/-5 click handlers, reactive propagation, multiple click accumulation. New components: - sx/sx/reactive-islands/test-runner.sx — reusable defisland that parses test source, runs defsuite/deftest forms via cek-eval, and displays pass/fail results with re-run button - sx/sx/reactive-islands/test-temperature.sx — standalone test file Added cek-try primitive to both browser (sx_browser.ml) and server (sx_server.ml) for safe test execution with error catching. Browser bundle now includes harness files (harness.sx, harness-reactive.sx, harness-web.sx) for inline test execution. Known: SSR renders test runner body instead of placeholder, causing arity error on complex str expressions. Needs island SSR handling fix. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
77 lines
3.4 KiB
Plaintext
77 lines
3.4 KiB
Plaintext
;; ~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.
|
|
|
|
(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)))))))))
|