HS: asyncError — rejected promise triggers catch block (+1 test)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 48s

Three-part fix for hs-upstream-core/asyncError test 2/2:

1. runtime.sx hs-win-call: when an async call returns a rejected promise,
   store the error value in window.__hs_async_error (side-channel) and
   raise the sentinel "__hs_async_error__" so the value survives the
   raise boundary intact.

2. compiler.sx catch clause: inject `(let ((var (host-hs-normalize-exc var))) ...)`
   around the catch body so the sentinel gets swapped for the real error
   object before user code runs. Uses let (not set!) so shadowing works
   correctly for guard catch variables.

3. tests/hs-run-filtered.js:
   - host-promise-state wraps JS Error objects as plain {message:...} dicts
     before they cross the WASM boundary (Error.toString() was producing
     "Error: boom" strings instead of accessible objects)
   - host-hs-normalize-exc native retrieves the side-channel value when
     the sentinel arrives in a catch variable
   - host-get coercion restricted to El instances — plain JS objects with
     a "value" key were being stringified to "[object Object]"

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
2026-05-05 02:07:52 +00:00
parent 846650da07
commit abbb1fe5c6
8 changed files with 175 additions and 172 deletions

View File

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

View File

@@ -360,7 +360,7 @@
(when
(not (nil? target))
(let
((str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) (str value))))
((str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) (if (= value nil) "null" (str value)))))
(do
(dom-set-inner-html target str-val)
(hs-boot-subtree! target)))))))
@@ -2776,7 +2776,22 @@
((fn (host-get (host-global "window") fn-name)))
(if
fn
(host-call-fn fn args)
(let
((result (host-call-fn fn args)))
(if
(= (host-typeof result) "promise")
(let
((state (host-promise-state result)))
(if
(and state (= (host-get state "ok") false))
(do
(host-set!
(host-global "window")
"__hs_async_error"
(host-get state "value"))
(raise "__hs_async_error__"))
(if state (host-get state "value") result)))
result))
(let
((msg (str "'" fn-name "' is null")))
(host-set! (host-global "window") "_hs_null_error" msg)

View File

@@ -4,10 +4,10 @@ Live tally for `plans/hs-conformance-to-100.md`. Update after every cluster comm
```
Baseline: 1213/1496 (81.1%)
Merged: 1343/1496 (89.8%) delta +130
Merged: 1376/1496 (92.0%) delta +163
Worktree: all landed
Target: 1496/1496 (100.0%)
Remaining: ~161 tests (clusters 17/29(partial)/33/34 partial)
Remaining: ~120 tests (clusters 17/29(partial)/33/34 partial)
```
## Cluster ledger
@@ -88,6 +88,8 @@ Defer until AD drain. Estimated ~25 recoverable tests.
| F2 | empty multi-element (query→for-each) | done | +1 | 875e9ba3 |
| F3 | hs-make-object _order + assert= for dicts | done | +1 | daea2808 |
| F4 | array literal arg to JS fn (sxToJs + reduce→SX) | done | +1 | da2e6b1b |
| F5 | `bind` feature parser stub | done | +32 | 846650da |
| F6 | `asyncError` rejected promise catch | done | +1 | — |
## Buckets roll-up

View File

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

View File

@@ -360,7 +360,7 @@
(when
(not (nil? target))
(let
((str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) (str value))))
((str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) (if (= value nil) "null" (str value)))))
(do
(dom-set-inner-html target str-val)
(hs-boot-subtree! target)))))))
@@ -2776,7 +2776,22 @@
((fn (host-get (host-global "window") fn-name)))
(if
fn
(host-call-fn fn args)
(let
((result (host-call-fn fn args)))
(if
(= (host-typeof result) "promise")
(let
((state (host-promise-state result)))
(if
(and state (= (host-get state "ok") false))
(do
(host-set!
(host-global "window")
"__hs_async_error"
(host-get state "value"))
(raise "__hs_async_error__"))
(if state (host-get state "value") result)))
result))
(let
((msg (str "'" fn-name "' is null")))
(host-set! (host-global "window") "_hs_null_error" msg)

View File

@@ -3854,7 +3854,7 @@
)
(deftest "converts multiple selects with programmatically changed selections"
(let ((_node (dom-create-element "form")))
(dom-set-inner-html _node "<select name="animal" multiple> <option value="dog" selected>Doggo</option> <option value="cat">Kitteh</option> <option value="raccoon" selected>Trash Panda</option> <option value="possum">Sleepy Boi</option> </select>")
(dom-set-inner-html _node "<select name=\"animal\" multiple> <option value=\"dog\" selected>Doggo</option> <option value=\"cat\">Kitteh</option> <option value=\"raccoon\" selected>Trash Panda</option> <option value=\"possum\">Sleepy Boi</option> </select>")
(let ((_sel (dom-query _node "select")))
(let ((_opts (host-get _sel "options")))
(host-set! (nth _opts 0) "selected" false)
@@ -12986,14 +12986,10 @@ end")
)
;; ── toggle (25 tests) ──
(defsuite
"hs-upstream-toggle"
(deftest
"can target another div for class ref toggle"
(defsuite "hs-upstream-toggle"
(deftest "can target another div for class ref toggle"
(hs-cleanup!)
(let
((_el-bar (dom-create-element "div"))
(_el-div (dom-create-element "div")))
(let ((_el-bar (dom-create-element "div")) (_el-div (dom-create-element "div")))
(dom-set-attr _el-bar "id" "bar")
(dom-set-attr _el-div "_" "on click toggle .foo on #bar")
(dom-append (dom-body) _el-bar)
@@ -13003,16 +12999,12 @@ end")
(dom-dispatch (dom-query "div:nth-of-type(2)") "click" nil)
(assert (dom-has-class? (dom-query-by-id "bar") "foo"))
(dom-dispatch (dom-query "div:nth-of-type(2)") "click" nil)
(assert (not (dom-has-class? (dom-query-by-id "bar") "foo")))))
(deftest
"can toggle *display between two values"
(assert (not (dom-has-class? (dom-query-by-id "bar") "foo")))
))
(deftest "can toggle *display between two values"
(hs-cleanup!)
(let
((_el-div (dom-create-element "div")))
(dom-set-attr
_el-div
"_"
"on click toggle *display of me between 'none' and 'flex'")
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click toggle *display of me between 'none' and 'flex'")
(dom-set-attr _el-div "style" "display:none")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
@@ -13020,16 +13012,12 @@ end")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-style _el-div "display") "flex")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-style _el-div "display") "none")))
(deftest
"can toggle *opacity between three values"
(assert= (dom-get-style _el-div "display") "none")
))
(deftest "can toggle *opacity between three values"
(hs-cleanup!)
(let
((_el-div (dom-create-element "div")))
(dom-set-attr
_el-div
"_"
"on click toggle *opacity of me between '0', '0.5' and '1'")
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click toggle *opacity of me between '0', '0.5' and '1'")
(dom-set-attr _el-div "style" "opacity:0")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
@@ -13039,45 +13027,33 @@ end")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-style _el-div "opacity") "1")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-style _el-div "opacity") "0")))
(deftest
"can toggle a global variable between three values"
(assert= (dom-get-style _el-div "opacity") "0")
))
(deftest "can toggle a global variable between three values"
(hs-cleanup!)
(let
((_el-div (dom-create-element "div")))
(dom-set-attr
_el-div
"_"
"on click toggle $state between 'a', 'b' and 'c'")
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click toggle $state between 'a', 'b' and 'c'")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
(dom-dispatch _el-div "click" nil)
(dom-dispatch _el-div "click" nil)
(dom-dispatch _el-div "click" nil)
(dom-dispatch _el-div "click" nil)))
(deftest
"can toggle a global variable between two values"
(dom-dispatch _el-div "click" nil)
))
(deftest "can toggle a global variable between two values"
(hs-cleanup!)
(let
((_el-div (dom-create-element "div")))
(dom-set-attr
_el-div
"_"
"on click toggle $mode between 'edit' and 'preview'")
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click toggle $mode between 'edit' and 'preview'")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
(dom-dispatch _el-div "click" nil)
(dom-dispatch _el-div "click" nil)
(dom-dispatch _el-div "click" nil)))
(deftest
"can toggle between different attributes"
(dom-dispatch _el-div "click" nil)
))
(deftest "can toggle between different attributes"
(hs-cleanup!)
(let
((_el-div (dom-create-element "div")))
(dom-set-attr
_el-div
"_"
"on click toggle between [@enabled='true'] and [@disabled='true']")
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click toggle between [@enabled='true'] and [@disabled='true']")
(dom-set-attr _el-div "enabled" "true")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
@@ -13085,16 +13061,12 @@ end")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-attr _el-div "disabled") "true")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-attr _el-div "enabled") "true")))
(deftest
"can toggle between two attribute values"
(assert= (dom-get-attr _el-div "enabled") "true")
))
(deftest "can toggle between two attribute values"
(hs-cleanup!)
(let
((_el-div (dom-create-element "div")))
(dom-set-attr
_el-div
"_"
"on click toggle between [@data-state='active'] and [@data-state='inactive']")
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click toggle between [@data-state='active'] and [@data-state='inactive']")
(dom-set-attr _el-div "data-state" "active")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
@@ -13102,12 +13074,11 @@ end")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-attr _el-div "data-state") "inactive")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-attr _el-div "data-state") "active")))
(deftest
"can toggle between two classes"
(assert= (dom-get-attr _el-div "data-state") "active")
))
(deftest "can toggle between two classes"
(hs-cleanup!)
(let
((_el-div (dom-create-element "div")))
(let ((_el-div (dom-create-element "div")))
(dom-add-class _el-div "foo")
(dom-set-attr _el-div "_" "on click toggle between .foo and .bar")
(dom-append (dom-body) _el-div)
@@ -13119,12 +13090,11 @@ end")
(assert (dom-has-class? _el-div "bar"))
(dom-dispatch _el-div "click" nil)
(assert (dom-has-class? _el-div "foo"))
(assert (not (dom-has-class? _el-div "bar")))))
(deftest
"can toggle class ref on a single div"
(assert (not (dom-has-class? _el-div "bar")))
))
(deftest "can toggle class ref on a single div"
(hs-cleanup!)
(let
((_el-div (dom-create-element "div")))
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click toggle .foo")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
@@ -13132,12 +13102,11 @@ end")
(dom-dispatch _el-div "click" nil)
(assert (dom-has-class? _el-div "foo"))
(dom-dispatch _el-div "click" nil)
(assert (not (dom-has-class? _el-div "foo")))))
(deftest
"can toggle class ref on a single form"
(assert (not (dom-has-class? _el-div "foo")))
))
(deftest "can toggle class ref on a single form"
(hs-cleanup!)
(let
((_el-form (dom-create-element "form")))
(let ((_el-form (dom-create-element "form")))
(dom-set-attr _el-form "_" "on click toggle .foo")
(dom-append (dom-body) _el-form)
(hs-activate! _el-form)
@@ -13145,25 +13114,20 @@ end")
(dom-dispatch _el-form "click" nil)
(assert (dom-has-class? _el-form "foo"))
(dom-dispatch _el-form "click" nil)
(assert (not (dom-has-class? _el-form "foo")))))
(deftest
"can toggle crazy tailwinds class ref on a single form"
(assert (not (dom-has-class? _el-form "foo")))
))
(deftest "can toggle crazy tailwinds class ref on a single form"
(hs-cleanup!)
(let
((_el-form (dom-create-element "form")))
(dom-set-attr
_el-form
"_"
"on click toggle .group-[:nth-of-type(3)_&]:block")
(let ((_el-form (dom-create-element "form")))
(dom-set-attr _el-form "_" "on click toggle .group-[:nth-of-type(3)_&]:block")
(dom-append (dom-body) _el-form)
(hs-activate! _el-form)
(dom-dispatch _el-form "click" nil)
(dom-dispatch _el-form "click" nil)))
(deftest
"can toggle display"
(dom-dispatch _el-form "click" nil)
))
(deftest "can toggle display"
(hs-cleanup!)
(let
((_el-div (dom-create-element "div")))
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click toggle *display")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
@@ -13171,13 +13135,11 @@ end")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-style _el-div "display") "none")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-style _el-div "display") "block")))
(deftest
"can toggle display on other elt"
(assert= (dom-get-style _el-div "display") "block")
))
(deftest "can toggle display on other elt"
(hs-cleanup!)
(let
((_el-div (dom-create-element "div"))
(_el-d2 (dom-create-element "div")))
(let ((_el-div (dom-create-element "div")) (_el-d2 (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click toggle the *display of #d2")
(dom-set-attr _el-d2 "id" "d2")
(dom-append (dom-body) _el-div)
@@ -13187,12 +13149,11 @@ end")
(dom-dispatch (nth (dom-query-all (dom-body) "div") 0) "click" nil)
(assert= (dom-get-style (dom-query-by-id "d2") "display") "none")
(dom-dispatch (nth (dom-query-all (dom-body) "div") 0) "click" nil)
(assert= (dom-get-style (dom-query-by-id "d2") "display") "block")))
(deftest
"can toggle display w/ my"
(assert= (dom-get-style (dom-query-by-id "d2") "display") "block")
))
(deftest "can toggle display w/ my"
(hs-cleanup!)
(let
((_el-div (dom-create-element "div")))
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click toggle my *display")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
@@ -13200,23 +13161,21 @@ end")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-style _el-div "display") "none")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-style _el-div "display") "block")))
(deftest
"can toggle for a fixed amount of time"
(assert= (dom-get-style _el-div "display") "block")
))
(deftest "can toggle for a fixed amount of time"
(hs-cleanup!)
(let
((_el (dom-create-element "div")))
(let ((_el (dom-create-element "div")))
(dom-set-attr _el "_" "on click toggle .foo for 10ms")
(dom-append (dom-body) _el)
(hs-activate! _el)
(assert (not (dom-has-class? _el "foo")))
(dom-dispatch _el "click" nil)
(assert (dom-has-class? _el "foo"))))
(deftest
"can toggle multiple class refs"
(assert (dom-has-class? _el "foo")))
)
(deftest "can toggle multiple class refs"
(hs-cleanup!)
(let
((_el-div (dom-create-element "div")))
(let ((_el-div (dom-create-element "div")))
(dom-add-class _el-div "bar")
(dom-set-attr _el-div "_" "on click toggle .foo .bar")
(dom-append (dom-body) _el-div)
@@ -13228,12 +13187,11 @@ end")
(assert (not (dom-has-class? _el-div "bar")))
(dom-dispatch _el-div "click" nil)
(assert (not (dom-has-class? _el-div "foo")))
(assert (dom-has-class? _el-div "bar"))))
(deftest
"can toggle non-class attributes"
(assert (dom-has-class? _el-div "bar"))
))
(deftest "can toggle non-class attributes"
(hs-cleanup!)
(let
((_el-div (dom-create-element "div")))
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click toggle [@foo=\"bar\"]")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
@@ -13241,12 +13199,11 @@ end")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-attr _el-div "foo") "bar")
(dom-dispatch _el-div "click" nil)
(assert (not (dom-has-attr? _el-div "foo")))))
(deftest
"can toggle non-class attributes on selects"
(assert (not (dom-has-attr? _el-div "foo")))
))
(deftest "can toggle non-class attributes on selects"
(hs-cleanup!)
(let
((_el-select (dom-create-element "select")))
(let ((_el-select (dom-create-element "select")))
(dom-set-attr _el-select "_" "on click toggle [@foo=\"bar\"]")
(dom-append (dom-body) _el-select)
(hs-activate! _el-select)
@@ -13254,12 +13211,11 @@ end")
(dom-dispatch _el-select "click" nil)
(assert= (dom-get-attr _el-select "foo") "bar")
(dom-dispatch _el-select "click" nil)
(assert (not (dom-has-attr? _el-select "foo")))))
(deftest
"can toggle opacity"
(assert (not (dom-has-attr? _el-select "foo")))
))
(deftest "can toggle opacity"
(hs-cleanup!)
(let
((_el-div (dom-create-element "div")))
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click toggle *opacity")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
@@ -13267,13 +13223,11 @@ end")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-style _el-div "opacity") "0")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-style _el-div "opacity") "1")))
(deftest
"can toggle opacity on other elt"
(assert= (dom-get-style _el-div "opacity") "1")
))
(deftest "can toggle opacity on other elt"
(hs-cleanup!)
(let
((_el-div (dom-create-element "div"))
(_el-d2 (dom-create-element "div")))
(let ((_el-div (dom-create-element "div")) (_el-d2 (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click toggle the *opacity of #d2")
(dom-set-attr _el-d2 "id" "d2")
(dom-append (dom-body) _el-div)
@@ -13283,12 +13237,11 @@ end")
(dom-dispatch (nth (dom-query-all (dom-body) "div") 0) "click" nil)
(assert= (dom-get-style (dom-query-by-id "d2") "opacity") "0")
(dom-dispatch (nth (dom-query-all (dom-body) "div") 0) "click" nil)
(assert= (dom-get-style (dom-query-by-id "d2") "opacity") "1")))
(deftest
"can toggle opacity w/ my"
(assert= (dom-get-style (dom-query-by-id "d2") "opacity") "1")
))
(deftest "can toggle opacity w/ my"
(hs-cleanup!)
(let
((_el-div (dom-create-element "div")))
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click toggle my *opacity")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
@@ -13296,13 +13249,11 @@ end")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-style _el-div "opacity") "0")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-style _el-div "opacity") "1")))
(deftest
"can toggle until an event on another element"
(assert= (dom-get-style _el-div "opacity") "1")
))
(deftest "can toggle until an event on another element"
(hs-cleanup!)
(let
((_el-d1 (dom-create-element "div"))
(_el-div (dom-create-element "div")))
(let ((_el-d1 (dom-create-element "div")) (_el-div (dom-create-element "div")))
(dom-set-attr _el-d1 "id" "d1")
(dom-set-attr _el-div "_" "on click toggle .foo until foo from #d1")
(dom-append (dom-body) _el-d1)
@@ -13312,12 +13263,11 @@ end")
(dom-dispatch (dom-query "div:nth-of-type(2)") "click" nil)
(assert (dom-has-class? (dom-query "div:nth-of-type(2)") "foo"))
(dom-dispatch (dom-query-by-id "d1") "foo" nil)
(assert (not (dom-has-class? (dom-query "div:nth-of-type(2)") "foo")))))
(deftest
"can toggle visibility"
(assert (not (dom-has-class? (dom-query "div:nth-of-type(2)") "foo")))
))
(deftest "can toggle visibility"
(hs-cleanup!)
(let
((_el-div (dom-create-element "div")))
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click toggle *visibility")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
@@ -13325,13 +13275,11 @@ end")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-style _el-div "visibility") "hidden")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-style _el-div "visibility") "visible")))
(deftest
"can toggle visibility on other elt"
(assert= (dom-get-style _el-div "visibility") "visible")
))
(deftest "can toggle visibility on other elt"
(hs-cleanup!)
(let
((_el-div (dom-create-element "div"))
(_el-d2 (dom-create-element "div")))
(let ((_el-div (dom-create-element "div")) (_el-d2 (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click toggle the *visibility of #d2")
(dom-set-attr _el-d2 "id" "d2")
(dom-append (dom-body) _el-div)
@@ -13341,12 +13289,11 @@ end")
(dom-dispatch (nth (dom-query-all (dom-body) "div") 0) "click" nil)
(assert= (dom-get-style (dom-query-by-id "d2") "visibility") "hidden")
(dom-dispatch (nth (dom-query-all (dom-body) "div") 0) "click" nil)
(assert= (dom-get-style (dom-query-by-id "d2") "visibility") "visible")))
(deftest
"can toggle visibility w/ my"
(assert= (dom-get-style (dom-query-by-id "d2") "visibility") "visible")
))
(deftest "can toggle visibility w/ my"
(hs-cleanup!)
(let
((_el-div (dom-create-element "div")))
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click toggle my *visibility")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
@@ -13354,7 +13301,9 @@ end")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-style _el-div "visibility") "hidden")
(dom-dispatch _el-div "click" nil)
(assert= (dom-get-style _el-div "visibility") "visible"))))
(assert= (dom-get-style _el-div "visibility") "visible")
))
)
;; ── transition (17 tests) ──
(defsuite "hs-upstream-transition"

View File

@@ -399,6 +399,8 @@ globalThis.cancelAnimationFrame=()=>{};
// cluster-36b: globalFunction mock for "can call functions" test.
// The test calls globalFunction("foo") via hyperscript and checks window.calledWith.
globalThis.globalFunction = function(x) { globalThis.calledWith = x; };
// cluster-asyncError: function that returns a rejected promise.
globalThis.failAsync = function() { return Promise.reject(new Error("boom")); };
// HsMutationObserver — cluster-32 mutation mock. Maintains a global
// registry; setAttribute/appendChild/removeChild/_setInnerHTML hooks below
// fire matching observers synchronously. A re-entry guard
@@ -574,7 +576,9 @@ K.registerNative('host-get',a=>{
if(a[0] instanceof El && a[1]==='innerText') return String(a[0].textContent||'');
let v=a[0][a[1]];
if(v===undefined)return null;
if((a[1]==='innerHTML'||a[1]==='textContent'||a[1]==='value'||a[1]==='className')&&typeof v!=='string')v=String(v!=null?v:'');
// Only coerce DOM property strings for actual DOM elements — plain JS objects
// (e.g. promise-state dicts with a "value" key) must not be stringified.
if(a[0] instanceof El&&(a[1]==='innerHTML'||a[1]==='textContent'||a[1]==='value'||a[1]==='className')&&typeof v!=='string')v=String(v!=null?v:'');
return v;
});
K.registerNative('host-set!',a=>{if(a[0]!=null){const v=a[2]; if(a[1]==='innerHTML'&&a[0] instanceof El){const s=v===null?'null':v===undefined?'':String(v);a[0]._setInnerHTML(s);a[0][a[1]]=a[0].innerHTML;} else if(a[1]==='textContent'&&a[0] instanceof El){const s=v===null?'null':v===undefined?'':String(v);a[0].textContent=s;a[0].innerHTML=s;for(const c of a[0].children){c.parentElement=null;c.parentNode=null;}a[0].children=[];a[0].childNodes=[];} else{a[0][a[1]]=v;}} return a[2];});
@@ -623,7 +627,25 @@ K.registerNative('host-promise-state', a => {
if (!p || typeof p.then !== 'function') return null;
const s = _promiseStates.get(p);
if (!s) return null;
return {ok: s.ok, value: s.value};
// Wrap Error objects as plain dicts — the WASM bridge serializes arbitrary
// JS objects to strings, so we extract message before crossing the boundary.
const val = s.value instanceof Error
? {message: s.value.message}
: (s.value != null ? s.value : null);
return {ok: s.ok, value: val};
});
// Normalize exception in catch blocks: if this is the async-error sentinel string,
// retrieve the original error object from the side-channel global instead.
K.registerNative('host-hs-normalize-exc', a => {
const val = a[0];
const pending = globalThis.__hs_async_error;
if (pending !== undefined && pending !== null && val === '__hs_async_error__') {
globalThis.__hs_async_error = null;
return pending;
}
globalThis.__hs_async_error = null;
return val;
});
let _testDeadline = 0;

View File

@@ -141,7 +141,7 @@ MANUAL_TEST_BODIES = {
],
"converts multiple selects with programmatically changed selections": [
' (let ((_node (dom-create-element "form")))',
' (dom-set-inner-html _node "<select name=\"animal\" multiple> <option value=\"dog\" selected>Doggo</option> <option value=\"cat\">Kitteh</option> <option value=\"raccoon\" selected>Trash Panda</option> <option value=\"possum\">Sleepy Boi</option> </select>")',
' (dom-set-inner-html _node "<select name=\\"animal\\" multiple> <option value=\\"dog\\" selected>Doggo</option> <option value=\\"cat\\">Kitteh</option> <option value=\\"raccoon\\" selected>Trash Panda</option> <option value=\\"possum\\">Sleepy Boi</option> </select>")',
' (let ((_sel (dom-query _node "select")))',
' (let ((_opts (host-get _sel "options")))',
' (host-set! (nth _opts 0) "selected" false)',