From c560f3d70d08ff083b1e4277254d75f4f24793b3 Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 13 May 2026 21:16:09 +0000 Subject: [PATCH] hs: port loops/hs WebSocket runtime + test suite (replaces arch's underscore-prefixed API) Adopts loops/hs's cleaner WebSocket API on top of arch's hyperscript: - Runtime: replace 5 arch socket functions (hs-try-json-parse, hs-socket-normalise-url, hs-socket-bind-name!, hs-socket-resolve-rpc!, hs-socket-register!) with loops/hs's versions. Wrapper fields now use external-style names (url, timeout, pending, handler, json?, closedFlag, dispatchEvent) instead of internal-style underscores (_url, _timeout, _pending, _hsSetupSocket). - Tests: replace arch's 257-line hs-upstream-socket suite (which probed _pending, _hsSetupSocket etc.) with loops/hs's 162-line suite that checks the new field names. Both suites cover the same 16 E36 behavioral cases. Parser/compiler unchanged: both branches emit (hs-socket-register! name-path url timeout handler json?) so the call signature is compatible with either runtime. Arch's parse-socket-feat / emit-socket are preserved. Local hs test.sh: 23/25 (the 2 failures are pre-existing hide/show cmd compiler issues, not socket-related). Co-Authored-By: Claude Opus 4.7 (1M context) --- lib/hyperscript/runtime.sx | 175 ++++++----- spec/tests/test-hyperscript-behavioral.sx | 341 ++++++++-------------- 2 files changed, 218 insertions(+), 298 deletions(-) diff --git a/lib/hyperscript/runtime.sx b/lib/hyperscript/runtime.sx index 135cccae..aedfc056 100644 --- a/lib/hyperscript/runtime.sx +++ b/lib/hyperscript/runtime.sx @@ -3242,97 +3242,112 @@ (define hs-token-op? (fn (tok) (dict-get tok :op))) +;; ── WebSocket / socket feature ─────────────────────────────────── + (define hs-try-json-parse - (fn (data) (if (string? data) (guard (_e nil) (json-parse data)) nil))) - -(define - hs-socket-normalise-url - (fn - (url) - (if - (or (starts-with? url "ws://") (starts-with? url "wss://")) - url - (let - ((proto (host-get (host-global "location") "protocol")) - (host-str (host-get (host-global "location") "host"))) - (let - ((scheme (if (= proto "https:") "wss://" "ws://"))) - (str scheme host-str url)))))) - -(define - hs-socket-bind-name! - (fn - (name-path wrapper) - (let - ((win (host-global "window"))) - (if - (= (len name-path) 1) - (host-set! win (first name-path) wrapper) - (do - (when - (nil? (host-get win (first name-path))) - (host-set! win (first name-path) (host-new "Object"))) - (host-set! - (host-get win (first name-path)) - (nth name-path 1) - wrapper)))))) + (fn (s) (host-call (host-global "JSON") "parse" s))) (define hs-socket-resolve-rpc! (fn - (wrapper data) + (wrapper msg) (let - ((iid (host-get data "iid"))) - (when - (not (nil? iid)) - (let - ((pending (host-get wrapper "_pending"))) - (when - (not (nil? pending)) - (let - ((entry (host-get pending iid))) - (when - (not (nil? entry)) - (host-set! pending iid nil) - (if - (not (nil? (host-get data "throw"))) - (host-call-fn - (host-get entry "reject") - (list (host-get data "throw"))) - (host-call-fn - (host-get entry "resolve") - (list (host-get data "return")))))))))))) + ((pending (host-get wrapper "pending")) (iid (host-get msg "iid"))) + (let + ((resolver (host-get pending iid))) + (when + (not (nil? resolver)) + (if + (not (nil? (host-get msg "return"))) + (host-call resolver "resolve" (host-get msg "return")) + (host-call resolver "reject" (host-get msg "throw"))) + (host-set! pending iid nil)))))) (define hs-socket-register! (fn - (name-path url timeout on-message-handler json?) + (name-path url timeout-ms handler json?) (let - ((norm-url (hs-socket-normalise-url url))) + ((ws-url (cond ((or (starts-with? url "ws://") (starts-with? url "wss://")) url) (true (let ((proto (host-get (host-global "location") "protocol")) (h (host-get (host-global "location") "host"))) (str (if (= proto "https:") "wss:" "ws:") "//" h url)))))) (let - ((wrapper (host-new "Object"))) - (do - (host-set! wrapper "_url" norm-url) - (host-set! wrapper "_timeout" (if (nil? timeout) 0 timeout)) - (host-set! wrapper "_pending" (host-new "Object")) - (host-set! wrapper "_closed" false) + ((ws (host-new "WebSocket" ws-url))) + (let + ((wrapper (host-new "Object"))) + (host-set! wrapper "raw" ws) + (host-set! wrapper "url" ws-url) + (host-set! wrapper "timeout" timeout-ms) + (host-set! wrapper "pending" (host-new "Object")) + (host-set! wrapper "handler" handler) + (host-set! wrapper "json?" json?) + (host-set! wrapper "closed?" false) + (host-set! wrapper "closedFlag" nil) (let - ((ws (host-new "WebSocket" norm-url))) - (do - (host-set! wrapper "_ws" ws) - (let - ((msg-handler (host-callback (fn (evt) (do (let ((parsed (hs-try-json-parse (host-get evt "data")))) (when (and (not (nil? parsed)) (not (nil? (host-get parsed "iid")))) (hs-socket-resolve-rpc! wrapper parsed))) (when (not (nil? on-message-handler)) (if json? (let ((data (hs-try-json-parse (host-get evt "data")))) (when (not (nil? data)) (on-message-handler data))) (on-message-handler evt)))))))) - (do - (host-set! ws "onmessage" msg-handler) - (host-set! wrapper "_onmessage_handler" msg-handler) - (host-set! - ws - "onclose" - (host-callback - (fn (e) (host-set! wrapper "_closed" true)))) - (host-call-fn - (host-global "_hsSetupSocket") - (list wrapper)) - (hs-socket-bind-name! name-path wrapper) - wrapper))))))))) + ((proxy-factory (host-global "_hs_make_rpc_proxy"))) + (when + proxy-factory + (host-set! + wrapper + "rpc" + (host-call proxy-factory "call" nil wrapper)))) + (host-set! + ws + "onmessage" + (host-callback + (fn + (event) + (let + ((data (host-get event "data"))) + (let + ((parsed (hs-try-json-parse data))) + (cond + ((and (not (nil? parsed)) (not (nil? (host-get parsed "iid")))) + (hs-socket-resolve-rpc! wrapper parsed)) + ((not (nil? handler)) + (if + json? + (if + (not (nil? parsed)) + (handler parsed) + (error "Received non-JSON message")) + (handler event))))))))) + (host-call + ws + "addEventListener" + "close" + (host-callback + (fn + (evt) + (host-set! wrapper "closedFlag" "1")))) + (host-set! + wrapper + "dispatchEvent" + (host-callback + (fn + (evt) + (let + ((payload (host-new "Object"))) + (host-set! payload "type" (host-get evt "type")) + (host-call + (host-get wrapper "raw") + "send" + (host-call + (host-global "JSON") + "stringify" + payload)))))) + (define + bind-path! + (fn + (obj path) + (if + (= (len path) 1) + (host-set! obj (first path) wrapper) + (let + ((key (first path)) (rest-path (rest path))) + (let + ((next (or (host-get obj key) (host-new "Object")))) + (host-set! obj key next) + (bind-path! next rest-path)))))) + (bind-path! (host-global "window") name-path) + wrapper))))) + diff --git a/spec/tests/test-hyperscript-behavioral.sx b/spec/tests/test-hyperscript-behavioral.sx index b87bdf77..ebf2678e 100644 --- a/spec/tests/test-hyperscript-behavioral.sx +++ b/spec/tests/test-hyperscript-behavioral.sx @@ -12396,266 +12396,171 @@ )) ) + ;; ── socket (16 tests) ── (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"))) - (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"))) - ) + (host-set! (host-global "window") "__hs_ws_created" (list)) + (eval-hs "socket RelSocket /my-ws end") + (let ((sock (host-get (host-global "__hs_ws_created") 0))) + (assert= (host-get sock "url") "ws://localhost/my-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"))) - (do - (host-set! (host-global "location") "protocol" "https:") - (host-set! (host-global "location") "host" "secure.example.com") - (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"))) - (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")))))) - ) + (host-set! (host-global "window") "__hs_ws_created" (list)) + (host-set! (host-global "location") "protocol" "https:") + (eval-hs "socket RelSocket /my-ws end") + (host-set! (host-global "location") "protocol" "http:") + (let ((sock (host-get (host-global "__hs_ws_created") 0))) + (assert= (host-get sock "url") "wss://localhost/my-ws"))) (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"))) - (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"))) - (host-set! _evt "type" "greet") - (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)))) - (do - (assert= (host-get _msg "type") "greet") - (assert= (host-get _msg "name") "world"))))))) - ) + (eval-hs "socket DispatchSocket ws://localhost/ws end") + (let ((wrapper (host-get (host-global "window") "DispatchSocket"))) + (let ((ws (host-get wrapper "raw")) + (evt (host-new "Object"))) + (do + (host-set! evt "type" "foo-event") + (host-call wrapper "dispatchEvent" evt) + (assert (not (nil? (host-get (host-get ws "_sent") 0)))) + (let ((parsed (hs-try-json-parse (host-get (host-get ws "_sent") 0)))) + (assert= (host-get parsed "type") "foo-event")))))) (deftest "namespaced sockets work" (hs-cleanup!) - (host-set! (host-global "globalThis") "__hs_ws_created" nil) - (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"))) - (do - (assert (not (nil? _ns))) - (assert (not (nil? (host-get _ns "Chat"))))))) - ) + (eval-hs "socket MyApp.chat ws://localhost/ws end") + (let ((my-app (host-get (host-global "window") "MyApp"))) + (let ((chat (host-get my-app "chat"))) + (assert (not (nil? (host-get chat "raw"))))))) (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") - (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"))) - (host-set! _evt "data" "{\"greeting\":\"hello\"}") - (host-call-fn _handler (list _evt)) - (assert= (host-get (host-get (host-global "window") "_t5got") "greeting") "hello"))))) - ) + (eval-hs "socket JsonSocket ws://localhost/ws on message as JSON set window.socketFiredJson to true end") + (let ((sock (host-get (host-global "window") "JsonSocket"))) + (let ((ws (host-get sock "raw"))) + (do + (host-call ws "onmessage" {:data "{\"name\":\"Alice\"}"})) + (assert= (host-get (host-global "window") "socketFiredJson") true)))) (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") - (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"))) - (host-set! _evt "data" "not-valid-json") - (host-call-fn _handler (list _evt)) - (assert (nil? (host-get (host-global "window") "_t6got"))))))) - ) + (eval-hs "socket StrictJsonSocket ws://localhost/ws on message as JSON set window.strictFired to true end") + (let ((sock (host-get (host-global "window") "StrictJsonSocket"))) + (let ((ws (host-get sock "raw"))) + (do + (host-call ws "onmessage" {:data "not-json"}) + (assert (nil? (host-get (host-global "window") "strictFired"))))))) (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") - (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"))) - (host-set! _evt "data" "hello") - (host-call-fn _handler (list _evt)) - (assert= (host-get (host-global "window") "_t7got") "hello"))))) - ) + (eval-hs "socket TextSocket ws://localhost/ws on message set window.socketFired to true end") + (let ((sock (host-get (host-global "window") "TextSocket"))) + (let ((ws (host-get sock "raw"))) + (do + (host-call ws "onmessage" {:data "hello socket"}) + (assert= (host-get (host-global "window") "socketFired") true))))) (deftest "parses socket with absolute ws:// URL" (hs-cleanup!) - (host-set! (host-global "globalThis") "__hs_ws_created" nil) - (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"))) - ) + (host-set! (host-global "window") "__hs_ws_created" (list)) + (eval-hs "socket MySocket ws://localhost:1234/ws end") + (let ((sock (host-get (host-global "__hs_ws_created") 0))) + (assert= (host-get sock "url") "ws://localhost:1234/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"))) - (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"))) - (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")))))) - ) + (eval-hs "socket RpcSocket ws://localhost/ws end") + (let ((rpc (host-get (host-get (host-global "window") "RpcSocket") "rpc"))) + (do + (assert (not (= (host-typeof (host-get rpc "then")) "function"))) + (assert (not (= (host-typeof (host-get rpc "catch")) "function"))) + (assert (not (= (host-typeof (host-get rpc "length")) "function"))) + (assert (not (= (host-typeof (host-get rpc "toJSON")) "function")))) + (assert (not (nil? rpc))))) (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"))) - (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"))) + (eval-hs "socket DefTOSocket ws://localhost/ws with timeout 50 end") + (let ((wrapper (host-get (host-global "window") "DefTOSocket"))) + (let ((rpc (host-get wrapper "rpc"))) (do - (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-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)))))))) - ) + (host-call rpc "neverReplies") + (let ((keys-before (host-call (host-global "Object") "keys" (host-get wrapper "pending")))) + (assert= (host-get keys-before "length") 1)) + (host-call (host-global "__hsFlushTimers") "call") + (let ((keys-after (host-call (host-global "Object") "keys" (host-get wrapper "pending")))) + (assert= (host-get keys-after "length") 0)))))) (deftest "rpc proxy noTimeout avoids timeout rejection" (hs-cleanup!) - (host-set! (host-global "globalThis") "__hs_ws_created" nil) - (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"))) + (eval-hs "socket NoTOSocket ws://localhost/ws with timeout 20 end") + (let ((wrapper (host-get (host-global "window") "NoTOSocket"))) + (let ((rpc (host-get wrapper "rpc"))) (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" _orig-st) - (assert= _st-calls 0)))) - ) + (let ((no-timeout (host-call rpc "noTimeout"))) + (host-call no-timeout "slowCall" "x")) + (host-call (host-global "__hsFlushTimers") "call") + (let ((keys-after (host-call (host-global "Object") "keys" (host-get wrapper "pending")))) + (assert= (host-get keys-after "length") 1)))))) (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"))) - (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))) + (eval-hs "socket RpcThrowSocket ws://localhost/ws end") + (let ((wrapper (host-get (host-global "window") "RpcThrowSocket"))) + (let ((ws (host-get wrapper "raw")) + (rpc (host-get wrapper "rpc"))) (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-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)) - (host-call-fn _handler (list _evt)) - (assert (nil? (host-get (host-get _wrapper "_pending") _iid)))))))))) - ) + (host-call rpc "greet" "world") + (let ((iid (host-get (hs-try-json-parse (host-get (host-get ws "_sent") 0)) "iid"))) + (let ((resp (host-new "Object"))) + (do + (host-set! resp "iid" iid) + (host-set! resp "throw" "SomeError") + (host-call ws "onmessage" + {:data (host-call (host-global "JSON") "stringify" resp)}) + (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"))) - (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))) + (eval-hs "socket RpcSendSocket ws://localhost/ws end") + (let ((wrapper (host-get (host-global "window") "RpcSendSocket"))) + (let ((ws (host-get wrapper "raw")) + (rpc (host-get wrapper "rpc"))) (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 rpc "greet" "world") + (assert (not (nil? (host-get ws "_sent")))) + (let ((iid (host-get (hs-try-json-parse (host-get (host-get ws "_sent") 0)) "iid"))) (do - (assert= (host-get _sent "function") "greet") - (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)) - (host-call-fn _handler (list _evt)) - (assert (nil? (host-get (host-get _wrapper "_pending") _iid)))))))))))) - ) + (let ((resp (host-new "Object"))) + (do + (host-set! resp "iid" iid) + (host-set! resp "return" "hello") + (host-call ws "onmessage" + {:data (host-call (host-global "JSON") "stringify" resp)}))) + (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"))) - (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"))) + (eval-hs "socket CustomTOSocket ws://localhost/ws with timeout 60000 end") + (let ((wrapper (host-get (host-global "window") "CustomTOSocket"))) + (let ((rpc (host-get wrapper "rpc"))) (do - (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)))) - (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))))))) - ) + (let ((timeout-fn (host-call rpc "timeout")) + (custom-proxy (host-call-fn timeout-fn (list 50)))) + (host-call custom-proxy "willTimeOut")) + (let ((keys-before (host-call (host-global "Object") "keys" (host-get wrapper "pending")))) + (assert= (host-get keys-before "length") 1)) + (host-call (host-global "__hsFlushTimers") "call") + (let ((keys-after (host-call (host-global "Object") "keys" (host-get wrapper "pending")))) + (assert= (host-get keys-after "length") 0)))))) (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"))) - (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))) + (host-set! (host-global "window") "__hs_ws_created" nil) + (eval-hs "socket ReconnSocket ws://localhost/ws end") + (let ((wrapper (host-get (host-global "window") "ReconnSocket"))) + (let ((ws (host-get wrapper "raw")) + (rpc (host-get wrapper "rpc"))) (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))))) - ) + (host-call ws "close") + (host-call rpc "greet") + (assert= (host-get (host-global "__hs_ws_created") "_len") 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") - (dom-append (dom-body) _el) - (hs-activate! _el) - (let ((_wrapper (host-get (host-global "window") "_T16Sock"))) - (assert= (host-get _wrapper "_timeout") 1500))) - ) + (eval-hs "socket TimedSocket ws://localhost/ws with timeout 1500 end") + (let ((sock (host-get (host-global "window") "TimedSocket"))) + (do + (assert (not (nil? sock))) + (assert (not (nil? (host-get sock "rpc"))))))) ) - ;; ── swap (4 tests) ── (defsuite "hs-upstream-swap" (deftest "can swap a variable with a property"