From f1428009fde62d8dfe4f013bedb359acbc6f76fb Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 6 May 2026 15:17:22 +0000 Subject: [PATCH] HS: on EVENT from SRC or EVENT from SRC multi-source listener (+1 test) Parser: limit `from SOURCE` to parse-collection/cmp/arith/poss/atom (stops before parse-logical so `or` is not consumed as binary op), then collect `or EVENT from SOURCE` pairs via recursive collect-ors!. Adds :or-sources key to the on-feature parts list. Compiler: scan-on gains or-sources param (11th); new :or-sources cond clause extracts the list; terminal `true` branch wraps on-call in (do on-call (hs-on target event handler) ...) for each extra source. Test: "can handle an or after a from clause" moved from skip-list to MANUAL_TEST_BODIES and now passes (1478/1496). Co-Authored-By: Claude Sonnet 4.6 --- lib/hyperscript/compiler.sx | 68 +++++++++++++++++++---- lib/hyperscript/parser.sx | 38 ++++++++++--- spec/tests/test-hyperscript-behavioral.sx | 16 +++++- tests/playwright/generate-sx-tests.py | 17 +++++- 4 files changed, 117 insertions(+), 22 deletions(-) diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index 07c4d91c..c323bb52 100644 --- a/lib/hyperscript/compiler.sx +++ b/lib/hyperscript/compiler.sx @@ -221,7 +221,8 @@ having-info of-filter-info count-filter-info - elsewhere?) + elsewhere? + or-sources) (cond ((<= (len items) 1) (let @@ -279,7 +280,27 @@ having-info (get having-info "threshold") nil)))) - (true on-call)))))))))))) + (true + (if + or-sources + (cons + (quote do) + (cons + on-call + (map + (fn + (pair) + (list + (quote hs-on) + (if + (nth pair 1) + (hs-to-sx + (nth pair 1)) + (quote me)) + (first pair) + handler)) + or-sources))) + on-call))))))))))))) ((= (first items) :from) (scan-on (rest (rest items)) @@ -291,7 +312,8 @@ having-info of-filter-info count-filter-info - elsewhere?)) + elsewhere? + or-sources)) ((= (first items) :filter) (scan-on (rest (rest items)) @@ -303,7 +325,8 @@ having-info of-filter-info count-filter-info - elsewhere?)) + elsewhere? + or-sources)) ((= (first items) :every) (scan-on (rest (rest items)) @@ -315,7 +338,8 @@ having-info of-filter-info count-filter-info - elsewhere?)) + elsewhere? + or-sources)) ((= (first items) :catch) (scan-on (rest (rest items)) @@ -327,7 +351,8 @@ having-info of-filter-info count-filter-info - elsewhere?)) + elsewhere? + or-sources)) ((= (first items) :finally) (scan-on (rest (rest items)) @@ -339,7 +364,8 @@ having-info of-filter-info count-filter-info - elsewhere?)) + elsewhere? + or-sources)) ((= (first items) :having) (scan-on (rest (rest items)) @@ -351,7 +377,8 @@ (nth items 1) of-filter-info count-filter-info - elsewhere?)) + elsewhere? + or-sources)) ((= (first items) :of-filter) (scan-on (rest (rest items)) @@ -363,7 +390,8 @@ having-info (nth items 1) count-filter-info - elsewhere?)) + elsewhere? + or-sources)) ((= (first items) :count-filter) (scan-on (rest (rest items)) @@ -375,7 +403,8 @@ having-info of-filter-info (nth items 1) - elsewhere?)) + elsewhere? + or-sources)) ((= (first items) :elsewhere) (scan-on (rest (rest items)) @@ -387,6 +416,20 @@ having-info of-filter-info count-filter-info + (nth items 1) + or-sources)) + ((= (first items) :or-sources) + (scan-on + (rest (rest items)) + source + filter + every? + catch-info + finally-info + having-info + of-filter-info + count-filter-info + elsewhere? (nth items 1))) (true (scan-on @@ -399,8 +442,9 @@ having-info of-filter-info count-filter-info - elsewhere?))))) - (scan-on (rest parts) nil nil false nil nil nil nil nil false))))) + elsewhere? + or-sources))))) + (scan-on (rest parts) nil nil false nil nil nil nil nil false nil))))) (define emit-send (fn diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index e245f39c..676b0887 100644 --- a/lib/hyperscript/parser.sx +++ b/lib/hyperscript/parser.sx @@ -3028,7 +3028,27 @@ ((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil))) (let ((elsewhere? (cond ((match-kw "elsewhere") true) ((and (= (tp-type) "keyword") (= (tp-val) "from") (let ((nxt (if (< (+ p 1) tok-len) (nth tokens (+ p 1)) nil))) (and nxt (= (get nxt "type") "keyword") (= (get nxt "value") "elsewhere")))) (do (adv!) (adv!) true)) (true false))) - (source (if (match-kw "from") (parse-expr) nil))) + (source + (if + (match-kw "from") + (parse-collection + (parse-cmp + (parse-arith (parse-poss (parse-atom))))) + nil))) + (define + collect-ors! + (fn + (acc) + (if + (match-kw "or") + (let + ((or-evt (parse-compound-event-name)) + (or-src + (if (match-kw "from") (parse-expr) nil))) + (collect-ors! + (append acc (list (list or-evt or-src))))) + acc))) + (define or-sources (collect-ors! (list))) (let ((h-margin nil) (h-threshold nil)) (define @@ -3081,18 +3101,20 @@ (let ((parts (if source (append parts (list :from source)) parts))) (let - ((parts (if count-filter (append parts (list :count-filter count-filter)) parts))) + ((parts (if (> (len or-sources) 0) (append parts (list :or-sources or-sources)) parts))) (let - ((parts (if of-filter (append parts (list :of-filter of-filter)) parts))) + ((parts (if count-filter (append parts (list :count-filter count-filter)) parts))) (let - ((parts (if having (append parts (list :having having)) parts))) + ((parts (if of-filter (append parts (list :of-filter of-filter)) parts))) (let - ((parts (if catch-clause (append parts (list :catch catch-clause)) parts))) + ((parts (if having (append parts (list :having having)) parts))) (let - ((parts (if finally-clause (append parts (list :finally finally-clause)) parts))) + ((parts (if catch-clause (append parts (list :catch catch-clause)) parts))) (let - ((parts (append parts (list (if (> (len event-vars) 0) (cons (quote do) (append (map (fn (nm) (list (quote ref) nm)) event-vars) (if (and (list? body) (= (first body) (quote do))) (rest body) (list body)))) body))))) - parts)))))))))))))))))))))))) + ((parts (if finally-clause (append parts (list :finally finally-clause)) parts))) + (let + ((parts (append parts (list (if (> (len event-vars) 0) (cons (quote do) (append (map (fn (nm) (list (quote ref) nm)) event-vars) (if (and (list? body) (= (first body) (quote do))) (rest body) (list body)))) body))))) + parts))))))))))))))))))))))))) (define parse-init-feat (fn diff --git a/spec/tests/test-hyperscript-behavioral.sx b/spec/tests/test-hyperscript-behavioral.sx index bd4aff24..8af8016e 100644 --- a/spec/tests/test-hyperscript-behavioral.sx +++ b/spec/tests/test-hyperscript-behavioral.sx @@ -9448,7 +9448,21 @@ (hs-activate! _el-d1) )) (deftest "can handle an or after a from clause" - (error "SKIP (skip-list): can handle an or after a from clause")) + (hs-cleanup!) + (let ((_d1 (dom-create-element "div")) + (_d2 (dom-create-element "div")) + (_el (dom-create-element "div"))) + (dom-set-attr _d1 "id" "d1") + (dom-set-attr _d2 "id" "d2") + (dom-set-attr _el "_" "on click from #d1 or click from #d2 increment @count then put @count into me") + (dom-append (dom-body) _d1) + (dom-append (dom-body) _d2) + (dom-append (dom-body) _el) + (hs-activate! _el) + (dom-dispatch _d1 "click" nil) + (dom-dispatch _d2 "click" nil) + (assert= (dom-text-content _el) "2")) + ) (deftest "can have a simple event filter" (hs-cleanup!) (let ((_el-d1 (dom-create-element "div"))) diff --git a/tests/playwright/generate-sx-tests.py b/tests/playwright/generate-sx-tests.py index f603ac13..58db4765 100644 --- a/tests/playwright/generate-sx-tests.py +++ b/tests/playwright/generate-sx-tests.py @@ -111,7 +111,6 @@ SKIP_TEST_NAMES = { "each behavior installation has its own event queue", "can catch exceptions thrown in hyperscript functions", "can catch exceptions thrown in js functions", - "can handle an or after a from clause", # upstream 'fetch' category — real DocumentFragment semantics (`its childElementCount` # after `as html`) not exercisable with our DOM mock. "can do a simple fetch w/ html", @@ -155,6 +154,22 @@ MANUAL_TEST_BODIES = { ' (assert-contains "foo" _names)', ' (assert-contains "bar" _values))', ], + "can handle an or after a from clause": [ + ' (hs-cleanup!)', + ' (let ((_d1 (dom-create-element "div"))', + ' (_d2 (dom-create-element "div"))', + ' (_el (dom-create-element "div")))', + ' (dom-set-attr _d1 "id" "d1")', + ' (dom-set-attr _d2 "id" "d2")', + ' (dom-set-attr _el "_" "on click from #d1 or click from #d2 increment @count then put @count into me")', + ' (dom-append (dom-body) _d1)', + ' (dom-append (dom-body) _d2)', + ' (dom-append (dom-body) _el)', + ' (hs-activate! _el)', + ' (dom-dispatch _d1 "click" nil)', + ' (dom-dispatch _d2 "click" nil)', + ' (assert= (dom-text-content _el) "2"))', + ], "raises a helpful error when the worker plugin is not installed": [ ' (hs-cleanup!)', ' (let ((caught nil))',