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>