Annotation of embedaddon/sqlite3/test/savepoint6.test, revision 1.1
1.1 ! misho 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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>