From 2cba359fdfbe6ecf9e22a1a2c639b721427e11e5 Mon Sep 17 00:00:00 2001 From: giles Date: Tue, 14 Apr 2026 10:03:26 +0000 Subject: [PATCH] HS behavioral tests: mock DOM + eval-hs in OCaml test runner MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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) --- hosts/ocaml/bin/run_tests.ml | 665 +++++++++++++++++++++++++++++++++++ 1 file changed, 665 insertions(+) diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml index d744812d..3532b09b 100644 --- a/hosts/ocaml/bin/run_tests.ml +++ b/hosts/ocaml/bin/run_tests.ml @@ -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;