HS: MutationObserver mock + on mutation dispatch (+7 tests)

Parser: parse-on-feat now consumes `of FILTER` after `mutation` event-name,
where FILTER is `attributes`/`childList`/`characterData` ident or `@a [or @b]*`
attr-token chain. Emits :of-filter dict on parts. Compiler: scan-on threads
of-filter-info; mutation event-name emits `(do (hs-on …) (hs-on-mutation-attach!
TARGET MODE ATTRS))`. Runtime: hs-on-mutation-attach! constructs a real
MutationObserver with config matched to filter and dispatches "mutation" event
with records detail. Runner: HsMutationObserver mock with global registry;
prototype hooks on El.setAttribute/appendChild/removeChild/_setInnerHTML fire
matching observers synchronously, with __hsMutationActive guard preventing
recursion. Generator: dropped 7 mutation tests from skip-list, added
evaluate(setAttribute) and evaluate(appendChild) body patterns.

hs-upstream-on: 36/70 → 43/70. Smoke 0-195 unchanged at 170/195.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-04-25 11:52:54 +00:00
parent 1340284bc8
commit 13e0254261
9 changed files with 560 additions and 261 deletions

View File

@@ -2605,59 +2605,66 @@
(let
((event-name (parse-compound-event-name)))
(let
((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil)))
((of-filter (when (and (= event-name "mutation") (match-kw "of")) (cond ((and (= (tp-type) "ident") (or (= (tp-val) "attributes") (= (tp-val) "childList") (= (tp-val) "characterData"))) (let ((nm (tp-val))) (do (adv!) (dict "type" nm)))) ((= (tp-type) "attr") (let ((attrs (list (tp-val)))) (do (adv!) (define collect-or! (fn () (when (match-kw "or") (cond ((= (tp-type) "attr") (do (set! attrs (append attrs (list (tp-val)))) (adv!) (collect-or!))) (true (set! p (- p 1))))))) (collect-or!) (dict "type" "attrs" "attrs" attrs)))) (true nil)))))
(let
((source (if (match-kw "from") (parse-expr) nil)))
((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil)))
(let
((h-margin nil) (h-threshold nil))
(define
consume-having!
(fn
()
(cond
((and (= (tp-type) "ident") (= (tp-val) "having"))
(do
(adv!)
(cond
((and (= (tp-type) "ident") (= (tp-val) "margin"))
(do
(adv!)
(set! h-margin (parse-expr))
(consume-having!)))
((and (= (tp-type) "ident") (= (tp-val) "threshold"))
(do
(adv!)
(set! h-threshold (parse-expr))
(consume-having!)))
(true nil))))
(true nil))))
(consume-having!)
((source (if (match-kw "from") (parse-expr) nil)))
(let
((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
((h-margin nil) (h-threshold nil))
(define
consume-having!
(fn
()
(cond
((and (= (tp-type) "ident") (= (tp-val) "having"))
(do
(adv!)
(cond
((and (= (tp-type) "ident") (= (tp-val) "margin"))
(do
(adv!)
(set! h-margin (parse-expr))
(consume-having!)))
((and (= (tp-type) "ident") (= (tp-val) "threshold"))
(do
(adv!)
(set! h-threshold (parse-expr))
(consume-having!)))
(true nil))))
(true nil))))
(consume-having!)
(let
((body (parse-cmd-list)))
((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
(let
((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil))
(finally-clause
(if (match-kw "finally") (parse-cmd-list) nil)))
(match-kw "end")
((body (parse-cmd-list)))
(let
((parts (list (quote on) event-name)))
((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil))
(finally-clause
(if
(match-kw "finally")
(parse-cmd-list)
nil)))
(match-kw "end")
(let
((parts (if every? (append parts (list :every true)) parts)))
((parts (list (quote on) event-name)))
(let
((parts (if flt (append parts (list :filter flt)) parts)))
((parts (if every? (append parts (list :every true)) parts)))
(let
((parts (if source (append parts (list :from source)) parts)))
((parts (if flt (append parts (list :filter flt)) parts)))
(let
((parts (if having (append parts (list :having having)) parts)))
((parts (if source (append parts (list :from source)) parts)))
(let
((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
((parts (if of-filter (append parts (list :of-filter of-filter)) parts)))
(let
((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
((parts (if having (append parts (list :having having)) parts)))
(let
((parts (append parts (list body))))
parts))))))))))))))))))
((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
(let
((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
(let
((parts (append parts (list body))))
parts))))))))))))))))))))
(define
parse-init-feat
(fn