HS: DOM ref-eq + compound selector + DOM tree fixes
- hs-id= uses JS === for DOM elements (hs-ref-eq), = for scalars - != operator now uses hs-id= for structural correctness - compound tag[attr=val] selector matching in test runner - dom-query-all replaces host-call querySelectorAll - DOM tree structure corrected in 4 generated tests (elements were appended to wrong parents)
This commit is contained in:
@@ -1148,6 +1148,11 @@
|
||||
(quote =)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote hs-id=))
|
||||
(list
|
||||
(quote hs-id=)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote +))
|
||||
(list
|
||||
(quote hs-add)
|
||||
|
||||
@@ -550,7 +550,9 @@
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote eq-ignore-case) left right)))
|
||||
(list (quote not) (list (quote =) left right)))))))
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote hs-id=) left right)))))))
|
||||
((match-kw "empty") (list (quote empty?) left))
|
||||
((match-kw "less")
|
||||
(do
|
||||
|
||||
@@ -650,9 +650,7 @@
|
||||
(true (find-prev (dom-get-prop el "previousElementSibling"))))))
|
||||
(find-prev sibling)))))
|
||||
|
||||
(define
|
||||
hs-query-all
|
||||
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
|
||||
(define hs-query-all (fn (sel) (dom-query-all (dom-body) sel)))
|
||||
|
||||
|
||||
|
||||
@@ -662,10 +660,7 @@
|
||||
hs-query-all-in
|
||||
(fn
|
||||
(sel target)
|
||||
(if
|
||||
(nil? target)
|
||||
(hs-query-all sel)
|
||||
(host-call target "querySelectorAll" sel))))
|
||||
(if (nil? target) (hs-query-all sel) (dom-query-all target sel))))
|
||||
|
||||
(define
|
||||
hs-list-set
|
||||
@@ -1418,6 +1413,15 @@
|
||||
hs-strict-eq
|
||||
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
|
||||
|
||||
(define
|
||||
hs-id=
|
||||
(fn
|
||||
(a b)
|
||||
(if
|
||||
(and (= (host-typeof a) "element") (= (host-typeof b) "element"))
|
||||
(hs-ref-eq a b)
|
||||
(= a b))))
|
||||
|
||||
(define
|
||||
hs-eq-ignore-case
|
||||
(fn (a b) (= (downcase (str a)) (downcase (str b)))))
|
||||
@@ -2511,14 +2515,14 @@
|
||||
((= a b) true)
|
||||
(true (hs-dom-is-ancestor? a (dom-parent b))))))
|
||||
|
||||
;; ── SourceInfo API ────────────────────────────────────────────────
|
||||
|
||||
(define
|
||||
hs-win-call
|
||||
(fn
|
||||
(fn-name args)
|
||||
(let ((fn (host-global fn-name))) (if fn (host-call-fn fn args) nil))))
|
||||
|
||||
;; ── SourceInfo API ────────────────────────────────────────────────
|
||||
|
||||
(define
|
||||
hs-source-for
|
||||
(fn
|
||||
@@ -2534,16 +2538,9 @@
|
||||
(line-idx (- (get node :line) 1)))
|
||||
(if (< line-idx (len lines)) (nth lines line-idx) ""))))
|
||||
|
||||
(define
|
||||
hs-node-get
|
||||
(fn
|
||||
(node key)
|
||||
(get (get node :fields) key)))
|
||||
(define hs-node-get (fn (node key) (get (get node :fields) key)))
|
||||
|
||||
(define
|
||||
hs-src
|
||||
(fn (src-str)
|
||||
(hs-source-for (hs-parse-ast src-str))))
|
||||
(define hs-src (fn (src-str) (hs-source-for (hs-parse-ast src-str))))
|
||||
|
||||
(define
|
||||
hs-src-at
|
||||
@@ -2553,7 +2550,8 @@
|
||||
walk
|
||||
(fn
|
||||
(node keys)
|
||||
(if (or (nil? keys) (= (len keys) 0))
|
||||
(if
|
||||
(or (nil? keys) (= (len keys) 0))
|
||||
node
|
||||
(walk (hs-node-get node (first keys)) (rest keys)))))
|
||||
(hs-source-for (walk (hs-parse-ast src-str) path))))
|
||||
@@ -2566,7 +2564,8 @@
|
||||
walk
|
||||
(fn
|
||||
(node keys)
|
||||
(if (or (nil? keys) (= (len keys) 0))
|
||||
(if
|
||||
(or (nil? keys) (= (len keys) 0))
|
||||
node
|
||||
(walk (hs-node-get node (first keys)) (rest keys)))))
|
||||
(hs-line-for (walk (hs-parse-ast src-str) path))))
|
||||
|
||||
@@ -1148,6 +1148,11 @@
|
||||
(quote =)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote hs-id=))
|
||||
(list
|
||||
(quote hs-id=)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote +))
|
||||
(list
|
||||
(quote hs-add)
|
||||
|
||||
@@ -550,7 +550,9 @@
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote eq-ignore-case) left right)))
|
||||
(list (quote not) (list (quote =) left right)))))))
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote hs-id=) left right)))))))
|
||||
((match-kw "empty") (list (quote empty?) left))
|
||||
((match-kw "less")
|
||||
(do
|
||||
|
||||
@@ -650,9 +650,7 @@
|
||||
(true (find-prev (dom-get-prop el "previousElementSibling"))))))
|
||||
(find-prev sibling)))))
|
||||
|
||||
(define
|
||||
hs-query-all
|
||||
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
|
||||
(define hs-query-all (fn (sel) (dom-query-all (dom-body) sel)))
|
||||
|
||||
|
||||
|
||||
@@ -662,10 +660,7 @@
|
||||
hs-query-all-in
|
||||
(fn
|
||||
(sel target)
|
||||
(if
|
||||
(nil? target)
|
||||
(hs-query-all sel)
|
||||
(host-call target "querySelectorAll" sel))))
|
||||
(if (nil? target) (hs-query-all sel) (dom-query-all target sel))))
|
||||
|
||||
(define
|
||||
hs-list-set
|
||||
@@ -1418,6 +1413,15 @@
|
||||
hs-strict-eq
|
||||
(fn (a b) (and (= (type-of a) (type-of b)) (= a b))))
|
||||
|
||||
(define
|
||||
hs-id=
|
||||
(fn
|
||||
(a b)
|
||||
(if
|
||||
(and (= (host-typeof a) "element") (= (host-typeof b) "element"))
|
||||
(hs-ref-eq a b)
|
||||
(= a b))))
|
||||
|
||||
(define
|
||||
hs-eq-ignore-case
|
||||
(fn (a b) (= (downcase (str a)) (downcase (str b)))))
|
||||
@@ -2511,14 +2515,14 @@
|
||||
((= a b) true)
|
||||
(true (hs-dom-is-ancestor? a (dom-parent b))))))
|
||||
|
||||
;; ── SourceInfo API ────────────────────────────────────────────────
|
||||
|
||||
(define
|
||||
hs-win-call
|
||||
(fn
|
||||
(fn-name args)
|
||||
(let ((fn (host-global fn-name))) (if fn (host-call-fn fn args) nil))))
|
||||
|
||||
;; ── SourceInfo API ────────────────────────────────────────────────
|
||||
|
||||
(define
|
||||
hs-source-for
|
||||
(fn
|
||||
@@ -2534,16 +2538,9 @@
|
||||
(line-idx (- (get node :line) 1)))
|
||||
(if (< line-idx (len lines)) (nth lines line-idx) ""))))
|
||||
|
||||
(define
|
||||
hs-node-get
|
||||
(fn
|
||||
(node key)
|
||||
(get (get node :fields) key)))
|
||||
(define hs-node-get (fn (node key) (get (get node :fields) key)))
|
||||
|
||||
(define
|
||||
hs-src
|
||||
(fn (src-str)
|
||||
(hs-source-for (hs-parse-ast src-str))))
|
||||
(define hs-src (fn (src-str) (hs-source-for (hs-parse-ast src-str))))
|
||||
|
||||
(define
|
||||
hs-src-at
|
||||
@@ -2553,7 +2550,8 @@
|
||||
walk
|
||||
(fn
|
||||
(node keys)
|
||||
(if (or (nil? keys) (= (len keys) 0))
|
||||
(if
|
||||
(or (nil? keys) (= (len keys) 0))
|
||||
node
|
||||
(walk (hs-node-get node (first keys)) (rest keys)))))
|
||||
(hs-source-for (walk (hs-parse-ast src-str) path))))
|
||||
@@ -2566,7 +2564,8 @@
|
||||
walk
|
||||
(fn
|
||||
(node keys)
|
||||
(if (or (nil? keys) (= (len keys) 0))
|
||||
(if
|
||||
(or (nil? keys) (= (len keys) 0))
|
||||
node
|
||||
(walk (hs-node-get node (first keys)) (rest keys)))))
|
||||
(hs-line-for (walk (hs-parse-ast src-str) path))))
|
||||
|
||||
@@ -1992,8 +1992,8 @@
|
||||
(dom-set-attr _el-d2 "id" "d2")
|
||||
(dom-set-attr _el-div "_" "on click make a <p/> then put #i1.value into its textContent put it.outerHTML at end of #d2")
|
||||
(dom-append (dom-body) _el-i1)
|
||||
(dom-append _el-i1 _el-d2)
|
||||
(dom-append _el-i1 _el-div)
|
||||
(dom-append (dom-body) _el-d2)
|
||||
(dom-append (dom-body) _el-div)
|
||||
(hs-activate! _el-div)
|
||||
(dom-dispatch (dom-query "div:nth-of-type(2)") "click" nil)
|
||||
))
|
||||
@@ -3479,11 +3479,11 @@
|
||||
(dom-set-attr _el-input6 "value" "555-1212")
|
||||
(dom-append (dom-body) _el-qsdiv)
|
||||
(dom-append _el-qsdiv _el-input)
|
||||
(dom-append _el-input _el-br)
|
||||
(dom-append _el-br _el-input3)
|
||||
(dom-append _el-input3 _el-br4)
|
||||
(dom-append _el-br4 _el-input5)
|
||||
(dom-append _el-input5 _el-input6)
|
||||
(dom-append _el-qsdiv _el-br)
|
||||
(dom-append _el-qsdiv _el-input3)
|
||||
(dom-append _el-qsdiv _el-br4)
|
||||
(dom-append _el-qsdiv _el-input5)
|
||||
(dom-append _el-qsdiv _el-input6)
|
||||
(hs-activate! _el-qsdiv)
|
||||
))
|
||||
(deftest "converts an array into HTML"
|
||||
@@ -4111,9 +4111,9 @@
|
||||
(dom-append _el-table _el-tr)
|
||||
(dom-append _el-tr _el-td)
|
||||
(dom-append _el-td _el-input)
|
||||
(dom-append _el-input _el-input4)
|
||||
(dom-append _el-input4 _el-master)
|
||||
(dom-append _el-master _el-out)
|
||||
(dom-append _el-td _el-input4)
|
||||
(dom-append _el-td _el-master)
|
||||
(dom-append (dom-body) _el-out)
|
||||
(hs-activate! _el-master)
|
||||
(dom-dispatch (dom-query-by-id "master") "click" nil)
|
||||
(assert= (dom-text-content (dom-query-by-id "out")) "2")
|
||||
@@ -4194,13 +4194,13 @@
|
||||
(dom-append _el-table _el-tr)
|
||||
(dom-append _el-tr _el-td)
|
||||
(dom-append _el-td _el-input)
|
||||
(dom-append _el-input _el-tr4)
|
||||
(dom-append _el-table _el-tr4)
|
||||
(dom-append _el-tr4 _el-td5)
|
||||
(dom-append _el-td5 _el-input6)
|
||||
(dom-append _el-input6 _el-tr7)
|
||||
(dom-append _el-table _el-tr7)
|
||||
(dom-append _el-tr7 _el-td8)
|
||||
(dom-append _el-td8 _el-input9)
|
||||
(dom-append _el-input9 _el-tr10)
|
||||
(dom-append _el-table _el-tr10)
|
||||
(dom-append _el-tr10 _el-td11)
|
||||
(dom-append _el-td11 _el-master)
|
||||
(hs-activate! _el-master)
|
||||
@@ -4382,13 +4382,13 @@
|
||||
(dom-append _el-table _el-tr)
|
||||
(dom-append _el-tr _el-td)
|
||||
(dom-append _el-td _el-input)
|
||||
(dom-append _el-input _el-tr4)
|
||||
(dom-append _el-table _el-tr4)
|
||||
(dom-append _el-tr4 _el-td5)
|
||||
(dom-append _el-td5 _el-input6)
|
||||
(dom-append _el-input6 _el-tr7)
|
||||
(dom-append _el-table _el-tr7)
|
||||
(dom-append _el-tr7 _el-td8)
|
||||
(dom-append _el-td8 _el-input9)
|
||||
(dom-append _el-input9 _el-tr10)
|
||||
(dom-append _el-table _el-tr10)
|
||||
(dom-append _el-tr10 _el-td11)
|
||||
(dom-append _el-td11 _el-master)
|
||||
(hs-activate! _el-master)
|
||||
@@ -4407,9 +4407,9 @@
|
||||
(dom-set-inner-html _el-script "<input type=\"checkbox\" _=\"set :checkboxes to <input[type=checkbox]/> in #box where it is not me on change set checked of the :checkboxes to my checked\">")
|
||||
(dom-append (dom-body) _el-box)
|
||||
(dom-append _el-box _el-input)
|
||||
(dom-append _el-input _el-input2)
|
||||
(dom-append _el-input2 _el-script)
|
||||
(dom-append _el-input2 _el-test-where-me)
|
||||
(dom-append _el-box _el-input2)
|
||||
(dom-append (dom-body) _el-script)
|
||||
(dom-append (dom-body) _el-test-where-me)
|
||||
(dom-dispatch (dom-query "test-where-me input") "click" nil)
|
||||
))
|
||||
(deftest "works with DOM elements"
|
||||
|
||||
@@ -297,6 +297,15 @@ function mt(e,s) {
|
||||
const m = base.match(/^\[([^\]=]+)(?:="([^"]*)")?\]$/);
|
||||
if(m) return m[2] !== undefined ? e.getAttribute(m[1]) === m[2] : e.hasAttribute(m[1]);
|
||||
}
|
||||
// Compound tag[attr=val] e.g. input[type=checkbox] or input[type="checkbox"]
|
||||
if(base.includes('[')) {
|
||||
const cm = base.match(/^([\w-]+)(\[.+\])$/);
|
||||
if(cm) {
|
||||
if(e.tagName.toLowerCase() !== cm[1]) return false;
|
||||
const attrParts = cm[2].match(/^\[([^\]=]+)(?:=["']?([^"'\]]+)["']?)?\]$/);
|
||||
if(attrParts) return attrParts[2] !== undefined ? e.getAttribute(attrParts[1]) === attrParts[2] : e.hasAttribute(attrParts[1]);
|
||||
}
|
||||
}
|
||||
if(base.includes('.')) { const [tag, cls] = base.split('.'); return e.tagName.toLowerCase() === tag && e.classList.contains(cls); }
|
||||
if(base.includes('#')) { const [tag, id] = base.split('#'); return e.tagName.toLowerCase() === tag && e.id === id; }
|
||||
return e.tagName.toLowerCase() === base.toLowerCase();
|
||||
@@ -536,6 +545,9 @@ globalThis.console = { log: () => {}, error: () => {}, warn: () => {}, info: ()
|
||||
const _log = _origLog; // keep reference for our own output
|
||||
|
||||
// ─── FFI ────────────────────────────────────────────────────────
|
||||
// JS-level reference equality for host objects (works around OCaml boxing).
|
||||
// The SX `=` primitive doesn't do JS === for host objects in the WASM kernel.
|
||||
K.registerNative('hs-ref-eq',a=>a[0]===a[1]);
|
||||
K.registerNative('host-global',a=>{const n=a[0];return(n in globalThis)?globalThis[n]:null;});
|
||||
K.registerNative('host-get',a=>{
|
||||
if(a[0]==null)return null;
|
||||
|
||||
@@ -210,11 +210,18 @@ def parse_html(html):
|
||||
# button HTML in `properly processes hyperscript X` tests). HTMLParser handles
|
||||
# backslashes in attribute values as literal characters, so we leave them.
|
||||
|
||||
# HTML5 void elements — never have children, auto-pop from stack immediately.
|
||||
VOID_TAGS = {'area','base','br','col','embed','hr','img','input','link',
|
||||
'meta','param','source','track','wbr'}
|
||||
|
||||
elements = []
|
||||
stack = []
|
||||
|
||||
class Parser(HTMLParser):
|
||||
def handle_starttag(self, tag, attrs):
|
||||
# Pop any void elements left on the stack (they have no close tag).
|
||||
while stack and stack[-1]['tag'] in VOID_TAGS:
|
||||
stack.pop()
|
||||
el = {
|
||||
'tag': tag, 'id': None, 'classes': [], 'hs': None,
|
||||
'attrs': {}, 'inner': '', 'depth': len(stack),
|
||||
@@ -244,6 +251,9 @@ def parse_html(html):
|
||||
elements.append(el)
|
||||
|
||||
def handle_endtag(self, tag):
|
||||
# Pop void elements first (they don't have close tags but may linger).
|
||||
while stack and stack[-1]['tag'] in VOID_TAGS:
|
||||
stack.pop()
|
||||
if stack and stack[-1]['tag'] == tag:
|
||||
stack.pop()
|
||||
|
||||
|
||||
Reference in New Issue
Block a user