xref: /sqlite-3.40.0/test/savepoint6.test (revision 4cd78b4d) 
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
14set testdir [file dirname $argv0]
15source $testdir/tester.tcl
16
17proc sql {zSql} {
18  uplevel db eval [list $zSql]
19  #puts stderr "$zSql ;"
20}
21
22set 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#--------------------------------------------------------------------------
30# In memory database state.
31#
32# ::lSavepoint is a list containing one entry for each active savepoint. The
33# first entry in the list corresponds to the most recently opened savepoint.
34# Each entry consists of two elements:
35#
36#   1. The savepoint name.
37#
38#   2. A serialized Tcl array representing the contents of table t1 at the
39#      start of the savepoint. The keys of the array are the x values. The
40#      values are the y values.
41#
42# Array ::aEntry contains the contents of database table t1. Array keys are
43# x values, the array data values are y values.
44#
45set lSavepoint [list]
46array set aEntry [list]
47
48proc x_to_y {x} {
49  set nChar [expr int(rand()*250) + 250]
50  set str " $nChar [string repeat $x. $nChar]"
51  string range $str 1 $nChar
52}
53#--------------------------------------------------------------------------
54
55#-------------------------------------------------------------------------
56# Procs to operate on database:
57#
58#   savepoint NAME
59#   rollback  NAME
60#   release   NAME
61#
62#   insert_rows XVALUES
63#   delete_rows XVALUES
64#
65proc savepoint {zName} {
66  catch { sql "SAVEPOINT $zName" }
67  lappend ::lSavepoint [list $zName [array get ::aEntry]]
68}
69
70proc rollback {zName} {
71  catch { sql "ROLLBACK TO $zName" }
72  for {set i [expr {[llength $::lSavepoint]-1}]} {$i>=0} {incr i -1} {
73    set zSavepoint [lindex $::lSavepoint $i 0]
74    if {$zSavepoint eq $zName} {
75      unset -nocomplain ::aEntry
76      array set ::aEntry [lindex $::lSavepoint $i 1]
77
78
79      if {$i+1 < [llength $::lSavepoint]} {
80        set ::lSavepoint [lreplace $::lSavepoint [expr $i+1] end]
81      }
82      break
83    }
84  }
85}
86
87proc release {zName} {
88  catch { sql "RELEASE $zName" }
89  for {set i [expr {[llength $::lSavepoint]-1}]} {$i>=0} {incr i -1} {
90    set zSavepoint [lindex $::lSavepoint $i 0]
91    if {$zSavepoint eq $zName} {
92      set ::lSavepoint [lreplace $::lSavepoint $i end]
93      break
94    }
95  }
96
97  if {[llength $::lSavepoint] == 0} {
98    #puts stderr "-- End of transaction!!!!!!!!!!!!!"
99  }
100}
101
102proc insert_rows {lX} {
103  foreach x $lX {
104    set y [x_to_y $x]
105
106    # Update database [db]
107    sql "INSERT OR REPLACE INTO t1 VALUES($x, '$y')"
108
109    # Update the Tcl database.
110    set ::aEntry($x) $y
111  }
112}
113
114proc delete_rows {lX} {
115  foreach x $lX {
116    # Update database [db]
117    sql "DELETE FROM t1 WHERE x = $x"
118
119    # Update the Tcl database.
120    unset -nocomplain ::aEntry($x)
121  }
122}
123#-------------------------------------------------------------------------
124
125#-------------------------------------------------------------------------
126# Proc to compare database content with the in-memory representation.
127#
128#   checkdb
129#
130proc checkdb {} {
131  set nEntry [db one {SELECT count(*) FROM t1}]
132  set nEntry2 [array size ::aEntry]
133  if {$nEntry != $nEntry2} {
134    error "$nEntry entries in database, $nEntry2 entries in array"
135  }
136  db eval {SELECT x, y FROM t1} {
137    if {![info exists ::aEntry($x)]} {
138      error "Entry $x exists in database, but not in array"
139    }
140    if {$::aEntry($x) ne $y} {
141      error "Entry $x is set to {$y} in database, {$::aEntry($x)} in array"
142    }
143  }
144
145  db eval { PRAGMA integrity_check }
146}
147#-------------------------------------------------------------------------
148
149#-------------------------------------------------------------------------
150# Proc to return random set of x values.
151#
152#   random_integers
153#
154proc random_integers {nRes nRange} {
155  set ret [list]
156  for {set i 0} {$i<$nRes} {incr i} {
157    lappend ret [expr int(rand()*$nRange)]
158  }
159  return $ret
160}
161#-------------------------------------------------------------------------
162
163proc database_op {} {
164  set i [expr int(rand()*2)]
165  if {$i==0} {
166    insert_rows [random_integers 100 1000]
167  }
168  if {$i==1} {
169    delete_rows [random_integers 100 1000]
170    set i [expr int(rand()*3)]
171    if {$i==0} {
172      sql {PRAGMA incremental_vacuum}
173    }
174  }
175}
176
177proc savepoint_op {} {
178  set names {one two three four five}
179  set cmds  {savepoint savepoint savepoint savepoint release rollback}
180
181  set C [lindex $cmds [expr int(rand()*6)]]
182  set N [lindex $names [expr int(rand()*5)]]
183
184  #puts stderr "   $C $N ;  "
185  #flush stderr
186
187  $C $N
188  return ok
189}
190
191expr srand(0)
192
193############################################################################
194############################################################################
195# Start of test cases.
196
197do_test savepoint6-1.1 {
198  sql $DATABASE_SCHEMA
199} {}
200do_test savepoint6-1.2 {
201  insert_rows {
202    497 166 230 355 779 588 394 317 290 475 362 193 805 851 564
203    763 44 930 389 819 765 760 966 280 538 414 500 18 25 287 320
204    30 382 751 87 283 981 429 630 974 421 270 810 405
205  }
206
207  savepoint one
208  insert_rows 858
209  delete_rows 930
210  savepoint two
211    execsql {PRAGMA incremental_vacuum}
212    savepoint three
213      insert_rows 144
214     rollback three
215    rollback two
216  release one
217
218  execsql {SELECT count(*) FROM t1}
219} {44}
220
221foreach zSetup [list {
222  set testname normal
223  sqlite3 db test.db
224} {
225  if {[wal_is_wal_mode]} continue
226  set testname tempdb
227  sqlite3 db ""
228} {
229  if {[catch {set ::permutations_test_prefix} z] == 0 && $z eq "journaltest"} {
230    continue
231  }
232  set testname nosync
233  sqlite3 db test.db
234  sql { PRAGMA synchronous = off }
235} {
236  set testname smallcache
237  sqlite3 db test.db
238  sql { PRAGMA cache_size = 10 }
239}] {
240
241  unset -nocomplain ::lSavepoint
242  unset -nocomplain ::aEntry
243
244  catch { db close }
245  file delete -force test.db test.db-wal test.db-journal
246  eval $zSetup
247  sql $DATABASE_SCHEMA
248
249  wal_set_journal_mode
250
251  do_test savepoint6-$testname.setup {
252    savepoint one
253    insert_rows [random_integers 100 1000]
254    release one
255    checkdb
256  } {ok}
257
258  for {set i 0} {$i < 50} {incr i} {
259    do_test savepoint6-$testname.$i.1 {
260      savepoint_op
261      checkdb
262    } {ok}
263
264    do_test savepoint6-$testname.$i.2 {
265      database_op
266      database_op
267      checkdb
268    } {ok}
269  }
270
271  wal_check_journal_mode savepoint6-$testname.walok
272}
273
274unset -nocomplain ::lSavepoint
275unset -nocomplain ::aEntry
276
277finish_test
278