coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

HS: fix parser then-skip + bootstrap test fixes (+3)

Browse Source 
Parser: parse-cmd-list now skips a leading 'then' token so that
'on click from #bar then add .clicked' compiles correctly instead
of producing nil as the body.

Bootstrap tests: fix two broken tests whose assertions were
incomplete or contradictory:
- "cleanup removes event listeners" — deactivate + re-click to
  verify listener is gone
- "reinitializes if script attribute changes" — actually change
  the _ attribute before re-activating and re-clicking

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-26 21:26:16 +00:00
parent 8b972483ae
commit 87072e61c1
3 changed files with 73 additions and 88 deletions
Download Patch File Download Diff File Expand all files Collapse all files

75
lib/hyperscript/parser.sx
View File

@@ -10,8 +10,10 @@
(tokens src) (tokens src)
(let (let
((tokens (filter (fn (t) (not (= (get t "type") "whitespace"))) tokens)) ((tokens (filter (fn (t) (not (= (get t "type") "whitespace"))) tokens))
(p 0) (p 0)
(tok-len (len (filter (fn (t) (not (= (get t "type") "whitespace"))) tokens)))) (tok-len
(len
(filter (fn (t) (not (= (get t "type") "whitespace"))) tokens))))
(define tp (fn () (if (< p tok-len) (nth tokens p) nil))) (define tp (fn () (if (< p tok-len) (nth tokens p) nil)))
(define (define
tp-type tp-type
@@ -1801,25 +1803,7 @@
(let (let
((fmt (or fmt-before fmt-after "text"))) ((fmt (or fmt-before fmt-after "text")))
(let (let
((do-not-throw ((do-not-throw (cond ((and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "do")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "not")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw")) (do (adv!) true) false)) false))) ((and (= (tp-type) "ident") (= (tp-val) "don't")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw")) (do (adv!) true) false))) (true false))))
(cond
((and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "do"))
(do
(adv!)
(if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "not"))
(do
(adv!)
(if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw"))
(do (adv!) true)
false))
false)))
((and (= (tp-type) "ident") (= (tp-val) "don't"))
(do
(adv!)
(if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw"))
(do (adv!) true)
false)))
(true false))))
(list (quote fetch) url fmt do-not-throw)))))))))) (list (quote fetch) url fmt do-not-throw))))))))))
(define (define
parse-call-args parse-call-args
@@ -2768,27 +2752,34 @@
cl-collect cl-collect
(fn (fn
(acc) (acc)
(let (do
((cmd (parse-cmd))) (when
(if (and (= (tp-type) "keyword") (= (tp-val) "then"))
(nil? cmd) (adv!))
acc (let
(let ((cmd (parse-cmd)))
((acc2 (append acc (list cmd)))) (if
(cond (nil? cmd)
((match-kw "unless") acc
(let (let
((cnd (parse-expr))) ((acc2 (append acc (list cmd))))
(cl-collect (cond
(append ((match-kw "unless")
acc (let
(list ((cnd (parse-expr)))
(list (quote if) (list (quote no) cnd) cmd)))))) (cl-collect
((match-kw "then") (append
(cl-collect (append acc2 (list (quote __then__))))) acc
((or (and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val))) (= (tp-type) "paren-open")) (list
(cl-collect acc2)) (list
(true acc2))))))) (quote if)
(list (quote no) cnd)
cmd))))))
((match-kw "then")
(cl-collect (append acc2 (list (quote __then__)))))
((or (and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val))) (= (tp-type) "paren-open"))
(cl-collect acc2))
(true acc2))))))))
(let (let
((cmds (cl-collect (list)))) ((cmds (cl-collect (list))))
(define (define

75
shared/static/wasm/sx/hs-parser.sx
View File

@@ -10,8 +10,10 @@
(tokens src) (tokens src)
(let (let
((tokens (filter (fn (t) (not (= (get t "type") "whitespace"))) tokens)) ((tokens (filter (fn (t) (not (= (get t "type") "whitespace"))) tokens))
(p 0) (p 0)
(tok-len (len (filter (fn (t) (not (= (get t "type") "whitespace"))) tokens)))) (tok-len
(len
(filter (fn (t) (not (= (get t "type") "whitespace"))) tokens))))
(define tp (fn () (if (< p tok-len) (nth tokens p) nil))) (define tp (fn () (if (< p tok-len) (nth tokens p) nil)))
(define (define
tp-type tp-type
@@ -1801,25 +1803,7 @@
(let (let
((fmt (or fmt-before fmt-after "text"))) ((fmt (or fmt-before fmt-after "text")))
(let (let
((do-not-throw ((do-not-throw (cond ((and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "do")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "not")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw")) (do (adv!) true) false)) false))) ((and (= (tp-type) "ident") (= (tp-val) "don't")) (do (adv!) (if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw")) (do (adv!) true) false))) (true false))))
(cond
((and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "do"))
(do
(adv!)
(if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "not"))
(do
(adv!)
(if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw"))
(do (adv!) true)
false))
false)))
((and (= (tp-type) "ident") (= (tp-val) "don't"))
(do
(adv!)
(if (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "throw"))
(do (adv!) true)
false)))
(true false))))
(list (quote fetch) url fmt do-not-throw)))))))))) (list (quote fetch) url fmt do-not-throw))))))))))
(define (define
parse-call-args parse-call-args
@@ -2768,27 +2752,34 @@
cl-collect cl-collect
(fn (fn
(acc) (acc)
(let (do
((cmd (parse-cmd))) (when
(if (and (= (tp-type) "keyword") (= (tp-val) "then"))
(nil? cmd) (adv!))
acc (let
(let ((cmd (parse-cmd)))
((acc2 (append acc (list cmd)))) (if
(cond (nil? cmd)
((match-kw "unless") acc
(let (let
((cnd (parse-expr))) ((acc2 (append acc (list cmd))))
(cl-collect (cond
(append ((match-kw "unless")
acc (let
(list ((cnd (parse-expr)))
(list (quote if) (list (quote no) cnd) cmd)))))) (cl-collect
((match-kw "then") (append
(cl-collect (append acc2 (list (quote __then__))))) acc
((or (and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val))) (= (tp-type) "paren-open")) (list
(cl-collect acc2)) (list
(true acc2))))))) (quote if)
(list (quote no) cnd)
cmd))))))
((match-kw "then")
(cl-collect (append acc2 (list (quote __then__)))))
((or (and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val))) (= (tp-type) "paren-open"))
(cl-collect acc2))
(true acc2))))))))
(let (let
((cmds (cl-collect (list)))) ((cmds (cl-collect (list))))
(define (define

11
spec/tests/test-hyperscript-behavioral.sx
View File

@@ -1396,8 +1396,10 @@
(hs-activate! _el-div) (hs-activate! _el-div)
(dom-dispatch _el-div "click" nil) (dom-dispatch _el-div "click" nil)
(assert (dom-has-class? _el-div "foo")) (assert (dom-has-class? _el-div "foo"))
(assert (not (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")))))
(deftest "cleanup tracks listeners in elt._hyperscript" (deftest "cleanup tracks listeners in elt._hyperscript"
(hs-cleanup!) (hs-cleanup!)
(let ((_el-div (dom-create-element "div"))) (let ((_el-div (dom-create-element "div")))
@@ -1478,9 +1480,10 @@
(hs-activate! _el-div) (hs-activate! _el-div)
(dom-dispatch _el-div "click" nil) (dom-dispatch _el-div "click" nil)
(assert (dom-has-class? _el-div "foo")) (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) (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" (deftest "sets data-hyperscript-powered on initialized elements"
(hs-cleanup!) (hs-cleanup!)
(let ((_el-div (dom-create-element "div"))) (let ((_el-div (dom-create-element "div")))