giles
a7da235459
New sxc/ content tree with 120 page files across docs, examples, home, and reference demos. sx/sx/testing/ adds page-runner.sx (317L) and index-runner.sx (394L) — SX-native test runner pages for browser-based evaluation. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
395 lines
13 KiB
Plaintext
395 lines
13 KiB
Plaintext
;; Test index — lists a page + its sub-components with their params and tests.
|
|
;; One "Run All Tests" button drives a shared iframe through every test of
|
|
;; the page and of every child component in sequence, reloading the iframe
|
|
;; to each target URL.
|
|
|
|
(define
|
|
_test-index-list-files
|
|
(fn
|
|
(dir)
|
|
(let
|
|
((entries (list-dir dir)))
|
|
(if
|
|
(nil? entries)
|
|
(list)
|
|
(filter
|
|
(fn
|
|
(f)
|
|
(and
|
|
(string? f)
|
|
(ends-with? f ".sx")
|
|
(not (= f "index.sx"))
|
|
(not (starts-with? f "_"))
|
|
(not (starts-with? f "."))))
|
|
entries)))))
|
|
|
|
(define
|
|
_test-index-list-dirs
|
|
(fn
|
|
(dir)
|
|
(let
|
|
((entries (list-dir dir)))
|
|
(if
|
|
(nil? entries)
|
|
(list)
|
|
(filter
|
|
(fn
|
|
(e)
|
|
(and
|
|
(string? e)
|
|
(not (ends-with? e ".sx"))
|
|
(not (starts-with? e "_"))
|
|
(not (starts-with? e "."))
|
|
(not (nil? (read-file (str dir "/" e "/index.sx"))))))
|
|
entries)))))
|
|
|
|
(define
|
|
_test-index-lookup
|
|
(fn
|
|
(full-name)
|
|
(cek-try (fn () (eval-expr (make-symbol full-name))) (fn (err) nil))))
|
|
|
|
(define
|
|
_test-index-entry
|
|
(fn
|
|
(prefix base)
|
|
(let
|
|
((comp-name (str prefix "/" base)))
|
|
(let
|
|
((full-name (str "~" comp-name))
|
|
(url (component-name->url comp-name))
|
|
(tests (load-tests-for-name comp-name)))
|
|
(let
|
|
((comp (_test-index-lookup full-name)))
|
|
(let
|
|
((is-comp (and comp (or (component? comp) (island? comp)))))
|
|
{:short base :url url :kind (cond (nil? comp) "missing" (island? comp) "island" :else "component") :full-name full-name :params (if is-comp (component-params comp) (list)) :tests tests :name comp-name}))))))
|
|
|
|
(define
|
|
load-index-entries
|
|
(fn
|
|
(dir-rel)
|
|
(let
|
|
((abs-dir (str _sx-components-dir "/" dir-rel))
|
|
(page-source
|
|
(or
|
|
(read-file (str _sx-components-dir "/" dir-rel "/index.sx"))
|
|
"")))
|
|
(let
|
|
((file-bases (map (fn (f) (slice f 0 (- (len f) 3))) (_test-index-list-files abs-dir)))
|
|
(dir-bases (_test-index-list-dirs abs-dir))
|
|
(island-bases
|
|
(map
|
|
(fn (f) (slice f 0 (- (len f) 3)))
|
|
(_test-index-list-files (str abs-dir "/_islands")))))
|
|
(let
|
|
((all-bases (concat file-bases (concat dir-bases island-bases))))
|
|
(let
|
|
((used-bases (filter (fn (b) (string-contains? page-source (str "~" dir-rel "/" b))) all-bases)))
|
|
(map (fn (b) (_test-index-entry dir-rel b)) used-bases)))))))
|
|
|
|
;; Control island — one button runs every test across every component section.
|
|
(defisland
|
|
~testing/test-index-controls
|
|
()
|
|
(let
|
|
((current (signal "Ready")))
|
|
(letrec
|
|
((get-doc (fn () (host-get (dom-query "#test-iframe") "contentDocument")))
|
|
(wait-boot
|
|
(fn
|
|
(tries)
|
|
(let
|
|
((doc (get-doc)))
|
|
(if
|
|
(and
|
|
doc
|
|
(=
|
|
(dom-get-attr
|
|
(host-get doc "documentElement")
|
|
"data-sx-ready")
|
|
"true"))
|
|
true
|
|
(if
|
|
(<= tries 0)
|
|
false
|
|
(do (hs-wait 200) (wait-boot (- tries 1))))))))
|
|
(wait-for-el
|
|
(fn
|
|
(sel tries)
|
|
(let
|
|
((doc (get-doc))
|
|
(el (when doc (host-call doc "querySelector" sel))))
|
|
(if
|
|
el
|
|
el
|
|
(if
|
|
(<= tries 0)
|
|
nil
|
|
(do (hs-wait 200) (wait-for-el sel (- tries 1))))))))
|
|
(load-url
|
|
(fn
|
|
(url)
|
|
(let
|
|
((iframe (dom-query "#test-iframe")))
|
|
(when
|
|
iframe
|
|
(dom-set-prop iframe "src" url)
|
|
(hs-wait 800)
|
|
(wait-boot 30)
|
|
(hs-wait 800)))))
|
|
(run-action
|
|
(fn
|
|
(action)
|
|
(let
|
|
((doc (get-doc)) (ty (first action)))
|
|
(cond
|
|
(= ty :click)
|
|
(let
|
|
((el (wait-for-el (nth action 1) 25)))
|
|
(if
|
|
(nil? el)
|
|
(str "Not found: " (nth action 1))
|
|
(do (host-call el "click") nil)))
|
|
(= ty :fill)
|
|
(let
|
|
((el (wait-for-el (nth action 1) 25)))
|
|
(if
|
|
(nil? el)
|
|
(str "Not found: " (nth action 1))
|
|
(do
|
|
(host-call el "focus")
|
|
(dom-set-prop el "value" (nth action 2))
|
|
(dom-dispatch el "input" nil)
|
|
(dom-dispatch el "change" nil)
|
|
nil)))
|
|
(= ty :wait)
|
|
(do (hs-wait (nth action 1)) nil)
|
|
(= ty :assert-text)
|
|
(let
|
|
((el (wait-for-el (nth action 1) 25)))
|
|
(if
|
|
(nil? el)
|
|
(str "Not found: " (nth action 1))
|
|
(let
|
|
((txt (host-get el "textContent"))
|
|
(kw (nth action 2))
|
|
(expected (nth action 3)))
|
|
(cond
|
|
(and
|
|
(= kw :contains)
|
|
(not (contains? txt expected)))
|
|
(str
|
|
"Expected '"
|
|
expected
|
|
"' in '"
|
|
(slice txt 0 60)
|
|
"'")
|
|
(and (= kw :not-contains) (contains? txt expected))
|
|
(str "Unexpected '" expected "'")
|
|
true
|
|
nil))))
|
|
(= ty :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)))
|
|
(if
|
|
(and (= kw :gte) (< count expected))
|
|
(str "Expected >=" expected " got " count)
|
|
nil)))
|
|
true
|
|
nil))))
|
|
(set-status
|
|
(fn
|
|
(detail-el glyph)
|
|
(let
|
|
((span (host-call detail-el "querySelector" "[data-status-icon]")))
|
|
(when span (dom-set-prop span "textContent" glyph)))))
|
|
(run-test
|
|
(fn
|
|
(detail-el)
|
|
(let
|
|
((name (dom-get-attr detail-el "data-test-name"))
|
|
(actions-src (dom-get-attr detail-el "data-actions")))
|
|
(set-status detail-el "⟳")
|
|
(let
|
|
((actions (parse actions-src)) (fail-msg nil))
|
|
(when
|
|
(list? actions)
|
|
(for-each
|
|
(fn
|
|
(action)
|
|
(when
|
|
(nil? fail-msg)
|
|
(let
|
|
((err (run-action action)))
|
|
(when (string? err) (set! fail-msg err)))))
|
|
actions))
|
|
(if
|
|
(nil? fail-msg)
|
|
(set-status detail-el "✓")
|
|
(do
|
|
(set-status detail-el "✗")
|
|
(console-log
|
|
(str "[test-index] FAIL " name ": " fail-msg))))))))
|
|
(run-section
|
|
(fn
|
|
(section-el)
|
|
(let
|
|
((url (dom-get-attr section-el "data-component-url"))
|
|
(tests (dom-query-all section-el "[data-test-name]")))
|
|
(when
|
|
(and (string? url) (not (empty? tests)))
|
|
(reset! current (str "Loading: " url))
|
|
(load-url url)
|
|
(for-each run-test tests)))))
|
|
(run-all
|
|
(fn
|
|
()
|
|
(reset! current "Running…")
|
|
(for-each
|
|
run-section
|
|
(dom-query-all (dom-body) "[data-component-url]"))
|
|
(reset! current "Done"))))
|
|
(div
|
|
(~tw
|
|
:tokens "flex items-center gap-4 mb-4 sticky top-0 bg-white py-2 z-10 border-b border-stone-200")
|
|
(button
|
|
:id "run-all-index-tests"
|
|
(~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))))))
|
|
|
|
;; Render a single test <details> element. Used by both the page-level tests
|
|
;; and the per-component tests.
|
|
(defcomp
|
|
~testing/test-index-test-row
|
|
(&key test)
|
|
(details
|
|
:data-test-name (get test :name)
|
|
:data-actions (pretty-print (get test :actions))
|
|
(summary
|
|
(~tw
|
|
:tokens "px-4 py-2 cursor-pointer hover:bg-stone-50 flex items-center gap-3")
|
|
(span
|
|
:data-status-icon "1"
|
|
(~tw :tokens "font-bold text-stone-400")
|
|
"○")
|
|
(span (~tw :tokens "font-medium text-sm") (get test :name))
|
|
(span (~tw :tokens "text-xs text-stone-400 ml-auto") (get test :desc)))
|
|
(div
|
|
(~tw :tokens "px-4 py-2 bg-stone-50 border-t border-stone-100")
|
|
(pre
|
|
(~tw :tokens "text-xs font-mono whitespace-pre-wrap")
|
|
(get test :source)))))
|
|
|
|
(defcomp
|
|
~testing/test-index
|
|
(&key dir-name target-url own-tests entries)
|
|
(let
|
|
((initial-url (cond (string? target-url) target-url (and entries (not (empty? entries))) (get (first entries) :url) :else "about:blank")))
|
|
(div
|
|
(~tw :tokens "space-y-4")
|
|
(h2 (~tw :tokens "text-xl font-semibold") "Test index: " dir-name)
|
|
(p
|
|
(~tw :tokens "text-stone-500 text-sm")
|
|
"Tests for page "
|
|
(a
|
|
:href target-url
|
|
(~tw :tokens "text-violet-600 underline font-mono")
|
|
target-url)
|
|
" and every child component.")
|
|
(~testing/test-index-controls)
|
|
(section
|
|
:data-component-url target-url
|
|
(~tw :tokens "border border-stone-200 rounded-lg overflow-hidden")
|
|
(div
|
|
(~tw :tokens "px-4 py-3 bg-stone-50 border-b border-stone-200")
|
|
(div
|
|
(~tw :tokens "flex items-center gap-3")
|
|
(span
|
|
(~tw
|
|
:tokens "text-xs font-mono text-stone-400 uppercase tracking-wide")
|
|
"page")
|
|
(a
|
|
:href target-url
|
|
:target "_blank"
|
|
(~tw
|
|
:tokens "font-mono font-semibold text-violet-700 hover:underline")
|
|
dir-name)))
|
|
(div
|
|
(~tw :tokens "divide-y divide-stone-100")
|
|
(if
|
|
(or (nil? own-tests) (empty? own-tests))
|
|
(div
|
|
(~tw :tokens "px-4 py-2 text-xs text-stone-400 italic")
|
|
"No page-level tests in "
|
|
(code (~tw :tokens "font-mono") (str dir-name "/_test/"))
|
|
".")
|
|
(map
|
|
(fn (test) (~testing/test-index-test-row :test test))
|
|
own-tests))))
|
|
(div
|
|
(~tw :tokens "space-y-4")
|
|
(if
|
|
(or (nil? entries) (empty? entries))
|
|
(div
|
|
(~tw :tokens "text-sm text-stone-400 italic")
|
|
"No child components under "
|
|
(code (~tw :tokens "font-mono") dir-name)
|
|
".")
|
|
(map
|
|
(fn
|
|
(entry)
|
|
(let
|
|
((short (get entry :short))
|
|
(url (get entry :url))
|
|
(params (get entry :params))
|
|
(kind (get entry :kind))
|
|
(tests (get entry :tests)))
|
|
(section
|
|
:data-component-url url
|
|
(~tw
|
|
:tokens "border border-stone-200 rounded-lg overflow-hidden")
|
|
(div
|
|
(~tw
|
|
:tokens "px-4 py-3 bg-stone-50 border-b border-stone-200")
|
|
(div
|
|
(~tw :tokens "flex items-center gap-3")
|
|
(span
|
|
(~tw
|
|
:tokens "text-xs font-mono text-stone-400 uppercase tracking-wide")
|
|
kind)
|
|
(a
|
|
:href url
|
|
:target "_blank"
|
|
(~tw
|
|
:tokens "font-mono font-semibold text-violet-700 hover:underline")
|
|
short))
|
|
(div
|
|
(~tw :tokens "font-mono text-xs text-stone-500 mt-1")
|
|
"("
|
|
(if (empty? params) "no params" (join " " params))
|
|
")"))
|
|
(div
|
|
(~tw :tokens "divide-y divide-stone-100")
|
|
(if
|
|
(or (nil? tests) (empty? tests))
|
|
(div
|
|
(~tw :tokens "px-4 py-2 text-xs text-stone-400 italic")
|
|
"No tests in _test/.")
|
|
(map
|
|
(fn (test) (~testing/test-index-test-row :test test))
|
|
tests))))))
|
|
entries)))
|
|
(iframe
|
|
:id "test-iframe"
|
|
:src initial-url
|
|
(~tw :tokens "w-full border border-stone-200 rounded")
|
|
:style "height:500px"))))
|