-C Memory\sallocation\sfailure\sin\sBitvec\sare\sprobably\sall\sbenign.\s\sStill,\sadd\ncode\sto\scheck\sthis,\sjust\sto\sbe\ssure.\s(CVS\s6104)
-D 2009-01-02T21:39:39
+C Add\stest\sfile\ssavepoint6.test.\sContains\spseudo\srandom\stests\sof\ssavepoint\srelated\scommands.\s(CVS\s6105)
+D 2009-01-03T10:41:29
F Makefile.arm-wince-mingw32ce-gcc fcd5e9cd67fe88836360bb4f9ef4cb7f8e2fb5a0
F Makefile.in 05461a9b5803d5ad10c79f989801e9fd2cc3e592
F Makefile.linux-gcc d53183f4aa6a9192d249731c90dbdffbd2c68654
F test/printf.test 262a5acd3158f788e9bdf7f18d718f3af32ff6ef
F test/progress.test 5b075c3c790c7b2a61419bc199db87aaf48b8301 x
F test/ptrchng.test ef1aa72d6cf35a2bbd0869a649b744e9d84977fc
-F test/quick.test a244cd60117c07afaba2223bb025fd482ca13290
+F test/quick.test 9ab91798b047684f0dd26ee698920dbb69a30a10
F test/quote.test 215897dbe8de1a6f701265836d6601cc6ed103e6
F test/randexpr1.tcl 40dec52119ed3a2b8b2a773bce24b63a3a746459
F test/randexpr1.test 1084050991e9ba22c1c10edd8d84673b501cc25a
F test/savepoint3.test 1a0b1c0f59c6ae4402bfbca7cec29d4b1b272ff0
F test/savepoint4.test fd8850063e3c40565545f5c291e7f79a30591670
F test/savepoint5.test 0735db177e0ebbaedc39812c8d065075d563c4fd
+F test/savepoint6.test 4808a41d2426d96d2fd742573c374f1d3ba90c61
F test/schema.test a8b000723375fd42c68d310091bdbd744fde647c
F test/schema2.test 35e1c9696443d6694c8980c411497c2b5190d32e
F test/select1.test d0a4cad954fd41c030ec16ffbd2d08a4c0548742
F tool/speedtest2.tcl ee2149167303ba8e95af97873c575c3e0fab58ff
F tool/speedtest8.c 2902c46588c40b55661e471d7a86e4dd71a18224
F tool/speedtest8inst1.c 293327bc76823f473684d589a8160bde1f52c14e
-P 3e9efb763875b20c856d748c19e449080a3ae97c
-R fbb0f228e00217f5f89f33568f0e8c54
-U drh
-Z 9cf41e60e2f6cdb3d7a7b42a85a7af92
+P 4688e1c8b1203c3538aa862421ed344888059fe2
+R 31d99a8d501205effd4ffc0b8feb8587
+U danielk1977
+Z fec136a2b1f38279973feea5622497f3
--- /dev/null
+# 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.1 2009/01/03 10:41:29 danielk1977 Exp $
+
+set testdir [file dirname $argv0]
+source $testdir/tester.tcl
+
+do_test savepoint6-1.1 {
+ execsql {
+ PRAGMA auto_vacuum = incremental;
+ CREATE TABLE t1(x, y);
+ CREATE UNIQUE INDEX i1 ON t1(x);
+ CREATE INDEX i2 ON t1(y);
+ }
+} {}
+
+#--------------------------------------------------------------------------
+# 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 { db eval "SAVEPOINT $zName" }
+ lappend ::lSavepoint [list $zName [array get ::aEntry]]
+}
+
+proc rollback {zName} {
+ catch { db eval "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 { db eval "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
+ }
+ }
+}
+
+proc insert_rows {lX} {
+ foreach x $lX {
+ set y [x_to_y $x]
+
+ # Update database [db]
+ db eval {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]
+ db eval {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
+}
+#-------------------------------------------------------------------------
+
+db eval { PRAGMA cache_size = 10 }
+expr srand(0)
+
+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} {
+ db eval {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)]]
+
+ $C $N
+ return ok
+}
+
+do_test savepoint6-2.1 {
+ savepoint one
+ insert_rows [random_integers 100 1000]
+ release one
+ checkdb
+} {ok}
+
+for {set i 0} {$i < 1000} {incr i} {
+ do_test savepoint6-3.$i.1 {
+ savepoint_op
+ } {ok}
+
+ do_test savepoint6-3.$i.2 {
+ database_op
+ database_op
+ checkdb
+ } {ok}
+}
+
+unset -nocomplain ::lSavepoint
+unset -nocomplain ::aEntry
+
+finish_test
+
projects / thirdparty / sqlite.git / commitdiff
