123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281 |
- # 2009 January 3
- #
- # The author disclaims copyright to this source code. In place of
- # a legal notice, here is a blessing:
- #
- # May you do good and not evil.
- # May you find forgiveness for yourself and forgive others.
- # May you share freely, never taking more than you give.
- #
- #***********************************************************************
- #
- # $Id: savepoint6.test,v 1.4 2009/06/05 17:09:12 drh Exp $
- set testdir [file dirname $argv0]
- source $testdir/tester.tcl
- proc sql {zSql} {
- uplevel db eval [list $zSql]
- #puts stderr "$zSql ;"
- }
- set DATABASE_SCHEMA {
- PRAGMA auto_vacuum = incremental;
- CREATE TABLE t1(x, y);
- CREATE UNIQUE INDEX i1 ON t1(x);
- CREATE INDEX i2 ON t1(y);
- }
- if {0==[info exists ::G(savepoint6_iterations)]} {
- set ::G(savepoint6_iterations) 1000
- }
- #--------------------------------------------------------------------------
- # In memory database state.
- #
- # ::lSavepoint is a list containing one entry for each active savepoint. The
- # first entry in the list corresponds to the most recently opened savepoint.
- # Each entry consists of two elements:
- #
- # 1. The savepoint name.
- #
- # 2. A serialized Tcl array representing the contents of table t1 at the
- # start of the savepoint. The keys of the array are the x values. The
- # values are the y values.
- #
- # Array ::aEntry contains the contents of database table t1. Array keys are
- # x values, the array data values are y values.
- #
- set lSavepoint [list]
- array set aEntry [list]
- proc x_to_y {x} {
- set nChar [expr int(rand()*250) + 250]
- set str " $nChar [string repeat $x. $nChar]"
- string range $str 1 $nChar
- }
- #--------------------------------------------------------------------------
- #-------------------------------------------------------------------------
- # Procs to operate on database:
- #
- # savepoint NAME
- # rollback NAME
- # release NAME
- #
- # insert_rows XVALUES
- # delete_rows XVALUES
- #
- proc savepoint {zName} {
- catch { sql "SAVEPOINT $zName" }
- lappend ::lSavepoint [list $zName [array get ::aEntry]]
- }
- proc rollback {zName} {
- catch { sql "ROLLBACK TO $zName" }
- for {set i [expr {[llength $::lSavepoint]-1}]} {$i>=0} {incr i -1} {
- set zSavepoint [lindex $::lSavepoint $i 0]
- if {$zSavepoint eq $zName} {
- unset -nocomplain ::aEntry
- array set ::aEntry [lindex $::lSavepoint $i 1]
- if {$i+1 < [llength $::lSavepoint]} {
- set ::lSavepoint [lreplace $::lSavepoint [expr $i+1] end]
- }
- break
- }
- }
- }
- proc release {zName} {
- catch { sql "RELEASE $zName" }
- for {set i [expr {[llength $::lSavepoint]-1}]} {$i>=0} {incr i -1} {
- set zSavepoint [lindex $::lSavepoint $i 0]
- if {$zSavepoint eq $zName} {
- set ::lSavepoint [lreplace $::lSavepoint $i end]
- break
- }
- }
- if {[llength $::lSavepoint] == 0} {
- #puts stderr "-- End of transaction!!!!!!!!!!!!!"
- }
- }
- proc insert_rows {lX} {
- foreach x $lX {
- set y [x_to_y $x]
- # Update database [db]
- sql "INSERT OR REPLACE INTO t1 VALUES($x, '$y')"
- # Update the Tcl database.
- set ::aEntry($x) $y
- }
- }
- proc delete_rows {lX} {
- foreach x $lX {
- # Update database [db]
- sql "DELETE FROM t1 WHERE x = $x"
- # Update the Tcl database.
- unset -nocomplain ::aEntry($x)
- }
- }
- #-------------------------------------------------------------------------
- #-------------------------------------------------------------------------
- # Proc to compare database content with the in-memory representation.
- #
- # checkdb
- #
- proc checkdb {} {
- set nEntry [db one {SELECT count(*) FROM t1}]
- set nEntry2 [array size ::aEntry]
- if {$nEntry != $nEntry2} {
- error "$nEntry entries in database, $nEntry2 entries in array"
- }
- db eval {SELECT x, y FROM t1} {
- if {![info exists ::aEntry($x)]} {
- error "Entry $x exists in database, but not in array"
- }
- if {$::aEntry($x) ne $y} {
- error "Entry $x is set to {$y} in database, {$::aEntry($x)} in array"
- }
- }
- db eval { PRAGMA integrity_check }
- }
- #-------------------------------------------------------------------------
- #-------------------------------------------------------------------------
- # Proc to return random set of x values.
- #
- # random_integers
- #
- proc random_integers {nRes nRange} {
- set ret [list]
- for {set i 0} {$i<$nRes} {incr i} {
- lappend ret [expr int(rand()*$nRange)]
- }
- return $ret
- }
- #-------------------------------------------------------------------------
- proc database_op {} {
- set i [expr int(rand()*2)]
- if {$i==0} {
- insert_rows [random_integers 100 1000]
- }
- if {$i==1} {
- delete_rows [random_integers 100 1000]
- set i [expr int(rand()*3)]
- if {$i==0} {
- sql {PRAGMA incremental_vacuum}
- }
- }
- }
- proc savepoint_op {} {
- set names {one two three four five}
- set cmds {savepoint savepoint savepoint savepoint release rollback}
- set C [lindex $cmds [expr int(rand()*6)]]
- set N [lindex $names [expr int(rand()*5)]]
- #puts stderr " $C $N ; "
- #flush stderr
- $C $N
- return ok
- }
- expr srand(0)
- ############################################################################
- ############################################################################
- # Start of test cases.
- do_test savepoint6-1.1 {
- sql $DATABASE_SCHEMA
- } {}
- do_test savepoint6-1.2 {
- insert_rows {
- 497 166 230 355 779 588 394 317 290 475 362 193 805 851 564
- 763 44 930 389 819 765 760 966 280 538 414 500 18 25 287 320
- 30 382 751 87 283 981 429 630 974 421 270 810 405
- }
- savepoint one
- insert_rows 858
- delete_rows 930
- savepoint two
- execsql {PRAGMA incremental_vacuum}
- savepoint three
- insert_rows 144
- rollback three
- rollback two
- release one
- execsql {SELECT count(*) FROM t1}
- } {44}
- foreach zSetup [list {
- set testname normal
- sqlite3 db test.db
- } {
- if {[wal_is_wal_mode]} continue
- set testname tempdb
- sqlite3 db ""
- } {
- if {[permutation] eq "journaltest"} {
- continue
- }
- set testname nosync
- sqlite3 db test.db
- sql { PRAGMA synchronous = off }
- } {
- set testname smallcache
- sqlite3 db test.db
- sql { PRAGMA cache_size = 10 }
- }] {
- unset -nocomplain ::lSavepoint
- unset -nocomplain ::aEntry
- catch { db close }
- forcedelete test.db test.db-wal test.db-journal
- eval $zSetup
- sql $DATABASE_SCHEMA
- wal_set_journal_mode
- do_test savepoint6-$testname.setup {
- savepoint one
- insert_rows [random_integers 100 1000]
- release one
- checkdb
- } {ok}
-
- for {set i 0} {$i < $::G(savepoint6_iterations)} {incr i} {
- do_test savepoint6-$testname.$i.1 {
- savepoint_op
- checkdb
- } {ok}
-
- do_test savepoint6-$testname.$i.2 {
- database_op
- database_op
- checkdb
- } {ok}
- }
- wal_check_journal_mode savepoint6-$testname.walok
- }
- unset -nocomplain ::lSavepoint
- unset -nocomplain ::aEntry
- finish_test
|