OLD | NEW |
| (Empty) |
1 # 2009 January 3 | |
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 # | |
12 # $Id: savepoint6.test,v 1.4 2009/06/05 17:09:12 drh Exp $ | |
13 | |
14 set testdir [file dirname $argv0] | |
15 source $testdir/tester.tcl | |
16 | |
17 proc sql {zSql} { | |
18 uplevel db eval [list $zSql] | |
19 #puts stderr "$zSql ;" | |
20 } | |
21 | |
22 set DATABASE_SCHEMA { | |
23 PRAGMA auto_vacuum = incremental; | |
24 CREATE TABLE t1(x, y); | |
25 CREATE UNIQUE INDEX i1 ON t1(x); | |
26 CREATE INDEX i2 ON t1(y); | |
27 } | |
28 | |
29 if {0==[info exists ::G(savepoint6_iterations)]} { | |
30 set ::G(savepoint6_iterations) 1000 | |
31 } | |
32 | |
33 #-------------------------------------------------------------------------- | |
34 # In memory database state. | |
35 # | |
36 # ::lSavepoint is a list containing one entry for each active savepoint. The | |
37 # first entry in the list corresponds to the most recently opened savepoint. | |
38 # Each entry consists of two elements: | |
39 # | |
40 # 1. The savepoint name. | |
41 # | |
42 # 2. A serialized Tcl array representing the contents of table t1 at the | |
43 # start of the savepoint. The keys of the array are the x values. The | |
44 # values are the y values. | |
45 # | |
46 # Array ::aEntry contains the contents of database table t1. Array keys are | |
47 # x values, the array data values are y values. | |
48 # | |
49 set lSavepoint [list] | |
50 array set aEntry [list] | |
51 | |
52 proc x_to_y {x} { | |
53 set nChar [expr int(rand()*250) + 250] | |
54 set str " $nChar [string repeat $x. $nChar]" | |
55 string range $str 1 $nChar | |
56 } | |
57 #-------------------------------------------------------------------------- | |
58 | |
59 #------------------------------------------------------------------------- | |
60 # Procs to operate on database: | |
61 # | |
62 # savepoint NAME | |
63 # rollback NAME | |
64 # release NAME | |
65 # | |
66 # insert_rows XVALUES | |
67 # delete_rows XVALUES | |
68 # | |
69 proc savepoint {zName} { | |
70 catch { sql "SAVEPOINT $zName" } | |
71 lappend ::lSavepoint [list $zName [array get ::aEntry]] | |
72 } | |
73 | |
74 proc rollback {zName} { | |
75 catch { sql "ROLLBACK TO $zName" } | |
76 for {set i [expr {[llength $::lSavepoint]-1}]} {$i>=0} {incr i -1} { | |
77 set zSavepoint [lindex $::lSavepoint $i 0] | |
78 if {$zSavepoint eq $zName} { | |
79 unset -nocomplain ::aEntry | |
80 array set ::aEntry [lindex $::lSavepoint $i 1] | |
81 | |
82 | |
83 if {$i+1 < [llength $::lSavepoint]} { | |
84 set ::lSavepoint [lreplace $::lSavepoint [expr $i+1] end] | |
85 } | |
86 break | |
87 } | |
88 } | |
89 } | |
90 | |
91 proc release {zName} { | |
92 catch { sql "RELEASE $zName" } | |
93 for {set i [expr {[llength $::lSavepoint]-1}]} {$i>=0} {incr i -1} { | |
94 set zSavepoint [lindex $::lSavepoint $i 0] | |
95 if {$zSavepoint eq $zName} { | |
96 set ::lSavepoint [lreplace $::lSavepoint $i end] | |
97 break | |
98 } | |
99 } | |
100 | |
101 if {[llength $::lSavepoint] == 0} { | |
102 #puts stderr "-- End of transaction!!!!!!!!!!!!!" | |
103 } | |
104 } | |
105 | |
106 proc insert_rows {lX} { | |
107 foreach x $lX { | |
108 set y [x_to_y $x] | |
109 | |
110 # Update database [db] | |
111 sql "INSERT OR REPLACE INTO t1 VALUES($x, '$y')" | |
112 | |
113 # Update the Tcl database. | |
114 set ::aEntry($x) $y | |
115 } | |
116 } | |
117 | |
118 proc delete_rows {lX} { | |
119 foreach x $lX { | |
120 # Update database [db] | |
121 sql "DELETE FROM t1 WHERE x = $x" | |
122 | |
123 # Update the Tcl database. | |
124 unset -nocomplain ::aEntry($x) | |
125 } | |
126 } | |
127 #------------------------------------------------------------------------- | |
128 | |
129 #------------------------------------------------------------------------- | |
130 # Proc to compare database content with the in-memory representation. | |
131 # | |
132 # checkdb | |
133 # | |
134 proc checkdb {} { | |
135 set nEntry [db one {SELECT count(*) FROM t1}] | |
136 set nEntry2 [array size ::aEntry] | |
137 if {$nEntry != $nEntry2} { | |
138 error "$nEntry entries in database, $nEntry2 entries in array" | |
139 } | |
140 db eval {SELECT x, y FROM t1} { | |
141 if {![info exists ::aEntry($x)]} { | |
142 error "Entry $x exists in database, but not in array" | |
143 } | |
144 if {$::aEntry($x) ne $y} { | |
145 error "Entry $x is set to {$y} in database, {$::aEntry($x)} in array" | |
146 } | |
147 } | |
148 | |
149 db eval { PRAGMA integrity_check } | |
150 } | |
151 #------------------------------------------------------------------------- | |
152 | |
153 #------------------------------------------------------------------------- | |
154 # Proc to return random set of x values. | |
155 # | |
156 # random_integers | |
157 # | |
158 proc random_integers {nRes nRange} { | |
159 set ret [list] | |
160 for {set i 0} {$i<$nRes} {incr i} { | |
161 lappend ret [expr int(rand()*$nRange)] | |
162 } | |
163 return $ret | |
164 } | |
165 #------------------------------------------------------------------------- | |
166 | |
167 proc database_op {} { | |
168 set i [expr int(rand()*2)] | |
169 if {$i==0} { | |
170 insert_rows [random_integers 100 1000] | |
171 } | |
172 if {$i==1} { | |
173 delete_rows [random_integers 100 1000] | |
174 set i [expr int(rand()*3)] | |
175 if {$i==0} { | |
176 sql {PRAGMA incremental_vacuum} | |
177 } | |
178 } | |
179 } | |
180 | |
181 proc savepoint_op {} { | |
182 set names {one two three four five} | |
183 set cmds {savepoint savepoint savepoint savepoint release rollback} | |
184 | |
185 set C [lindex $cmds [expr int(rand()*6)]] | |
186 set N [lindex $names [expr int(rand()*5)]] | |
187 | |
188 #puts stderr " $C $N ; " | |
189 #flush stderr | |
190 | |
191 $C $N | |
192 return ok | |
193 } | |
194 | |
195 expr srand(0) | |
196 | |
197 ############################################################################ | |
198 ############################################################################ | |
199 # Start of test cases. | |
200 | |
201 do_test savepoint6-1.1 { | |
202 sql $DATABASE_SCHEMA | |
203 } {} | |
204 do_test savepoint6-1.2 { | |
205 insert_rows { | |
206 497 166 230 355 779 588 394 317 290 475 362 193 805 851 564 | |
207 763 44 930 389 819 765 760 966 280 538 414 500 18 25 287 320 | |
208 30 382 751 87 283 981 429 630 974 421 270 810 405 | |
209 } | |
210 | |
211 savepoint one | |
212 insert_rows 858 | |
213 delete_rows 930 | |
214 savepoint two | |
215 execsql {PRAGMA incremental_vacuum} | |
216 savepoint three | |
217 insert_rows 144 | |
218 rollback three | |
219 rollback two | |
220 release one | |
221 | |
222 execsql {SELECT count(*) FROM t1} | |
223 } {44} | |
224 | |
225 foreach zSetup [list { | |
226 set testname normal | |
227 sqlite3 db test.db | |
228 } { | |
229 if {[wal_is_wal_mode]} continue | |
230 set testname tempdb | |
231 sqlite3 db "" | |
232 } { | |
233 if {[permutation] eq "journaltest"} { | |
234 continue | |
235 } | |
236 set testname nosync | |
237 sqlite3 db test.db | |
238 sql { PRAGMA synchronous = off } | |
239 } { | |
240 set testname smallcache | |
241 sqlite3 db test.db | |
242 sql { PRAGMA cache_size = 10 } | |
243 }] { | |
244 | |
245 unset -nocomplain ::lSavepoint | |
246 unset -nocomplain ::aEntry | |
247 | |
248 catch { db close } | |
249 forcedelete test.db test.db-wal test.db-journal | |
250 eval $zSetup | |
251 sql $DATABASE_SCHEMA | |
252 | |
253 wal_set_journal_mode | |
254 | |
255 do_test savepoint6-$testname.setup { | |
256 savepoint one | |
257 insert_rows [random_integers 100 1000] | |
258 release one | |
259 checkdb | |
260 } {ok} | |
261 | |
262 for {set i 0} {$i < $::G(savepoint6_iterations)} {incr i} { | |
263 do_test savepoint6-$testname.$i.1 { | |
264 savepoint_op | |
265 checkdb | |
266 } {ok} | |
267 | |
268 do_test savepoint6-$testname.$i.2 { | |
269 database_op | |
270 database_op | |
271 checkdb | |
272 } {ok} | |
273 } | |
274 | |
275 wal_check_journal_mode savepoint6-$testname.walok | |
276 } | |
277 | |
278 unset -nocomplain ::lSavepoint | |
279 unset -nocomplain ::aEntry | |
280 | |
281 finish_test | |
OLD | NEW |