diff --git a/plans/agent-briefings/sx-gate-loop.md b/plans/agent-briefings/sx-gate-loop.md index d14be3b6..f8134afe 100644 --- a/plans/agent-briefings/sx-gate-loop.md +++ b/plans/agent-briefings/sx-gate-loop.md @@ -69,7 +69,8 @@ Pin each confirmed-and-fixed finding with a minimal repro. Add suites to - [x] K19 — harness/runtime parity pinned (`scripts/test-harness-parity.sh`: drives mcp_tree sx_eval over JSON-RPC vs fresh sx_server over epoch, 12-probe battery from the finding, errors compared by message) -- [ ] C22/K104 — harness logs IO *before* invoking the mock (throwing-mock pin) +- [x] C22/K104 — FIXED harness (spec/harness.sx make-interceptor: log entry + appended before the mock runs, :result updated via dict-set!) + 3 pins - [ ] C21 — real perform/suspend mode in harness - [ ] C23 — adapter-dom render-output tests @@ -86,6 +87,19 @@ Pin each confirmed-and-fixed finding with a minimal repro. Add suites to ## Progress log (newest first) +- 2026-07-04 — **C22/K104 throwing-mock fix + pins (item C.2)**. First + actual FIX of the loop — in scope because spec/harness.sx is W14-owned + test infrastructure (PLAN approach item 4 assigns "log IO before invoking + the mock" to W14). TDD: reproduced pre-fix (caught error, 0 log entries), + then restructured `make-interceptor` to append the entry BEFORE the mock + runs (`:result nil` while pending, `dict-set!` in place on return). + Verified: throwing mock leaves entry, happy path updates result, mixed + sequence counts all 3. Added suite `gate-C22-throwing-mock-logged` + (3 tests). Harness self-suite (15) + test-relate-picker (only other + harness consumer) green; 285/0 pins run. Tooling notes: replace/insert + tools take `new_source` (not `replacement`); find_all paths still + disagree with read_subtree/replace_node on define-library files — + sx_write_file remains the reliable route. Test-infra-only. - 2026-07-04 — **K19 harness-parity pin (item C.1)**. Authored `scripts/test-harness-parity.sh`: drives `mcp_tree.exe` `sx_eval` with raw JSON-RPC over stdio and a fresh `sx_server.exe` over the epoch diff --git a/spec/harness.sx b/spec/harness.sx index 1f1ae91d..8787b1d4 100644 --- a/spec/harness.sx +++ b/spec/harness.sx @@ -1,6 +1,7 @@ ;; Assert condition is truthy, error with message -(define-library (sx harness) +(define-library + (sx harness) (export assert assert= @@ -24,71 +25,211 @@ assert-io-result assert-state) (begin - -(define assert (fn (condition msg) (when (not condition) (error (or msg "Assertion failed"))))) - -;; Assert two values are equal -(define assert= (fn (actual expected msg) (when (not (= actual expected)) (error (or msg (str "Expected " expected ", got " actual)))))) - -;; Dict of mock IO operations for testing -(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)}) - -;; Create a test session with mock IO platform -(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}}))) - -;; Clear IO log and state for a new test -(define harness-reset! :effects () (fn (session) (dict-set! session "log" (list)) (dict-set! session "state" {:cookies {} :storage {} :dom nil}) session)) - -;; Append an IO call record to session log -(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))))) - -;; Read state value from session store -(define harness-get :effects () (fn (session key) (get (get session "state") key))) - -;; Write state value to session store -(define harness-set! :effects () (fn (session key value) (dict-set! (get session "state") key value) nil)) - -;; Wrap a mock fn to record calls in the IO log -(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)))) - -;; Bind all interceptors into the eval environment -(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)) - -;; Query IO log: all calls, or filtered by op name -(define io-calls :effects () (fn (session op-name) (filter (fn (entry) (= (get entry "op") op-name)) (get session "log")))) - -;; Count IO calls, optionally filtered by op name -(define io-call-count :effects () (fn (session op-name) (len (io-calls session op-name)))) - -;; Get the nth IO call record -(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)))) - -;; Get args from the nth call to an operation -(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"))))) - -;; Get return value from the nth call to an operation -(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"))))) - -;; Assert an IO operation was called at least once -(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")))) - -;; Assert an IO operation was never called -(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)")))) - -;; Assert exact call count for an operation -(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)"))))) - -;; Assert args of the nth call match expected -(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)))))) - -;; Assert result of the nth call matches expected -(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)))))) - -;; Assert a state key has the expected value -(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)))))) - - -)) ;; end define-library + (define + assert + (fn + (condition msg) + (when (not condition) (error (or msg "Assertion failed"))))) + (define + assert= + (fn + (actual expected msg) + (when + (not (= actual expected)) + (error (or msg (str "Expected " expected ", got " actual)))))) + (define default-platform {:get-cookie (fn (name) nil) :local-storage-get (fn (key) nil) :emit-dom (fn (op &rest args) nil) :request-arg (fn (name) nil) :append-child (fn (parent child) nil) :remove-class (fn (el cls) nil) :action (fn (service name &rest args) {:ok true}) :abort (fn (code) nil) :now (fn () 0) :get-element (fn (id) nil) :add-class (fn (el cls) nil) :query (fn (service name &rest args) (list)) :fetch (fn (url &rest opts) {:ok true :body "" :status 200}) :remove-child (fn (parent child) nil) :set-text (fn (el text) nil) :set-attr (fn (el name val) nil) :config (fn (key) nil) :request-path (fn () "/") :create-element (fn (tag) nil) :url-for (fn (endpoint &rest args) "/mock-url") :set-cookie (fn (name val &rest opts) nil) :local-storage-set (fn (key val) nil) :sleep (fn (ms) nil) :frag (fn (service comp &rest args) "") :app-url (fn (service &rest path) "/mock-app-url") :csrf-token (fn () "test-csrf-token") :current-user (fn () nil)}) + (define + make-harness + :effects () + (fn + (&key platform) + (let + ((merged (if (nil? platform) default-platform (merge default-platform platform)))) + {:state {:dom nil :storage {} :cookies {}} :platform merged :log (list)}))) + (define + harness-reset! + :effects () + (fn + (session) + (dict-set! session "log" (list)) + (dict-set! session "state" {:dom nil :storage {} :cookies {}}) + 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 + ((entry {:op op-name :result nil :args args}) (log (get session "log"))) + (append! log entry) + (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))))))) + (dict-set! entry "result" result) + 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)))))))) ;; end define-library ;; Re-export to global namespace for backward compatibility (import (sx harness)) diff --git a/spec/tests/test-gate-pins.sx b/spec/tests/test-gate-pins.sx index 13f87945..57d1b444 100644 --- a/spec/tests/test-gate-pins.sx +++ b/spec/tests/test-gate-pins.sx @@ -217,3 +217,37 @@ (((fn (c) true) (fn (c) (* c 10)))) (+ 1 (signal-condition 5))) 51))) + +(defsuite + "gate-C22-throwing-mock-logged" + (deftest + "throwing mock still leaves an IO-log entry" + (let + ((h (make-harness)) + (f (make-interceptor h "fetch" (fn (url) (error "boom-io"))))) + (let + ((r (try-call (fn () (f "http://a"))))) + (assert (not (get r "ok")) "mock error must propagate") + (assert-io-called h "fetch") + (assert-io-count h "fetch" 1) + (assert= (get (io-call-nth h "fetch" 0) "result") nil)))) + (deftest + "successful mock entry gets its result updated in place" + (let + ((h (make-harness)) + (f (make-interceptor h "fetch" (fn (url) (str "got:" url))))) + (f "http://a") + (assert-io-count h "fetch" 1) + (assert-io-result h "fetch" 0 "got:http://a") + (assert-io-args h "fetch" 0 (list "http://a")))) + (deftest + "mixed throwing and successful calls are all counted" + (let + ((h (make-harness)) + (bomb (make-interceptor h "action" (fn (x) (error "nope")))) + (ok-f (make-interceptor h "action" (fn (x) "done")))) + (try-call (fn () (bomb 1))) + (ok-f 2) + (try-call (fn () (bomb 3))) + (assert-io-count h "action" 3) + (assert= (get (io-call-nth h "action" 1) "result") "done"))))