Tests: cek-try-seq / htmx / hs-diag / perform-chain + node HS runners
New spec tests: test-cek-try-seq (CEK try/seq), test-htmx (htmx directive coverage, 292L), test-hs-diag, test-perform-chain (IO suspension chains). tests/hs-*.js: Node.js-side hyperscript runners for browser-mode testing (hs-behavioral-node, hs-behavioral-runner, hs-parse-audit, hs-run-timed). Vendors shared/static/scripts/htmx.min.js. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
64
spec/tests/test-cek-try-seq.sx
Normal file
64
spec/tests/test-cek-try-seq.sx
Normal file
@@ -0,0 +1,64 @@
|
||||
;; Tests for cek-try sequential execution
|
||||
;; Bug: hydrate-island fallback leaves hydrating? scope active
|
||||
|
||||
(defsuite
|
||||
"cek-try-sequential"
|
||||
(deftest
|
||||
"code after cek-try runs on success"
|
||||
(let
|
||||
((result (list)))
|
||||
(append! result "before")
|
||||
(cek-try (fn () (append! result "body") 42) (fn (e) nil))
|
||||
(append! result "after")
|
||||
(assert= 3 (len result))
|
||||
(assert= "after" (nth result 2))))
|
||||
(deftest
|
||||
"code after cek-try runs on error"
|
||||
(let
|
||||
((result (list)))
|
||||
(append! result "before")
|
||||
(cek-try (fn () (error "boom")) (fn (e) (append! result "caught")))
|
||||
(append! result "after")
|
||||
(assert= 3 (len result))
|
||||
(assert= "after" (nth result 2))))
|
||||
(deftest
|
||||
"error in error handler propagates — skips post-try code"
|
||||
(let
|
||||
((result (list)))
|
||||
(append! result "before")
|
||||
(guard
|
||||
(outer-err (true (append! result "outer-caught")))
|
||||
(cek-try (fn () (error "boom")) (fn (e) (error "handler-boom")))
|
||||
(append! result "after-try"))
|
||||
(assert-true (contains? result "before"))
|
||||
(assert-true (contains? result "outer-caught"))
|
||||
(assert= false (contains? result "after-try"))))
|
||||
(deftest
|
||||
"scope-pop after cek-try executes on error"
|
||||
(scope-push! "test-scope" "value")
|
||||
(cek-try (fn () (error "boom")) (fn (e) nil))
|
||||
(scope-pop! "test-scope")
|
||||
(assert= nil (scope-peek "test-scope")))
|
||||
(deftest
|
||||
"scope-push/pop balanced across cek-try error"
|
||||
(let
|
||||
((result nil))
|
||||
(scope-push! "bal-test" "pushed")
|
||||
(cek-try (fn () (error "fail")) (fn (e) nil))
|
||||
(set! result (scope-peek "bal-test"))
|
||||
(scope-pop! "bal-test")
|
||||
(assert= "pushed" result)
|
||||
(assert= nil (scope-peek "bal-test"))))
|
||||
(deftest
|
||||
"error handler that errors skips cleanup"
|
||||
(let
|
||||
((cleaned false))
|
||||
(scope-push! "cleanup-test" "val")
|
||||
(guard
|
||||
(e (true nil))
|
||||
(cek-try (fn () (error "first")) (fn (e) (error "second")))
|
||||
(scope-pop! "cleanup-test")
|
||||
(set! cleaned true))
|
||||
(assert= false cleaned)
|
||||
(assert= "val" (scope-peek "cleanup-test"))
|
||||
(scope-pop! "cleanup-test"))))
|
||||
17
spec/tests/test-hs-diag.sx
Normal file
17
spec/tests/test-hs-diag.sx
Normal file
@@ -0,0 +1,17 @@
|
||||
(defsuite
|
||||
"hs-diag"
|
||||
(deftest
|
||||
"put into #id compiled"
|
||||
(let
|
||||
((sx (hs-to-sx-from-source "on click put \"foo\" into #d1")))
|
||||
(assert= (serialize sx) "SHOW")))
|
||||
(deftest
|
||||
"put into #id works"
|
||||
(let
|
||||
((el (dom-create-element "div")))
|
||||
(dom-set-attr el "id" "d1")
|
||||
(dom-set-attr el "_" "on click put \"foo\" into #d1")
|
||||
(dom-append (dom-body) el)
|
||||
(hs-activate! el)
|
||||
(dom-dispatch el "click" nil)
|
||||
(assert= (dom-text-content el) "foo"))))
|
||||
292
spec/tests/test-htmx.sx
Normal file
292
spec/tests/test-htmx.sx
Normal file
@@ -0,0 +1,292 @@
|
||||
;; test-htmx.sx — Tests for htmx 4.0 compatibility layer
|
||||
;;
|
||||
;; Tests the attribute-to-handler translator: pure parsing functions,
|
||||
;; swap mode resolution, trigger parsing, and DOM integration via harness.
|
||||
|
||||
;; ── Time parsing ────────────────────────────────────────────────
|
||||
|
||||
(defsuite
|
||||
"htmx-parse-time"
|
||||
(deftest "parses milliseconds" (assert= (hx-parse-time "500ms") 500))
|
||||
(deftest "parses seconds" (assert= (hx-parse-time "1s") 1000))
|
||||
(deftest "parses fractional seconds" (assert= (hx-parse-time "0.5s") 500))
|
||||
(deftest "parses minutes" (assert= (hx-parse-time "2m") 120000))
|
||||
(deftest "parses bare number" (assert= (hx-parse-time "100") 100))
|
||||
(deftest "returns nil for nil" (assert= (hx-parse-time nil) nil)))
|
||||
|
||||
;; ── Swap mode normalization (v4 aliases) ────────────────────────
|
||||
|
||||
(defsuite
|
||||
"htmx-swap-aliases"
|
||||
(deftest
|
||||
"before → beforebegin"
|
||||
(assert= (hx-normalize-swap-mode "before") "beforebegin"))
|
||||
(deftest
|
||||
"after → afterend"
|
||||
(assert= (hx-normalize-swap-mode "after") "afterend"))
|
||||
(deftest
|
||||
"prepend → afterbegin"
|
||||
(assert= (hx-normalize-swap-mode "prepend") "afterbegin"))
|
||||
(deftest
|
||||
"append → beforeend"
|
||||
(assert= (hx-normalize-swap-mode "append") "beforeend"))
|
||||
(deftest
|
||||
"innerHTML passes through"
|
||||
(assert= (hx-normalize-swap-mode "innerHTML") "innerHTML"))
|
||||
(deftest
|
||||
"outerHTML passes through"
|
||||
(assert= (hx-normalize-swap-mode "outerHTML") "outerHTML"))
|
||||
(deftest
|
||||
"delete passes through"
|
||||
(assert= (hx-normalize-swap-mode "delete") "delete"))
|
||||
(deftest
|
||||
"innerMorph passes through"
|
||||
(assert= (hx-normalize-swap-mode "innerMorph") "innerMorph"))
|
||||
(deftest
|
||||
"outerMorph passes through"
|
||||
(assert= (hx-normalize-swap-mode "outerMorph") "outerMorph"))
|
||||
(deftest
|
||||
"textContent passes through"
|
||||
(assert= (hx-normalize-swap-mode "textContent") "textContent")))
|
||||
|
||||
;; ── Swap spec parsing ───────────────────────────────────────────
|
||||
|
||||
(defsuite
|
||||
"htmx-parse-swap-spec"
|
||||
(deftest
|
||||
"nil defaults to innerHTML"
|
||||
(let
|
||||
((spec (hx-parse-swap-spec nil)))
|
||||
(assert= (get spec :mode) "innerHTML")))
|
||||
(deftest
|
||||
"bare mode"
|
||||
(let
|
||||
((spec (hx-parse-swap-spec "outerHTML")))
|
||||
(assert= (get spec :mode) "outerHTML")
|
||||
(assert= (get spec :swap-delay) nil)))
|
||||
(deftest
|
||||
"mode with swap delay"
|
||||
(let
|
||||
((spec (hx-parse-swap-spec "innerHTML swap:100ms")))
|
||||
(assert= (get spec :mode) "innerHTML")
|
||||
(assert= (get spec :swap-delay) 100)))
|
||||
(deftest
|
||||
"mode with settle delay"
|
||||
(let
|
||||
((spec (hx-parse-swap-spec "innerHTML settle:200ms")))
|
||||
(assert= (get spec :settle-delay) 200)))
|
||||
(deftest
|
||||
"mode with scroll"
|
||||
(let
|
||||
((spec (hx-parse-swap-spec "innerHTML scroll:top")))
|
||||
(assert= (get spec :scroll) "top")))
|
||||
(deftest
|
||||
"v4 alias normalized in spec"
|
||||
(let
|
||||
((spec (hx-parse-swap-spec "append settle:500ms")))
|
||||
(assert= (get spec :mode) "beforeend")
|
||||
(assert= (get spec :settle-delay) 500)))
|
||||
(deftest
|
||||
"full spec with multiple modifiers"
|
||||
(let
|
||||
((spec (hx-parse-swap-spec "innerHTML swap:50ms settle:100ms scroll:top")))
|
||||
(assert= (get spec :mode) "innerHTML")
|
||||
(assert= (get spec :swap-delay) 50)
|
||||
(assert= (get spec :settle-delay) 100)
|
||||
(assert= (get spec :scroll) "top"))))
|
||||
|
||||
;; ── Trigger parsing ─────────────────────────────────────────────
|
||||
|
||||
(defsuite
|
||||
"htmx-parse-trigger"
|
||||
(deftest
|
||||
"simple event"
|
||||
(let
|
||||
((spec (hx-parse-trigger "click" nil)))
|
||||
(assert= (get spec :event) "click")
|
||||
(assert= (get spec :delay) nil)
|
||||
(assert= (get spec :once) false)))
|
||||
(deftest
|
||||
"event with delay"
|
||||
(let
|
||||
((spec (hx-parse-trigger "keyup delay:500ms" nil)))
|
||||
(assert= (get spec :event) "keyup")
|
||||
(assert= (get spec :delay) 500)))
|
||||
(deftest
|
||||
"event with throttle"
|
||||
(let
|
||||
((spec (hx-parse-trigger "click throttle:1s" nil)))
|
||||
(assert= (get spec :event) "click")
|
||||
(assert= (get spec :throttle) 1000)))
|
||||
(deftest
|
||||
"event with once"
|
||||
(let
|
||||
((spec (hx-parse-trigger "click once" nil)))
|
||||
(assert= (get spec :event) "click")
|
||||
(assert= (get spec :once) true)))
|
||||
(deftest
|
||||
"event with changed"
|
||||
(let
|
||||
((spec (hx-parse-trigger "keyup changed delay:500ms" nil)))
|
||||
(assert= (get spec :event) "keyup")
|
||||
(assert= (get spec :changed) true)
|
||||
(assert= (get spec :delay) 500)))
|
||||
(deftest
|
||||
"event with from selector"
|
||||
(let
|
||||
((spec (hx-parse-trigger "click from:body" nil)))
|
||||
(assert= (get spec :event) "click")
|
||||
(assert= (get spec :from) "body")))
|
||||
(deftest
|
||||
"event with filter"
|
||||
(let
|
||||
((spec (hx-parse-trigger "keyup [key=='Enter']" nil)))
|
||||
(assert= (get spec :event) "keyup")
|
||||
(assert= (get spec :filter) "[key=='Enter']")))
|
||||
(deftest
|
||||
"every trigger"
|
||||
(let
|
||||
((spec (hx-parse-trigger "every delay:2s" nil)))
|
||||
(assert= (get spec :event) "every")
|
||||
(assert= (get spec :delay) 2000))))
|
||||
|
||||
;; ── URL encoding ────────────────────────────────────────────────
|
||||
|
||||
(defsuite
|
||||
"htmx-url-encode"
|
||||
(deftest
|
||||
"encodes single param"
|
||||
(assert= (url-encode-params {:q "search"}) "q=search"))
|
||||
(deftest
|
||||
"encodes numeric values"
|
||||
(assert= (url-encode-params {:page 1}) "page=1")))
|
||||
|
||||
(defsuite
|
||||
"htmx-status-matches"
|
||||
(deftest "exact match" (assert= (hx-status-matches? "404" "404") true))
|
||||
(deftest
|
||||
"exact non-match"
|
||||
(assert= (hx-status-matches? "404" "500") false))
|
||||
(deftest
|
||||
"1-digit wildcard 5xx matches 503"
|
||||
(assert= (hx-status-matches? "503" "5xx") true))
|
||||
(deftest
|
||||
"1-digit wildcard 4xx does not match 503"
|
||||
(assert= (hx-status-matches? "503" "4xx") false))
|
||||
(deftest
|
||||
"2-digit wildcard 50x matches 503"
|
||||
(assert= (hx-status-matches? "503" "50x") true))
|
||||
(deftest
|
||||
"2-digit wildcard 50x does not match 522"
|
||||
(assert= (hx-status-matches? "522" "50x") false))
|
||||
(deftest "2xx matches 200" (assert= (hx-status-matches? "200" "2xx") true)))
|
||||
|
||||
(defsuite
|
||||
"htmx-status-modifiers"
|
||||
(deftest
|
||||
"parses swap target push"
|
||||
(let
|
||||
((m (hx-parse-status-modifiers "swap:innerHTML target:#errors push:false")))
|
||||
(assert= (get m :swap) "innerHTML")
|
||||
(assert= (get m :target) "#errors")
|
||||
(assert= (get m :push) "false")))
|
||||
(deftest
|
||||
"parses transition"
|
||||
(let
|
||||
((m (hx-parse-status-modifiers "swap:none transition:true")))
|
||||
(assert= (get m :swap) "none")
|
||||
(assert= (get m :transition) "true"))))
|
||||
|
||||
(defsuite
|
||||
"htmx-match-status"
|
||||
(deftest
|
||||
"exact match wins over wildcard"
|
||||
(let
|
||||
((rules (list {:target nil :transition nil :swap "none" :select nil :push nil :specificity 1 :code "5xx" :replace nil} {:target nil :transition nil :swap "outerHTML" :select nil :push nil :specificity 3 :code "503" :replace nil})))
|
||||
(assert= (get (hx-match-status 503 rules) :swap) "outerHTML")))
|
||||
(deftest
|
||||
"2-digit wildcard wins over 1-digit"
|
||||
(let
|
||||
((rules (list {:target nil :transition nil :swap "none" :select nil :push nil :specificity 1 :code "5xx" :replace nil} {:target nil :transition nil :swap "innerHTML" :select nil :push nil :specificity 2 :code "50x" :replace nil})))
|
||||
(assert= (get (hx-match-status 501 rules) :swap) "innerHTML")))
|
||||
(deftest
|
||||
"nil when no match"
|
||||
(let
|
||||
((rules (list {:target nil :transition nil :swap "none" :select nil :push nil :specificity 1 :code "5xx" :replace nil})))
|
||||
(assert= (hx-match-status 404 rules) nil))))
|
||||
|
||||
(defsuite
|
||||
"htmx-sync-spec"
|
||||
(deftest
|
||||
"parses selector:strategy"
|
||||
(let
|
||||
((s (hx-parse-sync-spec "closest form:abort")))
|
||||
(assert= (get s :selector) "closest form")
|
||||
(assert= (get s :strategy) "abort")))
|
||||
(deftest
|
||||
"parses queue with mode"
|
||||
(let
|
||||
((s (hx-parse-sync-spec "this:queue last")))
|
||||
(assert= (get s :selector) "this")
|
||||
(assert= (get s :strategy) "queue")
|
||||
(assert= (get s :queue-mode) "last")))
|
||||
(deftest
|
||||
"defaults to drop strategy"
|
||||
(let
|
||||
((s (hx-parse-sync-spec "this:drop")))
|
||||
(assert= (get s :strategy) "drop")))
|
||||
(deftest "nil for nil input" (assert= (hx-parse-sync-spec nil) nil)))
|
||||
|
||||
(defsuite
|
||||
"htmx-sse-swap-parse"
|
||||
(deftest
|
||||
"parses single spec"
|
||||
(let
|
||||
((specs (hx-parse-sse-swap "message:#target")))
|
||||
(assert= (len specs) 1)
|
||||
(assert= (get (first specs) :event) "message")
|
||||
(assert= (get (first specs) :target) "#target")))
|
||||
(deftest
|
||||
"parses multiple specs with swap mode"
|
||||
(let
|
||||
((specs (hx-parse-sse-swap "message:#target,update:#list:outerHTML")))
|
||||
(assert= (len specs) 2)
|
||||
(assert= (get (nth specs 1) :event) "update")
|
||||
(assert= (get (nth specs 1) :swap) "outerHTML")))
|
||||
(deftest
|
||||
"nil returns empty list"
|
||||
(assert= (hx-parse-sse-swap nil) (list))))
|
||||
|
||||
(defsuite
|
||||
"htmx-swap-spec-v4-modifiers"
|
||||
(deftest
|
||||
"transition modifier"
|
||||
(let
|
||||
((spec (hx-parse-swap-spec "innerHTML transition:true")))
|
||||
(assert= (get spec :transition) true)
|
||||
(assert= (get spec :mode) "innerHTML")))
|
||||
(deftest
|
||||
"strip modifier"
|
||||
(let
|
||||
((spec (hx-parse-swap-spec "outerHTML strip:true")))
|
||||
(assert= (get spec :strip) true)))
|
||||
(deftest
|
||||
"target override in swap spec"
|
||||
(let
|
||||
((spec (hx-parse-swap-spec "innerHTML target:#alt")))
|
||||
(assert= (get spec :target) "#alt")))
|
||||
(deftest
|
||||
"ignoreTitle modifier"
|
||||
(let
|
||||
((spec (hx-parse-swap-spec "innerHTML ignoreTitle:true")))
|
||||
(assert= (get spec :ignore-title) true)))
|
||||
(deftest
|
||||
"all modifiers together"
|
||||
(let
|
||||
((spec (hx-parse-swap-spec "append swap:50ms settle:100ms scroll:top transition:true strip:true")))
|
||||
(assert= (get spec :mode) "beforeend")
|
||||
(assert= (get spec :swap-delay) 50)
|
||||
(assert= (get spec :settle-delay) 100)
|
||||
(assert= (get spec :scroll) "top")
|
||||
(assert= (get spec :transition) true)
|
||||
(assert= (get spec :strip) true))))
|
||||
63
spec/tests/test-perform-chain.sx
Normal file
63
spec/tests/test-perform-chain.sx
Normal file
@@ -0,0 +1,63 @@
|
||||
;; Tests for perform/IO suspension chaining through for-each
|
||||
;; Bug: after resume from first perform inside for-each,
|
||||
;; subsequent iterations' performs don't suspend — they complete
|
||||
;; synchronously, breaking multi-step async sequences like test runners.
|
||||
|
||||
(defsuite
|
||||
"perform-for-each-chain"
|
||||
(deftest
|
||||
"for-each with perform suspends on each iteration"
|
||||
(let
|
||||
((state1 (cek-step-loop (make-cek-state (quote (let ((results (list))) (for-each (fn (item) (let ((val (perform {:op "fetch" :key item}))) (append! results val))) (list "a" "b" "c")) results)) (make-env) (list)))))
|
||||
(assert-true (cek-suspended? state1))
|
||||
(assert= "a" (get (cek-io-request state1) :key))
|
||||
(let
|
||||
((state2 (cek-resume state1 "result-a")))
|
||||
(assert-true (cek-suspended? state2))
|
||||
(assert= "b" (get (cek-io-request state2) :key))
|
||||
(let
|
||||
((state3 (cek-resume state2 "result-b")))
|
||||
(assert-true (cek-suspended? state3))
|
||||
(assert= "c" (get (cek-io-request state3) :key))
|
||||
(let
|
||||
((final (cek-resume state3 "result-c")))
|
||||
(assert-true (cek-terminal? final))
|
||||
(assert= 3 (len (cek-value final))))))))
|
||||
(deftest
|
||||
"for-each with guard and perform chains correctly"
|
||||
(let
|
||||
((state1 (cek-step-loop (make-cek-state (quote (let ((results (list))) (for-each (fn (item) (guard (e (true (append! results (str "fail:" item)))) (let ((val (perform {:op "fetch" :key item}))) (append! results (str "ok:" val))))) (list "x" "y")) results)) (make-env) (list)))))
|
||||
(assert-true (cek-suspended? state1))
|
||||
(let
|
||||
((state2 (cek-resume state1 "X")))
|
||||
(assert-true (cek-suspended? state2))
|
||||
(let
|
||||
((final (cek-resume state2 "Y")))
|
||||
(assert-true (cek-terminal? final))
|
||||
(let
|
||||
((results (cek-value final)))
|
||||
(assert= 2 (len results))
|
||||
(assert= "ok:X" (nth results 0))
|
||||
(assert= "ok:Y" (nth results 1)))))))
|
||||
(deftest
|
||||
"nested performs in for-each — reload + wait pattern"
|
||||
(let
|
||||
((state1 (cek-step-loop (make-cek-state (quote (let ((log (list))) (for-each (fn (name) (perform {:op "wait" :ms 1000}) (append! log (str "reloaded:" name)) (perform {:op "wait" :ms 500}) (append! log (str "done:" name))) (list "t1" "t2")) log)) (make-env) (list)))))
|
||||
(assert-true (cek-suspended? state1))
|
||||
(assert= 1000 (get (cek-io-request state1) :ms))
|
||||
(let
|
||||
((s2 (cek-resume state1 nil)))
|
||||
(assert-true (cek-suspended? s2))
|
||||
(assert= 500 (get (cek-io-request s2) :ms))
|
||||
(let
|
||||
((s3 (cek-resume s2 nil)))
|
||||
(assert-true (cek-suspended? s3))
|
||||
(assert= 1000 (get (cek-io-request s3) :ms))
|
||||
(let
|
||||
((s4 (cek-resume s3 nil)))
|
||||
(assert-true (cek-suspended? s4))
|
||||
(assert= 500 (get (cek-io-request s4) :ms))
|
||||
(let
|
||||
((final (cek-resume s4 nil)))
|
||||
(assert-true (cek-terminal? final))
|
||||
(assert= 4 (len (cek-value final))))))))))
|
||||
Reference in New Issue
Block a user