Files
rose-ash/hosts/ocaml/bin/integration_tests.ml
giles 57cffb8bcc Fix isomorphic SSR: revert inline opcodes, add named let compilation, fix cookie decode
Three bugs broke island SSR rendering of the home stepper widget:

1. Inline VM opcodes (OP_ADD..OP_DEC) broke JIT-compiled functions.
   The compiler emitted single-byte opcodes for first/rest/len/= etc.
   that produced wrong results in complex recursive code (sx-parse
   returned nil, split-tag produced 1 step instead of 16). Reverted
   compiler to use CALL_PRIM for all primitives. VM opcode handlers
   kept for future use.

2. Named let (let loop ((x init)) body) had no compiler support —
   silently produced broken bytecode. Added desugaring to letrec.

3. URL-encoded cookie values not decoded server-side. Client set-cookie
   uses encodeURIComponent but Werkzeug doesn't decode cookie values.
   Added unquote() in bridge cookie injection.

Also: call-lambda used eval_expr which copies Dict values (signals),
breaking mutations through aser lambda calls. Switched to cek_call.

Also: stepper preview now includes ~cssx/tw spreads for SSR styling.

Tests: 1317 JS, 1114 OCaml, 26 integration (2 pre-existing failures)

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-03-24 22:32:51 +00:00

520 lines
25 KiB
OCaml

