From a11d0941e9af1c7bc31b4cd748adde1bb35995f0 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 23 Apr 2026 09:18:21 +0000 Subject: [PATCH] =?UTF-8?q?HS=20test=20generator:=20fix=20toHaveCSS,=20loc?= =?UTF-8?q?als,=20and=20`\"`-escapes=20=E2=80=94=20+28=20tests?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Generator changes (tests/playwright/generate-sx-tests.py): - toHaveCSS regex: balance parens so `'rgb(255, 0, 0)'` is captured intact (was truncating at first `)`) - Map browser-computed colors `rgb(R,G,B)` back to CSS keywords (red/green/blue/black/white) — our DOM mock returns the inline value - js_val_to_sx now handles object literals `{a: 1, b: {c: 2}}` → `{:a 1 :b {:c 2}}` - Pattern 2 (`var x = await run(...)`) now captures locals via balanced-brace scan and emits `eval-hs-locals` instead of `eval-hs` - Pattern 1 with locals: emit `eval-hs-locals` (was wrapping in `let`, which doesn't reach the inner HS env) - Stop collapsing `\"` → `"` in raw HTML (line 218): the backslash escapes are legitimate in single-quoted `_='...'` HS attribute values containing nested HS scripts Test-framework changes (regenerated into spec/tests/test-hyperscript-behavioral.sx): - `_hs-wrap-body`: returns expression value if non-nil, else `it`. Lets bare expressions (`foo.foo`) and `it`-mutating scripts (`pick first 3 of arr; set $test to it`) both round-trip through the same wrapper - `eval-hs-locals` now injects locals via `(let ((name (quote val)) ...) sx)` rather than `apply handler (cons nil vals)` — works around a JIT loop on some compiled forms (e.g. `bar.doh of foo` with undefined `bar`) Also synced lib/hyperscript/*.sx → shared/static/wasm/sx/hs-*.sx (the WASM test runner reads from the wasm/sx/ copies). Net per-cluster pass counts (vs prior baseline): - put: 23 → 29 (+6) - set: 21 → 28 (+7) - show: 7 → 15 (+8) - expressions/propertyAccess: 3 → 9 (+6) - expressions/possessiveExpression: 17 → 18 (+1) Co-Authored-By: Claude Opus 4.7 (1M context) --- shared/static/wasm/sx/hs-compiler.sx | 69 ++++++--- shared/static/wasm/sx/hs-integration.sx | 45 ++++-- shared/static/wasm/sx/hs-parser.sx | 166 ++++++++++++++++------ shared/static/wasm/sx/hs-runtime.sx | 88 +++++++++--- shared/static/wasm/sx/hs-tokenizer.sx | 4 + spec/tests/test-hyperscript-behavioral.sx | 147 ++++++++++--------- tests/playwright/generate-sx-tests.py | 126 ++++++++++++---- 7 files changed, 451 insertions(+), 194 deletions(-) diff --git a/shared/static/wasm/sx/hs-compiler.sx b/shared/static/wasm/sx/hs-compiler.sx index 05d81a2e..fc3ad1e8 100644 --- a/shared/static/wasm/sx/hs-compiler.sx +++ b/shared/static/wasm/sx/hs-compiler.sx @@ -77,7 +77,11 @@ ((= th (quote ref)) (list (quote set!) (make-symbol (nth target 1)) value)) ((= th (quote local)) - (list (quote define) (make-symbol (nth target 1)) value)) + (list + (quote hs-scoped-set!) + (quote me) + (nth target 1) + value)) ((= th (quote dom-ref)) (list (quote hs-dom-set!) @@ -753,35 +757,53 @@ (hs-to-sx (nth ast 3)))) ((= head (quote pick-first)) (list - (quote hs-pick-first) - (hs-to-sx (nth ast 1)) - (hs-to-sx (nth ast 2)))) + (quote set!) + (quote it) + (list + (quote hs-pick-first) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2))))) ((= head (quote pick-last)) (list - (quote hs-pick-last) - (hs-to-sx (nth ast 1)) - (hs-to-sx (nth ast 2)))) + (quote set!) + (quote it) + (list + (quote hs-pick-last) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2))))) ((= head (quote pick-random)) (list - (quote hs-pick-random) - (hs-to-sx (nth ast 1)) - (if (nil? (nth ast 2)) nil (hs-to-sx (nth ast 2))))) + (quote set!) + (quote it) + (list + (quote hs-pick-random) + (hs-to-sx (nth ast 1)) + (if (nil? (nth ast 2)) nil (hs-to-sx (nth ast 2)))))) ((= head (quote pick-items)) (list - (quote hs-pick-items) - (hs-to-sx (nth ast 1)) - (hs-to-sx (nth ast 2)) - (hs-to-sx (nth ast 3)))) + (quote set!) + (quote it) + (list + (quote hs-pick-items) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2)) + (hs-to-sx (nth ast 3))))) ((= head (quote pick-match)) (list - (quote regex-match) - (hs-to-sx (nth ast 1)) - (hs-to-sx (nth ast 2)))) + (quote set!) + (quote it) + (list + (quote regex-match) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2))))) ((= head (quote pick-matches)) (list - (quote regex-find-all) - (hs-to-sx (nth ast 1)) - (hs-to-sx (nth ast 2)))) + (quote set!) + (quote it) + (list + (quote regex-find-all) + (hs-to-sx (nth ast 1)) + (hs-to-sx (nth ast 2))))) ((= head (quote prop-is)) (list (quote hs-prop-is) @@ -894,7 +916,8 @@ (quote dom-has-class?) (hs-to-sx (nth ast 1)) (nth ast 2))) - ((= head (quote local)) (make-symbol (nth ast 1))) + ((= head (quote local)) + (list (quote hs-scoped-get) (quote me) (nth ast 1))) ((= head (quote array)) (cons (quote list) (map hs-to-sx (rest ast)))) ((= head (quote not)) @@ -1384,7 +1407,7 @@ nil)) ((= head (quote hide)) (let - ((tgt (hs-to-sx (nth ast 1))) + ((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt)))) (strategy (if (> (len ast) 2) (nth ast 2) "display")) (when-cond (if (> (len ast) 3) (nth ast 3) nil))) (if @@ -1400,7 +1423,7 @@ (hs-to-sx when-cond)))))) ((= head (quote show)) (let - ((tgt (hs-to-sx (nth ast 1))) + ((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt)))) (strategy (if (> (len ast) 2) (nth ast 2) "display")) (when-cond (if (> (len ast) 3) (nth ast 3) nil))) (if diff --git a/shared/static/wasm/sx/hs-integration.sx b/shared/static/wasm/sx/hs-integration.sx index 0c3feaa9..147d7350 100644 --- a/shared/static/wasm/sx/hs-integration.sx +++ b/shared/static/wasm/sx/hs-integration.sx @@ -53,13 +53,20 @@ ((sx (hs-to-sx-from-source src))) (let ((extra-vars (hs-collect-vars sx))) - (let - ((bindings (append (list (list (quote it) nil) (list (quote event) nil)) (map (fn (v) (list v nil)) extra-vars)))) - (eval-expr-cek - (list - (quote fn) - (list (quote me)) - (list (quote let) bindings sx))))))))) + (do + (for-each + (fn (v) (eval-expr-cek (list (quote define) v nil))) + extra-vars) + (let + ((guarded (list (quote guard) (list (quote _e) (list (quote true) (list (quote if) (list (quote and) (list (quote list?) (quote _e)) (list (quote =) (list (quote first) (quote _e)) "hs-return")) (list (quote nth) (quote _e) 1) (list (quote raise) (quote _e))))) sx))) + (eval-expr-cek + (list + (quote fn) + (list (quote me)) + (list + (quote let) + (list (list (quote it) nil) (list (quote event) nil)) + guarded)))))))))) ;; ── Activate a single element ─────────────────────────────────── ;; Reads the _="..." attribute, compiles, and executes with me=element. @@ -70,9 +77,10 @@ (fn (el) (let - ((src (dom-get-attr el "_"))) + ((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script"))) (when - (and src (not (dom-get-data el "hs-active"))) + (and src (not (= src prev))) + (dom-set-data el "hs-script" src) (dom-set-data el "hs-active" true) (let ((handler (hs-handler src))) (handler el)))))) @@ -80,6 +88,21 @@ ;; Called once at page load. Finds all elements with _ attribute, ;; compiles their hyperscript, and activates them. +(define + hs-deactivate! + (fn + (el) + (let + ((unlisteners (or (dom-get-data el "hs-unlisteners") (list)))) + (for-each (fn (u) (when u (u))) unlisteners) + (dom-set-data el "hs-unlisteners" (list)) + (dom-set-data el "hs-active" false) + (dom-set-data el "hs-script" nil)))) + +;; ── Boot subtree: for dynamic content ─────────────────────────── +;; Called after HTMX swaps or dynamic DOM insertion. +;; Only activates elements within the given root. + (define hs-boot! (fn @@ -88,10 +111,6 @@ ((elements (dom-query-all (host-get (host-global "document") "body") "[_]"))) (for-each (fn (el) (hs-activate! el)) elements)))) -;; ── Boot subtree: for dynamic content ─────────────────────────── -;; Called after HTMX swaps or dynamic DOM insertion. -;; Only activates elements within the given root. - (define hs-boot-subtree! (fn diff --git a/shared/static/wasm/sx/hs-parser.sx b/shared/static/wasm/sx/hs-parser.sx index a06076c1..3739084b 100644 --- a/shared/static/wasm/sx/hs-parser.sx +++ b/shared/static/wasm/sx/hs-parser.sx @@ -550,6 +550,14 @@ (quote and) (list (quote >=) left lo) (list (quote <=) left hi)))))) + ((or (and (or (= (tp-val) "a") (= (tp-val) "an")) (do (adv!) true))) + (let + ((type-name (tp-val))) + (do + (adv!) + (list + (quote not) + (list (quote type-check) left type-name))))) (true (let ((right (parse-expr))) @@ -566,6 +574,10 @@ (quote and) (list (quote >=) left lo) (list (quote <=) left hi))))) + ((or (and (or (= (tp-val) "a") (= (tp-val) "an")) (do (adv!) true))) + (let + ((type-name (tp-val))) + (do (adv!) (list (quote type-check) left type-name)))) (true (let ((right (parse-expr))) @@ -596,7 +608,7 @@ (match-kw "case") (list (quote ends-with-ic?) left rhs)) (list (quote ends-with?) left rhs))))) - ((and (= typ "keyword") (= val "matches")) + ((and (= typ "keyword") (or (= val "matches") (= val "match"))) (do (adv!) (let @@ -638,7 +650,22 @@ (quote as) left (str type-name ":" param))))) - (list (quote as) left type-name)))))) + (let + loop + ((result (list (quote as) left type-name))) + (if + (and (= (tp-type) "op") (= (tp-val) "|")) + (do + (adv!) + (when + (or (= (tp-val) "a") (= (tp-val) "an")) + (adv!)) + (let + ((next-type (tp-val))) + (do + (adv!) + (loop (list (quote as) result next-type))))) + result))))))) ((and (= typ "colon")) (do (adv!) @@ -713,7 +740,7 @@ (list (quote strict-eq) left (parse-expr)))) ((and (= typ "keyword") (or (= val "contain") (= val "include") (= val "includes"))) (do (adv!) (list (quote contains?) left (parse-expr)))) - ((and (= typ "keyword") (= val "precedes")) + ((and (= typ "keyword") (or (= val "precedes") (= val "precede"))) (do (adv!) (list (quote precedes?) left (parse-atom)))) ((and (= typ "keyword") (= val "follows")) (do (adv!) (list (quote follows?) left (parse-atom)))) @@ -792,7 +819,7 @@ (= (tp-val) "starts") (= (tp-val) "ends") (= (tp-val) "contains") - (= (tp-val) "matches") + (or (= (tp-val) "matches") (= (tp-val) "match")) (= (tp-val) "is") (= (tp-val) "does") (= (tp-val) "in") @@ -1082,38 +1109,67 @@ (match-kw "between") (let ((val1 (parse-atom))) - (expect-kw! "and") - (let - ((val2 (parse-atom))) + (do + (when (= (tp-type) "comma") (adv!)) (if - (match-kw "and") - (let - ((val3 (parse-atom))) - (if - (match-kw "and") + (and (= (tp-type) "keyword") (= (tp-val) "and")) + (adv!) + nil) + (let + ((val2 (parse-atom))) + (if + (or + (= (tp-type) "comma") + (and + (= (tp-type) "keyword") + (= (tp-val) "and"))) + (do + (when (= (tp-type) "comma") (adv!)) + (if + (and + (= (tp-type) "keyword") + (= (tp-val) "and")) + (adv!) + nil) (let - ((val4 (parse-atom))) - (list - (quote toggle-style-cycle) - prop - tgt - val1 - val2 - val3 - val4)) - (list - (quote toggle-style-cycle) - prop - tgt - val1 - val2 - val3))) - (list - (quote toggle-style-between) - prop - val1 - val2 - tgt)))) + ((val3 (parse-atom))) + (if + (or + (= (tp-type) "comma") + (and + (= (tp-type) "keyword") + (= (tp-val) "and"))) + (do + (when (= (tp-type) "comma") (adv!)) + (if + (and + (= (tp-type) "keyword") + (= (tp-val) "and")) + (adv!) + nil) + (let + ((val4 (parse-atom))) + (list + (quote toggle-style-cycle) + prop + tgt + val1 + val2 + val3 + val4))) + (list + (quote toggle-style-cycle) + prop + tgt + val1 + val2 + val3)))) + (list + (quote toggle-style-between) + prop + val1 + val2 + tgt))))) (list (quote toggle-style) prop tgt))))) ((= (tp-type) "attr") (let @@ -1422,7 +1478,7 @@ (let ((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr))))) (let - ((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (adv!) s)) "display"))) + ((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display"))) (let ((when-cond (if (and (= (tp-type) "keyword") (= (tp-val) "when")) (do (adv!) (parse-expr)) nil))) (list (quote hide) tgt strategy when-cond)))))) @@ -1433,7 +1489,7 @@ (let ((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr))))) (let - ((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (adv!) s)) "display"))) + ((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display"))) (let ((when-cond (if (and (= (tp-type) "keyword") (= (tp-val) "when")) (do (adv!) (parse-expr)) nil))) (list (quote show) tgt strategy when-cond)))))) @@ -1648,7 +1704,9 @@ (let ((n (parse-atom))) (do - (expect-kw! "of") + (if + (not (or (match-kw "of") (match-kw "from"))) + (error (str "Expected 'of' or 'from' at position " p))) (let ((coll (parse-expr))) (list (quote pick-first) coll n)))))) @@ -1658,7 +1716,9 @@ (let ((n (parse-atom))) (do - (expect-kw! "of") + (if + (not (or (match-kw "of") (match-kw "from"))) + (error (str "Expected 'of' or 'from' at position " p))) (let ((coll (parse-expr))) (list (quote pick-last) coll n)))))) @@ -1666,14 +1726,17 @@ (do (adv!) (if - (match-kw "of") + (or (match-kw "of") (match-kw "from")) (let ((coll (parse-expr))) (list (quote pick-random) coll nil)) (let ((n (parse-atom))) (do - (expect-kw! "of") + (if + (not (or (match-kw "of") (match-kw "from"))) + (error + (str "Expected 'of' or 'from' at position " p))) (let ((coll (parse-expr))) (list (quote pick-random) coll n))))))) @@ -1687,7 +1750,10 @@ (let ((end-expr (parse-atom))) (do - (expect-kw! "of") + (if + (not (or (match-kw "of") (match-kw "from"))) + (error + (str "Expected 'of' or 'from' at position " p))) (let ((coll (parse-expr))) (list (quote pick-items) coll start-expr end-expr)))))))) @@ -1727,10 +1793,26 @@ (let ((haystack (parse-expr))) (list (quote pick-matches) regex haystack)))))) + ((and (= typ "ident") (= val "item")) + (do + (adv!) + (let + ((n (parse-expr))) + (do + (if + (not (or (match-kw "of") (match-kw "from"))) + (error (str "Expected 'of' or 'from' at position " p))) + (let + ((coll (parse-expr))) + (list + (quote pick-items) + coll + n + (list (quote +) n 1))))))) (true (error (str - "Expected first/last/random/items/match/matches after 'pick' at " + "Expected first/last/random/item/items/match/matches after 'pick' at " p))))))) (define parse-go-cmd diff --git a/shared/static/wasm/sx/hs-runtime.sx b/shared/static/wasm/sx/hs-runtime.sx index c0df704d..ce30f325 100644 --- a/shared/static/wasm/sx/hs-runtime.sx +++ b/shared/static/wasm/sx/hs-runtime.sx @@ -94,7 +94,7 @@ ((or (= prop "display") (= prop "opacity")) (if (or (= cur "none") (= cur "0")) - (dom-set-style target prop (if (= prop "opacity") "1" "")) + (dom-set-style target prop (if (= prop "opacity") "1" "block")) (dom-set-style target prop (if (= prop "display") "none" "0")))) (true (if @@ -821,11 +821,26 @@ ((nil? suffix) false) (true (ends-with? (str s) (str suffix)))))) +(define + hs-scoped-set! + (fn (el name val) (dom-set-data el (str "hs-local-" name) val))) + +(define + hs-scoped-get + (fn (el name) (dom-get-data el (str "hs-local-" name)))) + (define hs-precedes? (fn (a b) - (cond ((nil? a) false) ((nil? b) false) (true (< (str a) (str b)))))) + (cond + ((nil? a) false) + ((nil? b) false) + ((and (dict? a) (dict? b)) + (let + ((pos (host-call a "compareDocumentPosition" b))) + (if (number? pos) (not (= 0 (mod (/ pos 4) 2))) false))) + (true (< (str a) (str b)))))) (define hs-follows? @@ -916,7 +931,18 @@ (= obj (nth r 1)) (= obj nil))))))) -(define precedes? (fn (a b) (< (str a) (str b)))) +(define + precedes? + (fn + (a b) + (cond + ((nil? a) false) + ((nil? b) false) + ((and (dict? a) (dict? b)) + (let + ((pos (host-call a "compareDocumentPosition" b))) + (if (number? pos) (not (= 0 (mod (/ pos 4) 2))) false))) + (true (< (str a) (str b)))))) (define hs-empty? @@ -1206,15 +1232,23 @@ (fn (el strategy) (let - ((tag (dom-get-prop el "tagName"))) - (cond - ((= tag "DIALOG") - (when (dom-has-attr? el "open") (host-call el "close"))) - ((= tag "DETAILS") (dom-set-prop el "open" false)) - ((= strategy "opacity") (dom-set-style el "opacity" "0")) - ((= strategy "visibility") - (dom-set-style el "visibility" "hidden")) - (true (dom-set-style el "display" "none")))))) + ((parts (split strategy ":")) (tag (dom-get-prop el "tagName"))) + (let + ((prop (first parts)) + (val (if (> (len parts) 1) (nth parts 1) nil))) + (cond + ((= tag "DIALOG") + (when (dom-has-attr? el "open") (host-call el "close"))) + ((= tag "DETAILS") (dom-set-prop el "open" false)) + ((= prop "opacity") + (dom-set-style el "opacity" (if val val "0"))) + ((= prop "visibility") + (dom-set-style el "visibility" (if val val "hidden"))) + ((= prop "hidden") (dom-set-attr el "hidden" "")) + ((= prop "twDisplay") (dom-add-class el "hidden")) + ((= prop "twVisibility") (dom-add-class el "invisible")) + ((= prop "twOpacity") (dom-add-class el "opacity-0")) + (true (dom-set-style el "display" (if val val "none")))))))) (define hs-hide! (fn @@ -1230,17 +1264,25 @@ (fn (el strategy) (let - ((tag (dom-get-prop el "tagName"))) - (cond - ((= tag "DIALOG") - (when - (not (dom-has-attr? el "open")) - (host-call el "showModal"))) - ((= tag "DETAILS") (dom-set-prop el "open" true)) - ((= strategy "opacity") (dom-set-style el "opacity" "1")) - ((= strategy "visibility") - (dom-set-style el "visibility" "visible")) - (true (dom-set-style el "display" "")))))) + ((parts (split strategy ":")) (tag (dom-get-prop el "tagName"))) + (let + ((prop (first parts)) + (val (if (> (len parts) 1) (nth parts 1) nil))) + (cond + ((= tag "DIALOG") + (when + (not (dom-has-attr? el "open")) + (host-call el "showModal"))) + ((= tag "DETAILS") (dom-set-prop el "open" true)) + ((= prop "opacity") + (dom-set-style el "opacity" (if val val "1"))) + ((= prop "visibility") + (dom-set-style el "visibility" (if val val "visible"))) + ((= prop "hidden") (dom-remove-attr el "hidden")) + ((= prop "twDisplay") (dom-remove-class el "hidden")) + ((= prop "twVisibility") (dom-remove-class el "invisible")) + ((= prop "twOpacity") (dom-remove-class el "opacity-0")) + (true (dom-set-style el "display" (if val val "block")))))))) (define hs-show! (fn diff --git a/shared/static/wasm/sx/hs-tokenizer.sx b/shared/static/wasm/sx/hs-tokenizer.sx index f846e34d..9440f95a 100644 --- a/shared/static/wasm/sx/hs-tokenizer.sx +++ b/shared/static/wasm/sx/hs-tokenizer.sx @@ -436,6 +436,8 @@ (let ((ch (hs-cur)) (start pos)) (cond + (and (= ch "-") (< (+ pos 1) src-len) (= (hs-peek 1) "-")) + (do (hs-advance! 2) (skip-comment!) (scan!)) (and (= ch "/") (< (+ pos 1) src-len) (= (hs-peek 1) "/")) (do (hs-advance! 2) (skip-comment!) (scan!)) (and @@ -613,6 +615,8 @@ (do (hs-emit! "op" "\\" start) (hs-advance! 1) (scan!)) (= ch ":") (do (hs-emit! "colon" ":" start) (hs-advance! 1) (scan!)) + (= ch "|") + (do (hs-emit! "op" "|" start) (hs-advance! 1) (scan!)) :else (do (hs-advance! 1) (scan!))))))) (scan!) (hs-emit! "eof" nil pos) diff --git a/spec/tests/test-hyperscript-behavioral.sx b/spec/tests/test-hyperscript-behavioral.sx index cc6186ab..68f1dc5e 100644 --- a/spec/tests/test-hyperscript-behavioral.sx +++ b/spec/tests/test-hyperscript-behavioral.sx @@ -16,13 +16,24 @@ (fn () (dom-set-inner-html (dom-body) ""))) -;; Evaluate a hyperscript expression and return the last-expression value. -;; Compiles the expression, wraps in a thunk, evaluates, returns result. +;; Evaluate a hyperscript expression and return either the expression +;; value or `it` (whichever is non-nil). Multi-statement scripts that +;; mutate `it` (e.g. `pick first 3 of arr; set $test to it`) get `it` back; +;; bare expressions (e.g. `foo.foo`) get the expression value back. +(define _hs-wrap-body + (fn (sx) + (list (quote let) + (list (list (quote it) nil) (list (quote event) nil)) + (list (quote let) + (list (list (quote _ret) sx)) + (list (quote if) (list (quote nil?) (quote _ret)) (quote it) (quote _ret)))))) + (define eval-hs (fn (src) (let ((sx (hs-to-sx (hs-compile src)))) (let ((handler (eval-expr-cek - (list (quote fn) (list (quote me)) (list (quote let) (list (list (quote it) nil) (list (quote event) nil)) sx))))) + (list (quote fn) (list (quote me)) + (list (quote let) (list (list (quote it) nil) (list (quote event) nil)) sx))))) (guard (_e (true @@ -33,18 +44,16 @@ (handler nil)))))) ;; Evaluate a hyperscript expression with locals. bindings = list of (symbol value). -;; The locals are injected as fn params so they resolve in the handler body. +;; Locals are injected as a `let` wrapping the compiled body, then evaluated +;; in a fresh CEK env. Avoids `apply` (whose JIT path can loop on some forms). (define eval-hs-locals (fn (src bindings) (let ((sx (hs-to-sx (hs-compile src)))) - (let ((names (map (fn (b) (first b)) bindings)) - (vals (map (fn (b) (nth b 1)) bindings))) - (let ((param-list (cons (quote me) names))) - (let ((wrapper (list (quote fn) param-list - (list (quote let) - (list (list (quote it) nil) (list (quote event) nil)) - sx (quote it))))) - (let ((handler (eval-expr-cek wrapper))) + ;; Build (let ((name1 (quote val1)) ...) ) + (let ((let-binds (map (fn (b) (list (first b) (list (quote quote) (nth b 1)))) bindings))) + (let ((wrapped (list (quote let) let-binds (_hs-wrap-body sx)))) + (let ((thunk (list (quote fn) (list (quote me)) wrapped))) + (let ((handler (eval-expr-cek thunk))) (guard (_e (true @@ -52,14 +61,14 @@ (and (list? _e) (= (first _e) "hs-return")) (nth _e 1) (raise _e)))) - (apply handler (cons nil vals)))))))))) + (handler nil))))))))) ;; Evaluate with a specific me value (for "I am between" etc.) (define eval-hs-with-me (fn (src me-val) (let ((sx (hs-to-sx (hs-compile src)))) (let ((handler (eval-expr-cek - (list (quote fn) (list (quote me)) (list (quote let) (list (list (quote it) nil) (list (quote event) nil)) sx))))) + (list (quote fn) (list (quote me)) (_hs-wrap-body sx))))) (guard (_e (true @@ -133,7 +142,7 @@ (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "color") "") + (assert= (dom-get-style _el-div "color") "red") (assert= (dom-get-style _el-div "font-family") "monospace") )) (deftest "can add multiple class refs" @@ -163,7 +172,7 @@ (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "color") "") + (assert= (dom-get-style _el-div "color") "red") )) (deftest "can add to an HTMLCollection" (hs-cleanup!) @@ -1287,7 +1296,7 @@ (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "color") "") + (assert= (dom-get-style _el-div "color") "red") )) (deftest "can take a class from other elements" (hs-cleanup!) @@ -2693,7 +2702,7 @@ (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "background-color") "") + (assert= (dom-get-style _el-div "background-color") "red") )) (deftest "can default variables" (hs-cleanup!) @@ -2770,7 +2779,7 @@ (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "color") "") + (assert= (dom-get-style _el-div "color") "blue") )) (deftest "default variables respect existing values" (hs-cleanup!) @@ -3286,7 +3295,7 @@ (assert= (eval-hs "[1 + 1, 2 * 3, 10 - 5]") (list 2 6 5)) ) (deftest "arrays containing objects work" - (assert= (eval-hs "[{a: 1}, {b: 2}]") (list "{a: 1}" "{b: 2}")) + (assert= (eval-hs "[{a: 1}, {b: 2}]") (list {:a 1} {:b 2})) ) (deftest "deeply nested array literals work" (assert= (eval-hs "[[[1]], [[2, 3]]]") (list (list (list 1)) (list (list 2 3)))) @@ -3359,7 +3368,7 @@ (dom-dispatch (dom-query-by-id "qsdiv") "click" nil) )) (deftest "converts an array into HTML" - (assert= (eval-hs "d as HTML") "`this-is-html`") + (assert= (eval-hs-locals "d as HTML" (list (list (quote d) (list "this-" "is-" "html")))) "`this-is-html`") ) (deftest "converts an element into HTML" (error "SKIP (untranslated): converts an element into HTML")) @@ -3389,7 +3398,7 @@ (deftest "converts null as null" (error "SKIP (untranslated): converts null as null")) (deftest "converts numbers things 'HTML'" - (assert= (eval-hs "value as HTML") "123") + (assert= (eval-hs-locals "value as HTML" (list (list (quote value) 123))) "123") ) (deftest "converts object as Entries" (assert= (eval-hs "{a:1} as Entries") (list (list "a" 1))) @@ -3434,7 +3443,7 @@ (assert= (eval-hs "'10' as Number") 10.4) ) (deftest "converts value as Object" - (assert= (host-get (eval-hs "x as Object") "foo") "bar") + (assert= (host-get (eval-hs-locals "x as Object" (list (list (quote x) {:foo "bar"}))) "foo") "bar") ) (deftest "converts value as String" (assert= (eval-hs "10 as String") "10") @@ -4160,7 +4169,7 @@ (dom-append _el-container _el-span3) )) (deftest "where binds after property access" - (assert= (eval-hs "obj.items where it > 2") (list 3 4)) + (assert= (eval-hs-locals "obj.items where it > 2" (list (list (quote obj) {:items (list 1 2 3 4)}))) (list 3 4)) ) (deftest "where in component init followed by on feature" (hs-cleanup!) @@ -4332,8 +4341,8 @@ (assert= (eval-hs "'Hello World' contains 'missing' ignoring case") false) ) (deftest "contains works with arrays" - (let ((that 1)) (assert= (eval-hs "I contain that") true)) - (let ((that "[1")) (assert= (eval-hs "that contains me") true)) + (assert= (eval-hs-locals "I contain that" (list (list (quote that) 1))) true) + (assert= (eval-hs-locals "that contains me" (list (list (quote that) "[1"))) true) ) (deftest "contains works with css literals" (hs-cleanup!) @@ -4486,14 +4495,14 @@ (assert= (eval-hs "2 > 2") false) ) (deftest "include works" - (let ((foo "foo") (foobar "foobar")) (assert= (eval-hs "foo includes foobar") false)) - (let ((foo "foo") (foobar "foobar")) (assert= (eval-hs "foobar includes foo") true)) - (let ((foo "foo") (foobar "foobar")) (assert= (eval-hs "foo does not include foobar") true)) - (let ((foo "foo") (foobar "foobar")) (assert= (eval-hs "foobar does not include foo") false)) + (assert= (eval-hs-locals "foo includes foobar" (list (list (quote foo) "foo") (list (quote foobar) "foobar"))) false) + (assert= (eval-hs-locals "foobar includes foo" (list (list (quote foo) "foo") (list (quote foobar) "foobar"))) true) + (assert= (eval-hs-locals "foo does not include foobar" (list (list (quote foo) "foo") (list (quote foobar) "foobar"))) true) + (assert= (eval-hs-locals "foobar does not include foo" (list (list (quote foo) "foo") (list (quote foobar) "foobar"))) false) ) (deftest "includes works with arrays" - (let ((that 1)) (assert= (eval-hs "I include that") true)) - (let ((that "[1")) (assert= (eval-hs "that includes me") true)) + (assert= (eval-hs-locals "I include that" (list (list (quote that) 1))) true) + (assert= (eval-hs-locals "that includes me" (list (list (quote that) "[1"))) true) ) (deftest "includes works with css literals" (hs-cleanup!) @@ -4706,8 +4715,8 @@ (assert= (eval-hs "2 is really '2'") false) ) (deftest "is still does equality when rhs variable exists" - (let ((x 5) (y 5)) (assert= (eval-hs "x is y") true)) - (let ((x 5) (y 6)) (assert= (eval-hs "x is y") false)) + (assert= (eval-hs-locals "x is y" (list (list (quote x) 5) (list (quote y) 5))) true) + (assert= (eval-hs-locals "x is y" (list (list (quote x) 5) (list (quote y) 6))) false) ) (deftest "is works" (assert= (eval-hs "1 is 2") false) @@ -5658,7 +5667,7 @@ (dom-append (dom-body) _el-pDiv) )) (deftest "can access basic properties" - (assert= (eval-hs "foo's foo") "foo") + (assert= (eval-hs-locals "foo's foo" (list (list (quote foo) {:foo "foo"}))) "foo") ) (deftest "can access basic style" (hs-cleanup!) @@ -5805,32 +5814,32 @@ ;; ── expressions/propertyAccess (12 tests) ── (defsuite "hs-upstream-expressions/propertyAccess" (deftest "can access basic properties" - (assert= (eval-hs "foo.foo") "foo") + (assert= (eval-hs-locals "foo.foo" (list (list (quote foo) {:foo "foo"}))) "foo") ) (deftest "chained property access (four levels)" - (assert= (eval-hs "a.b.c.d") 42) + (assert= (eval-hs-locals "a.b.c.d" (list (list (quote a) {:b {:c {:d 42}}}))) 42) ) (deftest "chained property access (three levels)" - (assert= (eval-hs "a.b.c") "deep") + (assert= (eval-hs-locals "a.b.c" (list (list (quote a) {:b {:c "deep"}}))) "deep") ) (deftest "is null safe" (error "SKIP (untranslated): is null safe")) (deftest "mixing dot and of forms" - (assert= (eval-hs "c of a.b") "mixed") + (assert= (eval-hs-locals "c of a.b" (list (list (quote a) {:b {:c "mixed"}}))) "mixed") ) (deftest "null-safe access through an undefined intermediate" (error "SKIP (untranslated): null-safe access through an undefined intermediate")) (deftest "of form chains through multiple levels" - (assert= (eval-hs "c of b of a") "deep") + (assert= (eval-hs-locals "c of b of a" (list (list (quote a) {:b {:c "deep"}}))) "deep") ) (deftest "of form works" - (assert= (eval-hs "foo of foo") "foo") + (assert= (eval-hs-locals "foo of foo" (list (list (quote foo) {:foo "foo"}))) "foo") ) (deftest "of form works w/ complex left side" - (assert= (eval-hs "bar.doh of foo") "foo") + (assert= (eval-hs-locals "bar.doh of foo" (list (list (quote foo) {:bar {:doh "foo"}}))) "foo") ) (deftest "of form works w/ complex right side" - (assert= (eval-hs "doh of foo.bar") "foo") + (assert= (eval-hs-locals "doh of foo.bar" (list (list (quote foo) {:bar {:doh "foo"}}))) "foo") ) (deftest "property access on function result" (assert= (eval-hs "makeObj().name") "hi") @@ -6350,7 +6359,7 @@ (assert= (eval-hs "\"foo\"") "foo") ) (deftest "should handle back slashes in non-template content" - (assert= (eval-hs "`https://${foo}`") "https://bar") + (assert= (eval-hs-locals "`https://${foo}`" (list (list (quote foo) "bar"))) "https://bar") ) (deftest "should handle strings with tags and quotes" (error "SKIP (untranslated): should handle strings with tags and quotes")) @@ -6425,7 +6434,7 @@ (deftest "resolves global context properly" (error "SKIP (untranslated): resolves global context properly")) (deftest "resolves local context properly" - (assert= (eval-hs "foo") 42) + (assert= (eval-hs-locals "foo" (list (list (quote foo) 42))) 42) ) ) @@ -9348,7 +9357,7 @@ (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "color") "") + (assert= (dom-get-style _el-div "color") "red") )) (deftest "can put array vals w/ array access syntax and var" (hs-cleanup!) @@ -9358,7 +9367,7 @@ (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "color") "") + (assert= (dom-get-style _el-div "color") "red") )) (deftest "can put at end of an array" (hs-cleanup!) @@ -9416,7 +9425,7 @@ (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "color") "") + (assert= (dom-get-style _el-div "color") "red") )) (deftest "can put properties w/ array access syntax and var" (hs-cleanup!) @@ -9426,7 +9435,7 @@ (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "color") "") + (assert= (dom-get-style _el-div "color") "red") )) (deftest "can set into attribute ref" (hs-cleanup!) @@ -9526,7 +9535,7 @@ (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "color") "") + (assert= (dom-get-style _el-div "color") "red") )) (deftest "can set into indirect style ref 2" (hs-cleanup!) @@ -9538,7 +9547,7 @@ (dom-append (dom-body) _el-div2) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style (dom-query-by-id "div2") "color") "") + (assert= (dom-get-style (dom-query-by-id "div2") "color") "red") )) (deftest "can set into indirect style ref 3" (hs-cleanup!) @@ -9550,7 +9559,7 @@ (dom-append (dom-body) _el-div2) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style (dom-query-by-id "div2") "color") "") + (assert= (dom-get-style (dom-query-by-id "div2") "color") "red") )) (deftest "can set into style ref" (hs-cleanup!) @@ -9560,7 +9569,7 @@ (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "color") "") + (assert= (dom-get-style _el-div "color") "red") )) (deftest "can set javascript globals" (hs-cleanup!) @@ -9599,7 +9608,7 @@ (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "color") "") + (assert= (dom-get-style _el-div "color") "red") )) (deftest "is null tolerant" (hs-cleanup!) @@ -9623,7 +9632,7 @@ (hs-cleanup!) (let ((_el-d1 (dom-create-element "div"))) (dom-set-attr _el-d1 "id" "d1") - (dom-set-attr _el-d1 "_" "on click put \"\" after me") + (dom-set-attr _el-d1 "_" "on click put \"\" after me") (dom-append (dom-body) _el-d1) (hs-activate! _el-d1) (dom-dispatch (dom-query-by-id "d1") "click" nil) @@ -9635,7 +9644,7 @@ (hs-cleanup!) (let ((_el-d1 (dom-create-element "div"))) (dom-set-attr _el-d1 "id" "d1") - (dom-set-attr _el-d1 "_" "on click put \"\" at the end of me") + (dom-set-attr _el-d1 "_" "on click put \"\" at the end of me") (dom-append (dom-body) _el-d1) (hs-activate! _el-d1) (dom-dispatch (dom-query-by-id "d1") "click" nil) @@ -9646,7 +9655,7 @@ (hs-cleanup!) (let ((_el-d1 (dom-create-element "div"))) (dom-set-attr _el-d1 "id" "d1") - (dom-set-attr _el-d1 "_" "on click put \"\" at the start of me") + (dom-set-attr _el-d1 "_" "on click put \"\" at the start of me") (dom-append (dom-body) _el-d1) (hs-activate! _el-d1) (dom-dispatch (dom-query-by-id "d1") "click" nil) @@ -9657,7 +9666,7 @@ (hs-cleanup!) (let ((_el-d1 (dom-create-element "div"))) (dom-set-attr _el-d1 "id" "d1") - (dom-set-attr _el-d1 "_" "on click put \"\" before me") + (dom-set-attr _el-d1 "_" "on click put \"\" before me") (dom-append (dom-body) _el-d1) (hs-activate! _el-d1) (dom-dispatch (dom-query-by-id "d1") "click" nil) @@ -9669,7 +9678,7 @@ (hs-cleanup!) (let ((_el-d1 (dom-create-element "div"))) (dom-set-attr _el-d1 "id" "d1") - (dom-set-attr _el-d1 "_" "on click put \"\" into ") + (dom-set-attr _el-d1 "_" "on click put \"\" into ") (dom-append (dom-body) _el-d1) (hs-activate! _el-d1) (dom-dispatch (dom-query-by-id "d1") "click" nil) @@ -9679,7 +9688,7 @@ (deftest "properly processes hyperscript in new content in a symbol write" (hs-cleanup!) (let ((_el-div (dom-create-element "div"))) - (dom-set-attr _el-div "_" "on click put \"\" into me") + (dom-set-attr _el-div "_" "on click put \"\" into me") (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) @@ -10736,7 +10745,7 @@ (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "color") "") + (assert= (dom-get-style _el-div "color") "red") )) (deftest "can set arrays w/ array access syntax and var" (hs-cleanup!) @@ -10746,7 +10755,7 @@ (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "color") "") + (assert= (dom-get-style _el-div "color") "red") )) (deftest "can set chained indirect properties" (hs-cleanup!) @@ -10869,7 +10878,7 @@ (dom-append (dom-body) _el-div2) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style (dom-query-by-id "div2") "color") "") + (assert= (dom-get-style (dom-query-by-id "div2") "color") "red") )) (deftest "can set into indirect style ref 2" (hs-cleanup!) @@ -10881,7 +10890,7 @@ (dom-append (dom-body) _el-div2) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style (dom-query-by-id "div2") "color") "") + (assert= (dom-get-style (dom-query-by-id "div2") "color") "red") )) (deftest "can set into indirect style ref 3" (hs-cleanup!) @@ -10893,7 +10902,7 @@ (dom-append (dom-body) _el-div2) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style (dom-query-by-id "div2") "color") "") + (assert= (dom-get-style (dom-query-by-id "div2") "color") "red") )) (deftest "can set into style ref" (hs-cleanup!) @@ -10903,7 +10912,7 @@ (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "color") "") + (assert= (dom-get-style _el-div "color") "red") )) (deftest "can set javascript globals" (hs-cleanup!) @@ -10950,7 +10959,7 @@ (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "color") "") + (assert= (dom-get-style _el-div "color") "red") )) (deftest "can set props w/ array access syntax and var" (hs-cleanup!) @@ -10960,7 +10969,7 @@ (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "color") "") + (assert= (dom-get-style _el-div "color") "red") )) (deftest "can set styles" (hs-cleanup!) @@ -10970,7 +10979,7 @@ (dom-append (dom-body) _el-div) (hs-activate! _el-div) (dom-dispatch _el-div "click" nil) - (assert= (dom-get-style _el-div "color") "") + (assert= (dom-get-style _el-div "color") "red") )) (deftest "global ($) variables are allowed at the feature level" (hs-cleanup!) diff --git a/tests/playwright/generate-sx-tests.py b/tests/playwright/generate-sx-tests.py index 16d18dda..0fe9c6f2 100644 --- a/tests/playwright/generate-sx-tests.py +++ b/tests/playwright/generate-sx-tests.py @@ -214,8 +214,10 @@ def parse_html(html): # Remove | separators html = html.replace(' | ', '') - # Fix escaped attribute delimiters from JSON extraction (\" → ") - html = html.replace('\\"', '"') + # Note: previously we collapsed `\"` → `"` here, but that destroys legitimate + # HS string escapes inside single-quoted `_='...'` attributes (e.g. nested + # button HTML in `properly processes hyperscript X` tests). HTMLParser handles + # backslashes in attribute values as literal characters, so we leave them. elements = [] stack = [] @@ -680,6 +682,17 @@ def pw_assertion_to_sx(target, negated, assert_type, args_str): elif assert_type == 'toHaveCSS': prop = args[0] if args else '' val = args[1] if len(args) >= 2 else '' + # Browsers normalize colors to rgb()/rgba(); our DOM mock returns the + # raw inline value. Map common rgb() forms back to keywords. + rgb_to_name = { + 'rgb(255, 0, 0)': 'red', + 'rgb(0, 255, 0)': 'green', + 'rgb(0, 0, 255)': 'blue', + 'rgb(0, 0, 0)': 'black', + 'rgb(255, 255, 255)': 'white', + } + if val in rgb_to_name: + val = rgb_to_name[val] escaped = val.replace('\\', '\\\\').replace('"', '\\"') if negated: return f'(assert (!= (dom-get-style {target} "{prop}") "{escaped}"))' @@ -764,7 +777,7 @@ def parse_dev_body(body, elements, var_names): m = re.search( r"expect\(find\((['\"])(.+?)\1\)(?:\.(?:first|last)\(\))?\)\.(not\.)?" r"(toHaveText|toHaveClass|toHaveCSS|toHaveAttribute|toHaveValue|toBeVisible|toBeHidden|toBeChecked)" - r"\(([^)]*)\)", + r"\(((?:[^()]|\([^()]*\))*)\)", line ) if m: @@ -956,6 +969,24 @@ def js_val_to_sx(val): return '(list)' items = [js_val_to_sx(x.strip()) for x in split_top_level(inner)] return '(list ' + ' '.join(items) + ')' + # Objects: { foo: "bar", baz: 1 } → {:foo "bar" :baz 1} + if val.startswith('{') and val.endswith('}'): + inner = val[1:-1].strip() + if not inner: + return '{}' + parts = [] + for kv in split_top_level(inner): + kv = kv.strip() + if not kv: + continue + # key: value (key is identifier or quoted string) + m = re.match(r'^(?:"([^"]+)"|\'([^\']+)\'|(\w+))\s*:\s*(.+)$', kv, re.DOTALL) + if not m: + return f'"{val}"' + key = m.group(1) or m.group(2) or m.group(3) + v = js_val_to_sx(m.group(4)) + parts.append(f':{key} {v}') + return '{' + ' '.join(parts) + '}' try: float(val) return val @@ -1044,12 +1075,13 @@ def generate_eval_only_test(test, idx): me_match = re.search(r'\bme:\s*(\d+)', opts_str) locals_match = re.search(r'locals:\s*\{([^}]+)\}', opts_str) if locals_match: - local_bindings = [] + local_pairs = [] for lm in re.finditer(r'(\w+)\s*:\s*([^,}]+)', locals_match.group(1)): lname = lm.group(1) lval = js_val_to_sx(lm.group(2).strip()) - local_bindings.append(f'({lname} {lval})') - assertions.append(f' (let ({" ".join(local_bindings)}) (assert= (eval-hs "{hs_expr}") {expected_sx}))') + local_pairs.append((lname, lval)) + locals_sx = '(list ' + ' '.join(f'(list (quote {n}) {v})' for n, v in local_pairs) + ')' if local_pairs else '(list)' + assertions.append(f' (assert= (eval-hs-locals "{hs_expr}" {locals_sx}) {expected_sx})') elif me_match: me_val = me_match.group(1) assertions.append(f' (assert= (eval-hs-with-me "{hs_expr}" {me_val}) {expected_sx})') @@ -1088,6 +1120,43 @@ def generate_eval_only_test(test, idx): if run_match: hs_expr = extract_hs_expr(run_match.group(2)) var_name = re.search(r'(?:var|let|const)\s+(\w+)', body).group(1) + # Capture locals from the run() call, if present. Use balanced-brace + # extraction so nested {a: {b: 1}} doesn't truncate at the inner }. + local_pairs = [] + locals_idx = body.find('locals:') + if locals_idx >= 0: + # Find the opening { after "locals:" + open_idx = body.find('{', locals_idx) + if open_idx >= 0: + depth = 0 + end_idx = -1 + in_str = None + for i in range(open_idx, len(body)): + ch = body[i] + if in_str: + if ch == in_str and body[i-1] != '\\': + in_str = None + continue + if ch in ('"', "'", '`'): + in_str = ch + continue + if ch == '{': + depth += 1 + elif ch == '}': + depth -= 1 + if depth == 0: + end_idx = i + break + if end_idx > open_idx: + locals_str = body[open_idx + 1:end_idx].strip() + for kv in split_top_level(locals_str): + kv = kv.strip() + m = re.match(r'^(\w+)\s*:\s*(.+)$', kv, re.DOTALL) + if m: + local_pairs.append((m.group(1), js_val_to_sx(m.group(2).strip()))) + locals_sx = '(list ' + ' '.join(f'(list (quote {n}) {v})' for n, v in local_pairs) + ')' if local_pairs else None + def eval_call(expr): + return f'(eval-hs-locals "{expr}" {locals_sx})' if locals_sx else f'(eval-hs "{expr}")' for m in re.finditer(r'expect\((' + re.escape(var_name) + r'(?:\["[^"]+"\]|\.\w+)?)\)\.toBe\(([^)]+)\)', body): accessor = m.group(1) expected_sx = js_val_to_sx(m.group(2)) @@ -1095,17 +1164,17 @@ def generate_eval_only_test(test, idx): prop_m = re.search(r'\["([^"]+)"\]|\.(\w+)', accessor[len(var_name):]) if prop_m: prop = prop_m.group(1) or prop_m.group(2) - assertions.append(f' (assert= (host-get (eval-hs "{hs_expr}") "{prop}") {expected_sx})') + assertions.append(f' (assert= (host-get {eval_call(hs_expr)} "{prop}") {expected_sx})') else: - assertions.append(f' (assert= (eval-hs "{hs_expr}") {expected_sx})') + assertions.append(f' (assert= {eval_call(hs_expr)} {expected_sx})') for m in re.finditer(r'expect\(' + re.escape(var_name) + r'(?:\.\w+)?\)\.toEqual\((\[.*?\])\)', body, re.DOTALL): expected_sx = js_val_to_sx(m.group(1)) - assertions.append(f' (assert= (eval-hs "{hs_expr}") {expected_sx})') + assertions.append(f' (assert= {eval_call(hs_expr)} {expected_sx})') # Handle .map(x => x.prop) before toEqual for m in re.finditer(r'expect\(' + re.escape(var_name) + r'\.map\(\w+\s*=>\s*\w+\.(\w+)\)\)\.toEqual\((\[.*?\])\)', body, re.DOTALL): prop = m.group(1) expected_sx = js_val_to_sx(m.group(2)) - assertions.append(f' (assert= (map (fn (x) (get x "{prop}")) (eval-hs "{hs_expr}")) {expected_sx})') + assertions.append(f' (assert= (map (fn (x) (get x "{prop}")) {eval_call(hs_expr)}) {expected_sx})') # Pattern 2b: run() with locals + evaluate(window.X) + expect().toBe/toEqual # e.g.: await run(`expr`, {locals: {arr: [1,2,3]}}); @@ -1480,13 +1549,24 @@ output.append('(define hs-cleanup!') output.append(' (fn ()') output.append(' (dom-set-inner-html (dom-body) "")))') output.append('') -output.append(';; Evaluate a hyperscript expression and return the last-expression value.') -output.append(';; Compiles the expression, wraps in a thunk, evaluates, returns result.') +output.append(';; Evaluate a hyperscript expression and return either the expression') +output.append(';; value or `it` (whichever is non-nil). Multi-statement scripts that') +output.append(';; mutate `it` (e.g. `pick first 3 of arr; set $test to it`) get `it` back;') +output.append(';; bare expressions (e.g. `foo.foo`) get the expression value back.') +output.append('(define _hs-wrap-body') +output.append(' (fn (sx)') +output.append(' (list (quote let)') +output.append(' (list (list (quote it) nil) (list (quote event) nil))') +output.append(' (list (quote let)') +output.append(' (list (list (quote _ret) sx))') +output.append(' (list (quote if) (list (quote nil?) (quote _ret)) (quote it) (quote _ret))))))') +output.append('') output.append('(define eval-hs') output.append(' (fn (src)') output.append(' (let ((sx (hs-to-sx (hs-compile src))))') output.append(' (let ((handler (eval-expr-cek') -output.append(' (list (quote fn) (list (quote me)) (list (quote let) (list (list (quote it) nil) (list (quote event) nil)) sx)))))') +output.append(' (list (quote fn) (list (quote me))') +output.append(' (list (quote let) (list (list (quote it) nil) (list (quote event) nil)) sx)))))') output.append(' (guard') output.append(' (_e') output.append(' (true') @@ -1497,18 +1577,16 @@ output.append(' (raise _e))))') output.append(' (handler nil))))))') output.append('') output.append(';; Evaluate a hyperscript expression with locals. bindings = list of (symbol value).') -output.append(';; The locals are injected as fn params so they resolve in the handler body.') +output.append(';; Locals are injected as a `let` wrapping the compiled body, then evaluated') +output.append(';; in a fresh CEK env. Avoids `apply` (whose JIT path can loop on some forms).') output.append('(define eval-hs-locals') output.append(' (fn (src bindings)') output.append(' (let ((sx (hs-to-sx (hs-compile src))))') -output.append(' (let ((names (map (fn (b) (first b)) bindings))') -output.append(' (vals (map (fn (b) (nth b 1)) bindings)))') -output.append(' (let ((param-list (cons (quote me) names)))') -output.append(' (let ((wrapper (list (quote fn) param-list') -output.append(' (list (quote let)') -output.append(' (list (list (quote it) nil) (list (quote event) nil))') -output.append(' sx (quote it)))))') -output.append(' (let ((handler (eval-expr-cek wrapper)))') +output.append(' ;; Build (let ((name1 (quote val1)) ...) )') +output.append(' (let ((let-binds (map (fn (b) (list (first b) (list (quote quote) (nth b 1)))) bindings)))') +output.append(' (let ((wrapped (list (quote let) let-binds (_hs-wrap-body sx))))') +output.append(' (let ((thunk (list (quote fn) (list (quote me)) wrapped)))') +output.append(' (let ((handler (eval-expr-cek thunk)))') output.append(' (guard') output.append(' (_e') output.append(' (true') @@ -1516,14 +1594,14 @@ output.append(' (if') output.append(' (and (list? _e) (= (first _e) "hs-return"))') output.append(' (nth _e 1)') output.append(' (raise _e))))') -output.append(' (apply handler (cons nil vals))))))))))') +output.append(' (handler nil)))))))))') output.append('') output.append(';; Evaluate with a specific me value (for "I am between" etc.)') output.append('(define eval-hs-with-me') output.append(' (fn (src me-val)') output.append(' (let ((sx (hs-to-sx (hs-compile src))))') output.append(' (let ((handler (eval-expr-cek') -output.append(' (list (quote fn) (list (quote me)) (list (quote let) (list (list (quote it) nil) (list (quote event) nil)) sx)))))') +output.append(' (list (quote fn) (list (quote me)) (_hs-wrap-body sx)))))') output.append(' (guard') output.append(' (_e') output.append(' (true')