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

HS: call command fix, event destructuring, array ops, form reset

Browse Source 
- call: use make-symbol for fn name, rest-rest for args (was string + nth)
- on: extract (ref ...) nodes from body as event.detail let-bindings
- host-set!: add ListRef+Number case for array index mutation
- append!: support index 0 for prepend
- hs-put!: branch on list? for array start/end operations
- hs-reset!: form reset restoring defaultValue/checked/textContent
- 522/793 pass (was 493/754)

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-21 12:16:09 +00:00
parent b23da3190e
commit 9d246f5c96
4 changed files with 110 additions and 47 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -352,7 +352,11 @@ let make_test_env () =
bind "append!" (fun args ->
match args with
| [ListRef r; v] -> r := !r @ [v]; ListRef r (* mutate in place *)
| [ListRef r; v; Number n] when int_of_float n = 0 ->
r := v :: !r; ListRef r (* prepend *)
| [ListRef r; v] -> r := !r @ [v]; ListRef r (* append in place *)
| [List items; v; Number n] when int_of_float n = 0 ->
List (v :: items) (* immutable prepend *)
| [List items; v] -> List (items @ [v]) (* immutable fallback *)
| _ -> raise (Eval_error "append!: expected list and value"));
@@ -1297,8 +1301,7 @@ let run_spec_tests env test_files =
let response = match op with
| "import" ->
let lib_spec = Sx_runtime.get_val request (String "library") in
let key = Sx_ref.library_name_key lib_spec in
if Sx_types.sx_truthy (Sx_ref.library_loaded_p key) then
if Sx_types.sx_truthy (Sx_ref.library_loaded_p lib_spec) then
Nil
else begin
(match resolve_library_path lib_spec with
@@ -1611,7 +1614,7 @@ let run_spec_tests env test_files =
| "contains" | "cloneNode" | "remove" | "focus" | "blur" | "click"
| "insertAdjacentHTML" | "prepend" | "showModal" | "show" | "close"
| "getBoundingClientRect" | "getAnimations" | "scrollIntoView"
| "scrollTo" | "scroll" -> Bool true
| "scrollTo" | "scroll" | "reset" -> Bool true
| "firstElementChild" ->
let kids = match Hashtbl.find_opt d "children" with Some (List l) -> l | _ -> [] in
(match kids with c :: _ -> c | [] -> Nil)
@@ -1718,6 +1721,17 @@ let run_spec_tests env test_files =
Hashtbl.replace d "childNodes" (List [])
| _ -> ());
stored
| [ListRef r; Number n; value] ->
let idx = int_of_float n in
let lst = !r in
if idx >= 0 && idx < List.length lst then
r := List.mapi (fun i v -> if i = idx then value else v) lst
else if idx = List.length lst then
r := lst @ [value];
value
| [List _; Number _; _value] ->
(* Immutable list — can't set, but don't crash *)
Nil
| _ -> Nil);
reg "host-call" (fun args ->
@@ -2079,6 +2093,56 @@ let run_spec_tests env test_files =
Hashtbl.replace cd "parentNode" (Dict d) | _ -> ());
Nil
| _ -> Nil)
| "reset" ->
(* Reset form elements to their default values *)
let rec reset_element el =
match el with
| Dict ed ->
let tag = match Hashtbl.find_opt ed "tagName" with Some (String t) -> String.lowercase_ascii t | _ -> "" in
let attrs = match Hashtbl.find_opt ed "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0 in
(match tag with
| "input" ->
let typ = match Hashtbl.find_opt attrs "type" with Some (String t) -> String.lowercase_ascii t | _ -> "text" in
(match typ with
| "checkbox" | "radio" ->
let default_checked = Hashtbl.mem attrs "checked" in
Hashtbl.replace ed "checked" (Bool default_checked)
| _ ->
let default_value = match Hashtbl.find_opt attrs "value" with Some v -> v | None -> String "" in
Hashtbl.replace ed "value" default_value)
| "textarea" ->
(* Textarea default is from innerHTML/textContent, not value attr *)
let default_value = match Hashtbl.find_opt attrs "value" with
| Some v -> v
| None -> (match Hashtbl.find_opt ed "textContent" with Some v -> v
| None -> (match Hashtbl.find_opt ed "innerHTML" with Some v -> v | None -> String "")) in
Hashtbl.replace ed "value" default_value
| "select" ->
(* Restore first option or defaultSelected *)
let kids = match Hashtbl.find_opt ed "children" with Some (List l) -> l | _ -> [] in
let rec find_default = function
| [] -> None
| Dict od :: _ when Hashtbl.mem (match Hashtbl.find_opt od "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0) "selected" ->
Some (match Hashtbl.find_opt (match Hashtbl.find_opt od "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0) "value" with Some (String v) -> v | _ -> "")
| _ :: rest -> find_default rest in
(match find_default kids with
| Some v -> Hashtbl.replace ed "value" (String v)
| None ->
(match kids with
| Dict od :: _ ->
let v = match Hashtbl.find_opt (match Hashtbl.find_opt od "attributes" with Some (Dict a) -> a | _ -> Hashtbl.create 0) "value" with Some (String v) -> v | _ -> "" in
Hashtbl.replace ed "value" (String v)
| _ -> ()))
| "form" ->
let kids = match Hashtbl.find_opt ed "children" with Some (List l) -> l | _ -> [] in
List.iter reset_element kids
| _ ->
(* Recurse into children for generic containers *)
let kids = match Hashtbl.find_opt ed "children" with Some (List l) -> l | _ -> [] in
List.iter reset_element kids);
| _ -> ()
in
reset_element (Dict d); Nil
| _ -> Nil)
| _ -> Nil);