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

HS: extend parser/runtime + new node test runner; ignore test-results/

Browse Source 
- Parser: `--` line comments, `|` op, `result` → `the-result`, query-scoped
  `<sel> in <expr>`, `is a/an <type>` predicate, multi-`as` chaining with `|`,
  `match`/`precede` keyword aliases, `[attr]` add/toggle, between attr forms
- Runtime: per-element listener registry + hs-deactivate!, attr toggle
  variants, set-inner-html boots subtree, hs-append polymorphic on
  string/list/element, default? / array-set! / query-all-in / list-set
  via take+drop, hs-script idempotence guard
- Integration: skip reserved (me/it/event/you/yourself) when collecting vars
- Tokenizer: emit `--` comments and `|` op
- Test framework + conformance runner updates; new tests/hs-run-filtered.js
  (single-process Node runner using OCaml VM step-limit to bound infinite
  loops); generate-sx-conformance-dev.py improvements
- mcp_tree.ml + run_tests.ml: harness extensions
- .gitignore: top-level test-results/ (Playwright artifacts)

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-23 07:11:07 +00:00
parent b2ae80fb21
commit 0515295317
20 changed files with 15224 additions and 8120 deletions
Download Patch File Download Diff File Expand all files Collapse all files

360
hosts/ocaml/bin/run_tests.ml
View File

