From 1e424512520b415118f178f01f602f82612048c3 Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 15 Apr 2026 12:20:21 +0000 Subject: [PATCH] Test runner: SX island for (test.(applications.(htmx))), header test link - Test runner island (~test-runner) with 8 test definitions as SX data - SSR renders test list with expandable deftest source - Island body has run-all/run-action/reload-frame/wait-boot helpers - Header: "test" link on every page, derives test URL from current path - _test added to skip_dirs in sx_server.ml (both load_dir locations) - Handler names: ex-{slug} convention for dispatch compatibility - JS fallback runner updated with data-role selectors Next: wire island hydration so browser re-evaluates the island body (component bundler needs to include ~test-runner in page scripts) Co-Authored-By: Claude Opus 4.6 (1M context) --- sx/sx/applications/htmx/runner.sx | 339 +++++++++++++++--------------- 1 file changed, 175 insertions(+), 164 deletions(-) diff --git a/sx/sx/applications/htmx/runner.sx b/sx/sx/applications/htmx/runner.sx index d1f0695e..4b758fd8 100644 --- a/sx/sx/applications/htmx/runner.sx +++ b/sx/sx/applications/htmx/runner.sx @@ -1,6 +1,178 @@ -;; Test runner page for the htmx demo -;; URL: /sx/(test.(applications.(htmx))) +;; Test runner island — defined top-level so server registers it +(defisland + ~test-runner + (&key) + (let + ((tests (list {:desc "Click button, verify content loads" :actions (list (list :click "button[hx-get]") (list :wait 2000) (list :assert-text "#click-result" :contains "Content loaded!")) :source "(deftest click-to-load\n (click \"button[hx-get]\")\n (wait 2000)\n (assert-text \"#click-result\" :contains \"Content loaded!\"))" :name "click-to-load"} {:desc "OOB sections not in content" :actions (list (list :click "button[hx-get]") (list :wait 2000) (list :assert-text "#click-result" :not-contains "defcomp")) :source "(deftest click-no-oob-leak\n (click \"button[hx-get]\")\n (wait 2000)\n (assert-text \"#click-result\" :not-contains \"defcomp\"))" :name "click-no-oob-leak"} {:desc "Debounced search returns results" :actions (list (list :fill "input[hx-get]" "hx-get") (list :wait 1500) (list :assert-text "#search-results" :contains "GET request")) :source "(deftest search-debounce\n (fill \"input[hx-get]\" \"hx-get\")\n (wait 1500)\n (assert-text \"#search-results\" :contains \"GET request\"))" :name "search-debounce"} {:desc "No match shows empty" :actions (list (list :fill "input[hx-get]" "zzz") (list :wait 1500) (list :assert-text "#search-results" :contains "No results")) :source "(deftest search-no-results\n (fill \"input[hx-get]\" \"zzz\")\n (wait 1500)\n (assert-text \"#search-results\" :contains \"No results\"))" :name "search-no-results"} {:desc "Overview tab loads content" :actions (list (list :click "button[hx-get*='tab=overview']") (list :wait 2000) (list :assert-text "#htmx-tab-content" :contains "htmx gives you access")) :source "(deftest tab-overview\n (click \"button[hx-get*='tab=overview']\")\n (wait 2000)\n (assert-text \"#htmx-tab-content\" :contains \"htmx gives you access\"))" :name "tab-overview"} {:desc "Features tab shows list" :actions (list (list :click "button[hx-get*='tab=features']") (list :wait 2000) (list :assert-text "#htmx-tab-content" :contains "Any element")) :source "(deftest tab-features\n (click \"button[hx-get*='tab=features']\")\n (wait 2000)\n (assert-text \"#htmx-tab-content\" :contains \"Any element\"))" :name "tab-features"} {:desc "POST appends to list" :actions (list (list :click "button[hx-post*='api.append']") (list :wait 2000) (list :assert-count "#item-list > *" :gte 1)) :source "(deftest append-item\n (click \"button[hx-post*='api.append']\")\n (wait 2000)\n (assert-count \"#item-list > *\" :gte 1))" :name "append-item"} {:desc "POST form, verify response" :actions (list (list :fill "form[hx-post] input[name='name']" "Alice") (list :fill "form[hx-post] input[name='email']" "a@b.com") (list :click "form[hx-post] button[type='submit']") (list :wait 2000) (list :assert-text "#form-result" :contains "Alice")) :source "(deftest form-submit\n (fill name \"Alice\")\n (click submit)\n (wait 2000)\n (assert-text \"#form-result\" :contains \"Alice\"))" :name "form-submit"})) + (results (signal {})) + (running (signal false)) + (current (signal "Ready"))) + (define + get-doc + (fn () (host-get (dom-query "#test-iframe") "contentDocument"))) + (define + wait-boot + (fn + () + (let + ((doc (get-doc))) + (if + (and + doc + (= + (dom-get-attr + (host-get doc "documentElement") + "data-sx-ready") + "true")) + true + (do (hs-wait 200) (wait-boot)))))) + (define + reload-frame + (fn + () + (let + ((w (host-get (dom-query "#test-iframe") "contentWindow"))) + (host-call (host-get w "location") "reload") + (hs-wait 1000) + (wait-boot) + (hs-wait 500)))) + (define + run-action + (fn + (action) + (let + ((doc (get-doc)) (type (first action))) + (cond + (= type :click) + (let + ((el (host-call doc "querySelector" (nth action 1)))) + (when (nil? el) (error (str "Not found: " (nth action 1)))) + (host-call el "click")) + (= type :fill) + (let + ((el (host-call doc "querySelector" (nth action 1)))) + (when (nil? el) (error (str "Not found: " (nth action 1)))) + (host-call el "focus") + (dom-set-prop el "value" (nth action 2)) + (dom-dispatch el "input" nil) + (dom-dispatch el "change" nil)) + (= type :wait) + (hs-wait (nth action 1)) + (= type :assert-text) + (let + ((el (host-call doc "querySelector" (nth action 1)))) + (when (nil? el) (error (str "Not found: " (nth action 1)))) + (let + ((txt (host-get el "textContent")) + (kw (nth action 2)) + (expected (nth action 3))) + (when + (and (= kw :contains) (not (contains? txt expected))) + (error + (str "Expected '" expected "' in '" (slice txt 0 60) "'"))) + (when + (and (= kw :not-contains) (contains? txt expected)) + (error (str "Unexpected '" expected "'"))))) + (= type :assert-count) + (let + ((els (host-call doc "querySelectorAll" (nth action 1)))) + (let + ((count (host-get els "length")) + (kw (nth action 2)) + (expected (nth action 3))) + (when + (and (= kw :gte) (< count expected)) + (error (str "Expected >=" expected " got " count))))) + true + nil)))) + (define + run-all + (fn + () + (reset! running true) + (reset! results {}) + (for-each + (fn + (test) + (let + ((name (get test :name))) + (reset! current (str "Running: " name)) + (reset! results (assoc (deref results) name "running")) + (reload-frame) + (guard + (e + (true + (reset! results (assoc (deref results) name "fail")) + (console-log (str "FAIL " name ": " e)))) + (for-each run-action (get test :actions)) + (reset! results (assoc (deref results) name "pass"))))) + tests) + (reset! running false) + (reset! current "Done"))) + (div + (~tw :tokens "space-y-4") + (div + (~tw :tokens "flex items-center gap-4 mb-4") + (button + (~tw + :tokens "px-4 py-2 bg-violet-600 text-white rounded hover:bg-violet-700") + :on-click (fn (e) (run-all)) + "Run All Tests") + (span (~tw :tokens "text-sm text-stone-500") (deref current))) + (div + (~tw :tokens "space-y-2") + (when + tests + (map + (fn + (test) + (let + ((name (get test :name)) + (status (get (deref results) name))) + (details + (~tw :tokens "border rounded-lg overflow-hidden") + :style (cond + (= status "pass") + "border-color:#bbf7d0;background:#f0fdf4" + (= status "fail") + "border-color:#fecaca;background:#fef2f2" + (= status "running") + "border-color:#c4b5fd" + true + "border-color:#e7e5e4") + (summary + (~tw + :tokens "px-4 py-2 cursor-pointer hover:bg-stone-50 flex items-center gap-2") + (span + (~tw :tokens "font-bold") + (cond + (= status "pass") + "✓" + (= status "fail") + "✗" + (= status "running") + "⟳" + true + "○")) + (span (~tw :tokens "font-medium") name) + (span + (~tw :tokens "text-sm text-stone-400 ml-auto") + (get test :desc))) + (div + (~tw + :tokens "px-4 py-3 bg-stone-50 border-t border-stone-200") + (pre + (~tw + :tokens "text-xs font-mono whitespace-pre-wrap text-stone-600") + (get test :source)))))) + tests))) + (iframe + :id "test-iframe" + :src "/sx/(applications.(htmx))" + (~tw :tokens "w-full border border-stone-200 rounded-lg mt-4") + :style "height:600px")))) +;; Page component — passes test definitions to the island (defcomp () (~docs/page @@ -12,165 +184,4 @@ :href "/sx/(applications.(htmx))" (~tw :tokens "text-violet-600 underline") "/sx/(applications.(htmx))")) - (div - (~tw :tokens "flex items-center gap-4 mb-4") - (button - :id "run-btn" - (~tw - :tokens "px-4 py-2 bg-violet-600 text-white rounded hover:bg-violet-700 transition-colors") - "Run All Tests") - (span :id "test-status" (~tw :tokens "text-sm text-stone-500") "Ready")) - (div :id "test-summary" (~tw :tokens "mb-4")) - (div - :id "test-list" - (~tw :tokens "space-y-2 mb-6") - (details - :class "sx-test-item" - :data-test "click-to-load" - (~tw :tokens "border border-stone-200 rounded-lg overflow-hidden") - (summary - (~tw - :tokens "px-4 py-2 cursor-pointer hover:bg-stone-50 flex items-center gap-2") - (span :data-role "test-icon" (~tw :tokens "font-bold") "○") - (span (~tw :tokens "font-medium") "click-to-load") - (span - (~tw :tokens "text-sm text-stone-400 ml-auto") - "Click button, verify content loads")) - (div - (~tw :tokens "px-4 py-3 bg-stone-50 border-t border-stone-200") - (pre - (~tw - :tokens "text-xs font-mono whitespace-pre-wrap text-stone-600") - "(deftest click-to-load\n :runner :playwright\n :url \"/sx/(applications.(htmx))\"\n (click \"button[hx-get]\")\n (wait 2000)\n (assert-text \"#click-result\" :contains \"Content loaded!\"))"))) - (details - :class "sx-test-item" - :data-test "click-no-oob-leak" - (~tw :tokens "border border-stone-200 rounded-lg overflow-hidden") - (summary - (~tw - :tokens "px-4 py-2 cursor-pointer hover:bg-stone-50 flex items-center gap-2") - (span :data-role "test-icon" (~tw :tokens "font-bold") "○") - (span (~tw :tokens "font-medium") "click-no-oob-leak") - (span - (~tw :tokens "text-sm text-stone-400 ml-auto") - "OOB swap sections filtered from content")) - (div - (~tw :tokens "px-4 py-3 bg-stone-50 border-t border-stone-200") - (pre - (~tw - :tokens "text-xs font-mono whitespace-pre-wrap text-stone-600") - "(deftest click-no-oob-leak\n :runner :playwright\n :url \"/sx/(applications.(htmx))\"\n (click \"button[hx-get]\")\n (wait 2000)\n (assert-text \"#click-result\" :not-contains \"defcomp\"))"))) - (details - :class "sx-test-item" - :data-test "search-debounce" - (~tw :tokens "border border-stone-200 rounded-lg overflow-hidden") - (summary - (~tw - :tokens "px-4 py-2 cursor-pointer hover:bg-stone-50 flex items-center gap-2") - (span :data-role "test-icon" (~tw :tokens "font-bold") "○") - (span (~tw :tokens "font-medium") "search-debounce") - (span - (~tw :tokens "text-sm text-stone-400 ml-auto") - "Type in search, results appear after debounce")) - (div - (~tw :tokens "px-4 py-3 bg-stone-50 border-t border-stone-200") - (pre - (~tw - :tokens "text-xs font-mono whitespace-pre-wrap text-stone-600") - "(deftest search-debounce\n :runner :playwright\n :url \"/sx/(applications.(htmx))\"\n (fill \"input[hx-get]\" \"hx-get\")\n (wait 1500)\n (assert-text \"#search-results\" :contains \"GET request\"))"))) - (details - :class "sx-test-item" - :data-test "search-no-results" - (~tw :tokens "border border-stone-200 rounded-lg overflow-hidden") - (summary - (~tw - :tokens "px-4 py-2 cursor-pointer hover:bg-stone-50 flex items-center gap-2") - (span :data-role "test-icon" (~tw :tokens "font-bold") "○") - (span (~tw :tokens "font-medium") "search-no-results") - (span - (~tw :tokens "text-sm text-stone-400 ml-auto") - "Non-matching query shows no results")) - (div - (~tw :tokens "px-4 py-3 bg-stone-50 border-t border-stone-200") - (pre - (~tw - :tokens "text-xs font-mono whitespace-pre-wrap text-stone-600") - "(deftest search-no-results\n :runner :playwright\n :url \"/sx/(applications.(htmx))\"\n (fill \"input[hx-get]\" \"xyznonexistent\")\n (wait 1500)\n (assert-text \"#search-results\" :contains \"No results\"))"))) - (details - :class "sx-test-item" - :data-test "tab-overview" - (~tw :tokens "border border-stone-200 rounded-lg overflow-hidden") - (summary - (~tw - :tokens "px-4 py-2 cursor-pointer hover:bg-stone-50 flex items-center gap-2") - (span :data-role "test-icon" (~tw :tokens "font-bold") "○") - (span (~tw :tokens "font-medium") "tab-overview") - (span - (~tw :tokens "text-sm text-stone-400 ml-auto") - "Click overview tab, verify content")) - (div - (~tw :tokens "px-4 py-3 bg-stone-50 border-t border-stone-200") - (pre - (~tw - :tokens "text-xs font-mono whitespace-pre-wrap text-stone-600") - "(deftest tab-overview\n :runner :playwright\n :url \"/sx/(applications.(htmx))\"\n (click \"button[hx-get*='tab=overview']\")\n (wait 2000)\n (assert-text \"#htmx-tab-content\" :contains \"htmx gives you access\"))"))) - (details - :class "sx-test-item" - :data-test "tab-features" - (~tw :tokens "border border-stone-200 rounded-lg overflow-hidden") - (summary - (~tw - :tokens "px-4 py-2 cursor-pointer hover:bg-stone-50 flex items-center gap-2") - (span :data-role "test-icon" (~tw :tokens "font-bold") "○") - (span (~tw :tokens "font-medium") "tab-features") - (span - (~tw :tokens "text-sm text-stone-400 ml-auto") - "Click features tab, verify list")) - (div - (~tw :tokens "px-4 py-3 bg-stone-50 border-t border-stone-200") - (pre - (~tw - :tokens "text-xs font-mono whitespace-pre-wrap text-stone-600") - "(deftest tab-features\n :runner :playwright\n :url \"/sx/(applications.(htmx))\"\n (click \"button[hx-get*='tab=features']\")\n (wait 2000)\n (assert-text \"#htmx-tab-content\" :contains \"Any element\"))"))) - (details - :class "sx-test-item" - :data-test "append-item" - (~tw :tokens "border border-stone-200 rounded-lg overflow-hidden") - (summary - (~tw - :tokens "px-4 py-2 cursor-pointer hover:bg-stone-50 flex items-center gap-2") - (span :data-role "test-icon" (~tw :tokens "font-bold") "○") - (span (~tw :tokens "font-medium") "append-item") - (span - (~tw :tokens "text-sm text-stone-400 ml-auto") - "POST appends new item to list")) - (div - (~tw :tokens "px-4 py-3 bg-stone-50 border-t border-stone-200") - (pre - (~tw - :tokens "text-xs font-mono whitespace-pre-wrap text-stone-600") - "(deftest append-item\n :runner :playwright\n :url \"/sx/(applications.(htmx))\"\n (click \"button[hx-post*='api.append']\")\n (wait 2000)\n (assert-count \"#item-list > *\" :gte 1))"))) - (details - :class "sx-test-item" - :data-test "form-submit" - (~tw :tokens "border border-stone-200 rounded-lg overflow-hidden") - (summary - (~tw - :tokens "px-4 py-2 cursor-pointer hover:bg-stone-50 flex items-center gap-2") - (span :data-role "test-icon" (~tw :tokens "font-bold") "○") - (span (~tw :tokens "font-medium") "form-submit") - (span - (~tw :tokens "text-sm text-stone-400 ml-auto") - "POST form data, verify name in response")) - (div - (~tw :tokens "px-4 py-3 bg-stone-50 border-t border-stone-200") - (pre - (~tw - :tokens "text-xs font-mono whitespace-pre-wrap text-stone-600") - "(deftest form-submit\n :runner :playwright\n :url \"/sx/(applications.(htmx))\"\n (fill \"form[hx-post] input[name='name']\" \"Alice\")\n (fill \"form[hx-post] input[name='email']\" \"alice@test.com\")\n (click \"form[hx-post] button[type='submit']\")\n (wait 2000)\n (assert-text \"#form-result\" :contains \"Alice\"))")))) - (iframe - :id "test-iframe" - :src "/sx/(applications.(htmx))" - (~tw :tokens "w-full border border-stone-200 rounded-lg") - :style "height:600px") - (script :src "/static/scripts/sx-test-runner.js?v=7"))) + (~test-runner)))