# 2001 September 15 # # 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 script is database locks between competing processes. # # $Id: lock2.test,v 1.9 2007/12/13 21:54:11 drh Exp $ set testdir [file dirname $argv0] source $testdir/tester.tcl # Launch another testfixture process to be controlled by this one. A # channel name is returned that may be passed as the first argument to proc # 'testfixture' to execute a command. The child testfixture process is shut # down by closing the channel. proc launch_testfixture {} { set prg [info nameofexec] if {$prg eq ""} { set prg [file join . testfixture] } set chan [open "|$prg tf_main.tcl" r+] fconfigure $chan -buffering line return $chan } # Execute a command in a child testfixture process, connected by two-way # channel $chan. Return the result of the command, or an error message. proc testfixture {chan cmd} { puts $chan $cmd puts $chan OVER set r "" while { 1 } { set line [gets $chan] if { $line == "OVER" } { return $r } append r $line } } # Write the main loop for the child testfixture processes into file # tf_main.tcl. The parent (this script) interacts with the child processes # via a two way pipe. The parent writes a script to the stdin of the child # process, followed by the word "OVER" on a line of its own. The child # process evaluates the script and writes the results to stdout, followed # by an "OVER" of its own. set f [open tf_main.tcl w] puts $f { set l [open log w] set script "" while {![eof stdin]} { flush stdout set line [gets stdin] puts $l "READ $line" if { $line == "OVER" } { catch {eval $script} result puts $result puts $l "WRITE $result" puts OVER puts $l "WRITE OVER" flush stdout set script "" } else { append script $line append script " ; " } } close $l } close $f # Simple locking test case: # # lock2-1.1: Connect a second process to the database. # lock2-1.2: Establish a RESERVED lock with this process. # lock2-1.3: Get a SHARED lock with the second process. # lock2-1.4: Try for a RESERVED lock with process 2. This fails. # lock2-1.5: Try to upgrade the first process to EXCLUSIVE, this fails so # it gets PENDING. # lock2-1.6: Release the SHARED lock held by the second process. # lock2-1.7: Attempt to reaquire a SHARED lock with the second process. # this fails due to the PENDING lock. # lock2-1.8: Ensure the first process can now upgrade to EXCLUSIVE. # do_test lock2-1.1 { set ::tf1 [launch_testfixture] testfixture $::tf1 "set sqlite_pending_byte $::sqlite_pending_byte" testfixture $::tf1 { sqlite3 db test.db -key xyzzy db eval {select * from sqlite_master} } } {} do_test lock2-1.1.1 { execsql {pragma lock_status} } {main unlocked temp closed} sqlite3_soft_heap_limit 0 do_test lock2-1.2 { execsql { BEGIN; CREATE TABLE abc(a, b, c); } } {} do_test lock2-1.3 { testfixture $::tf1 { db eval { BEGIN; SELECT * FROM sqlite_master; } } } {} do_test lock2-1.4 { testfixture $::tf1 { db eval { CREATE TABLE def(d, e, f) } } } {database is locked} do_test lock2-1.5 { catchsql { COMMIT; } } {1 {database is locked}} do_test lock2-1.6 { testfixture $::tf1 { db eval { SELECT * FROM sqlite_master; COMMIT; } } } {} do_test lock2-1.7 { testfixture $::tf1 { db eval { BEGIN; SELECT * FROM sqlite_master; } } } {database is locked} do_test lock2-1.8 { catchsql { COMMIT; } } {0 {}} do_test lock2-1.9 { execsql { SELECT * FROM sqlite_master; } } "table abc abc [expr $AUTOVACUUM?3:2] {CREATE TABLE abc(a, b, c)}" do_test lock2-1.10 { testfixture $::tf1 { db eval { SELECT * FROM sqlite_master; } } } "table abc abc [expr $AUTOVACUUM?3:2] {CREATE TABLE abc(a, b, c)}" catch {testfixture $::tf1 {db close}} catch {close $::tf1} sqlite3_soft_heap_limit $soft_limit finish_test