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 file delete -force 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 |