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"