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>
318 lines
10 KiB
Plaintext
318 lines
10 KiB
Plaintext
;; Generic page test runner.
|
|
;; Tests loaded from <comp>/_test/*.sx, rendered with status icons.
|
|
;; Run All island drives the iframe via DOM — actions stored on each
|
|
;; <details> as data-actions (SX source).
|
|
|
|
(define
|
|
segments->url
|
|
(fn
|
|
(segs)
|
|
(if
|
|
(= (len segs) 1)
|
|
(str "(" (first segs) ")")
|
|
(str "(" (first segs) "." (segments->url (rest segs)) ")"))))
|
|
|
|
(define
|
|
component-name->url
|
|
(fn (name) (str "/sx/" (segments->url (split name "/")))))
|
|
|
|
(define
|
|
action-form->list
|
|
(fn
|
|
(form)
|
|
(if
|
|
(and (list? form) (not (empty? form)) (symbol? (first form)))
|
|
(cons (make-keyword (symbol-name (first form))) (rest form))
|
|
form)))
|
|
|
|
(define
|
|
split-deftest-body
|
|
(fn
|
|
(args)
|
|
(letrec
|
|
((go (fn (xs keyargs actions) (cond (empty? xs) {:keyargs keyargs :actions (reverse actions)} (and (>= (len xs) 2) (keyword? (first xs))) (go (rest (rest xs)) (assoc keyargs (keyword-name (first xs)) (nth xs 1)) actions) :else (go (rest xs) keyargs (cons (action-form->list (first xs)) actions))))))
|
|
(go args {} (list)))))
|
|
|
|
(define
|
|
deftest->spec
|
|
(fn
|
|
(form)
|
|
(if
|
|
(and
|
|
(list? form)
|
|
(>= (len form) 2)
|
|
(symbol? (first form))
|
|
(= (symbol-name (first form)) "deftest"))
|
|
(let
|
|
((name-sym (nth form 1)))
|
|
(let
|
|
((rest-form (slice form 2 (len form))))
|
|
(let
|
|
((name (if (symbol? name-sym) (symbol-name name-sym) (str name-sym))))
|
|
(let
|
|
((split (split-deftest-body rest-form)))
|
|
(let
|
|
((kw (get split :keyargs)) (actions (get split :actions)))
|
|
{:desc (or (get kw "desc") name) :url (get kw "url") :actions actions :source (pretty-print form) :name name})))))
|
|
nil)))
|
|
|
|
(define
|
|
extract-deftests
|
|
(fn
|
|
(parsed)
|
|
(let
|
|
((forms (if (and (list? parsed) (not (empty? parsed)) (list? (first parsed))) parsed (list parsed))))
|
|
(filter (fn (x) (not (nil? x))) (map deftest->spec forms)))))
|
|
|
|
(define
|
|
load-tests-for-name
|
|
(fn
|
|
(name)
|
|
(let
|
|
((test-dir (str _sx-components-dir "/" name "/_test")))
|
|
(let
|
|
((files (list-dir test-dir)))
|
|
(if
|
|
(nil? files)
|
|
(list)
|
|
(reduce
|
|
(fn
|
|
(acc f)
|
|
(if
|
|
(and (string? f) (ends-with? f ".sx"))
|
|
(let
|
|
((src (read-file (str test-dir "/" f))))
|
|
(if src (concat acc (extract-deftests (parse src))) acc))
|
|
acc))
|
|
(list)
|
|
files))))))
|
|
|
|
;; Control island — Run All + status, reads tests from DOM.
|
|
(defisland
|
|
~testing/page-runner-controls
|
|
(&key target-url)
|
|
(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))))))))
|
|
(reload-frame
|
|
(fn
|
|
()
|
|
(let
|
|
((w (host-get (dom-query "#test-iframe") "contentWindow")))
|
|
(host-call (host-get w "location") "reload")
|
|
(hs-wait 800)
|
|
(wait-boot 30)
|
|
(hs-wait 1200))))
|
|
(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))))))))
|
|
(run-action
|
|
(fn
|
|
(action)
|
|
(let
|
|
((doc (get-doc)) (ty (first action)))
|
|
(cond
|
|
(= ty :click)
|
|
(let
|
|
((el (host-call doc "querySelector" (nth action 1))))
|
|
(if
|
|
(nil? el)
|
|
(str "Not found: " (nth action 1))
|
|
(do (host-call el "click") nil)))
|
|
(= ty :fill)
|
|
(let
|
|
((el (host-call doc "querySelector" (nth action 1))))
|
|
(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 (host-call doc "querySelector" (nth action 1))))
|
|
(if
|
|
(nil? el)
|
|
(str "Not found: " (nth action 1))
|
|
(let
|
|
((txt (dom-text-content el))
|
|
(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-one
|
|
(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 "⟳")
|
|
(reset! current (str "Running: " name))
|
|
(reload-frame)
|
|
(let
|
|
((actions (if actions-src (parse actions-src) (list)))
|
|
(fail-msg nil))
|
|
(when
|
|
(and (list? actions) (not (empty? actions)))
|
|
(let
|
|
((first-sel (nth (first actions) 1)))
|
|
(when
|
|
(string? first-sel)
|
|
(let
|
|
((found (wait-for-el first-sel 25)))
|
|
(when
|
|
(nil? found)
|
|
(set! fail-msg (str "Timeout: " first-sel)))))))
|
|
(when
|
|
(and (nil? fail-msg) (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] FAIL " name ": " fail-msg))))))))
|
|
(run-all
|
|
(fn
|
|
()
|
|
(reset! current "Running...")
|
|
(for-each
|
|
(fn (el) (run-one el))
|
|
(dom-query-all (dom-body) "[data-test-name]"))
|
|
(reset! current "Done"))))
|
|
(div
|
|
(~tw :tokens "flex items-center gap-4 mb-2")
|
|
(button
|
|
:id "run-all-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))))))
|
|
|
|
(defcomp
|
|
~testing/page-runner
|
|
(&key tests target-url title)
|
|
(div
|
|
(~tw :tokens "space-y-2")
|
|
(h2 (~tw :tokens "text-xl font-semibold") (or title "Test runner"))
|
|
(p
|
|
(~tw :tokens "text-stone-500 text-sm")
|
|
"Running tests against "
|
|
(a
|
|
:href target-url
|
|
(~tw :tokens "text-violet-600 underline")
|
|
target-url))
|
|
(~testing/page-runner-controls :target-url target-url)
|
|
(div
|
|
(~tw :tokens "space-y-2")
|
|
(if
|
|
(or (nil? tests) (empty? tests))
|
|
(div
|
|
(~tw :tokens "text-sm text-stone-400 italic")
|
|
"No deftest specs found in _test/ for this page.")
|
|
(map
|
|
(fn
|
|
(test)
|
|
(details
|
|
:data-test-name (get test :name)
|
|
:data-actions (pretty-print (get test :actions))
|
|
(~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-status-icon "1"
|
|
(~tw :tokens "font-bold text-stone-400")
|
|
"○")
|
|
(span (~tw :tokens "font-medium") (get test :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 target-url
|
|
(~tw :tokens "w-full border border-stone-200 rounded-lg mt-4")
|
|
:style "height:600px")))
|