HS: deferred-reraise in catch + exception event tests (+5)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 20s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 20s
- compiler: wrap catch body in nested guard so (raise e) inside a catch handler defers the re-raise until after the guard exits, avoiding the handler-stays-active infinite loop - generator: MANUAL_TEST_BODIES for rethrown/uncaught exception events, can-pick-detail/event-property, bootstrap bootstraps; remove from skip-list; regenerate behavioral spec Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -186,9 +186,9 @@
|
||||
(let
|
||||
((raw-compiled (hs-to-sx stripped-body)))
|
||||
(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 host-get) (list (quote host-get) (quote event) "detail") 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))))
|
||||
((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 do) (list (quote guard) (list var (list true catch-body)) compiled-body) (hs-to-sx finally-info)) (list (quote guard) (list var (list true catch-body)) compiled-body))) (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 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))))
|
||||
(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
|
||||
|
||||
@@ -186,9 +186,9 @@
|
||||
(let
|
||||
((raw-compiled (hs-to-sx stripped-body)))
|
||||
(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 host-get) (list (quote host-get) (quote event) "detail") 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))))
|
||||
((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 do) (list (quote guard) (list var (list true catch-body)) compiled-body) (hs-to-sx finally-info)) (list (quote guard) (list var (list true catch-body)) compiled-body))) (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 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))))
|
||||
(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
|
||||
|
||||
@@ -1172,7 +1172,7 @@
|
||||
))
|
||||
(deftest "can call global javascript functions"
|
||||
(hs-cleanup!)
|
||||
(host-set! (host-global "window") "calledWith" nil)
|
||||
(host-set! (host-global "window") "calledWith" null)
|
||||
(let ((_el-div (dom-create-element "div")))
|
||||
(dom-set-attr _el-div "_" "on click call globalFunction(\"foo\")")
|
||||
(dom-append (dom-body) _el-div)
|
||||
@@ -1252,7 +1252,8 @@
|
||||
(dom-append (dom-body) _el-div)
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
))
|
||||
)
|
||||
)
|
||||
(deftest "can change non-class properties"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-div (dom-create-element "div")))
|
||||
@@ -1399,7 +1400,8 @@
|
||||
(hs-deactivate! _el-div)
|
||||
(dom-remove-class _el-div "foo")
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
(assert (not (dom-has-class? _el-div "foo")))))
|
||||
(assert (not (dom-has-class? _el-div "foo"))))
|
||||
)
|
||||
(deftest "cleanup tracks listeners in elt._hyperscript"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-div (dom-create-element "div")))
|
||||
@@ -1483,7 +1485,8 @@
|
||||
(dom-set-attr _el-div "_" "on click add .bar")
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch _el-div "click" nil)
|
||||
(assert (dom-has-class? _el-div "bar"))))
|
||||
(assert (dom-has-class? _el-div "bar")))
|
||||
)
|
||||
(deftest "sets data-hyperscript-powered on initialized elements"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-div (dom-create-element "div")))
|
||||
@@ -2027,7 +2030,20 @@
|
||||
(assert= (dom-text-content _el-button) "select2")
|
||||
))
|
||||
(deftest "can pick detail fields out by name"
|
||||
(error "SKIP (skip-list): can pick detail fields out by name"))
|
||||
(hs-cleanup!)
|
||||
(let ((_el-d1 (dom-create-element "div")) (_el-d2 (dom-create-element "div")))
|
||||
(dom-set-attr _el-d1 "id" "d1")
|
||||
(dom-set-attr _el-d1 "_" "on click send custom(foo:\"fromBar\") to #d2")
|
||||
(dom-set-attr _el-d2 "id" "d2")
|
||||
(dom-set-attr _el-d2 "_" "on custom(foo) call me.classList.add(foo)")
|
||||
(dom-append (dom-body) _el-d1)
|
||||
(dom-append (dom-body) _el-d2)
|
||||
(hs-activate! _el-d1)
|
||||
(hs-activate! _el-d2)
|
||||
(assert (not (dom-has-class? _el-d2 "fromBar")))
|
||||
(dom-dispatch _el-d1 "click" nil)
|
||||
(assert (dom-has-class? _el-d2 "fromBar")))
|
||||
)
|
||||
(deftest "can refer to function in init blocks"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-d1 (dom-create-element "div")))
|
||||
@@ -9357,9 +9373,35 @@
|
||||
(hs-activate! _el-div)
|
||||
))
|
||||
(deftest "can pick detail fields out by name"
|
||||
(error "SKIP (skip-list): can pick detail fields out by name"))
|
||||
(hs-cleanup!)
|
||||
(let ((_el-d1 (dom-create-element "div")) (_el-d2 (dom-create-element "div")))
|
||||
(dom-set-attr _el-d1 "id" "d1")
|
||||
(dom-set-attr _el-d1 "_" "on click send custom(foo:\"fromBar\") to #d2")
|
||||
(dom-set-attr _el-d2 "id" "d2")
|
||||
(dom-set-attr _el-d2 "_" "on custom(foo) call me.classList.add(foo)")
|
||||
(dom-append (dom-body) _el-d1)
|
||||
(dom-append (dom-body) _el-d2)
|
||||
(hs-activate! _el-d1)
|
||||
(hs-activate! _el-d2)
|
||||
(assert (not (dom-has-class? _el-d2 "fromBar")))
|
||||
(dom-dispatch _el-d1 "click" nil)
|
||||
(assert (dom-has-class? _el-d2 "fromBar")))
|
||||
)
|
||||
(deftest "can pick event properties out by name"
|
||||
(error "SKIP (skip-list): can pick event properties out by name"))
|
||||
(hs-cleanup!)
|
||||
(let ((_el-d1 (dom-create-element "div")) (_el-d2 (dom-create-element "div")))
|
||||
(dom-set-attr _el-d1 "id" "d1")
|
||||
(dom-set-attr _el-d1 "_" "on click send fromBar to #d2")
|
||||
(dom-set-attr _el-d2 "id" "d2")
|
||||
(dom-set-attr _el-d2 "_" "on fromBar(type) call me.classList.add(type)")
|
||||
(dom-append (dom-body) _el-d1)
|
||||
(dom-append (dom-body) _el-d2)
|
||||
(hs-activate! _el-d1)
|
||||
(hs-activate! _el-d2)
|
||||
(assert (not (dom-has-class? _el-d2 "fromBar")))
|
||||
(dom-dispatch _el-d1 "click" nil)
|
||||
(assert (dom-has-class? _el-d2 "fromBar")))
|
||||
)
|
||||
(deftest "can queue all events"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-qa (dom-create-element "div")))
|
||||
@@ -9575,7 +9617,15 @@
|
||||
(hs-activate! _el-div)
|
||||
))
|
||||
(deftest "rethrown exceptions trigger 'exception' event"
|
||||
(error "SKIP (skip-list): rethrown exceptions trigger 'exception' event"))
|
||||
(hs-cleanup!)
|
||||
(let ((_el-button (dom-create-element "button")))
|
||||
(dom-set-attr _el-button "_"
|
||||
"on click put \"foo\" into me then throw \"bar\" catch e throw e on exception(error) put error into me")
|
||||
(dom-append (dom-body) _el-button)
|
||||
(hs-activate! _el-button)
|
||||
(dom-dispatch _el-button "click" nil)
|
||||
(assert= (dom-text-content _el-button) "bar"))
|
||||
)
|
||||
(deftest "supports \"elsewhere\" modifier"
|
||||
(hs-cleanup!)
|
||||
(let ((_el-div (dom-create-element "div")))
|
||||
@@ -9608,7 +9658,15 @@
|
||||
(assert= (dom-text-content (dom-query-by-id "d")) "1")
|
||||
))
|
||||
(deftest "uncaught exceptions trigger 'exception' event"
|
||||
(error "SKIP (skip-list): uncaught exceptions trigger 'exception' event"))
|
||||
(hs-cleanup!)
|
||||
(let ((_el-button (dom-create-element "button")))
|
||||
(dom-set-attr _el-button "_"
|
||||
"on click put \"foo\" into me then throw \"bar\" on exception(error) put error into me")
|
||||
(dom-append (dom-body) _el-button)
|
||||
(hs-activate! _el-button)
|
||||
(dom-dispatch _el-button "click" nil)
|
||||
(assert= (dom-text-content _el-button) "bar"))
|
||||
)
|
||||
)
|
||||
|
||||
;; ── pick (24 tests) ──
|
||||
|
||||
@@ -106,16 +106,11 @@ SKIP_TEST_NAMES = {
|
||||
# upstream 'on' category — missing runtime features
|
||||
"listeners on other elements are removed when the registering element is removed",
|
||||
"listeners on self are not removed when the element is removed",
|
||||
"can pick detail fields out by name",
|
||||
"can pick event properties out by name",
|
||||
"can be in a top level script tag",
|
||||
"multiple event handlers at a time are allowed to execute with the every keyword",
|
||||
"each behavior installation has its own event queue",
|
||||
"can catch exceptions thrown in js functions",
|
||||
"can catch exceptions thrown in hyperscript functions",
|
||||
"uncaught exceptions trigger 'exception' event",
|
||||
"rethrown exceptions trigger 'exception' event",
|
||||
"rethrown exceptions trigger 'exception' event",
|
||||
"basic finally blocks work",
|
||||
"finally blocks work when exception thrown in catch",
|
||||
"async basic finally blocks work",
|
||||
@@ -167,6 +162,94 @@ MANUAL_TEST_BODIES = {
|
||||
"can map an array": [
|
||||
' (assert= (map (eval-expr-cek (hs-to-sx (hs-compile "\\\\ s -> s.length"))) (list "a" "ab" "abc")) (list 1 2 3))',
|
||||
],
|
||||
# bootstrap: restore correct bodies that auto-regen gets wrong
|
||||
"can call functions": [
|
||||
' (hs-cleanup!)',
|
||||
' (host-set! (host-global "window") "calledWith" nil)',
|
||||
' (let ((_el-div (dom-create-element "div")))',
|
||||
' (dom-set-attr _el-div "_" "on click call globalFunction(\\"foo\\")")',
|
||||
' (dom-append (dom-body) _el-div)',
|
||||
' (hs-activate! _el-div)',
|
||||
' (dom-dispatch _el-div "click" nil)',
|
||||
' )',
|
||||
],
|
||||
"cleanup removes event listeners on the element": [
|
||||
' (hs-cleanup!)',
|
||||
' (let ((_el-div (dom-create-element "div")))',
|
||||
' (dom-set-attr _el-div "_" "on click add .foo")',
|
||||
' (dom-append (dom-body) _el-div)',
|
||||
' (hs-activate! _el-div)',
|
||||
' (dom-dispatch _el-div "click" nil)',
|
||||
' (assert (dom-has-class? _el-div "foo"))',
|
||||
' (hs-deactivate! _el-div)',
|
||||
' (dom-remove-class _el-div "foo")',
|
||||
' (dom-dispatch _el-div "click" nil)',
|
||||
' (assert (not (dom-has-class? _el-div "foo"))))',
|
||||
],
|
||||
"reinitializes if script attribute changes": [
|
||||
' (hs-cleanup!)',
|
||||
' (let ((_el-div (dom-create-element "div")))',
|
||||
' (dom-set-attr _el-div "_" "on click add .foo")',
|
||||
' (dom-append (dom-body) _el-div)',
|
||||
' (hs-activate! _el-div)',
|
||||
' (dom-dispatch _el-div "click" nil)',
|
||||
' (assert (dom-has-class? _el-div "foo"))',
|
||||
' (dom-set-attr _el-div "_" "on click add .bar")',
|
||||
' (hs-activate! _el-div)',
|
||||
' (dom-dispatch _el-div "click" nil)',
|
||||
' (assert (dom-has-class? _el-div "bar")))',
|
||||
],
|
||||
# on: event destructuring — on EVENT(prop) extracts from detail then event
|
||||
"can pick detail fields out by name": [
|
||||
' (hs-cleanup!)',
|
||||
' (let ((_el-d1 (dom-create-element "div")) (_el-d2 (dom-create-element "div")))',
|
||||
' (dom-set-attr _el-d1 "id" "d1")',
|
||||
' (dom-set-attr _el-d1 "_" "on click send custom(foo:\\"fromBar\\") to #d2")',
|
||||
' (dom-set-attr _el-d2 "id" "d2")',
|
||||
' (dom-set-attr _el-d2 "_" "on custom(foo) call me.classList.add(foo)")',
|
||||
' (dom-append (dom-body) _el-d1)',
|
||||
' (dom-append (dom-body) _el-d2)',
|
||||
' (hs-activate! _el-d1)',
|
||||
' (hs-activate! _el-d2)',
|
||||
' (assert (not (dom-has-class? _el-d2 "fromBar")))',
|
||||
' (dom-dispatch _el-d1 "click" nil)',
|
||||
' (assert (dom-has-class? _el-d2 "fromBar")))',
|
||||
],
|
||||
"can pick event properties out by name": [
|
||||
' (hs-cleanup!)',
|
||||
' (let ((_el-d1 (dom-create-element "div")) (_el-d2 (dom-create-element "div")))',
|
||||
' (dom-set-attr _el-d1 "id" "d1")',
|
||||
' (dom-set-attr _el-d1 "_" "on click send fromBar to #d2")',
|
||||
' (dom-set-attr _el-d2 "id" "d2")',
|
||||
' (dom-set-attr _el-d2 "_" "on fromBar(type) call me.classList.add(type)")',
|
||||
' (dom-append (dom-body) _el-d1)',
|
||||
' (dom-append (dom-body) _el-d2)',
|
||||
' (hs-activate! _el-d1)',
|
||||
' (hs-activate! _el-d2)',
|
||||
' (assert (not (dom-has-class? _el-d2 "fromBar")))',
|
||||
' (dom-dispatch _el-d1 "click" nil)',
|
||||
' (assert (dom-has-class? _el-d2 "fromBar")))',
|
||||
],
|
||||
"rethrown exceptions trigger 'exception' event": [
|
||||
' (hs-cleanup!)',
|
||||
' (let ((_el-button (dom-create-element "button")))',
|
||||
' (dom-set-attr _el-button "_"',
|
||||
' "on click put \\"foo\\" into me then throw \\"bar\\" catch e throw e on exception(error) put error into me")',
|
||||
' (dom-append (dom-body) _el-button)',
|
||||
' (hs-activate! _el-button)',
|
||||
' (dom-dispatch _el-button "click" nil)',
|
||||
' (assert= (dom-text-content _el-button) "bar"))',
|
||||
],
|
||||
"uncaught exceptions trigger 'exception' event": [
|
||||
' (hs-cleanup!)',
|
||||
' (let ((_el-button (dom-create-element "button")))',
|
||||
' (dom-set-attr _el-button "_"',
|
||||
' "on click put \\"foo\\" into me then throw \\"bar\\" on exception(error) put error into me")',
|
||||
' (dom-append (dom-body) _el-button)',
|
||||
' (hs-activate! _el-button)',
|
||||
' (dom-dispatch _el-button "click" nil)',
|
||||
' (assert= (dom-text-content _el-button) "bar"))',
|
||||
],
|
||||
}
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user