R3: test runner records a raising test as a failure (TDD); R2 deferred (mutex finding)

Failing test first (red: a probe with a raising actual-expr VANISHED — delta 0, total unchanged —
because the loader skips a raising top-level form and args are eager). Fix: host-bl-test is now a
MACRO expanding to (host-bl--check name (fn () actual) expected); the check evaluates the thunk under
(guard (e (true {:__raised …})) …), so an SX raise is recorded as a failure with the error instead
of disappearing. Native exceptions still escape guard — those already fail loud via conformance's
error grep, so this closes the actual silent-skip gap. Keeps the next TDD loop honest.

R2 DEFERRED: investigating it surfaced that lib/host serializes ALL handler evaluation per peer under
one mutex (held across persist IO + the outbound http-request) — zero intra-peer concurrency, so the
outbox 'race' is masked. Logged in plans + memory as the real concurrency task: narrow the handler
mutex for throughput (the multi-co-op future forces it, and that's when masked races become real).

blog suite 260/260; full conformance 662/662.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
2026-07-03 21:47:29 +00:00
parent 4f766ea4f1
commit 915cc29a52
2 changed files with 39 additions and 8 deletions

View File

@@ -6,14 +6,19 @@
(define host-bl-pass 0)
(define host-bl-fail 0)
(define host-bl-fails (list))
(define
host-bl-test
(fn (name actual expected)
(if (= actual expected)
(set! host-bl-pass (+ host-bl-pass 1))
(begin
(set! host-bl-fail (+ host-bl-fail 1))
(append! host-bl-fails {:name name :actual actual :expected expected})))))
;; R3: the check thunks `actual` and evaluates it under guard, so a test whose actual RAISES is
;; RECORDED as a failure (with the error) instead of vanishing (the loader skips a raising top-level
;; form). Native exceptions still escape guard — those already fail loud via conformance's error grep.
(define host-bl--check
(fn (name thunk expected)
(let ((actual (guard (e (true (list :__raised (str e)))) (thunk))))
(if (= actual expected)
(set! host-bl-pass (+ host-bl-pass 1))
(begin
(set! host-bl-fail (+ host-bl-fail 1))
(append! host-bl-fails {:name name :actual actual :expected expected}))))))
(defmacro host-bl-test (name actual expected)
(quasiquote (host-bl--check (unquote name) (fn () (unquote actual)) (unquote expected))))
(define host-bl-req (fn (target) (dream-request "GET" target {} "")))
(define host-bl-app (host/make-app (list host/feed-routes host/blog-routes)))
@@ -1591,6 +1596,18 @@
(set! host/blog--mint-ticket host-bl-h5-mint-was)
(set! host/blog--shop-base host-bl-h5-shop-was)
;; ── R3: a test whose actual-expr RAISES must be COUNTED as a failure, not silently vanish ──
;; The loader skips a raising top-level form, so an eager `actual` that raises disappears from the
;; tally (a red test can look green). host-bl-test must thunk `actual` + evaluate it under guard.
(define host-bl-r3-fail-before host-bl-fail)
(host-bl-test "R3-probe (deliberate SX raise — should be recorded)" (raise "r3-boom") 42)
(define host-bl-r3-delta (- host-bl-fail host-bl-r3-fail-before))
(when (= host-bl-r3-delta 1) ;; fixed: it was recorded → un-pollute the tally
(begin
(set! host-bl-fail (- host-bl-fail 1))
(set! host-bl-fails (filter (fn (f) (not (starts-with? (get f :name) "R3-probe"))) host-bl-fails))))
(host-bl-test "R3: a raising test is counted as a failure (not silently skipped)" host-bl-r3-delta 1)
(define
host-bl-tests-run!
(fn ()