From 714538f1b4a05de056ebe76a46014bf6d0cf2323 Mon Sep 17 00:00:00 2001 From: giles Date: Wed, 1 Apr 2026 18:18:13 +0000 Subject: [PATCH] Fix defhandler blockers: &key params, multi-body, HTML tags MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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) --- hosts/ocaml/bin/run_tests.ml | 25 +++++++++++++++++++++++-- web/tests/test-handlers.sx | 24 ++++++++++++++++++------ web/tests/test-swap-integration.sx | 24 ++++++++++++++++++------ 3 files changed, 59 insertions(+), 14 deletions(-) diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml index 84f1dbdd..140e165d 100644 --- a/hosts/ocaml/bin/run_tests.ml +++ b/hosts/ocaml/bin/run_tests.ml @@ -281,6 +281,13 @@ let make_test_env () = (* --- HTML Renderer (from sx_render.ml library module) --- *) 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 *) bind "set-render-active!" (fun _args -> Nil); bind "render-active?" (fun _args -> Bool true); @@ -437,12 +444,26 @@ let make_test_env () = | rest -> (acc, rest) in let opts = Hashtbl.create 4 in let (_, remaining) = parse_opts opts rest in - let _params, body = match remaining with - | List p :: b :: _ -> (p, b) | List _p :: [] -> (_p, Nil) | _ -> ([], Nil) in + let params, body_forms = match remaining with + | 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 Hashtbl.replace hdef "__type" (String "handler"); Hashtbl.replace hdef "name" (String name); 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 "method" (match Hashtbl.find_opt opts "method" with | Some (Keyword m) -> String m | Some v -> v | None -> String "get"); diff --git a/web/tests/test-handlers.sx b/web/tests/test-handlers.sx index 5a8bcbbb..20b00c54 100644 --- a/web/tests/test-handlers.sx +++ b/web/tests/test-handlers.sx @@ -82,12 +82,24 @@ run-handler (fn (hdef) - (let - ((result (aser (get hdef "body") (get hdef "closure")))) - (if - (sx-expr? result) - (sx-expr-source result) - (if (string? result) result (str result)))))) + (do + (let + ((params (get hdef "params")) (closure (get hdef "closure"))) + (when + (and params (not (empty? params))) + (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 "example:click-to-load" diff --git a/web/tests/test-swap-integration.sx b/web/tests/test-swap-integration.sx index 14482d39..e5aa2316 100644 --- a/web/tests/test-swap-integration.sx +++ b/web/tests/test-swap-integration.sx @@ -84,12 +84,24 @@ run-handler (fn (hdef) - (let - ((result (aser (get hdef "body") (get hdef "closure")))) - (if - (sx-expr? result) - (sx-expr-source result) - (if (string? result) result (str result)))))) + (do + (let + ((params (get hdef "params")) (closure (get hdef "closure"))) + (when + (and params (not (empty? params))) + (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 "swap:click-to-load"