Add SX test harness: mock IO platform for testing components

spec/harness.sx — spec-level test harness with:
- Mock platform (30+ default IO mocks: fetch, query, DOM, storage, etc.)
- Session management (make-harness, harness-reset!, harness-set!/get)
- IO interception (make-interceptor, install-interceptors)
- IO log queries (io-calls, io-call-count, io-call-nth, io-call-args)
- IO assertions (assert-io-called, assert-no-io, assert-io-count, etc.)

15 harness tests passing on both OCaml (1116/1116) and JS (15/15).
Loaded automatically by both test runners.

MCP tool: sx_harness_eval — evaluate SX with mock IO, returns result + IO trace.

The harness is extensible: new platforms just add entries to the platform dict.
Components can ship with deftest forms that verify IO behavior against mocks.
Tests are independent objects that can be published separately (by CID).

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>

hosts/javascript/run_tests.js

@@ -279,6 +279,18 @@ for (const expr of frameworkExprs) {
   Sx.eval(expr, env);
 }
 
+// Load test harness (mock IO platform)
+const harnessPath = path.join(projectDir, "spec", "harness.sx");
+if (fs.existsSync(harnessPath)) {
+  const harnessSrc = fs.readFileSync(harnessPath, "utf8");
+  const harnessExprs = Sx.parse(harnessSrc);
+  for (const expr of harnessExprs) {
+    try { Sx.eval(expr, env); } catch (e) {
+      console.error(`Error loading harness.sx: ${e.message}`);
+    }
+  }
+}
+
 // Load compiler + VM from lib/ when running full tests
 if (fullBuild) {
   const libDir = path.join(projectDir, "lib");

hosts/ocaml/bin/mcp_tree.ml

@@ -105,6 +105,41 @@ let setup_env () =
     | [Keyword k] -> String k | _ -> String "");
   bind "make-symbol" (fun args -> match args with
     | [String s] -> Symbol s | _ -> Nil);
