1# 2010 April 13 2# 3# The author disclaims copyright to this source code. In place of 4# a legal notice, here is a blessing: 5# 6# May you do good and not evil. 7# May you find forgiveness for yourself and forgive others. 8# May you share freely, never taking more than you give. 9# 10#*********************************************************************** 11# This file implements regression tests for SQLite library. The 12# focus of this file is testing the operation of the library in 13# "PRAGMA journal_mode=WAL" mode with multiple threads. 14# 15 16set testdir [file dirname $argv0] 17 18source $testdir/tester.tcl 19source $testdir/lock_common.tcl 20if {[run_thread_tests]==0} { finish_test ; return } 21ifcapable !wal { finish_test ; return } 22 23set sqlite_walsummary_mmap_incr 64 24 25# How long, in seconds, to run each test for. If a test is set to run for 26# 0 seconds, it is omitted entirely. 27# 28set seconds(walthread-1) 20 29set seconds(walthread-2) 20 30set seconds(walthread-3) 20 31set seconds(walthread-4) 20 32set seconds(walthread-5) 1 33 34# The parameter is the name of a variable in the callers context. The 35# variable may or may not exist when this command is invoked. 36# 37# If the variable does exist, its value is returned. Otherwise, this 38# command uses [vwait] to wait until it is set, then returns the value. 39# In other words, this is a version of the [set VARNAME] command that 40# blocks until a variable exists. 41# 42proc wait_for_var {varname} { 43 if {0==[uplevel [list info exists $varname]]} { 44 uplevel [list vwait $varname] 45 } 46 uplevel [list set $varname] 47} 48 49# The argument is the name of a list variable in the callers context. The 50# first element of the list is removed and returned. For example: 51# 52# set L {a b c} 53# set x [lshift L] 54# assert { $x == "a" && $L == "b c" } 55# 56proc lshift {lvar} { 57 upvar $lvar L 58 set ret [lindex $L 0] 59 set L [lrange $L 1 end] 60 return $ret 61} 62 63 64#------------------------------------------------------------------------- 65# do_thread_test TESTNAME OPTIONS... 66# 67# where OPTIONS are: 68# 69# -seconds SECONDS How many seconds to run the test for 70# -init SCRIPT Script to run before test. 71# -thread NAME COUNT SCRIPT Scripts to run in threads (or processes). 72# -processes BOOLEAN True to use processes instead of threads. 73# -check SCRIPT Script to run after test. 74# 75proc do_thread_test {args} { 76 77 set A $args 78 79 set P(testname) [lshift A] 80 set P(seconds) 5 81 set P(init) "" 82 set P(threads) [list] 83 set P(processes) 0 84 set P(check) { 85 set ic [db eval "PRAGMA integrity_check"] 86 if {$ic != "ok"} { error $ic } 87 } 88 89 unset -nocomplain ::done 90 91 while {[llength $A]>0} { 92 set a [lshift A] 93 switch -glob -- $a { 94 -seconds { 95 set P(seconds) [lshift A] 96 } 97 98 -init { 99 set P(init) [lshift A] 100 } 101 102 -processes { 103 set P(processes) [lshift A] 104 } 105 106 -check { 107 set P(check) [lshift A] 108 } 109 110 -thread { 111 set name [lshift A] 112 set count [lshift A] 113 set prg [lshift A] 114 lappend P(threads) [list $name $count $prg] 115 } 116 117 default { 118 error "Unknown option: $a" 119 } 120 } 121 } 122 123 if {$P(seconds) == 0} { 124 puts "Skipping $P(testname)" 125 return 126 } 127 128 puts "Running $P(testname) for $P(seconds) seconds..." 129 130 catch { db close } 131 file delete -force test.db test.db-journal test.db-wal 132 133 sqlite3 db test.db 134 eval $P(init) 135 catch { db close } 136 137 foreach T $P(threads) { 138 set name [lindex $T 0] 139 set count [lindex $T 1] 140 set prg [lindex $T 2] 141 142 for {set i 1} {$i <= $count} {incr i} { 143 set vars " 144 set E(pid) $i 145 set E(nthread) $count 146 set E(seconds) $P(seconds) 147 " 148 set program [string map [list %TEST% $prg %VARS% $vars] { 149 150 %VARS% 151 152 proc usleep {ms} { 153 set ::usleep 0 154 after $ms {set ::usleep 1} 155 vwait ::usleep 156 } 157 158 proc integrity_check {{db db}} { 159 set ic [$db eval {PRAGMA integrity_check}] 160 if {$ic != "ok"} {error $ic} 161 } 162 163 proc busyhandler {n} { usleep 10 ; return 0 } 164 165 sqlite3 db test.db 166 db busy busyhandler 167 db eval { SELECT randomblob($E(pid)*5) } 168 169 set ::finished 0 170 after [expr $E(seconds) * 1000] {set ::finished 1} 171 proc tt_continue {} { update ; expr ($::finished==0) } 172 173 set rc [catch { %TEST% } msg] 174 175 catch { db close } 176 list $rc $msg 177 }] 178 179 if {$P(processes)==0} { 180 sqlthread spawn ::done($name,$i) $program 181 } else { 182 testfixture_nb ::done($name,$i) $program 183 } 184 } 185 } 186 187 set report " Results:" 188 foreach T $P(threads) { 189 set name [lindex $T 0] 190 set count [lindex $T 1] 191 set prg [lindex $T 2] 192 193 set reslist [list] 194 for {set i 1} {$i <= $count} {incr i} { 195 set res [wait_for_var ::done($name,$i)] 196 lappend reslist [lindex $res 1] 197 do_test $P(testname).$name.$i [list lindex $res 0] 0 198 } 199 200 append report " $name $reslist" 201 } 202 puts $report 203 204 sqlite3 db test.db 205 set res "" 206 if {[catch $P(check) msg]} { set res $msg } 207 do_test $P(testname).check [list set {} $res] "" 208} 209 210# A wrapper around [do_thread_test] which runs the specified test twice. 211# Once using processes, once using threads. This command takes the same 212# arguments as [do_thread_test], except specifying the -processes switch 213# is illegal. 214# 215proc do_thread_test2 {args} { 216 set name [lindex $args 0] 217 if {[lsearch $args -processes]>=0} { error "bad option: -processes"} 218 uplevel [lreplace $args 0 0 do_thread_test "$name-threads" -processes 0] 219 uplevel [lreplace $args 0 0 do_thread_test "$name-processes" -processes 1] 220} 221 222 223#-------------------------------------------------------------------------- 224# Start 10 threads. Each thread performs both read and write 225# transactions. Each read transaction consists of: 226# 227# 1) Reading the md5sum of all but the last table row, 228# 2) Running integrity check. 229# 3) Reading the value stored in the last table row, 230# 4) Check that the values read in steps 1 and 3 are the same, and that 231# the md5sum of all but the last table row has not changed. 232# 233# Each write transaction consists of: 234# 235# 1) Modifying the contents of t1 (inserting, updating, deleting rows). 236# 2) Appending a new row to the table containing the md5sum() of all 237# rows in the table. 238# 239# Each of the N threads runs N read transactions followed by a single write 240# transaction in a loop as fast as possible. 241# 242# There is also a single checkpointer thread. It runs the following loop: 243# 244# 1) Execute "PRAGMA checkpoint" 245# 2) Sleep for 500 ms. 246# 247do_thread_test2 walthread-1 -seconds $seconds(walthread-1) -init { 248 execsql { 249 PRAGMA journal_mode = WAL; 250 CREATE TABLE t1(x PRIMARY KEY); 251 PRAGMA lock_status; 252 INSERT INTO t1 VALUES(randomblob(100)); 253 INSERT INTO t1 VALUES(randomblob(100)); 254 INSERT INTO t1 SELECT md5sum(x) FROM t1; 255 } 256} -thread main 10 { 257 258 proc read_transaction {} { 259 set results [db eval { 260 BEGIN; 261 PRAGMA integrity_check; 262 SELECT md5sum(x) FROM t1 WHERE rowid != (SELECT max(rowid) FROM t1); 263 SELECT x FROM t1 WHERE rowid = (SELECT max(rowid) FROM t1); 264 SELECT md5sum(x) FROM t1 WHERE rowid != (SELECT max(rowid) FROM t1); 265 COMMIT; 266 }] 267 268 if {[llength $results]!=4 269 || [lindex $results 0] != "ok" 270 || [lindex $results 1] != [lindex $results 2] 271 || [lindex $results 2] != [lindex $results 3] 272 } { 273 error "Failed read transaction: $results" 274 } 275 } 276 277 proc write_transaction {} { 278 db eval { 279 BEGIN; 280 INSERT INTO t1 VALUES(randomblob(100)); 281 INSERT INTO t1 VALUES(randomblob(100)); 282 INSERT INTO t1 SELECT md5sum(x) FROM t1; 283 COMMIT; 284 } 285 } 286 287 set nRun 0 288 while {[tt_continue]} { 289 read_transaction 290 write_transaction 291 incr nRun 292 } 293 set nRun 294 295} -thread ckpt 1 { 296 set nRun 0 297 while {[tt_continue]} { 298 db eval "PRAGMA checkpoint" 299 usleep 500 300 incr nRun 301 } 302 set nRun 303} 304 305#-------------------------------------------------------------------------- 306# This test has clients run the following procedure as fast as possible 307# in a loop: 308# 309# 1. Open a database handle. 310# 2. Execute a read-only transaction on the db. 311# 3. Do "PRAGMA journal_mode = XXX", where XXX is one of WAL or DELETE. 312# Ignore any SQLITE_BUSY error. 313# 4. Execute a write transaction to insert a row into the db. 314# 5. Run "PRAGMA integrity_check" 315# 316# At present, there are 4 clients in total. 2 do "journal_mode = WAL", and 317# two do "journal_mode = DELETE". 318# 319# Each client returns a string of the form "W w, R r", where W is the 320# number of write-transactions performed using a WAL journal, and D is 321# the number of write-transactions performed using a rollback journal. 322# For example, "192 w, 185 r". 323# 324do_thread_test2 walthread-2 -seconds $seconds(walthread-2) -init { 325 execsql { CREATE TABLE t1(x INTEGER PRIMARY KEY, y UNIQUE) } 326} -thread RB 2 { 327 328 db close 329 set nRun 0 330 set nDel 0 331 while {[tt_continue]} { 332 sqlite3 db test.db 333 db busy busyhandler 334 db eval { SELECT * FROM sqlite_master } 335 catch { db eval { PRAGMA journal_mode = DELETE } } 336 db eval { 337 BEGIN; 338 INSERT INTO t1 VALUES(NULL, randomblob(100+$E(pid))); 339 } 340 incr nRun 1 341 incr nDel [file exists test.db-journal] 342 if {[file exists test.db-journal] + [file exists test.db-wal] != 1} { 343 error "File-system looks bad..." 344 } 345 db eval COMMIT 346 347 integrity_check 348 db close 349 } 350 list $nRun $nDel 351 set {} "[expr $nRun-$nDel] w, $nDel r" 352 353} -thread WAL 2 { 354 db close 355 set nRun 0 356 set nDel 0 357 while {[tt_continue]} { 358 sqlite3 db test.db 359 db busy busyhandler 360 db eval { SELECT * FROM sqlite_master } 361 catch { db eval { PRAGMA journal_mode = WAL } } 362 db eval { 363 BEGIN; 364 INSERT INTO t1 VALUES(NULL, randomblob(110+$E(pid))); 365 } 366 incr nRun 1 367 incr nDel [file exists test.db-journal] 368 if {[file exists test.db-journal] + [file exists test.db-wal] != 1} { 369 error "File-system looks bad..." 370 } 371 db eval COMMIT 372 373 integrity_check 374 db close 375 } 376 set {} "[expr $nRun-$nDel] w, $nDel r" 377} 378 379do_thread_test walthread-3 -seconds $seconds(walthread-3) -init { 380 execsql { 381 PRAGMA journal_mode = WAL; 382 CREATE TABLE t1(cnt PRIMARY KEY, sum1, sum2); 383 CREATE INDEX i1 ON t1(sum1); 384 CREATE INDEX i2 ON t1(sum2); 385 INSERT INTO t1 VALUES(0, 0, 0); 386 } 387} -thread t 10 { 388 389 set nextwrite $E(pid) 390 391 proc wal_hook {zDb nEntry} { 392 if {$nEntry>10} { return 1 } 393 return 0 394 } 395 db wal_hook wal_hook 396 397 while {[tt_continue]} { 398 set max 0 399 while { $max != ($nextwrite-1) && [tt_continue] } { 400 set max [db eval { SELECT max(cnt) FROM t1 }] 401 } 402 403 if {[tt_continue]} { 404 set sum1 [db eval { SELECT sum(cnt) FROM t1 }] 405 set sum2 [db eval { SELECT sum(sum1) FROM t1 }] 406 db eval { INSERT INTO t1 VALUES($nextwrite, $sum1, $sum2) } 407 incr nextwrite $E(nthread) 408 integrity_check 409 } 410 } 411 412 set {} ok 413} -check { 414 puts " Final db contains [db eval {SELECT count(*) FROM t1}] rows" 415 puts " Final integrity-check says: [db eval {PRAGMA integrity_check}]" 416 417 # Check that the contents of the database are Ok. 418 set c 0 419 set s1 0 420 set s2 0 421 db eval { SELECT cnt, sum1, sum2 FROM t1 ORDER BY cnt } { 422 if {$c != $cnt || $s1 != $sum1 || $s2 != $sum2} { 423 error "database content is invalid" 424 } 425 incr s2 $s1 426 incr s1 $c 427 incr c 1 428 } 429} 430 431do_thread_test2 walthread-4 -seconds $seconds(walthread-4) -init { 432 execsql { 433 PRAGMA journal_mode = WAL; 434 CREATE TABLE t1(a INTEGER PRIMARY KEY, b UNIQUE); 435 } 436} -thread r 1 { 437 # This connection only ever reads the database. Therefore the 438 # busy-handler is not required. Disable it to check that this is true. 439 db busy {} 440 while {[tt_continue]} integrity_check 441 set {} ok 442} -thread w 1 { 443 444 proc wal_hook {zDb nEntry} { 445 if {$nEntry>15} { return 1 } 446 return 0 447 } 448 db wal_hook wal_hook 449 set row 1 450 while {[tt_continue]} { 451 db eval { REPLACE INTO t1 VALUES($row, randomblob(300)) } 452 incr row 453 if {$row == 10} { set row 1 } 454 } 455 456 set {} ok 457} 458 459 460# This test case attempts to provoke a deadlock condition that existed in 461# the unix VFS at one point. The problem occurred only while recovering a 462# very large wal file (one that requires a wal-index larger than the 463# initial default allocation of 64KB). 464# 465do_thread_test walthread-5 -seconds $seconds(walthread-5) -init { 466 467 proc log_file_size {nFrame pgsz} { 468 expr {12 + ($pgsz+16)*$nFrame} 469 } 470 471 execsql { 472 PRAGMA page_size = 1024; 473 PRAGMA journal_mode = WAL; 474 CREATE TABLE t1(x); 475 BEGIN; 476 INSERT INTO t1 VALUES(randomblob(900)); 477 INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 2 */ 478 INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 4 */ 479 INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 8 */ 480 INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 16 */ 481 INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 32 */ 482 INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 64 */ 483 INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 128 */ 484 INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 256 */ 485 INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 512 */ 486 INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 1024 */ 487 INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 2048 */ 488 INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 4096 */ 489 INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 8192 */ 490 INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 16384 */ 491 INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 32768 */ 492 INSERT INTO t1 SELECT randomblob(900) FROM t1; /* 65536 */ 493 COMMIT; 494 } 495 496 file copy -force test.db-wal bak.db-wal 497 file copy -force test.db bak.db 498 db close 499 500 file copy -force bak.db-wal test.db-wal 501 file copy -force bak.db test.db 502 503 if {[file size test.db-wal] < [log_file_size [expr 64*1024] 1024]} { 504 error "Somehow failed to create a large log file" 505 } 506 puts "Database with large log file recovered. Now running clients..." 507} -thread T 5 { 508 db eval { SELECT count(*) FROM t1 } 509} 510 511finish_test 512 513