HS behavioral tests: mock DOM + eval-hs in OCaml test runner
Add mock DOM layer to run_tests.ml so hyperscript behavioral tests (spec/tests/test-hyperscript-behavioral.sx) can run in the OCaml test runner without a browser. Previously these tests required Playwright which crashed after 10 minutes from WASM page reboots. Mock DOM implementation: - host-global, host-get, host-set!, host-call, host-new, host-callback, host-typeof, host-await — OCaml primitives operating on SX Dict elements - Mock elements with classList, style, attributes, event dispatch + bubbling - querySelector/querySelectorAll with #id, .class, tag, [attr] selectors - Load web/lib/dom.sx and web/lib/browser.sx for dom-* wrappers - eval-hs function for expression-only tests (comparisonOperator, etc.) Result: 367/831 HS tests pass in ~30 seconds (was: Playwright crash). 14 suites at 100%: live, component, liveTemplate, scroll, call, go, focus, log, reactive-properties, resize, measure, attributeRef, objectLiteral, queryRef. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -1337,6 +1337,642 @@ let run_spec_tests env test_files =
|
||||
with e -> Printf.eprintf "Warning: harness.sx: %s\n%!" (Printexc.to_string e))
|
||||
end;
|
||||
|
||||
(* ================================================================== *)
|
||||
(* Mock DOM — host-* primitives for hyperscript behavioral tests *)
|
||||
(* ================================================================== *)
|
||||
|
||||
(* Mock DOM elements are SX Dicts with special keys:
|
||||
__mock_type: "element" | "event" | "classList" | "style" | "document"
|
||||
__mock_el: back-reference to parent element (for classList/style)
|
||||
tagName, id, className, children, _listeners, attributes, style, ... *)
|
||||
|
||||
let mock_el_counter = ref 0 in
|
||||
|
||||
let make_mock_element tag =
|
||||
incr mock_el_counter;
|
||||
let d = Hashtbl.create 16 in
|
||||
Hashtbl.replace d "__mock_type" (String "element");
|
||||
Hashtbl.replace d "__mock_id" (Number (float_of_int !mock_el_counter));
|
||||
Hashtbl.replace d "tagName" (String (String.uppercase_ascii tag));
|
||||
Hashtbl.replace d "nodeName" (String (String.uppercase_ascii tag));
|
||||
Hashtbl.replace d "nodeType" (Number 1.0);
|
||||
Hashtbl.replace d "id" (String "");
|
||||
Hashtbl.replace d "className" (String "");
|
||||
Hashtbl.replace d "textContent" (String "");
|
||||
Hashtbl.replace d "innerHTML" (String "");
|
||||
Hashtbl.replace d "outerHTML" (String "");
|
||||
Hashtbl.replace d "value" (String "");
|
||||
Hashtbl.replace d "checked" (Bool false);
|
||||
Hashtbl.replace d "disabled" (Bool false);
|
||||
Hashtbl.replace d "open" (Bool false);
|
||||
Hashtbl.replace d "children" (List []);
|
||||
Hashtbl.replace d "childNodes" (List []);
|
||||
Hashtbl.replace d "parentElement" Nil;
|
||||
Hashtbl.replace d "parentNode" Nil;
|
||||
Hashtbl.replace d "_listeners" (Dict (Hashtbl.create 4));
|
||||
Hashtbl.replace d "attributes" (Dict (Hashtbl.create 4));
|
||||
Hashtbl.replace d "dataset" (Dict (Hashtbl.create 4));
|
||||
(* style is a sub-dict *)
|
||||
let style_d = Hashtbl.create 4 in
|
||||
Hashtbl.replace style_d "__mock_type" (String "style");
|
||||
Hashtbl.replace style_d "__mock_el" (Dict d);
|
||||
Hashtbl.replace d "style" (Dict style_d);
|
||||
(* classList is a sub-dict *)
|
||||
let cl_d = Hashtbl.create 4 in
|
||||
Hashtbl.replace cl_d "__mock_type" (String "classList");
|
||||
Hashtbl.replace cl_d "__mock_el" (Dict d);
|
||||
Hashtbl.replace d "classList" (Dict cl_d);
|
||||
Dict d
|
||||
in
|
||||
|
||||
let mock_body = match make_mock_element "body" with Dict d -> d | _ -> assert false in
|
||||
Hashtbl.replace mock_body "tagName" (String "BODY");
|
||||
Hashtbl.replace mock_body "nodeName" (String "BODY");
|
||||
|
||||
let mock_document =
|
||||
let d = Hashtbl.create 8 in
|
||||
Hashtbl.replace d "__mock_type" (String "document");
|
||||
Hashtbl.replace d "body" (Dict mock_body);
|
||||
Hashtbl.replace d "title" (String "");
|
||||
Dict d
|
||||
in
|
||||
|
||||
(* Helper: get classes from className string *)
|
||||
let get_classes d =
|
||||
match Hashtbl.find_opt d "className" with
|
||||
| Some (String s) -> String.split_on_char ' ' s |> List.filter (fun s -> s <> "")
|
||||
| _ -> []
|
||||
in
|
||||
|
||||
(* Helper: set className from class list *)
|
||||
let set_classes d classes =
|
||||
Hashtbl.replace d "className" (String (String.concat " " classes))
|
||||
in
|
||||
|
||||
(* Helper: add child to parent *)
|
||||
let mock_append_child parent child =
|
||||
match parent, child with
|
||||
| Dict pd, Dict cd ->
|
||||
(* Remove from old parent first *)
|
||||
(match Hashtbl.find_opt cd "parentElement" with
|
||||
| Some (Dict old_parent) ->
|
||||
let old_kids = match Hashtbl.find_opt old_parent "children" with
|
||||
| Some (List l) -> List.filter (fun c -> c != Dict cd) l | _ -> [] in
|
||||
Hashtbl.replace old_parent "children" (List old_kids);
|
||||
Hashtbl.replace old_parent "childNodes" (List old_kids)
|
||||
| _ -> ());
|
||||
let kids = match Hashtbl.find_opt pd "children" with
|
||||
| Some (List l) -> l | _ -> [] in
|
||||
Hashtbl.replace pd "children" (List (kids @ [child]));
|
||||
Hashtbl.replace pd "childNodes" (List (kids @ [child]));
|
||||
Hashtbl.replace cd "parentElement" parent;
|
||||
Hashtbl.replace cd "parentNode" parent;
|
||||
child
|
||||
| _ -> child
|
||||
in
|
||||
|
||||
(* Helper: remove child from parent *)
|
||||
let mock_remove_child parent child =
|
||||
match parent, child with
|
||||
| Dict pd, Dict cd ->
|
||||
let kids = match Hashtbl.find_opt pd "children" with
|
||||
| Some (List l) -> List.filter (fun c -> c != Dict cd) l | _ -> [] in
|
||||
Hashtbl.replace pd "children" (List kids);
|
||||
Hashtbl.replace pd "childNodes" (List kids);
|
||||
Hashtbl.replace cd "parentElement" Nil;
|
||||
Hashtbl.replace cd "parentNode" Nil;
|
||||
child
|
||||
| _ -> child
|
||||
in
|
||||
|
||||
(* Helper: querySelector - find element matching selector in tree *)
|
||||
let mock_matches el sel =
|
||||
match el with
|
||||
| Dict d ->
|
||||
let sel = String.trim sel in
|
||||
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
|
||||
let cls = String.sub sel 1 (String.length sel - 1) in
|
||||
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
|
||||
(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
|
||||
Hashtbl.mem attrs attr
|
||||
| [attr; v] ->
|
||||
let attrs = match Hashtbl.find_opt d "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0 in
|
||||
let v = if String.length v >= 2 && v.[0] = '"' then String.sub v 1 (String.length v - 2) else v in
|
||||
(match Hashtbl.find_opt attrs attr with Some (String s) -> s = v | _ -> false)
|
||||
| _ -> false)
|
||||
else
|
||||
(* Tag name match *)
|
||||
(match Hashtbl.find_opt d "tagName" with
|
||||
| Some (String t) -> String.lowercase_ascii t = String.lowercase_ascii sel
|
||||
| _ -> false)
|
||||
| _ -> false
|
||||
in
|
||||
|
||||
let rec mock_query_selector 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 child sel with
|
||||
| Nil -> search rest
|
||||
| found -> found
|
||||
in
|
||||
search kids
|
||||
| _ -> Nil
|
||||
in
|
||||
|
||||
let rec mock_query_all el sel =
|
||||
match el with
|
||||
| Dict d ->
|
||||
let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
|
||||
List.concat_map (fun child ->
|
||||
(if mock_matches child sel then [child] else []) @ mock_query_all child sel
|
||||
) kids
|
||||
| _ -> []
|
||||
in
|
||||
|
||||
(* Helper: dispatch event with bubbling *)
|
||||
let rec mock_dispatch_event target event =
|
||||
match event with
|
||||
| Dict ev ->
|
||||
let cur_target = match Hashtbl.find_opt ev "target" with Some Nil | None -> target | Some x -> x in
|
||||
Hashtbl.replace ev "target" cur_target;
|
||||
Hashtbl.replace ev "currentTarget" target;
|
||||
(match target with
|
||||
| Dict td ->
|
||||
let listeners = match Hashtbl.find_opt td "_listeners" with Some (Dict l) -> l | _ -> Hashtbl.create 0 in
|
||||
let evt_type = match Hashtbl.find_opt ev "type" with Some (String t) -> t | _ -> "" in
|
||||
let fns = match Hashtbl.find_opt listeners evt_type with Some (List l) -> l | _ -> [] in
|
||||
List.iter (fun fn ->
|
||||
let stopped = match Hashtbl.find_opt ev "_stopImmediate" with Some (Bool true) -> true | _ -> false in
|
||||
if not stopped then
|
||||
(try ignore (Sx_ref.cek_call fn (List [Dict ev]))
|
||||
with _ -> ())
|
||||
) fns;
|
||||
(* Bubble *)
|
||||
let bubbles = match Hashtbl.find_opt ev "bubbles" with Some (Bool true) -> true | _ -> false in
|
||||
let stopped = match Hashtbl.find_opt ev "_stopped" with Some (Bool true) -> true | _ -> false in
|
||||
if bubbles && not stopped then
|
||||
(match Hashtbl.find_opt td "parentElement" with
|
||||
| Some (Dict _ as parent) -> ignore (mock_dispatch_event parent (Dict ev))
|
||||
| _ -> ())
|
||||
| _ -> ());
|
||||
let dp = match Hashtbl.find_opt ev "defaultPrevented" with Some (Bool true) -> true | _ -> false in
|
||||
Bool (not dp)
|
||||
| _ -> Bool true
|
||||
in
|
||||
|
||||
(* Register host-* primitives *)
|
||||
let reg name fn = Sx_primitives.register name fn in
|
||||
|
||||
reg "host-global" (fun args ->
|
||||
match args with
|
||||
| [String "document"] -> mock_document
|
||||
| [String "window"] -> Nil (* self-referential, not needed for tests *)
|
||||
| [String name] ->
|
||||
(* Check SX env for globally defined things like "tmp" used in HS tests *)
|
||||
(try Sx_types.env_get env name with _ -> Nil)
|
||||
| _ -> Nil);
|
||||
|
||||
reg "host-get" (fun args ->
|
||||
match args with
|
||||
| [Nil; _] -> Nil
|
||||
| [Dict d; String key] ->
|
||||
let mt = match Hashtbl.find_opt d "__mock_type" with Some (String t) -> t | _ -> "" in
|
||||
(* classList.length *)
|
||||
if mt = "classList" && key = "length" then
|
||||
let el = match Hashtbl.find_opt d "__mock_el" with Some (Dict e) -> e | _ -> d in
|
||||
Number (float_of_int (List.length (get_classes el)))
|
||||
else
|
||||
(match Hashtbl.find_opt d key with Some v -> v | None -> Nil)
|
||||
| [Dict d; Number n] ->
|
||||
(* Array index access *)
|
||||
let i = int_of_float n in
|
||||
(match Hashtbl.find_opt d "children" with
|
||||
| Some (List l) when i >= 0 && i < List.length l -> List.nth l i
|
||||
| _ -> (match Hashtbl.find_opt d (string_of_int i) with Some v -> v | None -> Nil))
|
||||
| _ -> Nil);
|
||||
|
||||
reg "host-set!" (fun args ->
|
||||
match args with
|
||||
| [Nil; _; _] -> Nil
|
||||
| [Dict d; String key; value] ->
|
||||
Hashtbl.replace d key value;
|
||||
(* Side effects for special keys *)
|
||||
(if key = "className" then
|
||||
match Hashtbl.find_opt d "classList" with
|
||||
| Some (Dict cl) ->
|
||||
(* classList sub-dict doesn't store classes — they live in className *)
|
||||
ignore cl
|
||||
| _ -> ());
|
||||
value
|
||||
| _ -> Nil);
|
||||
|
||||
reg "host-call" (fun args ->
|
||||
match args with
|
||||
| Nil :: String m :: rest ->
|
||||
(* Global function call *)
|
||||
(match m with
|
||||
| "setTimeout" -> (match rest with fn :: _ -> ignore (Sx_ref.cek_call fn (List [])); Nil | _ -> Nil)
|
||||
| "clearTimeout" -> Nil
|
||||
| _ -> Nil)
|
||||
| Dict d :: String m :: rest ->
|
||||
let mt = match Hashtbl.find_opt d "__mock_type" with Some (String t) -> t | _ -> "" in
|
||||
|
||||
if mt = "document" then
|
||||
(* Document methods *)
|
||||
(match m with
|
||||
| "createElement" | "createElementNS" ->
|
||||
let tag = match rest with [String t] -> t | [_; String t] -> t | _ -> "div" in
|
||||
make_mock_element tag
|
||||
| "createDocumentFragment" ->
|
||||
let el = make_mock_element "fragment" in
|
||||
(match el with Dict d -> Hashtbl.replace d "nodeType" (Number 11.0); el | _ -> el)
|
||||
| "createTextNode" ->
|
||||
let text = match rest with [String t] -> t | _ -> "" in
|
||||
let d = Hashtbl.create 4 in
|
||||
Hashtbl.replace d "__mock_type" (String "text");
|
||||
Hashtbl.replace d "nodeType" (Number 3.0);
|
||||
Hashtbl.replace d "textContent" (String text);
|
||||
Hashtbl.replace d "data" (String text);
|
||||
Dict d
|
||||
| "createComment" ->
|
||||
let d = Hashtbl.create 4 in
|
||||
Hashtbl.replace d "__mock_type" (String "comment");
|
||||
Hashtbl.replace d "nodeType" (Number 8.0);
|
||||
Dict d
|
||||
| "getElementById" ->
|
||||
let id = match rest with [String i] -> i | _ -> "" in
|
||||
let body = match Hashtbl.find_opt d "body" with Some b -> b | None -> Nil in
|
||||
mock_query_selector body ("#" ^ id)
|
||||
| "querySelector" ->
|
||||
let sel = match rest with [String s] -> s | _ -> "" in
|
||||
let body = match Hashtbl.find_opt d "body" with Some b -> b | None -> Nil in
|
||||
mock_query_selector body sel
|
||||
| "querySelectorAll" ->
|
||||
let sel = match rest with [String s] -> s | _ -> "" in
|
||||
let body = match Hashtbl.find_opt d "body" with Some b -> b | None -> Nil in
|
||||
List (mock_query_all body sel)
|
||||
| "createEvent" ->
|
||||
let ev = Hashtbl.create 4 in
|
||||
Hashtbl.replace ev "__mock_type" (String "event");
|
||||
Dict ev
|
||||
| "addEventListener" | "removeEventListener" -> Nil
|
||||
| _ -> Nil)
|
||||
|
||||
else if mt = "classList" then
|
||||
let el = match Hashtbl.find_opt d "__mock_el" with Some (Dict e) -> e | _ -> d in
|
||||
(match m with
|
||||
| "add" ->
|
||||
let classes = get_classes el in
|
||||
let new_classes = List.fold_left (fun acc a ->
|
||||
match a with String c when not (List.mem c acc) -> acc @ [c] | _ -> acc
|
||||
) classes rest in
|
||||
set_classes el new_classes; Nil
|
||||
| "remove" ->
|
||||
let classes = get_classes el in
|
||||
let to_remove = List.filter_map (function String c -> Some c | _ -> None) rest in
|
||||
let new_classes = List.filter (fun c -> not (List.mem c to_remove)) classes in
|
||||
set_classes el new_classes; Nil
|
||||
| "toggle" ->
|
||||
(match rest with
|
||||
| [String cls] ->
|
||||
let classes = get_classes el in
|
||||
if List.mem cls classes then
|
||||
(set_classes el (List.filter (fun c -> c <> cls) classes); Bool false)
|
||||
else
|
||||
(set_classes el (classes @ [cls]); Bool true)
|
||||
| [String cls; Bool force] ->
|
||||
let classes = get_classes el in
|
||||
if force then
|
||||
(if not (List.mem cls classes) then set_classes el (classes @ [cls]); Bool true)
|
||||
else
|
||||
(set_classes el (List.filter (fun c -> c <> cls) classes); Bool false)
|
||||
| _ -> Nil)
|
||||
| "contains" ->
|
||||
(match rest with
|
||||
| [String cls] -> Bool (List.mem cls (get_classes el))
|
||||
| _ -> Bool false)
|
||||
| _ -> Nil)
|
||||
|
||||
else if mt = "style" then
|
||||
(match m with
|
||||
| "setProperty" ->
|
||||
(match rest with
|
||||
| [String prop; String value] -> Hashtbl.replace d prop (String value); Nil
|
||||
| [String prop; value] -> Hashtbl.replace d prop value; Nil
|
||||
| _ -> Nil)
|
||||
| "removeProperty" ->
|
||||
(match rest with [String prop] -> Hashtbl.remove d prop; Nil | _ -> Nil)
|
||||
| "getPropertyValue" ->
|
||||
(match rest with
|
||||
| [String prop] -> (match Hashtbl.find_opt d prop with Some v -> v | None -> String "")
|
||||
| _ -> String "")
|
||||
| _ -> Nil)
|
||||
|
||||
else
|
||||
(* Element methods *)
|
||||
(match m with
|
||||
| "setAttribute" ->
|
||||
(match rest with
|
||||
| [String name; value] ->
|
||||
let attrs = match Hashtbl.find_opt d "attributes" with Some (Dict a) -> a | _ ->
|
||||
let a = Hashtbl.create 4 in Hashtbl.replace d "attributes" (Dict a); a in
|
||||
let sv = match value with String s -> s | Number n ->
|
||||
let i = int_of_float n in if float_of_int i = n then string_of_int i
|
||||
else string_of_float n | _ -> Sx_types.inspect value in
|
||||
Hashtbl.replace attrs name (String sv);
|
||||
if name = "id" then Hashtbl.replace d "id" (String sv);
|
||||
if name = "class" then begin
|
||||
Hashtbl.replace d "className" (String sv);
|
||||
end;
|
||||
if name = "disabled" then Hashtbl.replace d "disabled" (Bool true);
|
||||
Nil
|
||||
| _ -> Nil)
|
||||
| "getAttribute" ->
|
||||
(match rest with
|
||||
| [String name] ->
|
||||
let attrs = match Hashtbl.find_opt d "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0 in
|
||||
(match Hashtbl.find_opt attrs name with Some v -> v | None -> Nil)
|
||||
| _ -> Nil)
|
||||
| "removeAttribute" ->
|
||||
(match rest with
|
||||
| [String name] ->
|
||||
let attrs = match Hashtbl.find_opt d "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0 in
|
||||
Hashtbl.remove attrs name;
|
||||
if name = "disabled" then Hashtbl.replace d "disabled" (Bool false);
|
||||
Nil
|
||||
| _ -> Nil)
|
||||
| "hasAttribute" ->
|
||||
(match rest with
|
||||
| [String name] ->
|
||||
let attrs = match Hashtbl.find_opt d "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0 in
|
||||
Bool (Hashtbl.mem attrs name)
|
||||
| _ -> Bool false)
|
||||
| "addEventListener" ->
|
||||
(match rest with
|
||||
| String evt_name :: fn :: _ ->
|
||||
let listeners = match Hashtbl.find_opt d "_listeners" with Some (Dict l) -> l | _ ->
|
||||
let l = Hashtbl.create 4 in Hashtbl.replace d "_listeners" (Dict l); l in
|
||||
let fns = match Hashtbl.find_opt listeners evt_name with Some (List l) -> l | _ -> [] in
|
||||
Hashtbl.replace listeners evt_name (List (fns @ [fn]));
|
||||
Nil
|
||||
| _ -> Nil)
|
||||
| "removeEventListener" ->
|
||||
(match rest with
|
||||
| [String evt_name; fn] ->
|
||||
let listeners = match Hashtbl.find_opt d "_listeners" with Some (Dict l) -> l | _ -> Hashtbl.create 0 in
|
||||
let fns = match Hashtbl.find_opt listeners evt_name with Some (List l) -> l | _ -> [] in
|
||||
Hashtbl.replace listeners evt_name (List (List.filter (fun f -> f != fn) fns));
|
||||
Nil
|
||||
| _ -> Nil)
|
||||
| "dispatchEvent" ->
|
||||
(match rest with [ev] -> mock_dispatch_event (Dict d) ev | _ -> Nil)
|
||||
| "appendChild" ->
|
||||
(match rest with [child] -> mock_append_child (Dict d) child | _ -> Nil)
|
||||
| "removeChild" ->
|
||||
(match rest with [child] -> mock_remove_child (Dict d) child | _ -> Nil)
|
||||
| "insertBefore" ->
|
||||
(match rest with
|
||||
| [new_child; ref_child] ->
|
||||
(* Remove from old parent *)
|
||||
(match new_child with
|
||||
| Dict cd -> (match Hashtbl.find_opt cd "parentElement" with
|
||||
| Some (Dict p) -> ignore (mock_remove_child (Dict p) new_child) | _ -> ())
|
||||
| _ -> ());
|
||||
let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
|
||||
let idx = let rec find_idx i = function [] -> List.length kids | c :: _ when c == ref_child -> i | _ :: rest -> find_idx (i+1) rest in find_idx 0 kids in
|
||||
let before = List.filteri (fun i _ -> i < idx) kids in
|
||||
let after = List.filteri (fun i _ -> i >= idx) kids in
|
||||
let new_kids = before @ [new_child] @ after in
|
||||
Hashtbl.replace d "children" (List new_kids);
|
||||
Hashtbl.replace d "childNodes" (List new_kids);
|
||||
(match new_child with Dict cd ->
|
||||
Hashtbl.replace cd "parentElement" (Dict d);
|
||||
Hashtbl.replace cd "parentNode" (Dict d) | _ -> ());
|
||||
new_child
|
||||
| _ -> Nil)
|
||||
| "replaceChild" ->
|
||||
(match rest with
|
||||
| [new_child; old_child] ->
|
||||
let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
|
||||
let new_kids = List.map (fun c -> if c == old_child then new_child else c) kids in
|
||||
Hashtbl.replace d "children" (List new_kids);
|
||||
Hashtbl.replace d "childNodes" (List new_kids);
|
||||
(match new_child with Dict cd ->
|
||||
Hashtbl.replace cd "parentElement" (Dict d);
|
||||
Hashtbl.replace cd "parentNode" (Dict d) | _ -> ());
|
||||
(match old_child with Dict cd ->
|
||||
Hashtbl.replace cd "parentElement" Nil;
|
||||
Hashtbl.replace cd "parentNode" Nil | _ -> ());
|
||||
old_child
|
||||
| _ -> Nil)
|
||||
| "remove" ->
|
||||
(match Hashtbl.find_opt d "parentElement" with
|
||||
| Some (Dict p) -> ignore (mock_remove_child (Dict p) (Dict d)) | _ -> ());
|
||||
Nil
|
||||
| "querySelector" ->
|
||||
(match rest with [String sel] -> mock_query_selector (Dict d) sel | _ -> Nil)
|
||||
| "querySelectorAll" ->
|
||||
(match rest with [String sel] -> List (mock_query_all (Dict d) sel) | _ -> List [])
|
||||
| "closest" ->
|
||||
(match rest with
|
||||
| [String sel] ->
|
||||
let rec up = function
|
||||
| Dict e as el -> if mock_matches el sel then el else
|
||||
(match Hashtbl.find_opt e "parentElement" with Some (Dict _ as p) -> up p | _ -> Nil)
|
||||
| _ -> Nil
|
||||
in up (Dict d)
|
||||
| _ -> Nil)
|
||||
| "matches" ->
|
||||
(match rest with [String sel] -> Bool (mock_matches (Dict d) sel) | _ -> Bool false)
|
||||
| "contains" ->
|
||||
(match rest with
|
||||
| [target] ->
|
||||
let rec contains_check el =
|
||||
if el == target then true
|
||||
else match el with
|
||||
| Dict dd -> let kids = match Hashtbl.find_opt dd "children" with Some (List l) -> l | _ -> [] in
|
||||
List.exists contains_check kids
|
||||
| _ -> false
|
||||
in Bool (contains_check (Dict d))
|
||||
| _ -> Bool false)
|
||||
| "cloneNode" ->
|
||||
let deep = match rest with [Bool b] -> b | _ -> false in
|
||||
let rec clone_el el = match el with Dict src ->
|
||||
let nd = Hashtbl.create 16 in
|
||||
Hashtbl.iter (fun k v ->
|
||||
if k <> "parentElement" && k <> "parentNode" && k <> "_listeners" && k <> "children" && k <> "childNodes" then
|
||||
Hashtbl.replace nd k v
|
||||
) src;
|
||||
Hashtbl.replace nd "parentElement" Nil;
|
||||
Hashtbl.replace nd "parentNode" Nil;
|
||||
Hashtbl.replace nd "_listeners" (Dict (Hashtbl.create 4));
|
||||
incr mock_el_counter;
|
||||
Hashtbl.replace nd "__mock_id" (Number (float_of_int !mock_el_counter));
|
||||
let new_style = Hashtbl.create 4 in
|
||||
(match Hashtbl.find_opt src "style" with
|
||||
| Some (Dict s) -> Hashtbl.iter (fun k v -> if k <> "__mock_el" then Hashtbl.replace new_style k v) s
|
||||
| _ -> ());
|
||||
Hashtbl.replace new_style "__mock_type" (String "style");
|
||||
Hashtbl.replace new_style "__mock_el" (Dict nd);
|
||||
Hashtbl.replace nd "style" (Dict new_style);
|
||||
let new_cl = Hashtbl.create 4 in
|
||||
Hashtbl.replace new_cl "__mock_type" (String "classList");
|
||||
Hashtbl.replace new_cl "__mock_el" (Dict nd);
|
||||
Hashtbl.replace nd "classList" (Dict new_cl);
|
||||
if deep then begin
|
||||
let kids = match Hashtbl.find_opt src "children" with Some (List l) -> l | _ -> [] in
|
||||
let cloned_kids = List.map (fun c -> match c with Dict _ -> clone_el c | _ -> c) kids in
|
||||
List.iter (fun c -> match c with Dict cd ->
|
||||
Hashtbl.replace cd "parentElement" (Dict nd);
|
||||
Hashtbl.replace cd "parentNode" (Dict nd) | _ -> ()) cloned_kids;
|
||||
Hashtbl.replace nd "children" (List cloned_kids);
|
||||
Hashtbl.replace nd "childNodes" (List cloned_kids)
|
||||
end else begin
|
||||
Hashtbl.replace nd "children" (List []);
|
||||
Hashtbl.replace nd "childNodes" (List [])
|
||||
end;
|
||||
Dict nd
|
||||
| _ -> el
|
||||
in
|
||||
(match rest with _ -> clone_el (Dict d))
|
||||
| "focus" | "blur" | "scrollIntoView" | "scrollTo" | "scroll" -> Nil
|
||||
| "click" ->
|
||||
let ev = Hashtbl.create 8 in
|
||||
Hashtbl.replace ev "__mock_type" (String "event");
|
||||
Hashtbl.replace ev "type" (String "click");
|
||||
Hashtbl.replace ev "bubbles" (Bool true);
|
||||
Hashtbl.replace ev "cancelable" (Bool true);
|
||||
Hashtbl.replace ev "defaultPrevented" (Bool false);
|
||||
Hashtbl.replace ev "_stopped" (Bool false);
|
||||
Hashtbl.replace ev "_stopImmediate" (Bool false);
|
||||
Hashtbl.replace ev "target" (Dict d);
|
||||
mock_dispatch_event (Dict d) (Dict ev)
|
||||
| "getAnimations" -> List []
|
||||
| "getBoundingClientRect" ->
|
||||
let r = Hashtbl.create 8 in
|
||||
Hashtbl.replace r "top" (Number 0.0); Hashtbl.replace r "left" (Number 0.0);
|
||||
Hashtbl.replace r "width" (Number 100.0); Hashtbl.replace r "height" (Number 100.0);
|
||||
Hashtbl.replace r "right" (Number 100.0); Hashtbl.replace r "bottom" (Number 100.0);
|
||||
Dict r
|
||||
| "insertAdjacentHTML" ->
|
||||
(* Simplified: just append text to innerHTML *)
|
||||
(match rest with
|
||||
| [String _pos; String html] ->
|
||||
let cur = match Hashtbl.find_opt d "innerHTML" with Some (String s) -> s | _ -> "" in
|
||||
Hashtbl.replace d "innerHTML" (String (cur ^ html)); Nil
|
||||
| _ -> Nil)
|
||||
| "showModal" | "show" ->
|
||||
Hashtbl.replace d "open" (Bool true);
|
||||
let attrs = match Hashtbl.find_opt d "attributes" with Some (Dict a) -> a | _ ->
|
||||
let a = Hashtbl.create 4 in Hashtbl.replace d "attributes" (Dict a); a in
|
||||
Hashtbl.replace attrs "open" (String ""); Nil
|
||||
| "close" ->
|
||||
Hashtbl.replace d "open" (Bool false);
|
||||
let attrs = match Hashtbl.find_opt d "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0 in
|
||||
Hashtbl.remove attrs "open"; Nil
|
||||
| "prepend" ->
|
||||
(match rest with
|
||||
| [child] ->
|
||||
let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
|
||||
Hashtbl.replace d "children" (List (child :: kids));
|
||||
Hashtbl.replace d "childNodes" (List (child :: kids));
|
||||
(match child with Dict cd ->
|
||||
Hashtbl.replace cd "parentElement" (Dict d);
|
||||
Hashtbl.replace cd "parentNode" (Dict d) | _ -> ());
|
||||
Nil
|
||||
| _ -> Nil)
|
||||
| _ -> Nil)
|
||||
| _ -> Nil);
|
||||
|
||||
reg "host-new" (fun args ->
|
||||
match args with
|
||||
| [String "CustomEvent"; String typ] ->
|
||||
let ev = Hashtbl.create 8 in
|
||||
Hashtbl.replace ev "__mock_type" (String "event");
|
||||
Hashtbl.replace ev "type" (String typ);
|
||||
Hashtbl.replace ev "bubbles" (Bool false);
|
||||
Hashtbl.replace ev "cancelable" (Bool true);
|
||||
Hashtbl.replace ev "defaultPrevented" (Bool false);
|
||||
Hashtbl.replace ev "_stopped" (Bool false);
|
||||
Hashtbl.replace ev "_stopImmediate" (Bool false);
|
||||
Hashtbl.replace ev "target" Nil;
|
||||
Hashtbl.replace ev "detail" Nil;
|
||||
Dict ev
|
||||
| [String "CustomEvent"; String typ; Dict opts] ->
|
||||
let ev = Hashtbl.create 8 in
|
||||
Hashtbl.replace ev "__mock_type" (String "event");
|
||||
Hashtbl.replace ev "type" (String typ);
|
||||
Hashtbl.replace ev "bubbles" (match Hashtbl.find_opt opts "bubbles" with Some v -> v | None -> Bool false);
|
||||
Hashtbl.replace ev "cancelable" (match Hashtbl.find_opt opts "cancelable" with Some v -> v | None -> Bool true);
|
||||
Hashtbl.replace ev "defaultPrevented" (Bool false);
|
||||
Hashtbl.replace ev "_stopped" (Bool false);
|
||||
Hashtbl.replace ev "_stopImmediate" (Bool false);
|
||||
Hashtbl.replace ev "target" Nil;
|
||||
Hashtbl.replace ev "detail" (match Hashtbl.find_opt opts "detail" with Some v -> v | None -> Nil);
|
||||
Dict ev
|
||||
| [String "Event"; String typ] ->
|
||||
let ev = Hashtbl.create 8 in
|
||||
Hashtbl.replace ev "__mock_type" (String "event");
|
||||
Hashtbl.replace ev "type" (String typ);
|
||||
Hashtbl.replace ev "bubbles" (Bool false);
|
||||
Hashtbl.replace ev "defaultPrevented" (Bool false);
|
||||
Hashtbl.replace ev "_stopped" (Bool false);
|
||||
Hashtbl.replace ev "_stopImmediate" (Bool false);
|
||||
Dict ev
|
||||
| _ -> Nil);
|
||||
|
||||
reg "host-callback" (fun args ->
|
||||
match args with
|
||||
| [fn] ->
|
||||
(* Wrap SX function as a NativeFn that calls it via CEK *)
|
||||
(match fn with
|
||||
| NativeFn _ -> fn (* already a native fn *)
|
||||
| Lambda _ | Component _ ->
|
||||
NativeFn ("host-callback", fun cb_args ->
|
||||
try Sx_ref.cek_call fn (List cb_args)
|
||||
with e -> Printf.eprintf "[mock] host-callback error: %s\n%!" (Printexc.to_string e); Nil)
|
||||
| _ -> NativeFn ("host-callback-noop", fun _ -> Nil))
|
||||
| _ -> NativeFn ("host-callback-noop", fun _ -> Nil));
|
||||
|
||||
reg "host-typeof" (fun args ->
|
||||
match args with
|
||||
| [Nil] -> String "nil"
|
||||
| [Dict d] ->
|
||||
(match Hashtbl.find_opt d "__mock_type" with
|
||||
| Some (String "element") -> String "element"
|
||||
| Some (String "text") -> String "text"
|
||||
| Some (String "event") -> String "event"
|
||||
| Some (String "document") -> String "document"
|
||||
| _ -> String "object")
|
||||
| [String _] -> String "string"
|
||||
| [Number _] -> String "number"
|
||||
| [Bool _] -> String "boolean"
|
||||
| [NativeFn _] | [Lambda _] -> String "function"
|
||||
| _ -> String "nil");
|
||||
|
||||
reg "host-await" (fun _args -> Nil);
|
||||
|
||||
(* Reset mock body — called between tests via hs-cleanup! *)
|
||||
reg "mock-dom-reset!" (fun _args ->
|
||||
Hashtbl.replace mock_body "children" (List []);
|
||||
Hashtbl.replace mock_body "childNodes" (List []);
|
||||
Hashtbl.replace mock_body "innerHTML" (String "");
|
||||
Hashtbl.replace mock_body "textContent" (String "");
|
||||
Nil);
|
||||
|
||||
(* Load modules needed by tests *)
|
||||
let spec_dir = Filename.concat project_dir "spec" in
|
||||
let lib_dir = Filename.concat project_dir "lib" in
|
||||
@@ -1409,12 +2045,41 @@ let run_spec_tests env test_files =
|
||||
load_module "freeze.sx" lib_dir;
|
||||
load_module "content.sx" lib_dir;
|
||||
load_module "parser-combinators.sx" lib_dir;
|
||||
(* DOM module — provides dom-* wrappers around host-* primitives *)
|
||||
let web_lib_dir = Filename.concat web_dir "lib" in
|
||||
load_module "dom.sx" web_lib_dir;
|
||||
load_module "browser.sx" web_lib_dir;
|
||||
let hs_dir = Filename.concat lib_dir "hyperscript" in
|
||||
load_module "tokenizer.sx" hs_dir;
|
||||
load_module "parser.sx" hs_dir;
|
||||
load_module "compiler.sx" hs_dir;
|
||||
load_module "runtime.sx" hs_dir;
|
||||
load_module "integration.sx" hs_dir;
|
||||
load_module "htmx.sx" hs_dir;
|
||||
(* eval-hs: compile hyperscript source to SX and evaluate it.
|
||||
Used by eval-only behavioral tests (comparisonOperator, mathOperator, etc.) *)
|
||||
ignore (Sx_types.env_bind env "eval-hs" (NativeFn ("eval-hs", fun args ->
|
||||
match args with
|
||||
| [String src] ->
|
||||
(* Add "return" prefix if source doesn't start with a command keyword *)
|
||||
let contains s sub = try ignore (String.index s sub.[0]); let rec check i j =
|
||||
if j >= String.length sub then true
|
||||
else if i >= String.length s then false
|
||||
else if s.[i] = sub.[j] then check (i+1) (j+1)
|
||||
else false in
|
||||
let rec scan i = if i > String.length s - String.length sub then false
|
||||
else if check i 0 then true else scan (i+1) in scan 0
|
||||
with _ -> false in
|
||||
let wrapped =
|
||||
let has_cmd = (String.length src > 4 &&
|
||||
(String.sub src 0 4 = "set " || String.sub src 0 4 = "put " ||
|
||||
String.sub src 0 4 = "get ")) ||
|
||||
contains src "return " || contains src "then " in
|
||||
if has_cmd then src else "return " ^ src
|
||||
in
|
||||
let sx_expr = eval_expr (List [Symbol "hs-to-sx-from-source"; String wrapped]) (Env env) in
|
||||
eval_expr (List [Symbol "eval-expr"; sx_expr; Env env]) (Env env)
|
||||
| _ -> raise (Eval_error "eval-hs: expected string"))));
|
||||
load_module "types.sx" lib_dir;
|
||||
load_module "text-layout.sx" lib_dir;
|
||||
load_module "sx-swap.sx" lib_dir;
|
||||
|
||||
Reference in New Issue
Block a user