test/test-sqlite-connection-pin.sgl

1;;; Regression test for the shared-connection snapshot pin.

2;;;

3;;; THE DEFECT. SQLite ends a connection's implicit read transaction only when

4;;; NO statement on it is active. So if fiber A has a statement open on a

5;;; connection -- parked in the cooperative busy-retry, say -- and fiber B runs

6;;; a query on the SAME connection, B's read transaction cannot be released

7;;; when B finalizes: A is still using the btree. The connection is pinned to

8;;; B's snapshot until A completes, and every later read on it silently misses

9;;; anything committed in between.

10;;;

11;;; It produced a CI controller serving a pre-commit view of its own database:

12;;; HTTP 200, no error, and permanent, because the parked write then could not

13;;; complete either -- it exhausted the busy budget, RAISED, and leaked its

14;;; unfinalized statement, which held the read transaction open for the life of

15;;; the process.

16;;;

17;;; THE ORDER IS THE VARIABLE, which is why arm 1 has a control that differs by

18;;; exactly one read. Before the fix, READ-DURING-PARK returned the pre-commit

19;;; count and NO-READ-DURING-PARK did not.

20;;;

21;;; Arms:

22;;; 1. NO-READ-DURING-PARK control -- no read while the write is parked

23;;; 2. READ-DURING-PARK the defect: a read on the shared connection while

24;;; a write on it is parked, across an external commit

25;;; 3. RAISE-LEAKS-STATEMENT a write that exhausts the budget and raises must

26;;; still finalize, or it pins the connection forever

27;;; 4. BUSY-TIMEOUT-PRAGMA `PRAGMA busy_timeout=N` must actually set the

28;;; retry budget rather than be silently swallowed

29

30(import (sigil core)

31 (sigil async)

32 (sigil sqlite)

33 (sigil time)

34 (sigil string))

35

36(display "Testing SQLite shared-connection snapshot pin...\n")

37

38(define SEED 700)

