third_party/sqlite/src/test/malloc_common.tcl

   1 # 2007 May 05
   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 # This file contains common code used by many different malloc tests
  13 # within the test suite.
  14 #
  15 # $Id: malloc_common.tcl,v 1.22 2008/09/23 16:41:30 danielk1977 Exp $
  16
  17 # If we did not compile with malloc testing enabled, then do nothing.
  18 #
  19 ifcapable builtin_test {
  20   set MEMDEBUG 1
  21 } else {
  22   set MEMDEBUG 0
  23   return 0
  24 }
  25
  26 # Transient and persistent OOM errors:
  27 #
  28 set FAULTSIM(oom-transient) [list          \
  29   -injectstart   {oom_injectstart 0}       \
  30   -injectstop    oom_injectstop            \
  31   -injecterrlist {{1 {out of memory}}}     \
  32 ]
  33 set FAULTSIM(oom-persistent) [list         \
  34   -injectstart {oom_injectstart 1000000}   \
  35   -injectstop oom_injectstop               \
  36   -injecterrlist {{1 {out of memory}}}     \
  37 ]
  38
  39 # Transient and persistent IO errors:
  40 #
  41 set FAULTSIM(ioerr-transient) [list        \
  42   -injectstart   {ioerr_injectstart 0}     \
  43   -injectstop    ioerr_injectstop          \
  44   -injecterrlist {{1 {disk I/O error}}}    \
  45 ]
  46 set FAULTSIM(ioerr-persistent) [list       \
  47   -injectstart   {ioerr_injectstart 1}     \
  48   -injectstop    ioerr_injectstop          \
  49   -injecterrlist {{1 {disk I/O error}}}    \
  50 ]
  51
  52 # SQLITE_FULL errors (always persistent):
  53 #
  54 set FAULTSIM(full) [list                   \
  55   -injectinstall   fullerr_injectinstall   \
  56   -injectstart     fullerr_injectstart     \
  57   -injectstop      fullerr_injectstop      \
  58   -injecterrlist   {{1 {database or disk is full}}} \
  59   -injectuninstall fullerr_injectuninstall \
  60 ]
  61
  62 # Transient and persistent SHM errors:
  63 #
  64 set FAULTSIM(shmerr-transient) [list       \
  65   -injectinstall   shmerr_injectinstall    \
  66   -injectstart     {shmerr_injectstart 0}  \
  67   -injectstop      shmerr_injectstop       \
  68   -injecterrlist   {{1 {disk I/O error}}}  \
  69   -injectuninstall shmerr_injectuninstall  \
  70 ]
  71 set FAULTSIM(shmerr-persistent) [list      \
  72   -injectinstall   shmerr_injectinstall    \
  73   -injectstart     {shmerr_injectstart 1}  \
  74   -injectstop      shmerr_injectstop       \
  75   -injecterrlist   {{1 {disk I/O error}}}  \
  76   -injectuninstall shmerr_injectuninstall  \
  77 ]
  78
  79 # Transient and persistent CANTOPEN errors:
  80 #
  81 set FAULTSIM(cantopen-transient) [list       \
  82   -injectinstall   cantopen_injectinstall    \
  83   -injectstart     {cantopen_injectstart 0}  \
  84   -injectstop      cantopen_injectstop       \
  85   -injecterrlist   {{1 {unable to open database file}}}  \
  86   -injectuninstall cantopen_injectuninstall  \
  87 ]
  88 set FAULTSIM(cantopen-persistent) [list      \
  89   -injectinstall   cantopen_injectinstall    \
  90   -injectstart     {cantopen_injectstart 1}  \
  91   -injectstop      cantopen_injectstop       \
  92   -injecterrlist   {{1 {unable to open database file}}}  \
  93   -injectuninstall cantopen_injectuninstall  \
  94 ]
  95
  96 set FAULTSIM(interrupt) [list                 \
  97   -injectinstall   interrupt_injectinstall    \
  98   -injectstart     interrupt_injectstart      \
  99   -injectstop      interrupt_injectstop       \
 100   -injecterrlist   {{1 interrupted} {1 interrupt}}        \
 101   -injectuninstall interrupt_injectuninstall  \
 102 ]
 103
 104
 105
 106 #--------------------------------------------------------------------------
 107 # Usage do_faultsim_test NAME ?OPTIONS...?
 108 #
 109 #     -faults           List of fault types to simulate.
 110 #
 111 #     -prep             Script to execute before -body.
 112 #
 113 #     -body             Script to execute (with fault injection).
 114 #
 115 #     -test             Script to execute after -body.
 116 #
 117 #     -install          Script to execute after faultsim -injectinstall
 118 #
 119 #     -uninstall        Script to execute after faultsim -uninjectinstall
 120 #
 121 proc do_faultsim_test {name args} {
 122   global FAULTSIM
 123
 124   foreach n [array names FAULTSIM] {
 125     if {$n != "interrupt"} {lappend DEFAULT(-faults) $n}
 126   }
 127   set DEFAULT(-prep)          ""
 128   set DEFAULT(-body)          ""
 129   set DEFAULT(-test)          ""
 130   set DEFAULT(-install)       ""
 131   set DEFAULT(-uninstall)     ""
 132
 133   fix_testname name
 134
 135   array set O [array get DEFAULT]
 136   array set O $args
 137   foreach o [array names O] {
 138     if {[info exists DEFAULT($o)]==0} { error "unknown option: $o" }
 139   }
 140
 141   set faultlist [list]
 142   foreach f $O(-faults) {
 143     set flist [array names FAULTSIM $f]
 144     if {[llength $flist]==0} { error "unknown fault: $f" }
 145     set faultlist [concat $faultlist $flist]
 146   }
 147
 148   set testspec [list -prep $O(-prep) -body $O(-body) \
 149       -test $O(-test) -install $O(-install) -uninstall $O(-uninstall)
 150   ]
 151   foreach f [lsort -unique $faultlist] {
 152     eval do_one_faultsim_test "$name-$f" $FAULTSIM($f) $testspec
 153   }
 154 }
 155
 156
 157 #-------------------------------------------------------------------------
 158 # Procedures to save and restore the current file-system state:
 159 #
 160 #   faultsim_save
 161 #   faultsim_restore
 162 #   faultsim_save_and_close
 163 #   faultsim_restore_and_reopen
 164 #   faultsim_delete_and_reopen
 165 #
 166 proc faultsim_save {args} { uplevel db_save $args }
 167 proc faultsim_save_and_close {args} { uplevel db_save_and_close $args }
 168 proc faultsim_restore {args} { uplevel db_restore $args }
 169 proc faultsim_restore_and_reopen {args} {
 170   uplevel db_restore_and_reopen $args
 171   sqlite3_extended_result_codes db 1
 172   sqlite3_db_config_lookaside db 0 0 0
 173 }
 174 proc faultsim_delete_and_reopen {args} {
 175   uplevel db_delete_and_reopen $args
 176   sqlite3_extended_result_codes db 1
 177   sqlite3_db_config_lookaside db 0 0 0
 178 }
 179
 180 proc faultsim_integrity_check {{db db}} {
 181   set ic [$db eval { PRAGMA integrity_check }]
 182   if {$ic != "ok"} { error "Integrity check: $ic" }
 183 }
 184
 185
 186 # The following procs are used as [do_one_faultsim_test] callbacks when
 187 # injecting OOM faults into test cases.
 188 #
 189 proc oom_injectstart {nRepeat iFail} {
 190   sqlite3_memdebug_fail [expr $iFail-1] -repeat $nRepeat
 191 }
 192 proc oom_injectstop {} {
 193   sqlite3_memdebug_fail -1
 194 }
 195
 196 # The following procs are used as [do_one_faultsim_test] callbacks when
 197 # injecting IO error faults into test cases.
 198 #
 199 proc ioerr_injectstart {persist iFail} {
 200   set ::sqlite_io_error_persist $persist
 201   set ::sqlite_io_error_pending $iFail
 202 }
 203 proc ioerr_injectstop {} {
 204   set sv $::sqlite_io_error_hit
 205   set ::sqlite_io_error_persist 0
 206   set ::sqlite_io_error_pending 0
 207   set ::sqlite_io_error_hardhit 0
 208   set ::sqlite_io_error_hit     0
 209   set ::sqlite_io_error_pending 0
 210   return $sv
 211 }
 212
 213 # The following procs are used as [do_one_faultsim_test] callbacks when
 214 # injecting shared-memory related error faults into test cases.
 215 #
 216 proc shmerr_injectinstall {} {
 217   testvfs shmfault -default true
 218   shmfault filter {xShmOpen xShmMap xShmLock}
 219 }
 220 proc shmerr_injectuninstall {} {
 221   catch {db  close}
 222   catch {db2 close}
 223   shmfault delete
 224 }
 225 proc shmerr_injectstart {persist iFail} {
 226   shmfault ioerr $iFail $persist
 227 }
 228 proc shmerr_injectstop {} {
 229   shmfault ioerr
 230 }
 231
 232 # The following procs are used as [do_one_faultsim_test] callbacks when
 233 # injecting SQLITE_FULL error faults into test cases.
 234 #
 235 proc fullerr_injectinstall {} {
 236   testvfs shmfault -default true
 237 }
 238 proc fullerr_injectuninstall {} {
 239   catch {db  close}
 240   catch {db2 close}
 241   shmfault delete
 242 }
 243 proc fullerr_injectstart {iFail} {
 244   shmfault full $iFail 1
 245 }
 246 proc fullerr_injectstop {} {
 247   shmfault full
 248 }
 249
 250 # The following procs are used as [do_one_faultsim_test] callbacks when
 251 # injecting SQLITE_CANTOPEN error faults into test cases.
 252 #
 253 proc cantopen_injectinstall {} {
 254   testvfs shmfault -default true
 255 }
 256 proc cantopen_injectuninstall {} {
 257   catch {db  close}
 258   catch {db2 close}
 259   shmfault delete
 260 }
 261 proc cantopen_injectstart {persist iFail} {
 262   shmfault cantopen $iFail $persist
 263 }
 264 proc cantopen_injectstop {} {
 265   shmfault cantopen
 266 }
 267
 268 # The following procs are used as [do_one_faultsim_test] callbacks
 269 # when injecting SQLITE_INTERRUPT error faults into test cases.
 270 #
 271 proc interrupt_injectinstall {} {
 272 }
 273 proc interrupt_injectuninstall {} {
 274 }
 275 proc interrupt_injectstart {iFail} {
 276   set ::sqlite_interrupt_count $iFail
 277 }
 278 proc interrupt_injectstop {} {
 279   set res [expr $::sqlite_interrupt_count<=0]
 280   set ::sqlite_interrupt_count 0
 281   set res
 282 }
 283
 284 # This command is not called directly. It is used by the
 285 # [faultsim_test_result] command created by [do_faultsim_test] and used
 286 # by -test scripts.
 287 #
 288 proc faultsim_test_result_int {args} {
 289   upvar testrc testrc testresult testresult testnfail testnfail
 290   set t [list $testrc $testresult]
 291   set r $args
 292   if { ($testnfail==0 && $t != [lindex $r 0]) || [lsearch $r $t]<0 } {
 293     error "nfail=$testnfail rc=$testrc result=$testresult list=$r"
 294   }
 295 }
 296
 297 #--------------------------------------------------------------------------
 298 # Usage do_one_faultsim_test NAME ?OPTIONS...?
 299 #
 300 # The first argument, <test number>, is used as a prefix of the test names
 301 # taken by tests executed by this command. Options are as follows. All
 302 # options take a single argument.
 303 #
 304 #     -injectstart      Script to enable fault-injection.
 305 #
 306 #     -injectstop       Script to disable fault-injection.
 307 #
 308 #     -injecterrlist    List of generally acceptable test results (i.e. error
 309 #                       messages). Example: [list {1 {out of memory}}]
 310 #
 311 #     -injectinstall
 312 #
 313 #     -injectuninstall
 314 #
 315 #     -prep             Script to execute before -body.
 316 #
 317 #     -body             Script to execute (with fault injection).
 318 #
 319 #     -test             Script to execute after -body.
 320 #
 321 proc do_one_faultsim_test {testname args} {
 322
 323   set DEFAULT(-injectstart)     "expr"
 324   set DEFAULT(-injectstop)      "expr 0"
 325   set DEFAULT(-injecterrlist)   [list]
 326   set DEFAULT(-injectinstall)   ""
 327   set DEFAULT(-injectuninstall) ""
 328   set DEFAULT(-prep)            ""
 329   set DEFAULT(-body)            ""
 330   set DEFAULT(-test)            ""
 331   set DEFAULT(-install)         ""
 332   set DEFAULT(-uninstall)       ""
 333
 334   array set O [array get DEFAULT]
 335   array set O $args
 336   foreach o [array names O] {
 337     if {[info exists DEFAULT($o)]==0} { error "unknown option: $o" }
 338   }
 339
 340   proc faultsim_test_proc {testrc testresult testnfail} $O(-test)
 341   proc faultsim_test_result {args} "
 342     uplevel faultsim_test_result_int \$args [list $O(-injecterrlist)]
 343   "
 344
 345   eval $O(-injectinstall)
 346   eval $O(-install)
 347
 348   set stop 0
 349   for {set iFail 1} {!$stop} {incr iFail} {
 350
 351     # Evaluate the -prep script.
 352     #
 353     eval $O(-prep)
 354
 355     # Start the fault-injection. Run the -body script. Stop the fault
 356     # injection. Local var $nfail is set to the total number of faults
 357     # injected into the system this trial.
 358     #
 359     eval $O(-injectstart) $iFail
 360     set rc [catch $O(-body) res]
 361     set nfail [eval $O(-injectstop)]
 362
 363     # Run the -test script. If it throws no error, consider this trial
 364     # sucessful. If it does throw an error, cause a [do_test] test to
 365     # fail (and print out the unexpected exception thrown by the -test
 366     # script at the same time).
 367     #
 368     set rc [catch [list faultsim_test_proc $rc $res $nfail] res]
 369     if {$rc == 0} {set res ok}
 370     do_test $testname.$iFail [list list $rc $res] {0 ok}
 371
 372     # If no faults where injected this trial, don't bother running
 373     # any more. This test is finished.
 374     #
 375     if {$nfail==0} { set stop 1 }
 376   }
 377
 378   eval $O(-uninstall)
 379   eval $O(-injectuninstall)
 380 }
 381
 382 # Usage: do_malloc_test <test number> <options...>
 383 #
 384 # The first argument, <test number>, is an integer used to name the
 385 # tests executed by this proc. Options are as follows:
 386 #
 387 #     -tclprep          TCL script to run to prepare test.
 388 #     -sqlprep          SQL script to run to prepare test.
 389 #     -tclbody          TCL script to run with malloc failure simulation.
 390 #     -sqlbody          TCL script to run with malloc failure simulation.
 391 #     -cleanup          TCL script to run after the test.
 392 #
 393 # This command runs a series of tests to verify SQLite's ability
 394 # to handle an out-of-memory condition gracefully. It is assumed
 395 # that if this condition occurs a malloc() call will return a
 396 # NULL pointer. Linux, for example, doesn't do that by default. See
 397 # the "BUGS" section of malloc(3).
 398 #
 399 # Each iteration of a loop, the TCL commands in any argument passed
 400 # to the -tclbody switch, followed by the SQL commands in any argument
 401 # passed to the -sqlbody switch are executed. Each iteration the
 402 # Nth call to sqliteMalloc() is made to fail, where N is increased
 403 # each time the loop runs starting from 1. When all commands execute
 404 # successfully, the loop ends.
 405 #
 406 proc do_malloc_test {tn args} {
 407   array unset ::mallocopts
 408   array set ::mallocopts $args
 409
 410   if {[string is integer $tn]} {
 411     set tn malloc-$tn
 412     catch { set tn $::testprefix-$tn }
 413   }
 414   if {[info exists ::mallocopts(-start)]} {
 415     set start $::mallocopts(-start)
 416   } else {
 417     set start 0
 418   }
 419   if {[info exists ::mallocopts(-end)]} {
 420     set end $::mallocopts(-end)
 421   } else {
 422     set end 50000
 423   }
 424   save_prng_state
 425
 426   foreach ::iRepeat {0 10000000} {
 427     set ::go 1
 428     for {set ::n $start} {$::go && $::n <= $end} {incr ::n} {
 429
 430       # If $::iRepeat is 0, then the malloc() failure is transient - it
 431       # fails and then subsequent calls succeed. If $::iRepeat is 1,
 432       # then the failure is persistent - once malloc() fails it keeps
 433       # failing.
 434       #
 435       set zRepeat "transient"
 436       if {$::iRepeat} {set zRepeat "persistent"}
 437       restore_prng_state
 438       foreach file [glob -nocomplain test.db-mj*] {forcedelete $file}
 439
 440       do_test ${tn}.${zRepeat}.${::n} {
 441
 442         # Remove all traces of database files test.db and test2.db
 443         # from the file-system. Then open (empty database) "test.db"
 444         # with the handle [db].
 445         #
 446         catch {db close}
 447         catch {db2 close}
 448         forcedelete test.db
 449         forcedelete test.db-journal
 450         forcedelete test.db-wal
 451         forcedelete test2.db
 452         forcedelete test2.db-journal
 453         forcedelete test2.db-wal
 454         if {[info exists ::mallocopts(-testdb)]} {
 455           copy_file $::mallocopts(-testdb) test.db
 456         }
 457         catch { sqlite3 db test.db }
 458         if {[info commands db] ne ""} {
 459           sqlite3_extended_result_codes db 1
 460         }
 461         sqlite3_db_config_lookaside db 0 0 0
 462
 463         # Execute any -tclprep and -sqlprep scripts.
 464         #
 465         if {[info exists ::mallocopts(-tclprep)]} {
 466           eval $::mallocopts(-tclprep)
 467         }
 468         if {[info exists ::mallocopts(-sqlprep)]} {
 469           execsql $::mallocopts(-sqlprep)
 470         }
 471
 472         # Now set the ${::n}th malloc() to fail and execute the -tclbody
 473         # and -sqlbody scripts.
 474         #
 475         sqlite3_memdebug_fail $::n -repeat $::iRepeat
 476         set ::mallocbody {}
 477         if {[info exists ::mallocopts(-tclbody)]} {
 478           append ::mallocbody "$::mallocopts(-tclbody)\n"
 479         }
 480         if {[info exists ::mallocopts(-sqlbody)]} {
 481           append ::mallocbody "db eval {$::mallocopts(-sqlbody)}"
 482         }
 483
 484         # The following block sets local variables as follows:
 485         #
 486         #     isFail  - True if an error (any error) was reported by sqlite.
 487         #     nFail   - The total number of simulated malloc() failures.
 488         #     nBenign - The number of benign simulated malloc() failures.
 489         #
 490         set isFail [catch $::mallocbody msg]
 491         set nFail [sqlite3_memdebug_fail -1 -benigncnt nBenign]
 492         # puts -nonewline " (isFail=$isFail nFail=$nFail nBenign=$nBenign) "
 493
 494         # If one or more mallocs failed, run this loop body again.
 495         #
 496         set go [expr {$nFail>0}]
 497
 498         if {($nFail-$nBenign)==0} {
 499           if {$isFail} {
 500             set v2 $msg
 501           } else {
 502             set isFail 1
 503             set v2 1
 504           }
 505         } elseif {!$isFail} {
 506           set v2 $msg
 507         } elseif {
 508           [info command db]=="" ||
 509           [db errorcode]==7 ||
 510           $msg=="out of memory"
 511         } {
 512           set v2 1
 513         } else {
 514           set v2 $msg
 515           puts [db errorcode]
 516         }
 517         lappend isFail $v2
 518       } {1 1}
 519
 520       if {[info exists ::mallocopts(-cleanup)]} {
 521         catch [list uplevel #0 $::mallocopts(-cleanup)] msg
 522       }
 523     }
 524   }
 525   unset ::mallocopts
 526   sqlite3_memdebug_fail -1
 527 }
 528
 529
 530 #-------------------------------------------------------------------------
 531 # This proc is used to test a single SELECT statement. Parameter $name is
 532 # passed a name for the test case (i.e. "fts3_malloc-1.4.1") and parameter
 533 # $sql is passed the text of the SELECT statement. Parameter $result is
 534 # set to the expected output if the SELECT statement is successfully
 535 # executed using [db eval].
 536 #
 537 # Example:
 538 #
 539 #   do_select_test testcase-1.1 "SELECT 1+1, 1+2" {1 2}
 540 #
 541 # If global variable DO_MALLOC_TEST is set to a non-zero value, or if
 542 # it is not defined at all, then OOM testing is performed on the SELECT
 543 # statement. Each OOM test case is said to pass if either (a) executing
 544 # the SELECT statement succeeds and the results match those specified
 545 # by parameter $result, or (b) TCL throws an "out of memory" error.
 546 #
 547 # If DO_MALLOC_TEST is defined and set to zero, then the SELECT statement
 548 # is executed just once. In this case the test case passes if the results
 549 # match the expected results passed via parameter $result.
 550 #
 551 proc do_select_test {name sql result} {
 552   uplevel [list doPassiveTest 0 $name $sql [list 0 [list {*}$result]]]
 553 }
 554
 555 proc do_restart_select_test {name sql result} {
 556   uplevel [list doPassiveTest 1 $name $sql [list 0 $result]]
 557 }
 558
 559 proc do_error_test {name sql error} {
 560   uplevel [list doPassiveTest 0 $name $sql [list 1 $error]]
 561 }
 562
 563 proc doPassiveTest {isRestart name sql catchres} {
 564   if {![info exists ::DO_MALLOC_TEST]} { set ::DO_MALLOC_TEST 1 }
 565
 566   if {[info exists ::testprefix]
 567    && [string is integer [string range $name 0 0]]
 568   } {
 569     set name $::testprefix.$name
 570   }
 571
 572   switch $::DO_MALLOC_TEST {
 573     0 { # No malloc failures.
 574       do_test $name [list set {} [uplevel [list catchsql $sql]]] $catchres
 575       return
 576     }
 577     1 { # Simulate transient failures.
 578       set nRepeat 1
 579       set zName "transient"
 580       set nStartLimit 100000
 581       set nBackup 1
 582     }
 583     2 { # Simulate persistent failures.
 584       set nRepeat 1
 585       set zName "persistent"
 586       set nStartLimit 100000
 587       set nBackup 1
 588     }
 589     3 { # Simulate transient failures with extra brute force.
 590       set nRepeat 100000
 591       set zName "ridiculous"
 592       set nStartLimit 1
 593       set nBackup 10
 594     }
 595   }
 596
 597   # The set of acceptable results from running [catchsql $sql].
 598   #
 599   set answers [list {1 {out of memory}} $catchres]
 600   set str [join $answers " OR "]
 601
 602   set nFail 1
 603   for {set iLimit $nStartLimit} {$nFail} {incr iLimit} {
 604     for {set iFail 1} {$nFail && $iFail<=$iLimit} {incr iFail} {
 605       for {set iTest 0} {$iTest<$nBackup && ($iFail-$iTest)>0} {incr iTest} {
 606
 607         if {$isRestart} { sqlite3 db test.db }
 608
 609         sqlite3_memdebug_fail [expr $iFail-$iTest] -repeat $nRepeat
 610         set res [uplevel [list catchsql $sql]]
 611         if {[lsearch -exact $answers $res]>=0} { set res $str }
 612         set testname "$name.$zName.$iFail"
 613         do_test "$name.$zName.$iLimit.$iFail" [list set {} $res] $str
 614
 615         set nFail [sqlite3_memdebug_fail -1 -benigncnt nBenign]
 616       }
 617     }
 618   }
 619 }
 620
 621
 622 #-------------------------------------------------------------------------
 623 # Test a single write to the database. In this case a  "write" is a
 624 # DELETE, UPDATE or INSERT statement.
 625 #
 626 # If OOM testing is performed, there are several acceptable outcomes:
 627 #
 628 #   1) The write succeeds. No error is returned.
 629 #
 630 #   2) An "out of memory" exception is thrown and:
 631 #
 632 #     a) The statement has no effect, OR
 633 #     b) The current transaction is rolled back, OR
 634 #     c) The statement succeeds. This can only happen if the connection
 635 #        is in auto-commit mode (after the statement is executed, so this
 636 #        includes COMMIT statements).
 637 #
 638 # If the write operation eventually succeeds, zero is returned. If a
 639 # transaction is rolled back, non-zero is returned.
 640 #
 641 # Parameter $name is the name to use for the test case (or test cases).
 642 # The second parameter, $tbl, should be the name of the database table
 643 # being modified. Parameter $sql contains the SQL statement to test.
 644 #
 645 proc do_write_test {name tbl sql} {
 646   if {![info exists ::DO_MALLOC_TEST]} { set ::DO_MALLOC_TEST 1 }
 647
 648   # Figure out an statement to get a checksum for table $tbl.
 649   db eval "SELECT * FROM $tbl" V break
 650   set cksumsql "SELECT md5sum([join [concat rowid $V(*)] ,]) FROM $tbl"
 651
 652   # Calculate the initial table checksum.
 653   set cksum1 [db one $cksumsql]
 654
 655   if {$::DO_MALLOC_TEST } {
 656     set answers [list {1 {out of memory}} {0 {}}]
 657     if {$::DO_MALLOC_TEST==1} {
 658       set modes {100000 persistent}
 659     } else {
 660       set modes {1 transient}
 661     }
 662   } else {
 663     set answers [list {0 {}}]
 664     set modes [list 0 nofail]
 665   }
 666   set str [join $answers " OR "]
 667
 668   foreach {nRepeat zName} $modes {
 669     for {set iFail 1} 1 {incr iFail} {
 670       if {$::DO_MALLOC_TEST} {sqlite3_memdebug_fail $iFail -repeat $nRepeat}
 671
 672       set res [uplevel [list catchsql $sql]]
 673       set nFail [sqlite3_memdebug_fail -1 -benigncnt nBenign]
 674       if {$nFail==0} {
 675         do_test $name.$zName.$iFail [list set {} $res] {0 {}}
 676         return
 677       } else {
 678         if {[lsearch $answers $res]>=0} {
 679           set res $str
 680         }
 681         do_test $name.$zName.$iFail [list set {} $res] $str
 682         set cksum2 [db one $cksumsql]
 683         if {$cksum1 != $cksum2} return
 684       }
 685     }
 686   }
 687 }