@@ -25,6 +25,9 @@ open Sx_ref
let pass_count = ref 0
let fail_count = ref 0
let suite_stack : string list ref = ref []
(* Test filter: when Some, only run tests (suite, name) in the set.
Populated by --only-failing=FILE from lines like "FAIL: suite > name: error". *)
let suite_filter : (string * string, unit) Hashtbl.t option ref = ref None
(* ====================================================================== *)
(* Deep equality — SX structural comparison *)
@@ -176,6 +179,17 @@ let make_test_env () =
suite_stack := (match !suite_stack with _ :: t -> t | [] -> []);
Nil);
bind "test-allowed?" (fun args ->
match !suite_filter with
| None -> Bool true
| Some filter ->
let name = match args with
| [String s] -> s
| [v] -> Sx_types.value_to_string v
| _ -> "" in
let suite = match !suite_stack with [] -> "" | s :: _ -> s in
Bool (Hashtbl.mem filter (suite, name)));
(* --- Test helpers --- *)
bind "sx-parse" (fun args ->
@@ -1563,6 +1577,131 @@ let run_spec_tests env test_files =
| _ -> child
in
(* Minimal HTML parser for test mock.
Parses an HTML string into mock child elements and appends them to `parent`.
Handles: <tag attr="v" attr='v' attr=v attr>content</tag>, nested elements,
self-closing tags, text content. No comments, CDATA, DOCTYPE, or entities. *)
let parse_html_into parent_d html =
let len = String.length html in
let pos = ref 0 in
let is_name_char c =
(c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||
(c >= '0' && c <= '9') || c = '-' || c = '_' || c = ':'
in
let skip_ws () =
while !pos < len && (let c = html.[!pos] in c = ' ' || c = '\n' || c = '\t' || c = '\r') do
incr pos
done
in
let parse_name () =
let start = !pos in
while !pos < len && is_name_char html.[!pos] do incr pos done;
String.sub html start (!pos - start)
in
let parse_attr_value () =
if !pos >= len then ""
else if html.[!pos] = '"' then begin
incr pos;
let start = !pos in
while !pos < len && html.[!pos] <> '"' do incr pos done;
let v = String.sub html start (!pos - start) in
if !pos < len then incr pos;
v
end
else if html.[!pos] = '\'' then begin
incr pos;
let start = !pos in
while !pos < len && html.[!pos] <> '\'' do incr pos done;
let v = String.sub html start (!pos - start) in
if !pos < len then incr pos;
v
end
else begin
let start = !pos in
while !pos < len && (let c = html.[!pos] in
c <> ' ' && c <> '\t' && c <> '\n' && c <> '\r'
&& c <> '>' && c <> '/') do
incr pos
done;
String.sub html start (!pos - start)
end
in
let parse_attrs (elem : (string, Sx_types.value) Hashtbl.t) =
skip_ws ();
while !pos < len && html.[!pos] <> '>' && html.[!pos] <> '/' do
let name = parse_name () in
if name = "" then begin
(* Avoid infinite loop on unexpected char *)
if !pos < len then incr pos
end else begin
let value =
if !pos < len && html.[!pos] = '=' then begin
incr pos; parse_attr_value ()
end else ""
in
let attrs = match Hashtbl.find_opt elem "attributes" with
| Some (Dict a) -> a
| _ -> let a = Hashtbl.create 4 in Hashtbl.replace elem "attributes" (Dict a); a in
Hashtbl.replace attrs name (String value);
if name = "id" then Hashtbl.replace elem "id" (String value);
if name = "class" then Hashtbl.replace elem "className" (String value);
if name = "value" then Hashtbl.replace elem "value" (String value);
skip_ws ()
end
done
in
let void_tags = ["br"; "hr"; "img"; "input"; "meta"; "link"; "area";
"base"; "col"; "embed"; "source"; "track"; "wbr"] in
let rec parse_children parent_elem =
while !pos < len && not (!pos + 1 < len && html.[!pos] = '<' && html.[!pos + 1] = '/') do
if !pos < len && html.[!pos] = '<' && !pos + 1 < len && is_name_char html.[!pos + 1] then
parse_element parent_elem
else if !pos < len && html.[!pos] = '<' then begin
(* Unknown/comment — skip to next '>' *)
while !pos < len && html.[!pos] <> '>' do incr pos done;
if !pos < len then incr pos
end
else begin
let start = !pos in
while !pos < len && html.[!pos] <> '<' do incr pos done;
let text = String.sub html start (!pos - start) in
if String.trim text <> "" then begin
let cur = match Hashtbl.find_opt parent_elem "textContent" with
| Some (String s) -> s | _ -> "" in
Hashtbl.replace parent_elem "textContent" (String (cur ^ text))
end
end
done
and parse_element parent_elem =
incr pos; (* skip '<' *)
let tag = parse_name () in
if tag = "" then () else begin
let el = make_mock_element tag in
let eld = match el with Dict d -> d | _ -> Hashtbl.create 0 in
parse_attrs eld;
skip_ws ();
let self_closing =
if !pos < len && html.[!pos] = '/' then begin incr pos; true end else false
in
if !pos < len && html.[!pos] = '>' then incr pos;
let is_void = List.mem (String.lowercase_ascii tag) void_tags in
if not self_closing && not is_void then begin
parse_children eld;
if !pos + 1 < len && html.[!pos] = '<' && html.[!pos + 1] = '/' then begin
pos := !pos + 2;
let _ = parse_name () in
skip_ws ();
if !pos < len && html.[!pos] = '>' then incr pos
end
end;
ignore (mock_append_child (Dict parent_elem) el)
end
in
pos := 0;
parse_children parent_d
in
let _ = parse_html_into in
(* Helper: remove child from parent *)
let mock_remove_child parent child =
match parent, child with
@@ -1578,11 +1717,21 @@ let run_spec_tests env test_files =
in
(* Helper: querySelector - find element matching selector in tree *)
let mock_matches el sel =
let rec mock_matches el sel =
match el with
| Dict d ->
let sel = String.trim sel in
if String.length sel > 0 && sel.[0] = '#' then
(* Compound selector: tag[attr=value] or tag.class or tag#id — split into parts *)
if String.length sel > 1 &&
((sel.[0] >= 'a' && sel.[0] <= 'z') || (sel.[0] >= 'A' && sel.[0] <= 'Z')) &&
(String.contains sel '[' || String.contains sel '.' || String.contains sel '#') then
let i = ref 0 in
let n = String.length sel in
while !i < n && ((sel.[!i] >= 'a' && sel.[!i] <= 'z') || (sel.[!i] >= 'A' && sel.[!i] <= 'Z') || (sel.[!i] >= '0' && sel.[!i] <= '9') || sel.[!i] = '-') do incr i done;
let tag_part = String.sub sel 0 !i in
let rest_part = String.sub sel !i (n - !i) in
(mock_matches el tag_part) && (mock_matches el rest_part)
else if String.length sel > 0 && sel.[0] = '#' then
let id = String.sub sel 1 (String.length sel - 1) in
(match Hashtbl.find_opt d "id" with Some (String i) -> i = id | _ -> false)
else if String.length sel > 0 && sel.[0] = '.' then
@@ -1590,7 +1739,8 @@ let run_spec_tests env test_files =
List.mem cls (get_classes d)
else if String.length sel > 0 && sel.[0] = '[' then
(* [attr] or [attr="value"] *)
let inner = String.sub sel 1 (String.length sel - 2) in
let end_bracket = try String.index sel ']' with Not_found -> String.length sel - 1 in
let inner = String.sub sel 1 (end_bracket - 1) in
(match String.split_on_char '=' inner with
| [attr] ->
let attrs = match Hashtbl.find_opt d "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0 in
@@ -1621,19 +1771,51 @@ let run_spec_tests env test_files =
| found -> mock_query_selector found (String.concat " " rest))
| [] -> Nil
and mock_query_selector_single el sel =
match el with
| Dict d ->
let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
let rec search = function
| [] -> Nil
| child :: rest ->
if mock_matches child sel then child
else match mock_query_selector_single child sel with
| Nil -> search rest
| found -> found
in
search kids
| _ -> Nil
(* Handle tag:nth-of-type(N): find Nth child of same tag under parent *)
let nth_match = try
let idx = String.index sel ':' in
let tag = String.sub sel 0 idx in
let rest = String.sub sel idx (String.length sel - idx) in
if String.length rest > String.length ":nth-of-type(" &&
String.sub rest 0 (String.length ":nth-of-type(") = ":nth-of-type(" &&
rest.[String.length rest - 1] = ')'
then
let n_str = String.sub rest (String.length ":nth-of-type(")
(String.length rest - String.length ":nth-of-type(" - 1) in
(try Some (tag, int_of_string (String.trim n_str)) with _ -> None)
else None
with Not_found -> None in
(match nth_match with
| Some (tag, n) ->
(* Walk tree; collect matching-tag elements in document order; return nth *)
let found = ref [] in
let rec walk node =
match node with
| Dict d ->
let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
List.iter (fun child ->
if mock_matches child tag then found := child :: !found;
walk child
) kids
| _ -> ()
in
walk el;
let matches = List.rev !found in
(try List.nth matches (n - 1) with _ -> Nil)
| None ->
(match el with
| Dict d ->
let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
let rec search = function
| [] -> Nil
| child :: rest ->
if mock_matches child sel then child
else match mock_query_selector_single child sel with
| Nil -> search rest
| found -> found
in
search kids
| _ -> Nil))
in
let rec mock_query_all el sel =
@@ -1742,7 +1924,7 @@ let run_spec_tests env test_files =
| "addEventListener" | "removeEventListener" | "dispatchEvent"
| "appendChild" | "removeChild" | "insertBefore" | "replaceChild"
| "querySelector" | "querySelectorAll" | "closest" | "matches"
| "contains" | "cloneNode" | "remove" | "focus" | "blur" | "click"
| "contains" | "compareDocumentPosition" | "cloneNode" | "remove" | "focus" | "blur" | "click"
| "insertAdjacentHTML" | "prepend" | "showModal" | "show" | "close"
| "getBoundingClientRect" | "getAnimations" | "scrollIntoView"
| "scrollTo" | "scroll" | "reset" -> Bool true
@@ -1841,16 +2023,19 @@ let run_spec_tests env test_files =
| Some (Dict _cl) -> () (* classes live in className *)
| _ -> ())
| "innerHTML" ->
(* Setting innerHTML clears children and syncs textContent (like a browser) *)
(* Setting innerHTML clears existing children, parses the HTML, and
creates new mock child elements (approximating browser behavior). *)
let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
List.iter (fun c -> match c with Dict cd ->
Hashtbl.replace cd "parentElement" Nil;
Hashtbl.replace cd "parentNode" Nil | _ -> ()) kids;
Hashtbl.replace d "children" (List []);
Hashtbl.replace d "childNodes" (List []);
(* Approximate textContent: strip HTML tags from innerHTML *)
Hashtbl.replace d "textContent" (String "");
(match stored with
| String s ->
| String s when String.contains s '<' ->
parse_html_into d s;
(* Strip tags for a best-effort textContent *)
let buf = Buffer.create (String.length s) in
let in_tag = ref false in
String.iter (fun c ->
@@ -1859,6 +2044,7 @@ let run_spec_tests env test_files =
else if not !in_tag then Buffer.add_char buf c
) s;
Hashtbl.replace d "textContent" (String (Buffer.contents buf))
| String s -> Hashtbl.replace d "textContent" (String s)
| _ -> Hashtbl.replace d "textContent" (String ""))
| "textContent" ->
(* Setting textContent clears children *)
@@ -1887,6 +2073,8 @@ let run_spec_tests env test_files =
| "setTimeout" -> (match rest with fn :: _ -> ignore (Sx_ref.cek_call fn (List [])); Nil | _ -> Nil)
| "clearTimeout" -> Nil
| _ -> Nil)
| Dict d :: String "hasOwnProperty" :: [String k] ->
Bool (Hashtbl.mem d k)
| Dict d :: String m :: rest ->
let mt = match Hashtbl.find_opt d "__mock_type" with Some (String t) -> t | _ -> "" in
@@ -2139,6 +2327,33 @@ let run_spec_tests env test_files =
| _ -> Nil
in up (Dict d)
| _ -> Nil)
| "compareDocumentPosition" ->
(match rest with
| [other] ->
let self = Dict d in
let body = Dict mock_body in
let found_self = ref false in
let found_other = ref false in
let self_first = ref false in
let rec walk node =
if !found_self && !found_other then ()
else begin
if mock_el_eq node self then begin
if not !found_other then self_first := true;
found_self := true
end;
if mock_el_eq node other then found_other := true;
(match node with
| Dict dd -> let kids = match Hashtbl.find_opt dd "children" with Some (List l) -> l | _ -> [] in
List.iter walk kids
| _ -> ())
end
in
walk body;
if !found_self && !found_other then
Number (if !self_first then 4.0 else 2.0)
else Number 0.0
| _ -> Number 0.0)
| "matches" ->
(match rest with [String sel] -> Bool (mock_matches (Dict d) sel) | _ -> Bool false)
| "contains" ->
@@ -2213,25 +2428,62 @@ let run_spec_tests env test_files =
Hashtbl.replace r "right" (Number 100.0); Hashtbl.replace r "bottom" (Number 100.0);
Dict r
| "insertAdjacentHTML" ->
(* Position-aware insertion, coerce value to string *)
(* Position-aware insertion. Parse the new HTML into a scratch
container, then splice the resulting children into the target
position WITHOUT disturbing sibling nodes. *)
(match rest with
| [String pos; value] ->
| [String pos_kind; value] ->
let html = match dom_stringify value with String s -> s | _ -> "" in
let cur = match Hashtbl.find_opt d "innerHTML" with Some (String s) -> s | _ -> "" in
let new_html = match pos with
| "afterbegin" -> html ^ cur (* prepend *)
| _ -> cur ^ html (* beforeend / default: append *)
(* Parse new HTML into scratch container to get new child list.
For pure-text content, wrap into the target's innerHTML path. *)
let scratch = make_mock_element "div" in
let scratch_d = match scratch with Dict sd -> sd | _ -> Hashtbl.create 0 in
if String.contains html '<' then parse_html_into scratch_d html;
let new_kids = match Hashtbl.find_opt scratch_d "children" with Some (List l) -> l | _ -> [] in
let prepend = pos_kind = "beforebegin" || pos_kind = "afterbegin" in
let insert_into container_d index =
List.iter (fun c -> match c with
| Dict cd ->
Hashtbl.replace cd "parentElement" (Dict container_d);
Hashtbl.replace cd "parentNode" (Dict container_d)
| _ -> ()) new_kids;
let kids = match Hashtbl.find_opt container_d "children" with Some (List l) -> l | _ -> [] in
let before = List.filteri (fun i _ -> i < index) kids in
let after = List.filteri (fun i _ -> i >= index) kids in
let all = before @ new_kids @ after in
Hashtbl.replace container_d "children" (List all);
Hashtbl.replace container_d "childNodes" (List all);
(* Update container innerHTML based on position kind, not index *)
let cur = match Hashtbl.find_opt container_d "innerHTML" with Some (String s) -> s | _ -> "" in
let new_html = if prepend then html ^ cur else cur ^ html in
Hashtbl.replace container_d "innerHTML" (String new_html);
let buf = Buffer.create (String.length new_html) in
let in_tag = ref false in
String.iter (fun c ->
if c = '<' then in_tag := true
else if c = '>' then in_tag := false
else if not !in_tag then Buffer.add_char buf c
) new_html;
Hashtbl.replace container_d "textContent" (String (Buffer.contents buf))
in
Hashtbl.replace d "innerHTML" (String new_html);
(* Sync textContent *)
let buf = Buffer.create (String.length new_html) in
let in_tag = ref false in
String.iter (fun c ->
if c = '<' then in_tag := true
else if c = '>' then in_tag := false
else if not !in_tag then Buffer.add_char buf c
) new_html;
Hashtbl.replace d "textContent" (String (Buffer.contents buf));
(match pos_kind with
| "beforebegin" | "afterend" ->
(match Hashtbl.find_opt d "parentElement" with
| Some (Dict pd) ->
let siblings = match Hashtbl.find_opt pd "children" with Some (List l) -> l | _ -> [] in
let rec find_idx i = function
| [] -> List.length siblings
| x :: _ when mock_el_eq x (Dict d) -> i
| _ :: rest -> find_idx (i+1) rest
in
let self_idx = find_idx 0 siblings in
let insert_idx = if pos_kind = "beforebegin" then self_idx else self_idx + 1 in
insert_into pd insert_idx
| _ -> ())
| "afterbegin" -> insert_into d 0
| _ (* "beforeend" *) ->
let kids_len = match Hashtbl.find_opt d "children" with Some (List l) -> List.length l | _ -> 0 in
insert_into d kids_len);
Nil
| _ -> Nil)
| "showModal" | "show" ->
@@ -2341,6 +2593,8 @@ let run_spec_tests env test_files =
Hashtbl.replace ev "_stopped" (Bool false);
Hashtbl.replace ev "_stopImmediate" (Bool false);
Dict ev
| [String "Object"] ->
Dict (Hashtbl.create 4)
| _ -> Nil);
reg "host-callback" (fun args ->
@@ -2823,7 +3077,39 @@ let () =
let args = Array.to_list Sys.argv |> List.tl in
let foundation_only = List.mem "--foundation" args in
let jit_enabled = List.mem "--jit" args in
let test_files = List.filter (fun a -> not (String.length a > 0 && a.[0] = '-')) args in
(* --only-failing=PATH : read lines of form "FAIL: suite > name: ..." and
restrict test runs to those (suite, name) pairs. *)
List.iter (fun a ->
let prefix = "--only-failing=" in
if String.length a > String.length prefix
&& String.sub a 0 (String.length prefix) = prefix then begin
let path = String.sub a (String.length prefix) (String.length a - String.length prefix) in
let filter = Hashtbl.create 64 in
let ic = open_in path in
(try while true do
let line = input_line ic in
(* Match " FAIL: <suite> > <name>: <err>" or "FAIL: <suite> > <name>: <err>" *)
let line = String.trim line in
if String.length line > 6 && String.sub line 0 6 = "FAIL: " then begin
let rest = String.sub line 6 (String.length line - 6) in
match String.index_opt rest '>' with
| Some gt ->
let suite = String.trim (String.sub rest 0 gt) in
let after = String.sub rest (gt + 1) (String.length rest - gt - 1) in
(match String.index_opt after ':' with
| Some colon ->
let name = String.trim (String.sub after 0 colon) in
Hashtbl.replace filter (suite, name) ()
| None -> ())
| None -> ()
end
done with End_of_file -> ());
close_in ic;
Printf.eprintf "[filter] %d tests loaded from %s\n%!" (Hashtbl.length filter) path;
suite_filter := Some filter
end) args;
let test_files = List.filter (fun a ->
not (String.length a > 0 && a.[0] = '-')) args in
(* Always run foundation tests *)
run_foundation_tests ();