sqlite/go-sqlite
1
0
Fork 0
mirror of https://gitlab.com/cznic/sqlite.git synced 2024-11-24 02:26:14 +00:00
Code
master
go-sqlite/testdata/tcl/walthread.test
Jan Mercl 8db47beb23 upgrade to tcl8.6.12/2
2021-12-08 11:33:15 +01:00

530 lines
15 KiB
Plaintext
Raw Permalink Blame History

# 2010 April 13
#
# The author disclaims copyright to this source code. In place of
# a legal notice, here is a blessing:
#
# May you do good and not evil.
# May you find forgiveness for yourself and forgive others.
# May you share freely, never taking more than you give.
#
#***********************************************************************
# This file implements regression tests for SQLite library. The
# focus of this file is testing the operation of the library in
# "PRAGMA journal_mode=WAL" mode with multiple threads.
#
set testdir [file dirname $argv0]
source $testdir/tester.tcl
source $testdir/lock_common.tcl
if {[run_thread_tests]==0} { finish_test ; return }
ifcapable !wal { finish_test ; return }
set sqlite_walsummary_mmap_incr 64
# How long, in seconds, to run each test for. If a test is set to run for
# 0 seconds, it is omitted entirely.
#
unset -nocomplain seconds
set seconds(walthread-1) 20
set seconds(walthread-2) 20
set seconds(walthread-3) 20
set seconds(walthread-4) 20
set seconds(walthread-5) 1
# The parameter is the name of a variable in the callers context. The
# variable may or may not exist when this command is invoked.
#
# If the variable does exist, its value is returned. Otherwise, this
# command uses [vwait] to wait until it is set, then returns the value.
# In other words, this is a version of the [set VARNAME] command that
# blocks until a variable exists.
#
proc wait_for_var {varname} {
if {0==[uplevel [list info exists $varname]]} {
uplevel [list vwait $varname]
}
uplevel [list set $varname]
}
# The argument is the name of a list variable in the callers context. The
# first element of the list is removed and returned. For example:
#
# set L {a b c}
# set x [lshift L]
# assert { $x == "a" && $L == "b c" }
#
proc lshift {lvar} {
upvar $lvar L
set ret [lindex $L 0]
set L [lrange $L 1 end]
return $ret
}
#-------------------------------------------------------------------------
# do_thread_test TESTNAME OPTIONS...
#
# where OPTIONS are:
#
# -seconds SECONDS How many seconds to run the test for
# -init SCRIPT Script to run before test.
# -thread NAME COUNT SCRIPT Scripts to run in threads (or processes).
# -processes BOOLEAN True to use processes instead of threads.
# -check SCRIPT Script to run after test.
#
proc do_thread_test {args} {
set A $args
set P(testname) [lshift A]
set P(seconds) 5
set P(init) ""
set P(threads) [list]
set P(processes) 0
set P(check) {
set ic [db eval "PRAGMA integrity_check"]
if {$ic != "ok"} { error $ic }
}
unset -nocomplain ::done
while {[llength $A]>0} {
set a [lshift A]
switch -glob -- $a {
-seconds {
set P(seconds) [lshift A]
}
-init {
set P(init) [lshift A]
}
-processes {
set P(processes) [lshift A]
}
-check {
set P(check) [lshift A]
}
-thread {
set name [lshift A]
set count [lshift A]
set prg [lshift A]
lappend P(threads) [list $name $count $prg]
}
default {
error "Unknown option: $a"
}
}
}
if {$P(seconds) == 0} {
puts "Skipping $P(testname)"
return
}
puts "Running $P(testname) for $P(seconds) seconds..."
catch { db close }
forcedelete test.db test.db-journal test.db-wal
sqlite3 db test.db
eval $P(init)
catch { db close }
foreach T $P(threads) {
set name [lindex $T 0]
set count [lindex $T 1]
set prg [lindex $T 2]
for {set i 1} {$i <= $count} {incr i} {
set vars "
set E(pid) $i
set E(nthread) $count
set E(seconds) $P(seconds)
"
set program [string map [list %TEST% $prg %VARS% $vars] {
%VARS%
proc usleep {ms} {
set ::usleep 0
after $ms {set ::usleep 1}
vwait ::usleep
}
proc integrity_check {{db db}} {
set ic [$db eval {PRAGMA integrity_check}]
if {$ic != "ok"} {error $ic}
}
proc busyhandler {n} { usleep 10 ; return 0 }
sqlite3 db test.db
db busy busyhandler
db eval { SELECT randomblob($E(pid)*5) }
set ::finished 0
after [expr $E(seconds) * 1000] {set ::finished 1}
proc tt_continue {} { update ; expr ($::finished==0) }
set rc [catch { %TEST% } msg]
catch { db close }
list $rc $msg
}]
if {$P(processes)==0} {
sqlthread spawn ::done($name,$i) $program
} else {
testfixture_nb ::done($name,$i) $program
}
}
}
set report " Results:"
foreach T $P(threads) {
set name [lindex $T 0]
set count [lindex $T 1]
set prg [lindex $T 2]
set reslist [list]
for {set i 1} {$i <= $count} {incr i} {
set res [wait_for_var ::done($name,$i)]
lappend reslist [lindex $res 1]
do_test $P(testname).$name.$i [list lindex $res 0] 0
}
append report " $name $reslist"
}
puts $report
sqlite3 db test.db
set res ""
if {[catch $P(check) msg]} { set res $msg }
do_test $P(testname).check [list set {} $res] ""
}
# A wrapper around [do_thread_test] which runs the specified test twice.
# Once using processes, once using threads. This command takes the same
# arguments as [do_thread_test], except specifying the -processes switch
# is illegal.
#
proc do_thread_test2 {args} {
set name [lindex $args 0]
if {[lsearch $args -processes]>=0} { error "bad option: -processes"}
uplevel [lreplace $args 0 0 do_thread_test "$name-threads" -processes 0]
uplevel [lreplace $args 0 0 do_thread_test "$name-processes" -processes 1]
}
#--------------------------------------------------------------------------
# Start 10 threads. Each thread performs both read and write
# transactions. Each read transaction consists of:
#
# 1) Reading the md5sum of all but the last table row,
# 2) Running integrity check.
# 3) Reading the value stored in the last table row,
# 4) Check that the values read in steps 1 and 3 are the same, and that
# the md5sum of all but the last table row has not changed.
#
# Each write transaction consists of:
#
# 1) Modifying the contents of t1 (inserting, updating, deleting rows).
# 2) Appending a new row to the table containing the md5sum() of all
# rows in the table.
#
# Each of the N threads runs N read transactions followed by a single write
# transaction in a loop as fast as possible.
#
# There is also a single checkpointer thread. It runs the following loop:
#
# 1) Execute "PRAGMA wal_checkpoint"
# 2) Sleep for 500 ms.
#
do_thread_test2 walthread-1 -seconds $seconds(walthread-1) -init {
execsql {
PRAGMA journal_mode = WAL;
CREATE TABLE t1(x PRIMARY KEY);
PRAGMA lock_status;
INSERT INTO t1 VALUES(randomblob(100));
INSERT INTO t1 VALUES(randomblob(100));
INSERT INTO t1 SELECT md5sum(x) FROM t1;
}
} -thread main 10 {
proc read_transaction {} {
set results [db eval {
BEGIN;
PRAGMA integrity_check;
SELECT md5sum(x) FROM t1 WHERE rowid != (SELECT max(rowid) FROM t1);
SELECT x FROM t1 WHERE rowid = (SELECT max(rowid) FROM t1);
SELECT md5sum(x) FROM t1 WHERE rowid != (SELECT max(rowid) FROM t1);
COMMIT;
}]
if {[llength $results]!=4
|| [lindex $results 0] != "ok"
|| [lindex $results 1] != [lindex $results 2]
|| [lindex $results 2] != [lindex $results 3]
} {
error "Failed read transaction: $results"
}
}
proc write_transaction {} {
db eval {
BEGIN;
INSERT INTO t1 VALUES(randomblob(101 + $::E(pid)));
INSERT INTO t1 VALUES(randomblob(101 + $::E(pid)));
INSERT INTO t1 SELECT md5sum(x) FROM t1;
COMMIT;
}
}
# Turn off auto-checkpoint. Otherwise, an auto-checkpoint run by a
# writer may cause the dedicated checkpoint thread to return an
# SQLITE_BUSY error.
#
db eval { PRAGMA wal_autocheckpoint = 0 }
set nRun 0
while {[tt_continue]} {
read_transaction
write_transaction
incr nRun
}
set nRun
} -thread ckpt 1 {
set nRun 0
while {[tt_continue]} {
db eval "PRAGMA wal_checkpoint"
usleep 500
incr nRun
}
set nRun
}
#--------------------------------------------------------------------------
# This test has clients run the following procedure as fast as possible
# in a loop:
#
# 1. Open a database handle.
# 2. Execute a read-only transaction on the db.
# 3. Do "PRAGMA journal_mode = XXX", where XXX is one of WAL or DELETE.
# Ignore any SQLITE_BUSY error.
# 4. Execute a write transaction to insert a row into the db.
# 5. Run "PRAGMA integrity_check"
#
# At present, there are 4 clients in total. 2 do "journal_mode = WAL", and
# two do "journal_mode = DELETE".
#
# Each client returns a string of the form "W w, R r", where W is the
# number of write-transactions performed using a WAL journal, and D is
# the number of write-transactions performed using a rollback journal.
# For example, "192 w, 185 r".
#
if {[atomic_batch_write test.db]==0} {
do_thread_test2 walthread-2 -seconds $seconds(walthread-2) -init {
execsql { CREATE TABLE t1(x INTEGER PRIMARY KEY, y UNIQUE) }
} -thread RB 2 {
db close
set nRun 0
set nDel 0
while {[tt_continue]} {
sqlite3 db test.db
db busy busyhandler
db eval { SELECT * FROM sqlite_master }
catch { db eval { PRAGMA journal_mode = DELETE } }
db eval {
BEGIN;
INSERT INTO t1 VALUES(NULL, randomblob(100+$E(pid)));
}
incr nRun 1
incr nDel [file exists test.db-journal]
if {[file exists test.db-journal] + [file exists test.db-wal] != 1} {
error "File-system looks bad..."
}
db eval COMMIT
integrity_check
db close
}
list $nRun $nDel
set {} "[expr $nRun-$nDel] w, $nDel r"
} -thread WAL 2 {
db close
set nRun 0
set nDel 0
while {[tt_continue]} {
sqlite3 db test.db
db busy busyhandler
db eval { SELECT * FROM sqlite_master }
catch { db eval { PRAGMA journal_mode = WAL } }
db eval {
BEGIN;
INSERT INTO t1 VALUES(NULL, randomblob(110+$E(pid)));
}
incr nRun 1
incr nDel [file exists test.db-journal]
if {[file exists test.db-journal] + [file exists test.db-wal] != 1} {
error "File-system looks bad..."
}
db eval COMMIT
integrity_check
db close
}
set {} "[expr $nRun-$nDel] w, $nDel r"
}
}
do_thread_test walthread-3 -seconds $seconds(walthread-3) -init {
execsql {
PRAGMA journal_mode = WAL;
CREATE TABLE t1(cnt PRIMARY KEY, sum1, sum2);
CREATE INDEX i1 ON t1(sum1);
CREATE INDEX i2 ON t1(sum2);
INSERT INTO t1 VALUES(0, 0, 0);
}
} -thread t 10 {
set nextwrite $E(pid)
proc wal_hook {zDb nEntry} {
if {$nEntry>10} {
set rc [catch { db eval {PRAGMA wal_checkpoint} } msg]
if {$rc && $msg != "database is locked"} { error $msg }
}
return 0
}
db wal_hook wal_hook
while {[tt_continue]} {
set max 0
while { $max != ($nextwrite-1) && [tt_continue] } {
set max [db eval { SELECT max(cnt) FROM t1 }]
}
if {[tt_continue]} {
set sum1 [db eval { SELECT sum(cnt) FROM t1 }]
set sum2 [db eval { SELECT sum(sum1) FROM t1 }]
db eval { INSERT INTO t1 VALUES($nextwrite, $sum1, $sum2) }
incr nextwrite $E(nthread)
integrity_check
}
}
set {} ok
} -check {
puts " Final db contains [db eval {SELECT count(*) FROM t1}] rows"
puts " Final integrity-check says: [db eval {PRAGMA integrity_check}]"
# Check that the contents of the database are Ok.
set c 0
set s1 0
set s2 0
db eval { SELECT cnt, sum1, sum2 FROM t1 ORDER BY cnt } {
if {$c != $cnt || $s1 != $sum1 || $s2 != $sum2} {
error "database content is invalid"
}
incr s2 $s1
incr s1 $c
incr c 1
}
}
do_thread_test2 walthread-4 -seconds $seconds(walthread-4) -init {
execsql {
PRAGMA journal_mode = WAL;
CREATE TABLE t1(a INTEGER PRIMARY KEY, b UNIQUE);
}
} -thread r 1 {
# This connection only ever reads the database. Therefore the
# busy-handler is not required. Disable it to check that this is true.
#
# UPDATE: That is no longer entirely true - as we don't use a blocking
# lock to enter RECOVER state. Which means there is a small chance a
# reader can see an SQLITE_BUSY.
#
while {[tt_continue]} {
integrity_check
}
set {} ok
} -thread w 1 {
proc wal_hook {zDb nEntry} {
if {$nEntry>15} {db eval {PRAGMA wal_checkpoint}}
return 0
}
db wal_hook wal_hook
set row 1
while {[tt_continue]} {
db eval { REPLACE INTO t1 VALUES($row, randomblob(300)) }
incr row
if {$row == 10} { set row 1 }
}
set {} ok
}
# This test case attempts to provoke a deadlock condition that existed in
# the unix VFS at one point. The problem occurred only while recovering a
# very large wal file (one that requires a wal-index larger than the
# initial default allocation of 64KB).
#
do_thread_test walthread-5 -seconds $seconds(walthread-5) -init {
proc log_file_size {nFrame pgsz} {
expr {12 + ($pgsz+16)*$nFrame}
}
execsql {
PRAGMA page_size = 1024;
PRAGMA journal_mode = WAL;
CREATE TABLE t1(x);
BEGIN;
INSERT INTO t1 VALUES(randomblob(900));
INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 2 */
INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 4 */
INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 8 */
INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 16 */
INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 32 */
INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 64 */
INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 128 */
INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 256 */
INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 512 */
INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 1024 */
INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 2048 */
INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 4096 */
INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 8192 */
INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 16384 */
INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 32768 */
INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 65536 */
COMMIT;
}
forcecopy test.db-wal bak.db-wal
forcecopy test.db bak.db
db close
forcecopy bak.db-wal test.db-wal
forcecopy bak.db test.db
if {[file size test.db-wal] < [log_file_size [expr 64*1024] 1024]} {
error "Somehow failed to create a large log file"
}
puts "Database with large log file recovered. Now running clients..."
} -thread T 5 {
db eval { SELECT count(*) FROM t1 }
}
unset -nocomplain seconds
finish_test
View Git Blame Copy Permalink