+  (* Environment operations needed by harness *)
+  bind "env-bind!" (fun args -> match args with
+    | [Env env_val; String name; v] -> ignore (env_bind env_val name v); v
+    | _ -> Nil);
+  bind "env-get" (fun args -> match args with
+    | [Env env_val; String name] -> env_get env_val name
+    | _ -> Nil);
+  bind "env-has?" (fun args -> match args with
+    | [Env env_val; String name] -> Bool (env_has env_val name)
+    | _ -> Bool false);
+  bind "make-env" (fun _args -> Env (make_env ()));
+  bind "keys" (fun args -> match args with
+    | [Dict d] -> List (Hashtbl.fold (fun k _ acc -> String k :: acc) d [])
+    | _ -> List []);
+  bind "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)
+    | [List items; Number n] -> (let i = int_of_float n in if i >= 0 && i < List.length items then List.nth items i else Nil)
+    | _ -> Nil);
+  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 "merge" (fun args -> match args with
+    | [Dict a; Dict b] ->
+      let d = Hashtbl.create (Hashtbl.length a + Hashtbl.length b) in
+      Hashtbl.iter (fun k v -> Hashtbl.replace d k v) a;
+      Hashtbl.iter (fun k v -> Hashtbl.replace d k v) b;
+      Dict d
+    | _ -> Nil);
+  bind "apply" (fun args -> match args with
+    | [f; List items] | [f; ListRef { contents = items }] ->
+      Sx_ref.cek_call f (List items)
+    | _ -> Nil);
+  bind "current-env" (fun _args -> Env e);
   bind "type-of" (fun args -> match args with
     | [v] -> String (type_of v) | _ -> String "nil");
   bind "list?" (fun args -> match args with
@@ -163,7 +198,10 @@ let setup_env () =
   (* Load tree-tools *)
   (try load_sx_file e (Filename.concat lib_dir "tree-tools.sx")
    with exn -> Printf.eprintf "[mcp] Error: tree-tools.sx load failed: %s\n%!" (Printexc.to_string exn); exit 1);
-  Printf.eprintf "[mcp] SX tree-tools loaded\n%!";
+  (* Load harness *)
+  (try load_sx_file e (Filename.concat spec_dir "harness.sx")
+   with exn -> Printf.eprintf "[mcp] Warning: harness.sx load failed: %s\n%!" (Printexc.to_string exn));
+  Printf.eprintf "[mcp] SX tree-tools + harness loaded\n%!";
   env := e
 
 (* ------------------------------------------------------------------ *)
@@ -667,6 +705,46 @@ let rec handle_tool name args =
     in
     text_result result
 
+  | "sx_harness_eval" ->
+    let expr_str = args |> member "expr" |> to_string in
+    let mock_str = args |> member "mock" |> to_string_option in
+    let file = args |> member "file" |> to_string_option in
+    let e = !env in
+    (* Optionally load a file's definitions *)
+    (match file with
+     | Some f ->
+       (try load_sx_file e f
+        with exn -> Printf.eprintf "[mcp] Warning: %s: %s\n%!" f (Printexc.to_string exn))
+     | None -> ());
+    (* Create harness with optional mock overrides *)
+    let mock_arg = match mock_str with
+      | Some s ->
+        let parsed = Sx_parser.parse_all s in
+        if parsed <> [] then List [Keyword "platform"; List.hd parsed] else List []
+      | None -> List []
+    in
+    let session = Sx_ref.cek_call (env_get e "make-harness") mock_arg in
+    (* Install interceptors *)
+    ignore (call_sx "install-interceptors" [session; Env e]);
+    (* Evaluate the expression *)
+    let exprs = Sx_parser.parse_all expr_str in
+    let result = List.fold_left (fun _acc expr ->
+      try Sx_ref.eval_expr expr (Env e)
+      with exn -> String (Printf.sprintf "Error: %s" (Printexc.to_string exn))
+    ) Nil exprs in
+    (* Get the IO log *)
+    let log = call_sx "harness-log" [session] in
+    let log_str = match log with
+      | List items | ListRef { contents = items } when items <> [] ->
+        "\n\nIO Log:\n" ^ String.concat "\n" (List.map (fun entry ->
+          let op = value_to_string (call_sx "get" [entry; String "op"]) in
+          let args_val = call_sx "get" [entry; String "args"] in
+          Printf.sprintf "  %s(%s)" op (Sx_types.inspect args_val)
+        ) items)
+      | _ -> "\n\n(no IO calls)"
+    in
+    text_result (Printf.sprintf "Result: %s%s" (Sx_types.inspect result) log_str)
+
   | "sx_write_file" ->
     let file = args |> member "file" |> to_string in
     let source = args |> member "source" |> to_string in
@@ -964,6 +1042,11 @@ let tool_definitions = `List [
     [file_prop; path_prop] ["file"];
   tool "sx_doc_gen" "Generate component documentation from all defcomp/defisland/defmacro signatures in a directory."
     [dir_prop] ["dir"];
+  tool "sx_harness_eval" "Evaluate SX in a test harness with mock IO. Returns result + IO trace. Use mock param to override default mock responses."
+    [("expr", `Assoc [("type", `String "string"); ("description", `String "SX expression to evaluate")]);
+     ("mock", `Assoc [("type", `String "string"); ("description", `String "Optional mock platform overrides as SX dict, e.g. {:fetch (fn (url) {:status 200})}")]);
+     ("file", `Assoc [("type", `String "string"); ("description", `String "Optional .sx file to load for definitions")])]
+    ["expr"];
   tool "sx_playwright" "Run Playwright browser tests for the SX docs site. Optionally specify a single spec file."
     [("spec", `Assoc [("type", `String "string"); ("description", `String "Optional spec file name (e.g. demo-interactions.spec.js)")])]
     [];

hosts/ocaml/bin/run_tests.ml

@@ -10,12 +10,7 @@
       dune exec bin/run_tests.exe -- test-primitives  # specific test
       dune exec bin/run_tests.exe -- --foundation     # foundation only *)
 
-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
+(* Modules accessed directly — library is unwrapped *)
 
 open Sx_types
 open Sx_parser
@@ -273,7 +268,7 @@ let make_test_env () =
     | _ -> raise (Eval_error "append!: expected list and value"));
 
   (* --- HTML Renderer (from sx_render.ml library module) --- *)
-  Sx.Sx_render.setup_render_env env;
+  Sx_render.setup_render_env env;
 
   (* Stubs needed by adapter-html.sx when loaded at test time *)
   bind "set-render-active!" (fun _args -> Nil);
@@ -734,6 +729,14 @@ let run_spec_tests env test_files =
   Printf.printf "\nLoading test framework...\n%!";
   load_and_eval framework_path;
 
+  (* Load test harness (mock IO platform) *)
+  let harness_path = Filename.concat (Filename.concat project_dir "spec") "harness.sx" in
+  if Sys.file_exists harness_path then begin
+    Printf.printf "Loading test harness...\n%!";
+    (try load_and_eval harness_path
+     with e -> Printf.eprintf "Warning: harness.sx: %s\n%!" (Printexc.to_string e))
+  end;
+
   (* Load modules needed by tests *)
   let spec_dir = Filename.concat project_dir "spec" in
   let lib_dir = Filename.concat project_dir "lib" in

spec/harness.sx

@@ -0,0 +1,37 @@
+(define default-platform {:current-user (fn () nil) :csrf-token (fn () "test-csrf-token") :app-url (fn (service &rest path) "/mock-app-url") :frag (fn (service comp &rest args) "") :sleep (fn (ms) nil) :local-storage-set (fn (key val) nil) :set-cookie (fn (name val &rest opts) nil) :url-for (fn (endpoint &rest args) "/mock-url") :create-element (fn (tag) nil) :request-path (fn () "/") :config (fn (key) nil) :set-attr (fn (el name val) nil) :set-text (fn (el text) nil) :remove-child (fn (parent child) nil) :fetch (fn (url &rest opts) {:status 200 :body "" :ok true}) :query (fn (service name &rest args) (list)) :add-class (fn (el cls) nil) :get-element (fn (id) nil) :now (fn () 0) :abort (fn (code) nil) :action (fn (service name &rest args) {:ok true}) :remove-class (fn (el cls) nil) :append-child (fn (parent child) nil) :request-arg (fn (name) nil) :emit-dom (fn (op &rest args) nil) :local-storage-get (fn (key) nil) :get-cookie (fn (name) nil)})
+
+(define make-harness :effects () (fn (&key platform) (let ((merged (if (nil? platform) default-platform (merge default-platform platform)))) {:log (list) :platform merged :state {:cookies {} :storage {} :dom nil}})))
+
+(define harness-reset! :effects () (fn (session) (dict-set! session "log" (list)) (dict-set! session "state" {:cookies {} :storage {} :dom nil}) session))
+
+(define harness-log :effects () (fn (session &key op) (let ((log (get session "log"))) (if (nil? op) log (filter (fn (entry) (= (get entry "op") op)) log)))))
+
+(define harness-get :effects () (fn (session key) (get (get session "state") key)))
+
+(define harness-set! :effects () (fn (session key value) (dict-set! (get session "state") key value) nil))
+
+(define make-interceptor :effects () (fn (session op-name mock-fn) (fn (&rest args) (let ((result (if (empty? args) (mock-fn) (if (= 1 (len args)) (mock-fn (first args)) (if (= 2 (len args)) (mock-fn (first args) (nth args 1)) (if (= 3 (len args)) (mock-fn (first args) (nth args 1) (nth args 2)) (apply mock-fn args)))))) (log (get session "log"))) (append! log {:args args :result result :op op-name}) result))))
+
+(define install-interceptors :effects () (fn (session env) (for-each (fn (key) (let ((mock-fn (get (get session "platform") key)) (interceptor (make-interceptor session key mock-fn))) (env-bind! env key interceptor))) (keys (get session "platform"))) env))
+
+(define io-calls :effects () (fn (session op-name) (filter (fn (entry) (= (get entry "op") op-name)) (get session "log"))))
+
+(define io-call-count :effects () (fn (session op-name) (len (io-calls session op-name))))
+
+(define io-call-nth :effects () (fn (session op-name n) (let ((calls (io-calls session op-name))) (if (< n (len calls)) (nth calls n) nil))))
+
+(define io-call-args :effects () (fn (session op-name n) (let ((call (io-call-nth session op-name n))) (if (nil? call) nil (get call "args")))))
+
+(define io-call-result :effects () (fn (session op-name n) (let ((call (io-call-nth session op-name n))) (if (nil? call) nil (get call "result")))))
+
+(define assert-io-called :effects () (fn (session op-name) (assert (> (io-call-count session op-name) 0) (str "Expected IO operation " op-name " to be called but it was not"))))
+
+(define assert-no-io :effects () (fn (session op-name) (assert (= (io-call-count session op-name) 0) (str "Expected IO operation " op-name " not to be called but it was called " (io-call-count session op-name) " time(s)"))))
+
+(define assert-io-count :effects () (fn (session op-name expected) (let ((actual (io-call-count session op-name))) (assert (= actual expected) (str "Expected " op-name " to be called " expected " time(s) but was called " actual " time(s)")))))
+
+(define assert-io-args :effects () (fn (session op-name n expected-args) (let ((actual (io-call-args session op-name n))) (assert (equal? actual expected-args) (str "Expected call " n " to " op-name " with args " (str expected-args) " but got " (str actual))))))
+
+(define assert-io-result :effects () (fn (session op-name n expected) (let ((actual (io-call-result session op-name n))) (assert (equal? actual expected) (str "Expected call " n " to " op-name " to return " (str expected) " but got " (str actual))))))
+
+(define assert-state :effects () (fn (session key expected) (let ((actual (harness-get session key))) (assert (equal? actual expected) (str "Expected state " key " to be " (str expected) " but got " (str actual))))))

spec/tests/test-harness.sx

@@ -0,0 +1 @@
+(defsuite "harness" (defsuite "session" (deftest "make-harness creates session with default platform" (let ((h (make-harness))) (assert-true (not (nil? h))) (assert-true (not (nil? (get h "platform")))) (assert-length 0 (get h "log")))) (deftest "make-harness merges custom platform with defaults" (let ((h (make-harness :platform {:fetch (fn () "custom")}))) (assert-equal "custom" ((get (get h "platform") "fetch"))) (assert-true (not (nil? (get (get h "platform") "query")))))) (deftest "harness-reset clears log" (let ((h (make-harness)) (f (make-interceptor h "op" (fn () "ok")))) (f) (assert-equal 1 (len (get h "log"))) (harness-reset! h) (assert-length 0 (get h "log"))))) (defsuite "state" (deftest "harness-set and harness-get work" (let ((h (make-harness))) (harness-set! h "cookies" "session-abc") (assert-equal "session-abc" (harness-get h "cookies")))) (deftest "harness-get returns nil for unset keys" (let ((h (make-harness))) (assert-nil (harness-get h "nonexistent"))))) (defsuite "interceptor" (deftest "make-interceptor logs calls" (let ((h (make-harness)) (mock-fn (fn (x) (str "got:" x))) (interceptor (make-interceptor h "test-op" mock-fn))) (interceptor "hello") (assert-equal 1 (len (get h "log"))) (assert-equal "test-op" (get (first (get h "log")) "op")))) (deftest "interceptor returns mock result" (let ((h (make-harness)) (interceptor (make-interceptor h "op" (fn (x) (str "got:" x)))) (result (interceptor "hello"))) (assert-type "string" result) (assert-true (contains? result "got:")))) (deftest "interceptor records multiple calls" (let ((h (make-harness)) (interceptor (make-interceptor h "inc" (fn () "ok")))) (interceptor) (interceptor) (interceptor) (assert-equal 3 (len (get h "log")))))) (defsuite "io-queries" (deftest "io-call-count counts by operation" (let ((h (make-harness)) (f1 (make-interceptor h "fetch" (fn () nil))) (f2 (make-interceptor h "query" (fn () nil)))) (f1) (f2) (f1) (assert-equal 2 (io-call-count h "fetch")) (assert-equal 1 (io-call-count h "query")) (assert-equal 0 (io-call-count h "missing")))) (deftest "io-call-nth returns nth call entry" (let ((h (make-harness)) (f1 (make-interceptor h "fetch" (fn () nil)))) (f1) (f1) (assert-equal "fetch" (get (io-call-nth h "fetch" 0) "op")) (assert-equal "fetch" (get (io-call-nth h "fetch" 1) "op")) (assert-nil (io-call-nth h "fetch" 2))))) (defsuite "assertions" (deftest "assert-io-called passes when called" (let ((h (make-harness)) (f1 (make-interceptor h "fetch" (fn () nil)))) (f1) (assert-io-called h "fetch"))) (deftest "assert-io-called fails when not called" (let ((h (make-harness)) (result (try-call (fn () (assert-io-called h "fetch"))))) (assert-false (get result "ok")))) (deftest "assert-no-io passes when not called" (let ((h (make-harness))) (assert-no-io h "fetch"))) (deftest "assert-io-count verifies exact count" (let ((h (make-harness)) (f1 (make-interceptor h "fetch" (fn () nil)))) (f1) (f1) (assert-io-count h "fetch" 2))) (deftest "assert-state checks state bucket" (let ((h (make-harness))) (harness-set! h "cookies" "token-xyz") (assert-state h "cookies" "token-xyz")))))