From 18657a960e125336f704ea058e25c27bd3900dcb Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Sun, 5 May 2024 19:28:19 +0200 Subject: Adding upstream version 3.40.1. Signed-off-by: Daniel Baumann --- test/savepoint6.test | 281 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 281 insertions(+) create mode 100644 test/savepoint6.test (limited to 'test/savepoint6.test') diff --git a/test/savepoint6.test b/test/savepoint6.test new file mode 100644 index 0000000..b1d0d46 --- /dev/null +++ b/test/savepoint6.test @@ -0,0 +1,281 @@ +# 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 -- cgit v1.2.3