39(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;; The measuring read is taken AFTER the external commit and WHILE the shared

48;; write is still parked. That is the only moment the defect is visible:

49;; - without the lock it runs during the park, joins the read transaction

50;; pinned by the earlier read, and returns the PRE-COMMIT count;

51;; - with the lock it cannot run during the park at all -- it queues behind

52;; the write and returns current data, which is the fix working.

53;; Measuring after the park ends passes either way; that is how the first

54;; version of this file was vacuous.

55(define failures '())

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

57

58(define (fresh-count path)

59 (let* ((F (sqlite-open path))

60 (r (sqlite-query-row F "SELECT count(*) AS n FROM t"))

61 (n (if r (assoc-ref 'n r) 'query-failed)))

62 (sqlite-close F)

63 n))

64

65(define (shared-count C)

66 (let ((r (sqlite-query-row C "SELECT count(*) AS n FROM t")))

67 (if r (assoc-ref 'n r) 'query-failed)))

68

69(define (make-db path)

70 (let ((C (sqlite-open path)))

71 (sqlite-exec C "PRAGMA journal_mode=WAL")

72 (sqlite-exec C "DROP TABLE IF EXISTS t")

73 (sqlite-exec C "DROP TABLE IF EXISTS w")

74 (sqlite-exec C "CREATE TABLE t (id INTEGER PRIMARY KEY, v TEXT)")

75 (sqlite-exec C "CREATE TABLE w (id INTEGER PRIMARY KEY, v TEXT)")

76 (let loop ((i 0))

77 (when (< i BASE)

78 (sqlite-run C "INSERT INTO t (v) VALUES (?)" "base")

79 (loop (+ i 1))))

80 C))

81

82;; ---------------------------------------------------------------- arms 1 & 2

83;;

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

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

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

87 (P #f)

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

89 (started 0) (finished 0)

90 (early (quote not-taken))

91 (during (quote not-taken))

92 (shared 'unset) (fresh 'unset))

93 (set! P (sqlite-open path))

94 (with-async

95 ;; The external writer: holds the lock, commits SEED rows, re-takes it so

96 ;; the park outlives the commit, then releases.

97 (go (begin

98 (sqlite-exec P "BEGIN IMMEDIATE")

99 (sleep 0.30)

100 (let loop ((i 0))

101 (when (< i SEED)

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

103 (loop (+ i 1))))

104 (sqlite-exec P "COMMIT")

105 (set! committed #t)

106 (sqlite-exec P "BEGIN IMMEDIATE")

107 (set! reheld #t)

108 (sleep 0.80)

109 (sqlite-exec P "COMMIT")

110 (set! released #t)))

111 ;; The write on the SHARED connection. Parks on the external lock.

112 (go (begin

113 (sleep 0.05)

114 (set! started (+ started 1))

115 (guard (exn (#t #f))

116 (sqlite-run C "INSERT INTO w (v) VALUES (?)" "shared-write"))

117 (set! finished (+ finished 1))))

118 ;; THE ONE DIFFERENCE: a read on the shared connection during the park.

119 (go (when read-during?

120 (sleep 0.15)

121 (set! early (shared-count C))))

122 ;; THE MEASUREMENT: after the external commit, while the write is parked.

123 (go (begin

124 (let loop ((n 0))

125 (when (and (not reheld) (< n 4000)) (sleep 0.005) (loop (+ n 1))))

126 (set! during (shared-count C))))

127 ;; And a final reading once everything has drained.

128 (go (begin

129 (let loop ((n 0))

130 (when (and (not reheld) (< n 2000)) (sleep 0.005) (loop (+ n 1))))

131 (let loop ((n 0))

132 (when (and (not (and released (= finished started))) (< n 4000))

133 (sleep 0.005) (loop (+ n 1))))

134 (sleep 0.05)

135 (set! shared (shared-count C))

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

137 (sqlite-set-busy-budget! 5.0)

138 (sqlite-close C)

139 (sqlite-close P)

140 (display (string-append " " name

141 ": shared=" (number->string shared)

142 " fresh=" (number->string fresh)

143 " during-park-read=" (if (eq? during (quote not-taken)) "not-taken"

144 (number->string during))

145 " early-read=" (if (eq? early (quote not-taken)) "not-taken"

146 (number->string early))

147 "\n"))

148 ;; SETUP ASSERTIONS FIRST. Without these an "agree" could be two equal

149 ;; wrong numbers -- a seed that never landed makes every arm pass.

150 (when (not committed)

151 (fail! (string-append name ": SETUP -- the external writer never committed")))

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

153 (fail! (string-append name ": SETUP -- an independent connection sees "

154 (number->string fresh) ", expected "

155 (number->string (+ BASE SEED)))))

156 (when (and read-during? (eq? early 'not-taken))

157 (fail! (string-append name ": SETUP -- the during-park read never happened, "

158 "so this arm did not test what it claims")))

159 ;; THE ASSERTION: the read taken after the commit must see the commit.

160 (when (eq? during (quote not-taken))

161 (fail! (string-append name ": SETUP -- the during-park read never ran")))

162 (when (and (not (eq? during (quote not-taken))) (not (= during (+ BASE SEED))))

163 (fail! (string-append name ": THE CONNECTION IS PINNED. A read taken after the "

164 "external commit returned " (number->string during)

165 " rows, not " (number->string (+ BASE SEED))

166 ". It ran while a write on the same connection was parked "

167 "and joined a read transaction that could not be released.")))

168 (when (not (equal? shared fresh))

169 (fail! (string-append name ": THE CONNECTION IS PINNED. It reports "

170 (number->string shared)

171 " rows while an independent connection sees "

172 (number->string fresh)

173 " in the same database. A read ran on the shared "

174 "connection while a write on it was parked, and the "

175 "read transaction it opened could not be released.")))

176 (list shared fresh)))

177

178(run-pin-arm "arm1 NO-READ-DURING-PARK (control)" "/tmp/sqlite-pin-a.db" #f)

179(run-pin-arm "arm2 READ-DURING-PARK" "/tmp/sqlite-pin-b.db" #t)

180

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

182;;

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

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

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

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

187;;

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

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

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

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

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

193(define (run-leak-arm)

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

195 (C (make-db path))

196 (P (sqlite-open path))

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

198 (sqlite-set-busy-budget! 0.25)

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

200 (sqlite-exec P "BEGIN IMMEDIATE")

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

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

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

204 (sqlite-exec P "COMMIT")

205 (sqlite-set-busy-budget! 5.0)

206 (sqlite-close C)

207 (sqlite-close P)

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

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

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

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

212 ;; below would pass for free.

213 (when (not raised)

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

215 (when (not (= before 0))

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

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

218 (when (not (= after 0))

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

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

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

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

223(run-leak-arm)

224

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

226;;

227;; `PRAGMA busy_timeout=N` was accepted and silently ignored: the native layer

228;; forces SQLite's own busy_timeout to 0 (it must -- a blocking step freezes the

229;; whole cooperative scheduler). It now sets the cooperative retry budget.

230(define (run-pragma-arm)

231 (let ((path "/tmp/sqlite-pin-d.db"))

232 (let ((C (sqlite-open path)))

233 (sqlite-set-busy-budget! 5.0)

234 ;; CONTROL FIRST: an unrelated pragma must NOT move the budget, or this

235 ;; arm would pass for any pragma at all.

236 (sqlite-exec C "PRAGMA journal_mode=WAL")

237 (when (not (= (sqlite-busy-budget) 5.0))

238 (fail! (string-append "arm4: CONTROL -- an unrelated pragma changed the budget to "

239 (number->string (sqlite-busy-budget)))))

240 (sqlite-exec C "PRAGMA busy_timeout=250")

241 (display (string-append " arm4 BUSY-TIMEOUT-PRAGMA: budget after PRAGMA busy_timeout=250 is "

242 (number->string (sqlite-busy-budget)) "s\n"))

243 (when (not (= (sqlite-busy-budget) 0.25))

244 (fail! (string-append "arm4: `PRAGMA busy_timeout=250` did not set the retry budget; "

245 "it is " (number->string (sqlite-busy-budget))

246 "s. Dead configuration that reads as live.")))

247 (sqlite-set-busy-budget! 5.0)

248 (sqlite-close C))))

249(run-pragma-arm)

250

251;; ---------------------------------------------------------------- verdict

252(if (null? failures)

253 (display "PASS: the shared connection is serialised; no pin, no leaked statement, busy_timeout honoured\n")

254 (begin

255 (display "FAIL:\n")

256 (let loop ((f (reverse failures)))

257 (when (not (null? f))

258 (display (string-append " - " (car f) "\n"))

259 (loop (cdr f))))))

260

261;; Final top-level value drives the harness exit code: 0 on pass, error on fail.

262(if (null? failures)

263 0

264 (error "shared-connection snapshot pin regression"))