test/test-sqlite-wal-cooperative.sgl

1;;; Regression test for cooperative WAL busy-retry.

2;;;

3;;; Before the fix, a contended sqlite3_step BLOCKED the single cooperative

4;;; scheduler thread for the whole busy_timeout (kiln sets 5000ms). Fiber A

5;;; could hold a WAL write lock, yield, and then be UNABLE to run to commit

6;;; because fiber B's blocking step froze the thread — a deadlock. This test

7;;; sets up exactly that shape and asserts both fibers finish quickly (well

8;;; under the busy_timeout), proving the step no longer blocks the scheduler.

9;;;

10;;; On the pre-fix runtime A commits only after ~5000ms (the busy_timeout) and

11;;; this test FAILS; on the fix A commits at ~its intended yield (~200ms) and B

12;;; retries cooperatively right after.

14(import (sigil core)

15 (sigil async)

16 (sigil sqlite)

17 (sigil time)

18 (sigil string))

20(display "Testing SQLite WAL cooperative busy-retry (deadlock regression)...\n")

22(define dbfile "/tmp/sqlite-wal-coop-test.db")

23(define A (sqlite-open dbfile))

24(sqlite-exec A "PRAGMA journal_mode=WAL")

25(sqlite-exec A "PRAGMA busy_timeout=5000")

26(sqlite-exec A "DROP TABLE IF EXISTS t")

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

28(define B (sqlite-open dbfile))

29(sqlite-exec B "PRAGMA busy_timeout=5000")

31(define t0 (current-milliseconds))

32(define (ms) (- (current-milliseconds) t0))

33(define a-commit-ms 0)

34(define b-ms 0)

36(with-async

37 ;; A: take the WAL write lock, YIELD 0.2s while holding it, then commit.

38 (go (begin

39 (sqlite-exec A "BEGIN IMMEDIATE")

40 (sleep 0.2)

41 (sqlite-exec A "INSERT INTO t (v) VALUES ('a')")

42 (sqlite-exec A "COMMIT")

43 (set! a-commit-ms (ms))))

44 ;; B: write into the contended db — must cooperatively retry, NOT freeze the

45 ;; scheduler thread (which would prevent A from ever committing).

46 (go (begin

47 (sleep 0.05)

48 (sqlite-exec B "INSERT INTO t (v) VALUES ('b')")

49 (set! b-ms (ms)))))

51(sqlite-close A)

52(sqlite-close B)

54;; On the fix both finish ~0.2s; on the bug A only commits after ~5s (busy_timeout).

55(define wal-cooperative-pass?

56 (and (> a-commit-ms 0) (> b-ms 0)

57 (< a-commit-ms 2000) (< b-ms 2000)))

59(if wal-cooperative-pass?

60 (display (string-append "PASS: A committed @" (number->string a-commit-ms)

61 "ms, B @" (number->string b-ms)

62 "ms (cooperative retry — scheduler not frozen)\n"))

63 (display (string-append "FAIL: A @" (number->string a-commit-ms)

64 "ms, B @" (number->string b-ms)

65 "ms (>=2000ms => blocking sqlite3_step froze the scheduler)\n")))

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

68(if wal-cooperative-pass?

69 0

70 (error "WAL cooperative busy-retry regression"))