From ed4256107189fda2fce9db278285253511a9f06f Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 13:09:17 +0000 Subject: [PATCH] HS: computed property names in object literals (+1 test) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Parser: bracket-open in obj-collect key cond → (computed-key expr). Compiler: detect computed-key list at object-literal pair key and compile the inner expression instead of emitting a literal string. Generator: special case for 'expressions work in object literal field names' using eval-hs-locals with host-callback so hs-win-call can find the fn. Co-Authored-By: Claude Sonnet 4.6 --- lib/hyperscript/compiler.sx | 9 +- lib/hyperscript/parser.sx | 2 +- shared/static/wasm/sx/hs-compiler.sx | 36 +- shared/static/wasm/sx/hs-parser.sx | 41 ++- spec/tests/test-hyperscript-behavioral.sx | 394 ++++++++-------------- tests/playwright/generate-sx-tests.py | 16 + 6 files changed, 237 insertions(+), 261 deletions(-) diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index 56296304..07c4d91c 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -933,7 +933,14 @@ (pair) (list (quote list) - (first pair) + (if + (and + (list? (first pair)) + (= + (first (first pair)) + (quote computed-key))) + (hs-to-sx (nth (first pair) 1)) + (first pair)) (hs-to-sx (nth pair 1)))) pairs))))))) ((= head (quote template)) diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index 9638bc03..e245f39c 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -378,7 +378,7 @@ (or (at-end?) (= (tp-type) "brace-close")) (do (when (= (tp-type) "brace-close") (adv!)) acc) (let - ((key (cond ((= (tp-type) "string") (let ((k (tp-val))) (do (adv!) k))) (true (let ((k (tp-val))) (do (adv!) k)))))) + ((key (cond ((= (tp-type) "string") (let ((k (tp-val))) (do (adv!) k))) ((= (tp-type) "bracket-open") (do (adv!) (let ((expr (parse-expr))) (do (when (= (tp-type) "bracket-close") (adv!)) (list (quote computed-key) expr))))) (true (let ((k (tp-val))) (do (adv!) k)))))) (let ((value (cond ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (cond ((= v "true") true) ((= v "false") false) ((= v "null") nil) (true (list (quote ref) v)))))) ((= (tp-type) "colon") (do (adv!) (parse-expr))) (true (parse-expr))))) (do diff --git a/shared/static/wasm/sx/hs-compiler.sx b/shared/static/wasm/sx/hs-compiler.sx index ff8dcb5c..07c4d91c 100644 --- a/shared/static/wasm/sx/hs-compiler.sx +++ b/shared/static/wasm/sx/hs-compiler.sx @@ -237,7 +237,7 @@ (let ((compiled-body (let ((base (if (> (len event-refs) 0) (let ((bindings (map (fn (r) (let ((name (nth r 1))) (list (make-symbol name) (list (quote let) (list (list (quote _det) (list (quote host-get) (quote event) "detail"))) (list (quote if) (list (quote and) (quote _det) (list (quote not) (list (quote nil?) (list (quote host-get) (quote _det) name)))) (list (quote host-get) (quote _det) name) (list (quote host-get) (quote event) name)))))) event-refs))) (list (quote let) bindings raw-compiled)) raw-compiled))) (if elsewhere? (list (quote when) (list (quote not) (list (quote host-call) (quote me) "contains" (list (quote host-get) (quote event) "target"))) base) base)))) (let - ((wrapped-body (if catch-info (let ((var (make-symbol (nth catch-info 0))) (catch-body (hs-to-sx (nth catch-info 1)))) (if finally-info (list (quote let) (list (list (quote __hs-exc) nil) (list (quote __hs-reraise) false)) (list (quote do) (list (quote guard) (list var (list true (list (quote let) (list (list var (list (quote host-hs-normalize-exc) var))) (list (quote guard) (list (quote __inner-exc) (list true (list (quote do) (list (quote set!) (quote __hs-exc) (quote __inner-exc)) (list (quote set!) (quote __hs-reraise) true)))) catch-body)))) compiled-body) (hs-to-sx finally-info) (list (quote when) (quote __hs-reraise) (list (quote raise) (quote __hs-exc))))) (list (quote let) (list (list (quote __hs-exc) nil) (list (quote __hs-reraise) false)) (list (quote guard) (list var (list true (list (quote let) (list (list var (list (quote host-hs-normalize-exc) var))) (list (quote guard) (list (quote __inner-exc) (list true (list (quote do) (list (quote set!) (quote __hs-exc) (quote __inner-exc)) (list (quote set!) (quote __hs-reraise) true)))) catch-body)))) compiled-body) (list (quote when) (quote __hs-reraise) (list (quote raise) (quote __hs-exc)))))) (if finally-info (list (quote do) compiled-body (hs-to-sx finally-info)) compiled-body)))) + ((wrapped-body (if catch-info (let ((var (make-symbol (nth catch-info 0))) (catch-body (hs-to-sx (nth catch-info 1)))) (if finally-info (list (quote let) (list (list (quote __hs-exc) nil) (list (quote __hs-reraise) false)) (list (quote do) (list (quote guard) (list var (list true (list (quote let) (list (list var (list (quote host-hs-normalize-exc) var))) (list (quote guard) (list (quote __inner-exc) (list true (list (quote do) (list (quote set!) (quote __hs-exc) (quote __inner-exc)) (list (quote set!) (quote __hs-reraise) true)))) catch-body)))) compiled-body) (hs-to-sx finally-info) (list (quote when) (quote __hs-reraise) (list (quote raise) (quote __hs-exc))))) (list (quote let) (list (list (quote __hs-exc) nil) (list (quote __hs-reraise) false)) (list (quote do) (list (quote guard) (list var (list true (list (quote let) (list (list var (list (quote host-hs-normalize-exc) var))) (list (quote guard) (list (quote __inner-exc) (list true (list (quote do) (list (quote set!) (quote __hs-exc) (quote __inner-exc)) (list (quote set!) (quote __hs-reraise) true)))) catch-body)))) compiled-body) (list (quote when) (quote __hs-reraise) (list (quote raise) (quote __hs-exc))))))) (if finally-info (list (quote do) compiled-body (hs-to-sx finally-info)) compiled-body)))) (let ((handler (let ((uses-the-result? (fn (expr) (cond ((= expr (quote the-result)) true) ((list? expr) (some (fn (x) (uses-the-result? x)) expr)) (true false))))) (let ((base-handler (list (quote fn) (list (quote event)) (if (uses-the-result? wrapped-body) (list (quote let) (list (list (quote the-result) nil)) wrapped-body) wrapped-body)))) (if count-filter-info (let ((mn (get count-filter-info "min")) (mx (get count-filter-info "max"))) (list (quote let) (list (list (quote __hs-count) 0)) (list (quote fn) (list (quote event)) (list (quote begin) (list (quote set!) (quote __hs-count) (list (quote +) (quote __hs-count) 1)) (list (quote when) (if (= mx -1) (list (quote >=) (quote __hs-count) mn) (list (quote and) (list (quote >=) (quote __hs-count) mn) (list (quote <=) (quote __hs-count) mx))) (nth base-handler 2)))))) base-handler))))) (let @@ -933,7 +933,14 @@ (pair) (list (quote list) - (first pair) + (if + (and + (list? (first pair)) + (= + (first (first pair)) + (quote computed-key))) + (hs-to-sx (nth (first pair) 1)) + (first pair)) (hs-to-sx (nth pair 1)))) pairs))))))) ((= head (quote template)) @@ -2017,7 +2024,11 @@ ((= head (quote wait)) (list (quote hs-wait) (nth ast 1))) ((= head (quote wait-for)) (emit-wait-for ast)) ((= head (quote log)) - (list (quote console-log) (hs-to-sx (nth ast 1)))) + (cons + (quote do) + (map + (fn (arg) (list (quote console-log) (hs-to-sx arg))) + (rest ast)))) ((= head (quote send)) (emit-send ast)) ((= head (quote trigger)) (let @@ -2352,6 +2363,25 @@ ((= head (quote live-no-op)) nil) ((= head (quote when-feat-no-op)) nil) ((= head (quote bind-feat)) nil) + ((= head (quote socket)) + (let + ((name-path (nth ast 1)) + (url (nth ast 2)) + (timeout (nth ast 3)) + (on-message (nth ast 4))) + (let + ((handler-sx (if (and (list? on-message) (= (first on-message) (quote on-message))) (list (quote fn) (list (quote event)) (hs-to-sx (nth on-message 2))) nil))) + (let + ((json? (if (and (list? on-message) (= (first on-message) (quote on-message))) (nth on-message 1) false))) + (list + (quote hs-socket-register!) + (cons + (quote list) + (map (fn (seg) seg) name-path)) + (hs-to-sx url) + (hs-to-sx timeout) + handler-sx + json?))))) ((= head (quote on)) (emit-on ast)) ((= head (quote when-changes)) (let diff --git a/shared/static/wasm/sx/hs-parser.sx b/shared/static/wasm/sx/hs-parser.sx index 5f718cb6..e245f39c 100644 --- a/shared/static/wasm/sx/hs-parser.sx +++ b/shared/static/wasm/sx/hs-parser.sx @@ -378,7 +378,7 @@ (or (at-end?) (= (tp-type) "brace-close")) (do (when (= (tp-type) "brace-close") (adv!)) acc) (let - ((key (cond ((= (tp-type) "string") (let ((k (tp-val))) (do (adv!) k))) (true (let ((k (tp-val))) (do (adv!) k)))))) + ((key (cond ((= (tp-type) "string") (let ((k (tp-val))) (do (adv!) k))) ((= (tp-type) "bracket-open") (do (adv!) (let ((expr (parse-expr))) (do (when (= (tp-type) "bracket-close") (adv!)) (list (quote computed-key) expr))))) (true (let ((k (tp-val))) (do (adv!) k)))))) (let ((value (cond ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (cond ((= v "true") true) ((= v "false") false) ((= v "null") nil) (true (list (quote ref) v)))))) ((= (tp-type) "colon") (do (adv!) (parse-expr))) (true (parse-expr))))) (do @@ -3178,6 +3178,35 @@ (match-kw "end") (list (quote bind-feat) lhs rhs))) (true (do (match-kw "end") (list (quote bind-feat) lhs nil))))))) + (define + parse-socket-feat + (fn + () + (let + ((first-seg (tp-val))) + (do + (adv!) + (define + collect-dots! + (fn + (acc) + (if + (= (tp-type) "class") + (let + ((seg (tp-val))) + (do (adv!) (collect-dots! (append acc (list seg))))) + acc))) + (let + ((name-path (collect-dots! (list first-seg)))) + (let + ((url (parse-arith (parse-poss (parse-atom))))) + (let + ((timeout (if (match-kw "with") (do (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (= (tp-val) "timeout")) (adv!)) (parse-arith (parse-poss (parse-atom)))) nil))) + (let + ((on-message (if (and (= (tp-type) "keyword") (= (tp-val) "on")) (do (adv!) (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (= (tp-val) "message")) (do (adv!) (let ((json? (if (match-kw "as") (do (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (= (tp-val) "JSON")) (adv!)) true) false))) (let ((body (parse-cmd-list))) (list (quote on-message) json? body)))))) nil))) + (do + (match-kw "end") + (list (quote socket) name-path url timeout on-message)))))))))) (define parse-feat (fn @@ -3218,6 +3247,7 @@ (error "worker plugin is not installed — see https://hyperscript.org/features/worker")) ((= val "bind") (do (adv!) (parse-bind-feat))) + ((= val "socket") (do (adv!) (parse-socket-feat))) (true (if (= (tp-type) "keyword") @@ -3263,9 +3293,12 @@ (define hs-compile (fn (src) (hs-parse (hs-tokenize src) src))) -(define hs-parse-ast - (fn (src) +(define + hs-parse-ast + (fn + (src) (do (set! hs-span-mode true) - (let ((result (hs-parse (hs-tokenize src) src))) + (let + ((result (hs-parse (hs-tokenize src) src))) (do (set! hs-span-mode false) result))))) diff --git a/spec/tests/test-hyperscript-behavioral.sx b/spec/tests/test-hyperscript-behavioral.sx index 13685037..a1054a03 100644 --- a/spec/tests/test-hyperscript-behavioral.sx +++ b/spec/tests/test-hyperscript-behavioral.sx @@ -6078,7 +6078,15 @@ ;; TODO: assert= (eval-hs "{}") against {} ) (deftest "expressions work in object literal field names" - (error "SKIP (untranslated): expressions work in object literal field names")) + (hs-cleanup!) + (assert-equal + {:bar true :foo false} + (hs-strip-order-deep + (eval-hs-locals "{[foo]:true, [bar()]:false}" + (list + (list (quote foo) "bar") + (list (quote bar) (host-callback (fn () "foo"))))))) + ) (deftest "hyphens work in object literal field names" ;; TODO: assert= (eval-hs "{-foo:true, bar-baz:false}") against { "-foo": true, "bar-baz": false } ) @@ -12113,382 +12121,264 @@ ) ;; ── socket (16 tests) ── -(defsuite - "hs-upstream-socket" - (deftest - "converts relative URL to ws:// on http pages" +(defsuite "hs-upstream-socket" + (deftest "converts relative URL to ws:// on http pages" (hs-cleanup!) (host-set! (host-global "globalThis") "__hs_ws_created" nil) - (let - ((_el (dom-create-element "div"))) + (let ((_el (dom-create-element "div"))) (dom-set-attr _el "_" "socket _T1Sock \"/ws\" end") (dom-append (dom-body) _el) (hs-activate! _el) - (let - ((_created (host-get (host-global "globalThis") "__hs_ws_created"))) - (assert= (host-get (host-get _created 0) "url") "ws://localhost/ws")))) - (deftest - "converts relative URL to wss:// on https pages" + (let ((_created (host-get (host-global "globalThis") "__hs_ws_created"))) + (assert= (host-get (host-get _created 0) "url") "ws://localhost/ws"))) + ) + (deftest "converts relative URL to wss:// on https pages" (hs-cleanup!) (host-set! (host-global "globalThis") "__hs_ws_created" nil) - (let - ((_orig-proto (host-get (host-global "location") "protocol")) - (_orig-host (host-get (host-global "location") "host"))) + (let ((_orig-proto (host-get (host-global "location") "protocol")) + (_orig-host (host-get (host-global "location") "host"))) (do (host-set! (host-global "location") "protocol" "https:") (host-set! (host-global "location") "host" "secure.example.com") - (let - ((_el (dom-create-element "div"))) + (let ((_el (dom-create-element "div"))) (dom-set-attr _el "_" "socket _T2Sock \"/wss-test\" end") (dom-append (dom-body) _el) (hs-activate! _el) - (let - ((_url (host-get (host-get (host-get (host-global "globalThis") "__hs_ws_created") 0) "url"))) + (let ((_url (host-get (host-get (host-get (host-global "globalThis") "__hs_ws_created") 0) "url"))) (do (host-set! (host-global "location") "protocol" _orig-proto) (host-set! (host-global "location") "host" _orig-host) - (assert= _url "wss://secure.example.com/wss-test"))))))) - (deftest - "dispatchEvent sends JSON-encoded event over the socket" + (assert= _url "wss://secure.example.com/wss-test")))))) + ) + (deftest "dispatchEvent sends JSON-encoded event over the socket" (hs-cleanup!) (host-set! (host-global "globalThis") "__hs_ws_created" nil) - (let - ((_el (dom-create-element "div"))) + (let ((_el (dom-create-element "div"))) (dom-set-attr _el "_" "socket _T3Sock \"/ws\" end") (dom-append (dom-body) _el) (hs-activate! _el) - (let - ((_wrapper (host-get (host-global "window") "_T3Sock")) - (_ws - (host-get - (host-get (host-global "globalThis") "__hs_ws_created") - 0))) - (let - ((_evt (host-new "Object"))) + (let ((_wrapper (host-get (host-global "window") "_T3Sock")) + (_ws (host-get (host-get (host-global "globalThis") "__hs_ws_created") 0))) + (let ((_evt (host-new "Object"))) (host-set! _evt "type" "greet") - (let - ((_detail (host-new "Object"))) + (let ((_detail (host-new "Object"))) (host-set! _detail "name" "world") (host-set! _detail "sender" "ignored") (host-set! _evt "detail" _detail) (host-call-fn (host-get _wrapper "dispatchEvent") (list _evt)) - (let - ((_msg (json-parse (host-get (host-get _ws "_sent") 0)))) + (let ((_msg (json-parse (host-get (host-get _ws "_sent") 0)))) (do (assert= (host-get _msg "type") "greet") - (assert= (host-get _msg "name") "world")))))))) - (deftest - "namespaced sockets work" + (assert= (host-get _msg "name") "world"))))))) + ) + (deftest "namespaced sockets work" (hs-cleanup!) (host-set! (host-global "globalThis") "__hs_ws_created" nil) - (let - ((_el (dom-create-element "div"))) + (let ((_el (dom-create-element "div"))) (dom-set-attr _el "_" "socket _T4App.Chat \"/ws\" end") (dom-append (dom-body) _el) (hs-activate! _el) - (let - ((_ns (host-get (host-global "window") "_T4App"))) + (let ((_ns (host-get (host-global "window") "_T4App"))) (do (assert (not (nil? _ns))) - (assert (not (nil? (host-get _ns "Chat")))))))) - (deftest - "on message as JSON handler decodes JSON payload" + (assert (not (nil? (host-get _ns "Chat"))))))) + ) + (deftest "on message as JSON handler decodes JSON payload" (hs-cleanup!) (host-set! (host-global "globalThis") "__hs_ws_created" nil) (host-set! (host-global "window") "_t5got" nil) - (let - ((_el (dom-create-element "div"))) - (dom-set-attr - _el - "_" - "socket _T5Sock \"/ws\" on message as JSON set window._t5got to the event end") + (let ((_el (dom-create-element "div"))) + (dom-set-attr _el "_" "socket _T5Sock \"/ws\" on message as JSON set window._t5got to the event end") (dom-append (dom-body) _el) (hs-activate! _el) - (let - ((_ws (host-get (host-get (host-global "globalThis") "__hs_ws_created") 0))) - (let - ((_handler (host-get _ws "onmessage"))) - (let - ((_evt (host-new "Object"))) + (let ((_ws (host-get (host-get (host-global "globalThis") "__hs_ws_created") 0))) + (let ((_handler (host-get _ws "onmessage"))) + (let ((_evt (host-new "Object"))) (host-set! _evt "data" "{\"greeting\":\"hello\"}") (host-call-fn _handler (list _evt)) - (assert= - (host-get - (host-get (host-global "window") "_t5got") - "greeting") - "hello")))))) - (deftest - "on message as JSON throws on non-JSON payload" + (assert= (host-get (host-get (host-global "window") "_t5got") "greeting") "hello"))))) + ) + (deftest "on message as JSON throws on non-JSON payload" (hs-cleanup!) (host-set! (host-global "globalThis") "__hs_ws_created" nil) (host-set! (host-global "window") "_t6got" nil) - (let - ((_el (dom-create-element "div"))) - (dom-set-attr - _el - "_" - "socket _T6Sock \"/ws\" on message as JSON set window._t6got to the event end") + (let ((_el (dom-create-element "div"))) + (dom-set-attr _el "_" "socket _T6Sock \"/ws\" on message as JSON set window._t6got to the event end") (dom-append (dom-body) _el) (hs-activate! _el) - (let - ((_ws (host-get (host-get (host-global "globalThis") "__hs_ws_created") 0))) - (let - ((_handler (host-get _ws "onmessage"))) - (let - ((_evt (host-new "Object"))) + (let ((_ws (host-get (host-get (host-global "globalThis") "__hs_ws_created") 0))) + (let ((_handler (host-get _ws "onmessage"))) + (let ((_evt (host-new "Object"))) (host-set! _evt "data" "not-valid-json") (host-call-fn _handler (list _evt)) - (assert (nil? (host-get (host-global "window") "_t6got")))))))) - (deftest - "on message handler fires on incoming text message" + (assert (nil? (host-get (host-global "window") "_t6got"))))))) + ) + (deftest "on message handler fires on incoming text message" (hs-cleanup!) (host-set! (host-global "globalThis") "__hs_ws_created" nil) (host-set! (host-global "window") "_t7got" nil) - (let - ((_el (dom-create-element "div"))) - (dom-set-attr - _el - "_" - "socket _T7Sock \"/ws\" on message set window._t7got to the event.data end") + (let ((_el (dom-create-element "div"))) + (dom-set-attr _el "_" "socket _T7Sock \"/ws\" on message set window._t7got to the event.data end") (dom-append (dom-body) _el) (hs-activate! _el) - (let - ((_ws (host-get (host-get (host-global "globalThis") "__hs_ws_created") 0))) - (let - ((_handler (host-get _ws "onmessage"))) - (let - ((_evt (host-new "Object"))) + (let ((_ws (host-get (host-get (host-global "globalThis") "__hs_ws_created") 0))) + (let ((_handler (host-get _ws "onmessage"))) + (let ((_evt (host-new "Object"))) (host-set! _evt "data" "hello") (host-call-fn _handler (list _evt)) - (assert= (host-get (host-global "window") "_t7got") "hello")))))) - (deftest - "parses socket with absolute ws:// URL" + (assert= (host-get (host-global "window") "_t7got") "hello"))))) + ) + (deftest "parses socket with absolute ws:// URL" (hs-cleanup!) (host-set! (host-global "globalThis") "__hs_ws_created" nil) - (let - ((_el (dom-create-element "div"))) + (let ((_el (dom-create-element "div"))) (dom-set-attr _el "_" "socket _T8Sock \"ws://example.com/ws\" end") (dom-append (dom-body) _el) (hs-activate! _el) - (let - ((_created (host-get (host-global "globalThis") "__hs_ws_created"))) - (assert= - (host-get (host-get _created 0) "url") - "ws://example.com/ws")))) - (deftest - "rpc proxy blacklists then/catch/length/toJSON" + (let ((_created (host-get (host-global "globalThis") "__hs_ws_created"))) + (assert= (host-get (host-get _created 0) "url") "ws://example.com/ws"))) + ) + (deftest "rpc proxy blacklists then/catch/length/toJSON" (hs-cleanup!) (host-set! (host-global "globalThis") "__hs_ws_created" nil) - (let - ((_el (dom-create-element "div"))) + (let ((_el (dom-create-element "div"))) (dom-set-attr _el "_" "socket _T9Sock \"ws://localhost/ws\" end") (dom-append (dom-body) _el) (hs-activate! _el) - (let - ((_rpc (host-get (host-get (host-global "window") "_T9Sock") "rpc"))) + (let ((_rpc (host-get (host-get (host-global "window") "_T9Sock") "rpc"))) (do (assert (nil? (host-get _rpc "then"))) (assert (nil? (host-get _rpc "catch"))) (assert (nil? (host-get _rpc "length"))) - (assert (nil? (host-get _rpc "toJSON"))))))) - (deftest - "rpc proxy default timeout rejects the promise" + (assert (nil? (host-get _rpc "toJSON")))))) + ) + (deftest "rpc proxy default timeout rejects the promise" (hs-cleanup!) (host-set! (host-global "globalThis") "__hs_ws_created" nil) - (let - ((_el (dom-create-element "div"))) + (let ((_el (dom-create-element "div"))) (dom-set-attr _el "_" "socket _T10Sock \"ws://localhost/ws\" end") (dom-append (dom-body) _el) (hs-activate! _el) - (let - ((_wrapper (host-get (host-global "window") "_T10Sock")) - (_ws - (host-get - (host-get (host-global "globalThis") "__hs_ws_created") - 0)) - (_orig-st (host-global "setTimeout"))) + (let ((_wrapper (host-get (host-global "window") "_T10Sock")) + (_ws (host-get (host-get (host-global "globalThis") "__hs_ws_created") 0)) + (_orig-st (host-global "setTimeout"))) (do - (host-set! - (host-global "globalThis") - "setTimeout" + (host-set! (host-global "globalThis") "setTimeout" (host-callback (fn (thunk ms) (host-call-fn thunk (list))))) - (host-call-fn - (host-get (host-get _wrapper "rpc") "greet") - (list "world")) + (host-call-fn (host-get (host-get _wrapper "rpc") "greet") (list "world")) (host-set! (host-global "globalThis") "setTimeout" _orig-st) - (let - ((_sent-str (host-get (host-get _ws "_sent") 0))) - (let - ((_iid (host-get (json-parse _sent-str) "iid"))) - (assert (nil? (host-get (host-get _wrapper "_pending") _iid))))))))) - (deftest - "rpc proxy noTimeout avoids timeout rejection" + (let ((_sent-str (host-get (host-get _ws "_sent") 0))) + (let ((_iid (host-get (json-parse _sent-str) "iid"))) + (assert (nil? (host-get (host-get _wrapper "_pending") _iid)))))))) + ) + (deftest "rpc proxy noTimeout avoids timeout rejection" (hs-cleanup!) (host-set! (host-global "globalThis") "__hs_ws_created" nil) - (let - ((_el (dom-create-element "div"))) + (let ((_el (dom-create-element "div"))) (dom-set-attr _el "_" "socket _T11Sock \"ws://localhost/ws\" end") (dom-append (dom-body) _el) (hs-activate! _el) - (let - ((_wrapper (host-get (host-global "window") "_T11Sock")) - (_st-calls 0) - (_orig-st (host-global "setTimeout"))) + (let ((_wrapper (host-get (host-global "window") "_T11Sock")) + (_st-calls 0) + (_orig-st (host-global "setTimeout"))) (do - (host-set! - (host-global "globalThis") - "setTimeout" - (host-callback - (fn (thunk ms) (set! _st-calls (+ _st-calls 1))))) - (let - ((_no-timeout-proxy (host-get (host-get _wrapper "rpc") "noTimeout"))) - (host-call-fn - (host-get _no-timeout-proxy "greet") - (list "world"))) + (host-set! (host-global "globalThis") "setTimeout" + (host-callback (fn (thunk ms) (set! _st-calls (+ _st-calls 1))))) + (let ((_no-timeout-proxy (host-get (host-get _wrapper "rpc") "noTimeout"))) + (host-call-fn (host-get _no-timeout-proxy "greet") (list "world"))) (host-set! (host-global "globalThis") "setTimeout" _orig-st) - (assert= _st-calls 0))))) - (deftest - "rpc proxy reply with throw rejects the promise" + (assert= _st-calls 0)))) + ) + (deftest "rpc proxy reply with throw rejects the promise" (hs-cleanup!) (host-set! (host-global "globalThis") "__hs_ws_created" nil) - (let - ((_el (dom-create-element "div"))) + (let ((_el (dom-create-element "div"))) (dom-set-attr _el "_" "socket _T12Sock \"ws://localhost/ws\" end") (dom-append (dom-body) _el) (hs-activate! _el) - (let - ((_wrapper (host-get (host-global "window") "_T12Sock")) - (_ws - (host-get - (host-get (host-global "globalThis") "__hs_ws_created") - 0))) + (let ((_wrapper (host-get (host-global "window") "_T12Sock")) + (_ws (host-get (host-get (host-global "globalThis") "__hs_ws_created") 0))) (do - (host-call-fn - (host-get (host-get _wrapper "rpc") "greet") - (list "world")) - (let - ((_iid (host-get (json-parse (host-get (host-get _ws "_sent") 0)) "iid"))) - (let - ((_reply (host-new "Object"))) + (host-call-fn (host-get (host-get _wrapper "rpc") "greet") (list "world")) + (let ((_iid (host-get (json-parse (host-get (host-get _ws "_sent") 0)) "iid"))) + (let ((_reply (host-new "Object"))) (host-set! _reply "iid" _iid) (host-set! _reply "throw" "boom") - (let - ((_handler (host-get _ws "onmessage"))) - (let - ((_evt (host-new "Object"))) - (host-set! - _evt - "data" - (host-call (host-global "JSON") "stringify" _reply)) + (let ((_handler (host-get _ws "onmessage"))) + (let ((_evt (host-new "Object"))) + (host-set! _evt "data" (host-call (host-global "JSON") "stringify" _reply)) (host-call-fn _handler (list _evt)) - (assert - (nil? (host-get (host-get _wrapper "_pending") _iid))))))))))) - (deftest - "rpc proxy sends a message and resolves the reply" + (assert (nil? (host-get (host-get _wrapper "_pending") _iid)))))))))) + ) + (deftest "rpc proxy sends a message and resolves the reply" (hs-cleanup!) (host-set! (host-global "globalThis") "__hs_ws_created" nil) - (let - ((_el (dom-create-element "div"))) + (let ((_el (dom-create-element "div"))) (dom-set-attr _el "_" "socket _T13Sock \"ws://localhost/ws\" end") (dom-append (dom-body) _el) (hs-activate! _el) - (let - ((_wrapper (host-get (host-global "window") "_T13Sock")) - (_ws - (host-get - (host-get (host-global "globalThis") "__hs_ws_created") - 0))) + (let ((_wrapper (host-get (host-global "window") "_T13Sock")) + (_ws (host-get (host-get (host-global "globalThis") "__hs_ws_created") 0))) (do - (host-call-fn - (host-get (host-get _wrapper "rpc") "greet") - (list "world")) - (let - ((_sent (json-parse (host-get (host-get _ws "_sent") 0)))) + (host-call-fn (host-get (host-get _wrapper "rpc") "greet") (list "world")) + (let ((_sent (json-parse (host-get (host-get _ws "_sent") 0)))) (do (assert= (host-get _sent "function") "greet") - (let - ((_iid (host-get _sent "iid"))) - (let - ((_reply (host-new "Object"))) + (let ((_iid (host-get _sent "iid"))) + (let ((_reply (host-new "Object"))) (host-set! _reply "iid" _iid) (host-set! _reply "return" "got it") - (let - ((_handler (host-get _ws "onmessage"))) - (let - ((_evt (host-new "Object"))) - (host-set! - _evt - "data" - (host-call (host-global "JSON") "stringify" _reply)) + (let ((_handler (host-get _ws "onmessage"))) + (let ((_evt (host-new "Object"))) + (host-set! _evt "data" (host-call (host-global "JSON") "stringify" _reply)) (host-call-fn _handler (list _evt)) - (assert - (nil? (host-get (host-get _wrapper "_pending") _iid))))))))))))) - (deftest - "rpc proxy timeout(n) rejects after a custom window" + (assert (nil? (host-get (host-get _wrapper "_pending") _iid)))))))))))) + ) + (deftest "rpc proxy timeout(n) rejects after a custom window" (hs-cleanup!) (host-set! (host-global "globalThis") "__hs_ws_created" nil) - (let - ((_el (dom-create-element "div"))) + (let ((_el (dom-create-element "div"))) (dom-set-attr _el "_" "socket _T14Sock \"ws://localhost/ws\" end") (dom-append (dom-body) _el) (hs-activate! _el) - (let - ((_wrapper (host-get (host-global "window") "_T14Sock")) - (_ws - (host-get - (host-get (host-global "globalThis") "__hs_ws_created") - 0)) - (_orig-st (host-global "setTimeout"))) + (let ((_wrapper (host-get (host-global "window") "_T14Sock")) + (_ws (host-get (host-get (host-global "globalThis") "__hs_ws_created") 0)) + (_orig-st (host-global "setTimeout"))) (do - (host-set! - (host-global "globalThis") - "setTimeout" + (host-set! (host-global "globalThis") "setTimeout" (host-callback (fn (thunk ms) (host-call-fn thunk (list))))) - (let - ((_t100-fn (host-call-fn (host-get (host-get _wrapper "rpc") "timeout") (list 100)))) + (let ((_t100-fn (host-call-fn (host-get (host-get _wrapper "rpc") "timeout") (list 100)))) (host-call-fn (host-get _t100-fn "greet") (list "world"))) (host-set! (host-global "globalThis") "setTimeout" _orig-st) - (let - ((_iid (host-get (json-parse (host-get (host-get _ws "_sent") 0)) "iid"))) - (assert (nil? (host-get (host-get _wrapper "_pending") _iid)))))))) - (deftest - "rpc reconnects after the underlying socket closes" + (let ((_iid (host-get (json-parse (host-get (host-get _ws "_sent") 0)) "iid"))) + (assert (nil? (host-get (host-get _wrapper "_pending") _iid))))))) + ) + (deftest "rpc reconnects after the underlying socket closes" (hs-cleanup!) (host-set! (host-global "globalThis") "__hs_ws_created" nil) - (let - ((_el (dom-create-element "div"))) + (let ((_el (dom-create-element "div"))) (dom-set-attr _el "_" "socket _T15Sock \"ws://localhost/ws\" end") (dom-append (dom-body) _el) (hs-activate! _el) - (let - ((_wrapper (host-get (host-global "window") "_T15Sock")) - (_ws - (host-get - (host-get (host-global "globalThis") "__hs_ws_created") - 0))) + (let ((_wrapper (host-get (host-global "window") "_T15Sock")) + (_ws (host-get (host-get (host-global "globalThis") "__hs_ws_created") 0))) (do (host-call _ws "close") - (host-call-fn - (host-get (host-get _wrapper "rpc") "greet") - (list "world")) - (let - ((_created (host-get (host-global "globalThis") "__hs_ws_created"))) - (assert= (host-get _created "length") 2)))))) - (deftest - "with timeout parses and uses the configured timeout" + (host-call-fn (host-get (host-get _wrapper "rpc") "greet") (list "world")) + (let ((_created (host-get (host-global "globalThis") "__hs_ws_created"))) + (assert= (host-get _created "length") 2))))) + ) + (deftest "with timeout parses and uses the configured timeout" (hs-cleanup!) (host-set! (host-global "globalThis") "__hs_ws_created" nil) - (let - ((_el (dom-create-element "div"))) - (dom-set-attr - _el - "_" - "socket _T16Sock \"ws://localhost/ws\" with timeout 1500 end") + (let ((_el (dom-create-element "div"))) + (dom-set-attr _el "_" "socket _T16Sock \"ws://localhost/ws\" with timeout 1500 end") (dom-append (dom-body) _el) (hs-activate! _el) - (let - ((_wrapper (host-get (host-global "window") "_T16Sock"))) - (assert= (host-get _wrapper "_timeout") 1500))))) + (let ((_wrapper (host-get (host-global "window") "_T16Sock"))) + (assert= (host-get _wrapper "_timeout") 1500))) + ) +) ;; ── swap (4 tests) ── (defsuite "hs-upstream-swap" diff --git a/tests/playwright/generate-sx-tests.py b/tests/playwright/generate-sx-tests.py index 2fad9801..6e7a16c4 100644 --- a/tests/playwright/generate-sx-tests.py +++ b/tests/playwright/generate-sx-tests.py @@ -2991,6 +2991,22 @@ def generate_eval_only_test(test, idx): if '_hyperscript.internals.tokenizer' in body: return generate_tokenizer_test(test, safe_name) + # Special case: computed property names in object literals. + # window.foo="bar", window.bar=fn → {[foo]:true, [bar()]:false} = {bar:true,foo:false} + if test['name'] == 'expressions work in object literal field names': + return ( + f' (deftest "{safe_name}"\n' + f' (hs-cleanup!)\n' + f' (assert-equal\n' + f' {{:bar true :foo false}}\n' + f' (hs-strip-order-deep\n' + f' (eval-hs-locals "{{[foo]:true, [bar()]:false}}"\n' + f' (list\n' + f' (list (quote foo) "bar")\n' + f' (list (quote bar) (host-callback (fn () "foo")))))))\n' + f' )' + ) + lines.append(f' (deftest "{safe_name}"') assertions = []