W14: build C21 perform-mode harness + 5 pins (test-infra only)

The synchronous harness binds mocks as plain NativeFns, so no harness test
could exercise the real CEK perform/suspend/resume path — the HO+perform
element-drop class (S10) was structurally invisible (hosts.md C21).

Add harness-run-perform to spec/harness.sx: drives make-cek-state/
cek-step-loop, services each (perform {:op X :args L}) suspension from the
session's platform mocks (entry logged before invocation, C22-consistent),
cek-resumes with the mock value, loops to terminal; clear error on an
unmocked op. Shared arity dispatch extracted as harness-invoke-mock.

Pins (gate-C21-perform-mode-harness): single suspension, arithmetic-frame
resume, sequential performs, unmocked-op error, and the S10 probe — map
over a perform-suspending lambda keeps ALL 3 elements through 3
suspensions on the CEK path (localizing the drop class to serving-JIT).
290/0 under OCaml run_tests; harness self-suite green.

Caveat (documented): requires the runner's cek-* driver bindings — absent
on bare sx_server/MCP, the same runner-only-binding theme as section B.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
2026-07-04 02:30:40 +00:00
parent 6f52cff0d9
commit 53c0ec14da
3 changed files with 105 additions and 2 deletions

View File

@@ -71,7 +71,11 @@ Pin each confirmed-and-fixed finding with a minimal repro. Add suites to
12-probe battery from the finding, errors compared by message) 12-probe battery from the finding, errors compared by message)
- [x] C22/K104 — FIXED harness (spec/harness.sx make-interceptor: log entry - [x] C22/K104 — FIXED harness (spec/harness.sx make-interceptor: log entry
appended before the mock runs, :result updated via dict-set!) + 3 pins appended before the mock runs, :result updated via dict-set!) + 3 pins
- [ ] C21 — real perform/suspend mode in harness - [x] C21 — BUILT `harness-run-perform` (spec/harness.sx): drives real CEK
suspend/resume, services performs from session mocks, C22-style
logging; 5 pins incl. the S10 map-over-perform probe (CEK keeps all
elements — the drop class is serving-JIT-side). Runner-only (needs
cek-* driver bindings)
- [ ] C23 — adapter-dom render-output tests - [ ] C23 — adapter-dom render-output tests
### D. WASM corpus runner ### D. WASM corpus runner
@@ -87,6 +91,20 @@ Pin each confirmed-and-fixed finding with a minimal repro. Add suites to
## Progress log (newest first) ## Progress log (newest first)
- 2026-07-04 — **C21 perform-mode harness (item C.3)**. Added
`harness-run-perform` to spec/harness.sx (exported): drives
`make-cek-state`/`cek-step-loop`, services each
`(perform {:op X :args L})` suspension from the session's platform mocks
(entry logged before invocation, C22-consistent), `cek-resume`s with the
mock value, loops to terminal. Self-recursion via the `(self self …)`
pattern (avoids letrec-injection K06 territory). Extracted the arity
dispatch into shared `harness-invoke-mock`. 5 pins in
`gate-C21-perform-mode-harness` — notably the **S10 probe**: `(map (fn (u)
(perform …)) '("a" "b" "c"))` keeps ALL elements through 3 suspensions on
the CEK path, confirming the element-drop class is serving-JIT-side, not
CEK. Caveat noted in the docstring: needs the runner's cek-* driver
bindings (absent on bare sx_server/MCP — the env-parity theme again).
290/0. Test-infra-only.
- 2026-07-04 — **C22/K104 throwing-mock fix + pins (item C.2)**. 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 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 test infrastructure (PLAN approach item 4 assigns "log IO before invoking

View File

@@ -13,6 +13,7 @@
harness-set! harness-set!
make-interceptor make-interceptor
install-interceptors install-interceptors
harness-run-perform
io-calls io-calls
io-call-count io-call-count
io-call-nth io-call-nth
@@ -76,6 +77,27 @@
(session key value) (session key value)
(dict-set! (get session "state") key value) (dict-set! (get session "state") key value)
nil)) nil))
(define
harness-invoke-mock
:effects ()
(fn
(mock-fn args)
(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)))))))
(define (define
make-interceptor make-interceptor
:effects () :effects ()
@@ -87,7 +109,7 @@
((entry {:op op-name :result nil :args args}) (log (get session "log"))) ((entry {:op op-name :result nil :args args}) (log (get session "log")))
(append! log entry) (append! log entry)
(let (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))))))) ((result (harness-invoke-mock mock-fn args)))
(dict-set! entry "result" result) (dict-set! entry "result" result)
result))))) result)))))
(define (define
@@ -104,6 +126,14 @@
(env-bind! env key interceptor))) (env-bind! env key interceptor)))
(keys (get session "platform"))) (keys (get session "platform")))
env)) env))
(define
harness-run-perform
:effects ()
(fn
(session expr env)
(let
((drive (fn (self state) (if (cek-suspended? state) (let ((req (cek-io-request state))) (let ((op (get req "op")) (args (or (get req "args") (list)))) (let ((mock-fn (get (get session "platform") op))) (when (nil? mock-fn) (error (str "harness-run-perform: no mock for op " op))) (let ((entry {:op op :result nil :args args}) (log (get session "log"))) (append! log entry) (let ((result (harness-invoke-mock mock-fn args))) (dict-set! entry "result" result) (self self (cek-resume state result))))))) (cek-value state)))))
(drive drive (cek-step-loop (make-cek-state expr env (list)))))))
(define (define
io-calls io-calls
:effects () :effects ()

View File

@@ -251,3 +251,58 @@
(try-call (fn () (bomb 3))) (try-call (fn () (bomb 3)))
(assert-io-count h "action" 3) (assert-io-count h "action" 3)
(assert= (get (io-call-nth h "action" 1) "result") "done")))) (assert= (get (io-call-nth h "action" 1) "result") "done"))))
(defsuite
"gate-C21-perform-mode-harness"
(deftest
"single perform suspension is serviced by the mock"
(let
((h (make-harness :platform {:fetch (fn (u) (str "R:" u))})))
(assert=
(harness-run-perform h (quote (perform {:op "fetch" :args (list "a")})) (make-env))
"R:a")
(assert-io-count h "fetch" 1)
(assert-io-result h "fetch" 0 "R:a")))
(deftest
"perform result feeds the surrounding arithmetic frame"
(let
((h (make-harness :platform {:query (fn () 41)})))
(assert=
(harness-run-perform
h
(quote (+ 1 (perform {:op "query"})))
(make-env))
42)))
(deftest
"sequential performs each suspend and resume in order"
(let
((h (make-harness :platform {:fetch (fn (u) (str "R:" u))})))
(assert=
(harness-run-perform
h
(quote (list (perform {:op "fetch" :args (list "x")}) (perform {:op "fetch" :args (list "y")})))
(make-env))
(list "R:x" "R:y"))
(assert-io-count h "fetch" 2)
(assert-io-args h "fetch" 1 (list "y"))))
(deftest
"S10 probe: map over perform-suspending lambda keeps ALL elements"
(let
((h (make-harness :platform {:fetch (fn (u) (str "R:" u))})))
(assert=
(harness-run-perform
h
(quote (map (fn (u) (perform {:op "fetch" :args (list u)})) (list "a" "b" "c")))
(make-env))
(list "R:a" "R:b" "R:c"))
(assert-io-count h "fetch" 3)))
(deftest
"unmocked op raises a clear error instead of hanging"
(let
((h (make-harness :platform {})))
(let
((r (try-call (fn () (harness-run-perform h (quote (perform {:op "no-such-op"})) (make-env))))))
(assert (not (get r "ok")) "expected an error for unmocked op")
(assert
(contains? (get r "error") "no mock for op")
(get r "error"))))))