1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
# 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
|
