diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index e685be17..850b222a 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -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 diff --git a/shared/static/wasm/sx/hs-compiler.sx b/shared/static/wasm/sx/hs-compiler.sx index e685be17..850b222a 100644 --- a/shared/static/wasm/sx/hs-compiler.sx +++ b/shared/static/wasm/sx/hs-compiler.sx @@ -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 diff --git a/spec/tests/test-hyperscript-behavioral.sx b/spec/tests/test-hyperscript-behavioral.sx index 0e77d941..e739487b 100644 --- a/spec/tests/test-hyperscript-behavioral.sx +++ b/spec/tests/test-hyperscript-behavioral.sx @@ -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) ── diff --git a/tests/playwright/generate-sx-tests.py b/tests/playwright/generate-sx-tests.py index 68cf0474..c8205bcf 100644 --- a/tests/playwright/generate-sx-tests.py +++ b/tests/playwright/generate-sx-tests.py @@ -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"))', + ], }