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

HS: fix empty/halt/morph/reset/dialog — 17 upstream tests pass

Browse Source 
- parser `empty` no-target → (ref "me") (was bogus (sym "me"))
- parser `halt` modes distinguish: "all"/"bubbling"/"default" halt execution
  (raise hs-return), "the-event"/"the event's" only stop propagation/default.
  "'s" now matched as op token, not keyword.
- parser `get` cmd: dispatch + cmd-kw list + parse-get-cmd (parses expr with
  optional `as TYPE`). Required for `get result as JSON` in fetch chains.
- compiler empty-target for (local X): emit (set! X (hs-empty-like X)) so
  arrays/sets/maps clear the variable, not call DOM empty on the value.
- runtime hs-empty-like: container-of-same-type empty value.
- runtime hs-empty-target!: drop dead FORM branch that was short-circuiting
  to innerHTML=""; the querySelectorAll-over-inputs branch now runs.
- runtime hs-halt!: take ev param (was free `event` lookup); raise hs-return
  to stop execution unless mode is "the-event".
- runtime hs-reset!: type-aware — FORM → reset, INPUT/TEXTAREA → value/checked
  from defaults, SELECT → defaultSelected option.
- runtime hs-open!/hs-close!: toggle `open` attribute on details elements
  (not just the prop) so dom-has-attr? assertions work.
- runtime hs-coerce JSON: json-stringify dict/list (was str).
- test-runner mock: host-get on List + "length"/"size" (was only Dict);
  dom-set-attr tracks defaultChecked / defaultSelected / defaultValue;
  mock_query_all supports comma-separated selector groups.
- generator: emit boolean attrs (checked/selected/etc) even with null value;
  drop overcautious "skip HS with bare quotes or embedded HTML" guard so
  morph tests (source contains embedded <div>) emit properly.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-22 15:36:01 +00:00
parent 5c66095b0f
commit 802ccd23e8
12 changed files with 1340 additions and 345 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -1637,6 +1637,20 @@ let run_spec_tests env test_files =
in
let rec mock_query_all el sel =
(* Handle comma-separated selector groups: "a, b, c" *)
if String.contains sel ',' then
let parts = String.split_on_char ',' sel
|> List.map String.trim
|> List.filter (fun s -> String.length s > 0) in
let seen = ref [] in
List.concat_map (fun part ->
let results = mock_query_all el part in
List.filter (fun r ->
if List.memq r !seen then false
else (seen := r :: !seen; true)
) results
) parts
else
match split_selector sel with
| [single] -> mock_query_all_single el single
| first :: rest ->
@@ -1705,6 +1719,11 @@ let run_spec_tests env test_files =
| [Nil; _] -> Nil
| [String s; String "length"] -> Number (float_of_int (String.length s))
| [List l; String "length"] -> Number (float_of_int (List.length l))
| [ListRef { contents = l }; String "length"] -> Number (float_of_int (List.length l))
| [List l; String "size"] -> Number (float_of_int (List.length l))
| [ListRef { contents = l }; String "size"] -> Number (float_of_int (List.length l))
| [Dict d; String "size"] when not (Hashtbl.mem d "__mock_type") ->
Number (float_of_int (Hashtbl.length d))
| [Dict d; String key] ->
let mt = match Hashtbl.find_opt d "__mock_type" with Some (String t) -> t | _ -> "" in
(* classList.length *)
@@ -1789,6 +1808,18 @@ let run_spec_tests env test_files =
| Bool false -> String "false"
| List l -> String (String.concat "," (List.map (fun v -> match dom_stringify v with String s -> s | _ -> "") l))
| Nil -> String ""
| Dict d ->
(* Avoid `inspect` on circular mock-DOM dicts. Prefer outerHTML, fall
back to a tag placeholder, then "[object Object]". *)
(match Hashtbl.find_opt d "outerHTML" with
| Some (String s) when String.length s > 0 -> String s
| _ ->
(match Hashtbl.find_opt d "__mock_type" with
| Some (String "element") ->
let tag = match Hashtbl.find_opt d "tagName" with
| Some (String t) -> String.lowercase_ascii t | _ -> "div" in
String ("<" ^ tag ^ ">")
| _ -> String "[object Object]"))
| v -> String (Sx_types.inspect v)
in
@@ -1980,6 +2011,21 @@ let run_spec_tests env test_files =
Hashtbl.replace d "className" (String sv);
end;
if name = "disabled" then Hashtbl.replace d "disabled" (Bool true);
if name = "checked" then begin
Hashtbl.replace d "defaultChecked" (Bool true);
Hashtbl.replace d "checked" (Bool true);
end;
if name = "selected" then begin
Hashtbl.replace d "defaultSelected" (Bool true);
Hashtbl.replace d "selected" (Bool true);
end;
if name = "value" then begin
(match Hashtbl.find_opt d "defaultValue" with
| Some _ -> ()
| None -> Hashtbl.replace d "defaultValue" (String sv));
Hashtbl.replace d "value" (String sv);
end;
if name = "type" then Hashtbl.replace d "type" (String sv);
if name = "style" then begin
(* Parse CSS string into the style sub-dict *)
let style_d = match Hashtbl.find_opt d "style" with Some (Dict s) -> s | _ ->
@@ -2543,6 +2589,11 @@ let run_spec_tests env test_files =
ignore (Sx_types.env_bind env "console-log" (NativeFn ("console-log", fun _ -> Nil)));
ignore (Sx_types.env_bind env "console-debug" (NativeFn ("console-debug", fun _ -> Nil)));
ignore (Sx_types.env_bind env "console-error" (NativeFn ("console-error", fun _ -> Nil)));
(* promiseAString / promiseAnInt: upstream hyperscript tests use these to
exercise promise awaiting. In the synchronous mock environment they
resolve immediately to the expected value. *)
ignore (Sx_types.env_bind env "promiseAString" (NativeFn ("promiseAString", fun _ -> String "foo")));
ignore (Sx_types.env_bind env "promiseAnInt" (NativeFn ("promiseAnInt", fun _ -> Number 42.0)));
(* eval-hs: compile hyperscript source to SX and evaluate it.
Used by eval-only behavioral tests (comparisonOperator, mathOperator, etc.).
Accepts optional ctx dict: {:me V :locals {:x V :y V ...}}. Catches