savepoint6.test 6.7 KB

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