282 lines
6.7 KiB
Plaintext
282 lines
6.7 KiB
Plaintext
# 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 ::savepoint6_iterations]} {
|
|
set ::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 {[catch {set ::permutations_test_prefix} z] == 0 && $z 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 }
|
|
file delete -force 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 < $::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
|