xref: /sqlite-3.40.0/test/savepoint6.test (revision dda70fe3) 
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  set testname tempdb
226  sqlite3 db ""
227} {
228  if {[catch {set ::permutations_test_prefix} z] == 0 && $z eq "journaltest"} {
229    continue
230  }
231  set testname nosync
232  sqlite3 db test.db
233  sql { PRAGMA synchronous = off }
234} {
235  set testname smallcache
236  sqlite3 db test.db
237  sql { PRAGMA cache_size = 10 }
238}] {
239
240  unset -nocomplain ::lSavepoint
241  unset -nocomplain ::aEntry
242
243  catch { db close }
244  file delete -force test.db
245  eval $zSetup
246  sql $DATABASE_SCHEMA
247
248  do_test savepoint6-$testname.setup {
249    savepoint one
250    insert_rows [random_integers 100 1000]
251    release one
252    checkdb
253  } {ok}
254
255  for {set i 0} {$i < 1000} {incr i} {
256    do_test savepoint6-$testname.$i.1 {
257      savepoint_op
258      checkdb
259    } {ok}
260
261    do_test savepoint6-$testname.$i.2 {
262      database_op
263      database_op
264      checkdb
265    } {ok}
266  }
267}
268
269unset -nocomplain ::lSavepoint
270unset -nocomplain ::aEntry
271
272finish_test
273