HS: computed property names in object literals (+1 test)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled

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 <noreply@anthropic.com>
This commit is contained in:
2026-05-06 13:09:17 +00:00
parent 6d8f366439
commit ed42561071
6 changed files with 237 additions and 261 deletions

View File

@@ -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"