(** Integration tests — exercises the full rendering pipeline.
Loads spec files + web adapters into a server-like env, then renders
HTML expressions. Catches "Undefined symbol" errors that only surface
when the full stack is loaded (not caught by spec unit tests).
Usage:
dune exec bin/integration_tests.exe *)
module Sx_types = Sx.Sx_types
module Sx_parser = Sx.Sx_parser
module Sx_primitives = Sx.Sx_primitives
module Sx_runtime = Sx.Sx_runtime
module Sx_ref = Sx.Sx_ref
module Sx_render = Sx.Sx_render
open Sx_types
let pass_count = ref 0
let fail_count = ref 0
let assert_eq name expected actual =
if expected = actual then begin
incr pass_count;
Printf.printf " PASS: %s\n%!" name
end else begin
incr fail_count;
Printf.printf " FAIL: %s\n expected: %s\n got: %s\n%!" name expected actual
end
let assert_contains name needle haystack =
let rec find i =
if i + String.length needle > String.length haystack then false
else if String.sub haystack i (String.length needle) = needle then true
else find (i + 1)
in
if String.length needle > 0 && find 0 then begin
incr pass_count;
Printf.printf " PASS: %s\n%!" name
end else begin
incr fail_count;
Printf.printf " FAIL: %s — expected to contain %S in %S\n%!" name needle haystack
end
let assert_no_error name f =
try
ignore (f ());
incr pass_count;
Printf.printf " PASS: %s\n%!" name
with
| Eval_error msg ->
incr fail_count;
Printf.printf " FAIL: %s — %s\n%!" name msg
| exn ->
incr fail_count;
Printf.printf " FAIL: %s — %s\n%!" name (Printexc.to_string exn)
(* Build a server-like env with rendering support *)
let make_integration_env () =
let env = make_env () in
let bind (n : string) fn =
ignore (Sx_types.env_bind env n (NativeFn (n, fn)))
in
Sx_render.setup_render_env env;
(* HTML tag functions — same as sx_server.ml *)
List.iter (fun tag ->
ignore (env_bind env tag
(NativeFn ("html:" ^ tag, fun args -> List (Symbol tag :: args))))
) Sx_render.html_tags;
(* Platform primitives needed by spec/render.sx and adapters *)
bind "make-raw-html" (fun args ->
match args with [String s] -> RawHTML s | [v] -> RawHTML (value_to_string v) | _ -> Nil);
bind "raw-html-content" (fun args ->
match args with [RawHTML s] -> String s | [String s] -> String s | _ -> String "");
bind "escape-html" (fun args ->
match args with [String s] -> String (Sx_render.escape_html s) | _ -> String "");
bind "escape-attr" (fun args ->
match args with [String s] -> String (Sx_render.escape_html s) | _ -> String "");
bind "escape-string" (fun args ->
match args with [String s] -> String (Sx_render.escape_html s) | _ -> String "");
bind "is-html-tag?" (fun args ->
match args with [String s] -> Bool (Sx_render.is_html_tag s) | _ -> Bool false);
bind "is-void-element?" (fun args ->
match args with [String s] -> Bool (Sx_render.is_void s) | _ -> Bool false);
bind "is-boolean-attr?" (fun args ->
match args with [String s] -> Bool (Sx_render.is_boolean_attr s) | _ -> Bool false);
(* Mutable operations needed by adapter code *)
bind "append!" (fun args ->
match args with
| [ListRef r; v] -> r := !r @ [v]; ListRef r
| [List items; v] -> List (items @ [v])
| _ -> raise (Eval_error "append!: expected list and value"));
bind "dict-set!" (fun args ->
match args with
| [Dict d; String k; v] -> Hashtbl.replace d k v; v
| [Dict d; Keyword k; v] -> Hashtbl.replace d k v; v
| _ -> Nil);
bind "dict-has?" (fun args ->
match args with
| [Dict d; String k] -> Bool (Hashtbl.mem d k)
| [Dict d; Keyword k] -> Bool (Hashtbl.mem d k)
| _ -> Bool false);
bind "dict-get" (fun args ->
match args with
| [Dict d; String k] -> (match Hashtbl.find_opt d k with Some v -> v | None -> Nil)
| [Dict d; Keyword k] -> (match Hashtbl.find_opt d k with Some v -> v | None -> Nil)
| _ -> Nil);
bind "empty-dict?" (fun args ->
match args with
| [Dict d] -> Bool (Hashtbl.length d = 0)
| _ -> Bool true);
bind "mutable-list" (fun _args -> ListRef (ref []));
(* Symbol/keyword accessors needed by adapter-html.sx *)
bind "symbol-name" (fun args ->
match args with [Symbol s] -> String s | _ -> raise (Eval_error "symbol-name: expected symbol"));
bind "keyword-name" (fun args ->
match args with [Keyword k] -> String k | _ -> raise (Eval_error "keyword-name: expected keyword"));
bind "make-symbol" (fun args ->
match args with [String s] -> Symbol s | _ -> raise (Eval_error "make-symbol: expected string"));
bind "make-keyword" (fun args ->
match args with [String s] -> Keyword s | _ -> raise (Eval_error "make-keyword: expected string"));
(* Type predicates needed by adapters *)
bind "island?" (fun args -> match args with [Island _] -> Bool true | _ -> Bool false);
bind "component?" (fun args -> match args with [Component _] -> Bool true | _ -> Bool false);
bind "macro?" (fun args -> match args with [Macro _] -> Bool true | _ -> Bool false);
bind "lambda?" (fun args -> match args with [Lambda _] -> Bool true | _ -> Bool false);
bind "spread?" (fun args -> match args with [Spread _] -> Bool true | _ -> Bool false);
bind "spread-attrs" (fun args ->
match args with
| [Spread pairs] -> let d = Hashtbl.create 8 in
List.iter (fun (k, v) -> Hashtbl.replace d k v) pairs; Dict d
| _ -> Nil);
bind "component-name" (fun args -> match args with [Component c] -> String c.c_name | [Island i] -> String i.i_name | _ -> Nil);
bind "component-params" (fun args -> match args with [Component c] -> List (List.map (fun s -> String s) c.c_params) | _ -> List []);
bind "component-body" (fun args -> match args with [Component c] -> c.c_body | _ -> Nil);
bind "component-closure" (fun args -> match args with [Component c] -> Env c.c_closure | _ -> Nil);
bind "component-has-children?" (fun args -> match args with [Component c] -> Bool c.c_has_children | _ -> Bool false);
bind "component-affinity" (fun args -> match args with [Component c] -> String c.c_affinity | _ -> String "auto");
bind "lambda-params" (fun args -> match args with [Lambda l] -> List (List.map (fun s -> String s) l.l_params) | _ -> List []);
bind "lambda-body" (fun args -> match args with [Lambda l] -> l.l_body | _ -> Nil);
bind "lambda-closure" (fun args -> match args with [Lambda l] -> Env l.l_closure | _ -> Nil);
bind "lambda-name" (fun args -> match args with [Lambda l] -> (match l.l_name with Some n -> String n | None -> Nil) | _ -> Nil);
bind "set-lambda-name!" (fun args -> match args with [Lambda l; String n] -> l.l_name <- Some n; Nil | _ -> Nil);
(* Environment operations *)
bind "env-extend" (fun args ->
match args with [Env e] -> Env (env_extend e) | _ -> Env (env_extend env));
bind "env-bind!" (fun args ->
match args with [Env e; String k; v] -> env_bind e k v | _ -> Nil);
bind "env-set!" (fun args ->
match args with [Env e; String k; v] -> env_set e k v | _ -> Nil);
bind "env-get" (fun args ->
match args with [Env e; String k] -> env_get e k | _ -> Nil);
bind "env-has?" (fun args ->
match args with [Env e; String k] -> Bool (env_has e k) | _ -> Bool false);
bind "env-merge" (fun args ->
match args with [Env a; Env b] -> Env (env_merge a b) | _ -> Nil);
bind "make-env" (fun _args -> Env (make_env ()));
(* Eval/trampoline — needed by adapters *)
bind "eval-expr" (fun args ->
match args with
| [expr; e] -> Sx_ref.eval_expr expr e
| _ -> Nil);
bind "trampoline" (fun args ->
match args with
| [Thunk (e, env)] -> Sx_ref.eval_expr e (Env env)
| [v] -> v | _ -> Nil);
bind "call-lambda" (fun args ->
match args with
| [f; List a] -> Sx_runtime.sx_call f a
| [f; a] -> Sx_runtime.sx_call f [a]
| _ -> Nil);
bind "expand-macro" (fun args ->
match args with
| [Macro m; List macro_args; _env] ->
let local = env_extend m.m_closure in
let rec bind_params ps as' = match ps, as' with
| [], rest ->
(match m.m_rest_param with Some rp -> ignore (env_bind local rp (List rest)) | None -> ())
| p :: ps_rest, a :: as_rest ->
ignore (env_bind local p a); bind_params ps_rest as_rest
| _ :: _, [] -> ()
in
bind_params m.m_params macro_args;
Sx_ref.eval_expr m.m_body (Env local)
| _ -> Nil);
(* Scope/provide — needed by adapter-html.sx and the CEK evaluator.
Must be registered as primitives (prim_call) not just env bindings. *)
let scope_stacks : (string, value list) Hashtbl.t = Hashtbl.create 8 in
let scope_emitted : (string, value list) Hashtbl.t = Hashtbl.create 8 in
let scope_push name v =
let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in
Hashtbl.replace scope_stacks name (v :: stack); Nil in
let scope_pop name =
(match Hashtbl.find_opt scope_stacks name with
| Some (_ :: rest) -> Hashtbl.replace scope_stacks name rest
| _ -> ()); Nil in
let scope_peek name =
match Hashtbl.find_opt scope_stacks name with
| Some (v :: _) -> v | _ -> Nil in
let scope_emit name v =
let items = try Hashtbl.find scope_emitted name with Not_found -> [] in
Hashtbl.replace scope_emitted name (items @ [v]); Nil in
let emitted name =
match Hashtbl.find_opt scope_emitted name with Some l -> List l | None -> List [] in
(* Register as both env bindings AND primitives *)
bind "scope-push!" (fun args -> match args with [String n; v] -> scope_push n v | _ -> Nil);
bind "scope-pop!" (fun args -> match args with [String n] -> scope_pop n | _ -> Nil);
bind "scope-peek" (fun args -> match args with [String n] -> scope_peek n | _ -> Nil);
bind "scope-emit!" (fun args -> match args with [String n; v] -> scope_emit n v | _ -> Nil);
bind "emitted" (fun args -> match args with [String n] -> emitted n | _ -> List []);
bind "emit!" (fun args -> match args with [String n; v] -> scope_emit n v | _ -> Nil);
bind "scope-emitted" (fun args -> match args with [String n] -> emitted n | _ -> List []);
bind "collect!" (fun _args -> Nil);
bind "collected" (fun _args -> List []);
bind "clear-collected!" (fun _args -> Nil);
bind "scope-collected" (fun _args -> List []);
bind "scope-clear-collected!" (fun _args -> Nil);
bind "provide-push!" (fun args -> match args with [String n; v] -> scope_push n v | _ -> Nil);
bind "provide-pop!" (fun args -> match args with [String n] -> scope_pop n | _ -> Nil);
bind "context" (fun args -> match args with [String n] -> scope_peek n | [String n; _] -> scope_peek n | _ -> Nil);
bind "sx-context" (fun args -> match args with [String n] -> scope_peek n | [String n; _] -> scope_peek n | _ -> Nil);
(* Also register as primitives for prim_call *)
Sx_primitives.register "scope-push!" (fun args -> match args with [String n; v] -> scope_push n v | _ -> Nil);
Sx_primitives.register "scope-pop!" (fun args -> match args with [String n] -> scope_pop n | _ -> Nil);
Sx_primitives.register "scope-peek" (fun args -> match args with [String n] -> scope_peek n | _ -> Nil);
Sx_primitives.register "scope-emit!" (fun args -> match args with [String n; v] -> scope_emit n v | _ -> Nil);
Sx_primitives.register "emitted" (fun args -> match args with [String n] -> emitted n | _ -> List []);
Sx_primitives.register "emit!" (fun args -> match args with [String n; v] -> scope_emit n v | _ -> Nil);
Sx_primitives.register "scope-emitted" (fun args -> match args with [String n] -> emitted n | _ -> List []);
Sx_primitives.register "collect!" (fun _args -> Nil);
Sx_primitives.register "collected" (fun _args -> List []);
Sx_primitives.register "clear-collected!" (fun _args -> Nil);
Sx_primitives.register "scope-collected" (fun _args -> List []);
Sx_primitives.register "scope-clear-collected!" (fun _args -> Nil);
Sx_primitives.register "provide-push!" (fun args -> match args with [String n; v] -> scope_push n v | _ -> Nil);
Sx_primitives.register "provide-pop!" (fun args -> match args with [String n] -> scope_pop n | _ -> Nil);
Sx_primitives.register "context" (fun args -> match args with [String n] -> scope_peek n | [String n; _] -> scope_peek n | _ -> Nil);
(* Render-mode flags *)
ignore (env_bind env "*render-active*" (Bool false));
bind "set-render-active!" (fun args ->
match args with [v] -> ignore (env_set env "*render-active*" v); Nil | _ -> Nil);
bind "render-active?" (fun _args ->
try env_get env "*render-active*" with _ -> Bool false);
bind "definition-form?" (fun args ->
match args with
| [String s] -> Bool (List.mem s ["define"; "defcomp"; "defisland"; "defmacro";
"defstyle"; "defhandler"; "deftype"; "defeffect"; "defquery"; "defaction"; "defrelation"])
| _ -> Bool false);
(* Signal stubs for SSR — overridden when signals.sx is loaded *)
bind "signal" (fun args -> match args with [v] -> v | _ -> Nil);
bind "computed" (fun args -> match args with [f] -> Sx_runtime.sx_call f [] | _ -> Nil);
bind "deref" (fun args -> match args with [v] -> v | _ -> Nil);
bind "reset!" (fun _args -> Nil);
bind "swap!" (fun _args -> Nil);
bind "effect" (fun _args -> Nil);
bind "batch" (fun _args -> Nil);
(* Type predicates — needed by adapter-sx.sx *)
bind "callable?" (fun args ->
match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true | _ -> Bool false);
bind "lambda?" (fun args -> match args with [Lambda _] -> Bool true | _ -> Bool false);
bind "macro?" (fun args -> match args with [Macro _] -> Bool true | _ -> Bool false);
bind "island?" (fun args -> match args with [Island _] -> Bool true | _ -> Bool false);
bind "component?" (fun args ->
match args with [Component _] | [Island _] -> Bool true | _ -> Bool false);
bind "spread?" (fun args -> match args with [Spread _] -> Bool true | _ -> Bool false);
bind "lambda-params" (fun args ->
match args with [Lambda l] -> List (List.map (fun s -> String s) l.l_params) | _ -> List []);
bind "lambda-body" (fun args -> match args with [Lambda l] -> l.l_body | _ -> Nil);
bind "lambda-closure" (fun args ->
match args with [Lambda l] -> Env l.l_closure | _ -> Dict (Hashtbl.create 0));
bind "component-name" (fun args ->
match args with [Component c] -> String c.c_name | [Island i] -> String i.i_name | _ -> String "");
bind "component-closure" (fun args ->
match args with [Component c] -> Env c.c_closure | [Island i] -> Env i.i_closure | _ -> Dict (Hashtbl.create 0));
bind "component-params" (fun args ->
match args with
| [Component c] -> List (List.map (fun s -> String s) c.c_params)
| [Island i] -> List (List.map (fun s -> String s) i.i_params)
| _ -> Nil);
bind "component-body" (fun args ->
match args with [Component c] -> c.c_body | [Island i] -> i.i_body | _ -> Nil);
bind "component-affinity" (fun args ->
match args with [Component c] -> String c.c_affinity
| [Island _] -> Nil | _ -> Nil);
bind "component-has-children?" (fun args ->
match args with
| [Component c] -> Bool (List.mem "children" c.c_params)
| [Island i] -> Bool (List.mem "children" i.i_params)
| _ -> Bool false);
(* Evaluator bridge — needed by adapter-sx.sx *)
bind "call-lambda" (fun args ->
match args with
| [fn_val; List call_args; Env _e] ->
Sx_ref.cek_call fn_val (List call_args)
| [fn_val; List call_args] ->
Sx_ref.cek_call fn_val (List call_args)
| _ -> raise (Eval_error "call-lambda: expected (fn args env?)"));
bind "cek-call" (fun args ->
match args with
| [fn_val; List call_args] -> Sx_ref.cek_call fn_val (List call_args)
| [fn_val; Nil] -> Sx_ref.cek_call fn_val (List [])
| [fn_val] -> Sx_ref.cek_call fn_val (List [])
| _ -> Nil);
bind "expand-macro" (fun args ->
match args with
| [Macro m; List macro_args; Env e] ->
let body_env = { bindings = Hashtbl.create 16; parent = Some e } in
List.iteri (fun i p ->
let v = if i < List.length macro_args then List.nth macro_args i else Nil in
Hashtbl.replace body_env.bindings p v
) m.m_params;
Sx_ref.eval_expr m.m_body (Env body_env)
| _ -> raise (Eval_error "expand-macro: expected (macro args env)"));
bind "eval-expr" (fun args ->
match args with
| [expr; e] -> Sx_ref.eval_expr expr (Env (Sx_runtime.unwrap_env e))
| [expr] -> Sx_ref.eval_expr expr (Env env)
| _ -> raise (Eval_error "eval-expr: expected (expr env?)"));
bind "trampoline" (fun args ->
match args with
| [v] ->
let rec resolve v = match v with
| Thunk (body, closure_env) -> resolve (Sx_ref.eval_expr body (Env closure_env))
| _ -> v
in resolve v
| _ -> raise (Eval_error "trampoline: expected 1 arg"));
bind "expand-components?" (fun _args -> Bool false);
bind "register-special-form!" (fun args ->
match args with
| [String name; handler] ->
ignore (Sx_ref.register_special_form (String name) handler); Nil
| _ -> raise (Eval_error "register-special-form!: expected (name handler)"));
ignore (env_bind env "*custom-special-forms*" Sx_ref.custom_special_forms);
(* DOM stubs *)
bind "create-text-node" (fun args -> match args with [String s] -> String s | _ -> Nil);
bind "create-fragment" (fun _args -> Nil);
bind "dom-create-element" (fun _args -> Nil);
bind "dom-append" (fun _args -> Nil);
bind "dom-set-attr" (fun _args -> Nil);
bind "dom-set-prop" (fun _args -> Nil);
bind "dom-get-attr" (fun _args -> Nil);
bind "dom-query" (fun _args -> Nil);
bind "dom-body" (fun _args -> Nil);
(* Misc stubs *)
bind "random-int" (fun args ->
match args with
| [Number lo; Number hi] -> Number (lo +. Float.round (Random.float (hi -. lo)))
| _ -> Number 0.0);
bind "expand-components?" (fun _args -> Bool false);
bind "freeze-scope" (fun _args -> Nil);
bind "freeze-signal" (fun _args -> Nil);
bind "thaw-from-sx" (fun _args -> Nil);
bind "local-storage-get" (fun _args -> Nil);
bind "local-storage-set" (fun _args -> Nil);
bind "schedule-idle" (fun _args -> Nil);
bind "run-post-render-hooks" (fun _args -> Nil);
bind "freeze-to-sx" (fun _args -> String "");
env
let () =
Printexc.record_backtrace true;
(* Find project root *)
let rec find_root dir =
let candidate = Filename.concat dir "spec/render.sx" in
if Sys.file_exists candidate then dir
else let parent = Filename.dirname dir in
if parent = dir then Sys.getcwd () else find_root parent
in
let root = find_root (Sys.getcwd ()) in
let spec p = Filename.concat (Filename.concat root "spec") p in
let web p = Filename.concat (Filename.concat root "web") p in
let env = make_integration_env () in
(* Load spec + adapters *)
Printf.printf "Loading spec + adapters...\n%!";
let load path =
if Sys.file_exists path then begin
let exprs = Sx_parser.parse_file path in
List.iter (fun expr -> ignore (Sx_ref.eval_expr expr (Env env))) exprs;
Printf.printf " loaded %s (%d defs)\n%!" (Filename.basename path) (List.length exprs)
end else
Printf.printf " SKIP %s (not found)\n%!" path
in
load (spec "parser.sx");
load (spec "render.sx");
load (web "signals.sx");
load (web "adapter-html.sx");
load (web "adapter-sx.sx");
(* Helper: render SX source string to HTML *)
let render_html src =
let exprs = Sx_parser.parse_all src in
let expr = match exprs with [e] -> e | _ -> Nil in
Sx_render.render_to_html expr env
in
(* Helper: call SX render-to-html via the adapter *)
let sx_render_html src =
let exprs = Sx_parser.parse_all src in
let expr = match exprs with [e] -> e | _ -> Nil in
let call = List [Symbol "render-to-html"; List [Symbol "quote"; expr]; Env env] in
match Sx_ref.eval_expr call (Env env) with
| String s | RawHTML s -> s
| v -> value_to_string v
in
(* ================================================================== *)
Printf.printf "\nSuite: native renderer — HTML tags\n%!";
assert_eq "div" "<div>hello</div>" (render_html "(div \"hello\")");
assert_eq "div with class" "<div class=\"card\">text</div>" (render_html "(div :class \"card\" \"text\")");
assert_eq "nested tags" "<div><p>inner</p></div>" (render_html "(div (p \"inner\"))");
assert_eq "void element" "<br />" (render_html "(br)");
assert_eq "h1" "<h1>Title</h1>" (render_html "(h1 \"Title\")");
assert_eq "span with attrs" "<span class=\"bold\">text</span>" (render_html "(span :class \"bold\" \"text\")");
(* ================================================================== *)
Printf.printf "\nSuite: SX adapter render-to-html — HTML tags\n%!";
assert_no_error "div doesn't throw" (fun () -> sx_render_html "(div \"hello\")");
assert_contains "div produces tag" "<div" (sx_render_html "(div \"hello\")");
assert_contains "div with class" "class=\"card\"" (sx_render_html "(div :class \"card\" \"text\")");
assert_contains "nested tags" "<p>" (sx_render_html "(div (p \"inner\"))");
assert_no_error "h1 doesn't throw" (fun () -> sx_render_html "(h1 \"Title\")");
assert_no_error "span doesn't throw" (fun () -> sx_render_html "(span :class \"bold\" \"text\")");
assert_no_error "table doesn't throw" (fun () -> sx_render_html "(table (tr (td \"cell\")))");
(* ================================================================== *)
Printf.printf "\nSuite: SX adapter — special forms in HTML context\n%!";
assert_contains "when true renders" "<p>" (sx_render_html "(when true (p \"yes\"))");
assert_eq "when false empty" "" (sx_render_html "(when false (p \"no\"))");
assert_contains "if true branch" "yes" (sx_render_html "(if true (span \"yes\") (span \"no\"))");
assert_contains "if false branch" "no" (sx_render_html "(if false (span \"yes\") (span \"no\"))");
assert_contains "let in render" "hello" (sx_render_html "(let ((x \"hello\")) (p x))");
(* ================================================================== *)
Printf.printf "\nSuite: SX adapter — letrec in HTML context\n%!";
assert_no_error "letrec with div body" (fun () ->
sx_render_html "(letrec ((x 42)) (div (str x)))");
assert_contains "letrec renders body" "<div>" (sx_render_html "(letrec ((x 42)) (div (str x)))");
assert_no_error "letrec with side effects then div" (fun () ->
sx_render_html "(letrec ((x 1) (y 2)) (let ((z (+ x y))) (div (str z))))");
(* ================================================================== *)
Printf.printf "\nSuite: SX adapter — components\n%!";
(try
assert_no_error "defcomp + render" (fun () ->
ignore (Sx_ref.eval_expr
(List.hd (Sx_parser.parse_all "(defcomp ~test-card (&key title &rest children) (div :class \"card\" (h2 title) children))"))
(Env env));
sx_render_html "(~test-card :title \"Hi\" (p \"body\"))");
assert_contains "component renders div" "<div" (sx_render_html "(~test-card :title \"Hi\" (p \"body\"))");
assert_contains "component renders title" "Hi" (sx_render_html "(~test-card :title \"Hi\" (p \"body\"))")
with Eval_error msg -> incr fail_count; Printf.printf " FAIL: components — %s\n%!" msg);
(* ================================================================== *)
Printf.printf "\nSuite: eval-expr with HTML tag functions\n%!";
assert_no_error "eval (div) returns list" (fun () ->
Sx_ref.eval_expr (List [Symbol "div"; Keyword "class"; String "foo"; String "hi"]) (Env env));
assert_no_error "eval (span) returns list" (fun () ->
Sx_ref.eval_expr (List [Symbol "span"; String "text"]) (Env env));
(* ================================================================== *)
(* Regression: call-lambda re-evaluated Dict args through eval_expr,
which copies dicts. Mutations inside the lambda (e.g. signal
reset!) operated on the copy, not the original. This broke
island SSR where aser processes multi-body let forms. *)
Printf.printf "\nSuite: call-lambda dict identity (aser mode)\n%!";
let aser_eval src =
let exprs = Sx_parser.parse_all src in
let expr = match exprs with [e] -> e | _ -> Nil in
let call = List [Symbol "aser"; List [Symbol "quote"; expr]; Env env] in
match Sx_ref.eval_expr call (Env env) with
| String s | SxExpr s -> s
| v -> value_to_string v
in
assert_eq "lambda dict mutation in aser multi-body let"
"99"
(aser_eval
"(let ((mutate! (fn (d k v) (dict-set! d k v)))
(d (dict \"x\" 1)))
(mutate! d \"x\" 99)
(get d \"x\"))");
assert_eq "signal reset! in aser multi-body let"
"99"
(aser_eval
"(let ((s (signal 42)))
(reset! s 99)
(deref s))");
assert_eq "signal reset! then len of deref"
"3"
(aser_eval
"(let ((s (signal (list))))
(reset! s (list 1 2 3))
(len (deref s)))");
(* ================================================================== *)
Printf.printf "\n";
Printf.printf "============================================================\n";
Printf.printf "Integration: %d passed, %d failed\n" !pass_count !fail_count;
Printf.printf "============================================================\n";
if !fail_count > 0 then exit 1