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.1.1.1 2012/02/21 17:04:16 misho 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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to savepoint6.test CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / sqlite3 / test