Make the pin regression test able to fail

Message

Sabotage found two of its three defect arms VACUOUS. Both plants landed (hashes verified before and after) and both planted trees compiled, so these were real "the arm cannot detect this" results rather than setup failures.

arm2 (the lock) measured AFTER the park ended. With a busy budget longer than the external hold, the parked write completes, every statement finalizes, the pin resolves before anyone looks, and the arm passes whether or not the connection is serialised. It now uses a budget SHORTER than the hold, so the parked write raises and a pin -- if the lock is missing -- survives to be measured.

arm3 (finalize on raise) asserted staleness after a raise. That cannot work: a parked write holds no read transaction of its own, so leaking its statement pins nothing by itself. The leak's only consequence is that it keeps the connection's btree in use, which stops a pinned read transaction from being released -- a consequence that needs a pin to be visible at all. It now asserts the property directly, on a new supported diagnostic:

  sqlite-open-statements -- statements prepared through the high-level API and
  not yet finalized. 0 at rest; non-zero at rest is a leaked statement.

arm4 (busy_timeout) reddened correctly and is unchanged.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_01NuSfnnNgQ81hjRygkkqWM6

Changed

 src/sigil/sqlite.sgl                | 27 ++++++++++++++++++++++++---
 test/test-sqlite-connection-pin.sgl | 55 +++++++++++++++++++++++++++++++++++--------------------
 2 files changed, 59 insertions(+), 23 deletions(-)

Diff

src/sigil/sqlite.sglmodified

@@ -65,7 +65,10 @@

sqlite-set-busy-budget!

;; Diagnostic: is a fiber holding this connection?

−68

sqlite-connection-locked?)

+68

sqlite-connection-locked?

+69

+70

;; Diagnostic: statements open through the high-level API (0 at rest)

+71

sqlite-open-statements)

