OLD | NEW |
| (Empty) |
1 # 2008 October 6 | |
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 script is database locks. | |
13 # | |
14 # $Id: lock6.test,v 1.3 2009/02/05 16:31:46 drh Exp $ | |
15 | |
16 | |
17 set testdir [file dirname $argv0] | |
18 source $testdir/tester.tcl | |
19 | |
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] | |
26 if {$prg eq ""} { | |
27 set prg [file join . testfixture] | |
28 } | |
29 set chan [open "|$prg tf_main2.tcl" r+] | |
30 fconfigure $chan -buffering line | |
31 return $chan | |
32 } | |
33 | |
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} { | |
37 puts $chan $cmd | |
38 puts $chan OVER | |
39 set r "" | |
40 while { 1 } { | |
41 set line [gets $chan] | |
42 if { $line == "OVER" } { | |
43 return $r | |
44 } | |
45 append r $line | |
46 } | |
47 } | |
48 | |
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] | |
56 puts $f { | |
57 set l [open log w] | |
58 set script "" | |
59 while {![eof stdin]} { | |
60 flush stdout | |
61 set line [gets stdin] | |
62 puts $l "READ $line" | |
63 if { $line == "OVER" } { | |
64 catch {eval $script} result | |
65 puts $result | |
66 puts $l "WRITE $result" | |
67 puts OVER | |
68 puts $l "WRITE OVER" | |
69 flush stdout | |
70 set script "" | |
71 } else { | |
72 append script $line | |
73 append script " ; " | |
74 } | |
75 } | |
76 close $l | |
77 } | |
78 close $f | |
79 | |
80 | |
81 ifcapable lock_proxy_pragmas&&prefer_proxy_locking { | |
82 set sqlite_hostid_num 1 | |
83 | |
84 set using_proxy 0 | |
85 foreach {name value} [array get env SQLITE_FORCE_PROXY_LOCKING] { | |
86 set using_proxy $value | |
87 } | |
88 | |
89 # Test the lock_proxy_file pragmas. | |
90 # | |
91 set env(SQLITE_FORCE_PROXY_LOCKING) "1" | |
92 | |
93 do_test lock6-1.1 { | |
94 set ::tf1 [launch_testfixture] | |
95 testfixture $::tf1 "sqlite3_test_control_pending_byte $::sqlite_pending_byte
" | |
96 testfixture $::tf1 { | |
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; | |
103 }] | |
104 string match "*test.db:auto:" $lockpath | |
105 } | |
106 } {1} | |
107 | |
108 set sqlite_hostid_num 3 | |
109 do_test lock6-1.2 { | |
110 execsql {pragma lock_status} | |
111 } {main unlocked temp closed} | |
112 | |
113 sqlite3_soft_heap_limit 0 | |
114 do_test lock6-1.3 { | |
115 list [catch { | |
116 sqlite3 db test.db | |
117 execsql { select * from sqlite_master } | |
118 } msg] $msg | |
119 } {1 {database is locked}} | |
120 | |
121 do_test lock6-1.4 { | |
122 set lockpath [execsql { | |
123 PRAGMA lock_proxy_file=":auto:"; | |
124 PRAGMA lock_proxy_file; | |
125 } db] | |
126 set lockpath | |
127 } {{:auto: (not held)}} | |
128 | |
129 do_test lock6-1.4.1 { | |
130 catchsql { | |
131 PRAGMA lock_proxy_file="notmine"; | |
132 select * from sqlite_master; | |
133 } db | |
134 } {1 {database is locked}} | |
135 | |
136 do_test lock6-1.4.2 { | |
137 execsql { | |
138 PRAGMA lock_proxy_file; | |
139 } db | |
140 } {notmine} | |
141 | |
142 do_test lock6-1.5 { | |
143 testfixture $::tf1 { | |
144 db eval { | |
145 BEGIN; | |
146 SELECT * FROM sqlite_master; | |
147 } | |
148 } | |
149 } {} | |
150 | |
151 catch {testfixture $::tf1 {db close}} | |
152 | |
153 do_test lock6-1.6 { | |
154 execsql { | |
155 PRAGMA lock_proxy_file="mine"; | |
156 select * from sqlite_master; | |
157 } db | |
158 } {} | |
159 | |
160 catch {close $::tf1} | |
161 set env(SQLITE_FORCE_PROXY_LOCKING) $using_proxy | |
162 set sqlite_hostid_num 0 | |
163 | |
164 sqlite3_soft_heap_limit $cmdlinearg(soft-heap-limit) | |
165 } | |
166 | |
167 finish_test | |
OLD | NEW |