3 # The author disclaims copyright to this source code. In place of
4 # a legal notice, here is a blessing:
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.
10 #***********************************************************************
11 # This file implements regression tests for SQLite library. The
12 # focus of this script is database locks.
14 # $Id: lock6.test,v 1.3 2009/02/05 16:31:46 drh Exp $
17 set testdir [file dirname $argv0]
18 source $testdir/tester.tcl
20 # Launch another testfixture process to be controlled by this one. A
21 # channel name is returned that may be passed as the first argument to proc
22 # 'testfixture' to execute a command. The child testfixture process is shut
23 # down by closing the channel.
24 proc launch_testfixture {} {
25 set prg [info nameofexec]
27 set prg [file join . testfixture]
29 set chan [open "|$prg tf_main2.tcl" r+]
30 fconfigure $chan -buffering line
34 # Execute a command in a child testfixture process, connected by two-way
35 # channel $chan. Return the result of the command, or an error message.
36 proc testfixture {chan cmd} {
42 if { $line == "OVER" } {
49 # Write the main loop for the child testfixture processes into file
50 # tf_main2.tcl. The parent (this script) interacts with the child processes
51 # via a two way pipe. The parent writes a script to the stdin of the child
52 # process, followed by the word "OVER" on a line of its own. The child
53 # process evaluates the script and writes the results to stdout, followed
54 # by an "OVER" of its own.
55 set f [open tf_main2.tcl w]
59 while {![eof stdin]} {
63 if { $line == "OVER" } {
64 catch {eval $script} result
66 puts $l "WRITE $result"
81 ifcapable lock_proxy_pragmas&&prefer_proxy_locking {
82 set sqlite_hostid_num 1
85 foreach {name value} [array get env SQLITE_FORCE_PROXY_LOCKING] {
86 set using_proxy $value
89 # Test the lock_proxy_file pragmas.
91 set env(SQLITE_FORCE_PROXY_LOCKING) "1"
94 set ::tf1 [launch_testfixture]
95 testfixture $::tf1 "sqlite3_test_control_pending_byte $::sqlite_pending_byte"
97 set sqlite_hostid_num 2
98 sqlite3 db test.db -key xyzzy
99 set lockpath [db eval {
100 PRAGMA lock_proxy_file=":auto:";
101 select * from sqlite_master;
102 PRAGMA lock_proxy_file;
104 string match "*test.db:auto:" $lockpath
108 set sqlite_hostid_num 3
110 execsql {pragma lock_status}
111 } {main unlocked temp closed}
113 sqlite3_soft_heap_limit 0
117 execsql { select * from sqlite_master }
119 } {1 {database is locked}}
122 set lockpath [execsql {
123 PRAGMA lock_proxy_file=":auto:";
124 PRAGMA lock_proxy_file;
127 } {{:auto: (not held)}}
129 do_test lock6-1.4.1 {
131 PRAGMA lock_proxy_file="notmine";
132 select * from sqlite_master;
134 } {1 {database is locked}}
136 do_test lock6-1.4.2 {
138 PRAGMA lock_proxy_file;
146 SELECT * FROM sqlite_master;
151 catch {testfixture $::tf1 {db close}}
155 PRAGMA lock_proxy_file="mine";
156 select * from sqlite_master;
161 set env(SQLITE_FORCE_PROXY_LOCKING) $using_proxy
162 set sqlite_hostid_num 0
164 sqlite3_soft_heap_limit $cmdlinearg(soft-heap-limit)