Fix defhandler blockers: &key params, multi-body, HTML tags
Three fixes in run_tests.ml defhandler parser: 1. Extract &key param names, store in hdef["params"]. run-handler binds them from mock args before evaluating — fixes row-editing, tabs, inline-edit, profile-editing handlers. 2. Capture all body forms after params, wrap in (do ...) when multiple — fixes ex-slow (sleep before let). 3. Register all HTML tags as native fns via Sx_render.html_tags — fixes ex-bulk (tr tag), and enables aser to serialize any tag. 1352 → 1361 passing tests. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -281,6 +281,13 @@ let make_test_env () =
|
|||||||
(* --- HTML Renderer (from sx_render.ml library module) --- *)
|
(* --- HTML Renderer (from sx_render.ml library module) --- *)
|
||||||
Sx_render.setup_render_env env;
|
Sx_render.setup_render_env env;
|
||||||
|
|
||||||
|
(* HTML tag functions — bind all tags as native fns returning (tag ...args) *)
|
||||||
|
List.iter (fun tag ->
|
||||||
|
ignore (Sx_types.env_bind env tag
|
||||||
|
(NativeFn ("html:" ^ tag, fun args -> List (Symbol tag :: args))))
|
||||||
|
) Sx_render.html_tags;
|
||||||
|
bind "is-html-tag?" (fun args -> match args with [String s] -> Bool (Sx_render.is_html_tag s) | _ -> Bool false);
|
||||||
|
|
||||||
(* Stubs needed by adapter-html.sx when loaded at test time *)
|
(* Stubs needed by adapter-html.sx when loaded at test time *)
|
||||||
bind "set-render-active!" (fun _args -> Nil);
|
bind "set-render-active!" (fun _args -> Nil);
|
||||||
bind "render-active?" (fun _args -> Bool true);
|
bind "render-active?" (fun _args -> Bool true);
|
||||||
@@ -437,12 +444,26 @@ let make_test_env () =
|
|||||||
| rest -> (acc, rest) in
|
| rest -> (acc, rest) in
|
||||||
let opts = Hashtbl.create 4 in
|
let opts = Hashtbl.create 4 in
|
||||||
let (_, remaining) = parse_opts opts rest in
|
let (_, remaining) = parse_opts opts rest in
|
||||||
let _params, body = match remaining with
|
let params, body_forms = match remaining with
|
||||||
| List p :: b :: _ -> (p, b) | List _p :: [] -> (_p, Nil) | _ -> ([], Nil) in
|
| List p :: rest -> (p, rest) | _ -> ([], []) in
|
||||||
|
(* Wrap multiple body forms in (do ...) *)
|
||||||
|
let body = match body_forms with
|
||||||
|
| [] -> Nil | [b] -> b
|
||||||
|
| forms -> List (Symbol "do" :: forms) in
|
||||||
|
(* Extract &key param names for binding *)
|
||||||
|
let key_params =
|
||||||
|
let rec collect acc in_key = function
|
||||||
|
| [] -> List.rev acc
|
||||||
|
| Symbol "&key" :: rest -> collect acc true rest
|
||||||
|
| Symbol "&rest" :: _ :: rest -> collect acc false rest
|
||||||
|
| Symbol s :: rest when in_key -> collect (s :: acc) true rest
|
||||||
|
| _ :: rest -> collect acc in_key rest
|
||||||
|
in collect [] false params in
|
||||||
let hdef = Hashtbl.create 8 in
|
let hdef = Hashtbl.create 8 in
|
||||||
Hashtbl.replace hdef "__type" (String "handler");
|
Hashtbl.replace hdef "__type" (String "handler");
|
||||||
Hashtbl.replace hdef "name" (String name);
|
Hashtbl.replace hdef "name" (String name);
|
||||||
Hashtbl.replace hdef "body" body;
|
Hashtbl.replace hdef "body" body;
|
||||||
|
Hashtbl.replace hdef "params" (List (List.map (fun s -> String s) key_params));
|
||||||
Hashtbl.replace hdef "closure" (Env eval_env);
|
Hashtbl.replace hdef "closure" (Env eval_env);
|
||||||
Hashtbl.replace hdef "method" (match Hashtbl.find_opt opts "method" with
|
Hashtbl.replace hdef "method" (match Hashtbl.find_opt opts "method" with
|
||||||
| Some (Keyword m) -> String m | Some v -> v | None -> String "get");
|
| Some (Keyword m) -> String m | Some v -> v | None -> String "get");
|
||||||
|
|||||||
@@ -82,12 +82,24 @@
|
|||||||
run-handler
|
run-handler
|
||||||
(fn
|
(fn
|
||||||
(hdef)
|
(hdef)
|
||||||
(let
|
(do
|
||||||
((result (aser (get hdef "body") (get hdef "closure"))))
|
(let
|
||||||
(if
|
((params (get hdef "params")) (closure (get hdef "closure")))
|
||||||
(sx-expr? result)
|
(when
|
||||||
(sx-expr-source result)
|
(and params (not (empty? params)))
|
||||||
(if (string? result) result (str result))))))
|
(for-each
|
||||||
|
(fn
|
||||||
|
(p)
|
||||||
|
(let
|
||||||
|
((val (get _mock-args p)))
|
||||||
|
(env-bind! closure p (or val nil))))
|
||||||
|
params)))
|
||||||
|
(let
|
||||||
|
((result (aser (get hdef "body") (get hdef "closure"))))
|
||||||
|
(if
|
||||||
|
(sx-expr? result)
|
||||||
|
(sx-expr-source result)
|
||||||
|
(if (string? result) result (str result)))))))
|
||||||
|
|
||||||
(defsuite
|
(defsuite
|
||||||
"example:click-to-load"
|
"example:click-to-load"
|
||||||
|
|||||||
@@ -84,12 +84,24 @@
|
|||||||
run-handler
|
run-handler
|
||||||
(fn
|
(fn
|
||||||
(hdef)
|
(hdef)
|
||||||
(let
|
(do
|
||||||
((result (aser (get hdef "body") (get hdef "closure"))))
|
(let
|
||||||
(if
|
((params (get hdef "params")) (closure (get hdef "closure")))
|
||||||
(sx-expr? result)
|
(when
|
||||||
(sx-expr-source result)
|
(and params (not (empty? params)))
|
||||||
(if (string? result) result (str result))))))
|
(for-each
|
||||||
|
(fn
|
||||||
|
(p)
|
||||||
|
(let
|
||||||
|
((val (get _mock-args p)))
|
||||||
|
(env-bind! closure p (or val nil))))
|
||||||
|
params)))
|
||||||
|
(let
|
||||||
|
((result (aser (get hdef "body") (get hdef "closure"))))
|
||||||
|
(if
|
||||||
|
(sx-expr? result)
|
||||||
|
(sx-expr-source result)
|
||||||
|
(if (string? result) result (str result)))))))
|
||||||
|
|
||||||
(defsuite
|
(defsuite
|
||||||
"swap:click-to-load"
|
"swap:click-to-load"
|
||||||
|
|||||||
Reference in New Issue
Block a user