test/savepoint6.test

   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