(begin

@@ -238,6 +241,22 @@

241

;; connections acquired in opposite orders by two fibers is a deadlock, and

242

;; a bounded wait turns that into a loud, attributable error instead of a

243

;; process that stops forever with no output.

+244

;; Statements prepared through the high-level API and not yet finalized.

+245

;; A statement that outlives its call keeps the connection's btree in use,

+246

;; which stops a read transaction on that connection from ever being

+247

;; released. It is exported so the property `every exit path finalizes' is

+248

;; DIRECTLY observable rather than inferred from a downstream symptom.

+249

(define *sqlite-open-statements* 0)

+250

+251

;;; How many statements the high-level API currently has open. Should be

+252

;;; 0 between calls; a non-zero value at rest is a leaked statement.

+253

(define (sqlite-open-statements)

+254

(: -> integer?)

+255

*sqlite-open-statements*)

+256

+257

(define (%stmt-opened!) (set! *sqlite-open-statements* (+ *sqlite-open-statements* 1)))

+258

(define (%stmt-closed!) (set! *sqlite-open-statements* (- *sqlite-open-statements* 1)))

+259

260

(define *sqlite-connection-wait-seconds* 15.0)

261

(define *sqlite-connection-poll-interval* 0.001)

262

@@ -463,6 +482,7 @@

482

(call-with-connection db

483

(lambda ()

484

(let ((stmt (sqlite-prepare db sql)))

+485

(when stmt (%stmt-opened!))

486

(if (not stmt)

487

'()

488

;; The statement is finalized by the after thunk, so it is

@@ -503,7 +523,7 @@

523

pairs))))))

524

(loop (cons row rows))))

525

(else (reverse rows)))))))

−506

(lambda () (sqlite-finalize stmt))))))))

+526

(lambda () (%stmt-closed!) (sqlite-finalize stmt))))))))

527

528

;;; Execute a SQL query and return only the first row as an alist.

529

;;; Returns #f if no rows match.

@@ -534,6 +554,7 @@

554

(call-with-connection db

555

(lambda ()

556

(let ((stmt (sqlite-prepare db sql)))

+557

(when stmt (%stmt-opened!))

558

(if (not stmt)

559

#f

560

;; Finalized on every exit path -- see sqlite-query.

@@ -545,7 +566,7 @@

566

(sqlite-bind stmt idx (car params))

567

(loop (cdr params) (+ idx 1))))

568

(and (sqlite-step stmt) #t))

−548

(lambda () (sqlite-finalize stmt))))))))

+569

(lambda () (%stmt-closed!) (sqlite-finalize stmt))))))))

570

571

;;; Open a database, call proc with the handle, and ensure it's closed.

572

;;;

test/test-sqlite-connection-pin.sglmodified

@@ -37,6 +37,14 @@

(define SEED 700)

(define BASE 10)

+40

+41

;; The parked write must RAISE, not merely wait. A pin only survives to be

+42

;; measured if the statement that caused it outlives the call -- which is

+43

;; what a raise used to do. With a budget longer than the external hold the

+44

;; write completes, everything finalizes, the pin resolves before anyone

+45

;; looks, and this test passes whether or not the connection is serialised.

+46

;; That is exactly how the first version of this file was vacuous.

+47

(define PARK-BUDGET 0.30)

(define failures '())

(define (fail! msg) (set! failures (cons msg failures)))

@@ -68,6 +76,7 @@

;;

;; `read-during?` is the ONLY difference between them.

(define (run-pin-arm name path read-during?)

+79

(sqlite-set-busy-budget! PARK-BUDGET)

(let ((C (make-db path))

(P #f)

(committed #f) (reheld #f) (released #f)

@@ -113,6 +122,7 @@

122

(sleep 0.05)

123

(set! shared (shared-count C))

124

(set! fresh (fresh-count path)))))

+125

(sqlite-set-busy-budget! 5.0)

126

(sqlite-close C)

127

(sqlite-close P)

128

(display (string-append " " name

@@ -149,40 +159,45 @@

159

;; ------------------------------------------------------------------- arm 3

160

;;

161

;; A write that exhausts the busy budget RAISES. If it does not finalize on the

−152

;; way out, its statement holds the connection's read transaction open forever

−153

;; and every later read on that connection is stale.

+162

;; way out, the statement outlives the call and keeps the connection's btree in

+163

;; use -- which is what stops a pinned read transaction from ever being

+164

;; released, and what turned a transient stale read into a permanent one.

+165

;;

+166

;; ASSERTED DIRECTLY on the open-statement count rather than through a

+167

;; downstream symptom. The first version of this arm asserted staleness after a

+168

;; raise, and was VACUOUS: a parked write holds no read transaction of its own,

+169

;; so leaking one pins nothing by itself. Sabotage caught that; the count does

+170

;; not depend on the leak having a visible consequence.

171

(define (run-leak-arm)

172

(let* ((path "/tmp/sqlite-pin-c.db")

173

(C (make-db path))

174

(P (sqlite-open path))

−158

(raised #f) (after 'unset) (fresh 'unset))

+175

(before 'unset) (raised #f) (after 'unset))

176

(sqlite-set-busy-budget! 0.25)

+177

(set! before (sqlite-open-statements))

178

(sqlite-exec P "BEGIN IMMEDIATE")

179

(guard (exn (#t (set! raised #t)))

180

(sqlite-run C "INSERT INTO w (v) VALUES (?)" "doomed"))

−163

;; The external writer commits and gets out of the way.

−164

(let loop ((i 0))

−165

(when (< i SEED)

−166

(sqlite-run P "INSERT INTO t (v) VALUES (?)" "seed")

−167

(loop (+ i 1))))

+181

(set! after (sqlite-open-statements))

182

(sqlite-exec P "COMMIT")

−169

(set! after (shared-count C))

−170

(set! fresh (fresh-count path))

183

(sqlite-set-busy-budget! 5.0)

184

(sqlite-close C)

185

(sqlite-close P)

186

(display (string-append " arm3 RAISE-LEAKS-STATEMENT: raised=" (if raised "#t" "#f")

−175

" shared-after=" (number->string after)

−176

" fresh=" (number->string fresh) "\n"))

+187

" open-statements before=" (number->string before)

+188

" after=" (number->string after) "\n"))

+189

;; SETUP FIRST: with no raise there is nothing to leak and the assertion

+190

;; below would pass for free.

191

(when (not raised)

−178

(fail! "arm3: SETUP -- the contended write did not raise, so nothing was leaked or not leaked"))

−179

(when (not (= fresh (+ BASE SEED)))

−180

(fail! "arm3: SETUP -- the external writer's rows are not in the database"))

−181

(when (not (= after fresh))

−182

(fail! (string-append "arm3: A RAISED STATEMENT WAS NOT FINALIZED. The connection "

−183

"reports " (number->string after) " rows where an independent "

−184

"connection sees " (number->string fresh)

−185

". The leaked statement is holding the read transaction open.")))))

+192

(fail! "arm3: SETUP -- the contended write did not raise, so nothing could leak"))

+193

(when (not (= before 0))

+194

(fail! (string-append "arm3: SETUP -- " (number->string before)

+195

" statements were already open before this arm ran")))

+196

(when (not (= after 0))

+197

(fail! (string-append "arm3: A RAISED STATEMENT WAS NOT FINALIZED -- "

+198

(number->string after) " left open. It holds the "

+199

"connection's btree in use, so any read transaction on "

+200

"that connection can never be released.")))))

201

(run-leak-arm)

202

203

;; ------------------------------------------------------------------- arm 4