Merge Chromium + Blink git repositories
[chromium-blink-merge.git] / third_party / sqlite / sqlite-src-3080704 / test / malloc_common.tcl
blobb586c88d1f0c91f6785ae2e3e2994163d640b5e7
1 # 2007 May 05
3 # The author disclaims copyright to this source code. In place of
4 # a legal notice, here is a blessing:
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.
10 #***********************************************************************
12 # This file contains common code used by many different malloc tests
13 # within the test suite.
15 # $Id: malloc_common.tcl,v 1.22 2008/09/23 16:41:30 danielk1977 Exp $
17 # If we did not compile with malloc testing enabled, then do nothing.
19 ifcapable builtin_test {
20 set MEMDEBUG 1
21 } else {
22 set MEMDEBUG 0
23 return 0
26 # Transient and persistent OOM errors:
28 set FAULTSIM(oom-transient) [list \
29 -injectstart {oom_injectstart 0} \
30 -injectstop oom_injectstop \
31 -injecterrlist {{1 {out of memory}}} \
33 set FAULTSIM(oom-persistent) [list \
34 -injectstart {oom_injectstart 1000000} \
35 -injectstop oom_injectstop \
36 -injecterrlist {{1 {out of memory}}} \
39 # Transient and persistent IO errors:
41 set FAULTSIM(ioerr-transient) [list \
42 -injectstart {ioerr_injectstart 0} \
43 -injectstop ioerr_injectstop \
44 -injecterrlist {{1 {disk I/O error}}} \
46 set FAULTSIM(ioerr-persistent) [list \
47 -injectstart {ioerr_injectstart 1} \
48 -injectstop ioerr_injectstop \
49 -injecterrlist {{1 {disk I/O error}}} \
52 # SQLITE_FULL errors (always persistent):
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 \
62 # Transient and persistent SHM errors:
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 \
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 \
79 # Transient and persistent CANTOPEN errors:
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 \
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 \
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 \
106 #--------------------------------------------------------------------------
107 # Usage do_faultsim_test NAME ?OPTIONS...?
109 # -faults List of fault types to simulate.
111 # -prep Script to execute before -body.
113 # -body Script to execute (with fault injection).
115 # -test Script to execute after -body.
117 # -install Script to execute after faultsim -injectinstall
119 # -uninstall Script to execute after faultsim -uninjectinstall
121 proc do_faultsim_test {name args} {
122 global FAULTSIM
124 foreach n [array names FAULTSIM] {
125 if {$n != "interrupt"} {lappend DEFAULT(-faults) $n}
127 set DEFAULT(-prep) ""
128 set DEFAULT(-body) ""
129 set DEFAULT(-test) ""
130 set DEFAULT(-install) ""
131 set DEFAULT(-uninstall) ""
133 fix_testname name
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" }
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]
148 set testspec [list -prep $O(-prep) -body $O(-body) \
149 -test $O(-test) -install $O(-install) -uninstall $O(-uninstall)
151 foreach f [lsort -unique $faultlist] {
152 eval do_one_faultsim_test "$name-$f" $FAULTSIM($f) $testspec
157 #-------------------------------------------------------------------------
158 # Procedures to save and restore the current file-system state:
160 # faultsim_save
161 # faultsim_restore
162 # faultsim_save_and_close
163 # faultsim_restore_and_reopen
164 # faultsim_delete_and_reopen
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
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
180 proc faultsim_integrity_check {{db db}} {
181 set ic [$db eval { PRAGMA integrity_check }]
182 if {$ic != "ok"} { error "Integrity check: $ic" }
186 # The following procs are used as [do_one_faultsim_test] callbacks when
187 # injecting OOM faults into test cases.
189 proc oom_injectstart {nRepeat iFail} {
190 sqlite3_memdebug_fail [expr $iFail-1] -repeat $nRepeat
192 proc oom_injectstop {} {
193 sqlite3_memdebug_fail -1
196 # The following procs are used as [do_one_faultsim_test] callbacks when
197 # injecting IO error faults into test cases.
199 proc ioerr_injectstart {persist iFail} {
200 set ::sqlite_io_error_persist $persist
201 set ::sqlite_io_error_pending $iFail
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
213 # The following procs are used as [do_one_faultsim_test] callbacks when
214 # injecting shared-memory related error faults into test cases.
216 proc shmerr_injectinstall {} {
217 testvfs shmfault -default true
218 shmfault filter {xShmOpen xShmMap xShmLock}
220 proc shmerr_injectuninstall {} {
221 catch {db close}
222 catch {db2 close}
223 shmfault delete
225 proc shmerr_injectstart {persist iFail} {
226 shmfault ioerr $iFail $persist
228 proc shmerr_injectstop {} {
229 shmfault ioerr
232 # The following procs are used as [do_one_faultsim_test] callbacks when
233 # injecting SQLITE_FULL error faults into test cases.
235 proc fullerr_injectinstall {} {
236 testvfs shmfault -default true
238 proc fullerr_injectuninstall {} {
239 catch {db close}
240 catch {db2 close}
241 shmfault delete
243 proc fullerr_injectstart {iFail} {
244 shmfault full $iFail 1
246 proc fullerr_injectstop {} {
247 shmfault full
250 # The following procs are used as [do_one_faultsim_test] callbacks when
251 # injecting SQLITE_CANTOPEN error faults into test cases.
253 proc cantopen_injectinstall {} {
254 testvfs shmfault -default true
256 proc cantopen_injectuninstall {} {
257 catch {db close}
258 catch {db2 close}
259 shmfault delete
261 proc cantopen_injectstart {persist iFail} {
262 shmfault cantopen $iFail $persist
264 proc cantopen_injectstop {} {
265 shmfault cantopen
268 # The following procs are used as [do_one_faultsim_test] callbacks
269 # when injecting SQLITE_INTERRUPT error faults into test cases.
271 proc interrupt_injectinstall {} {
273 proc interrupt_injectuninstall {} {
275 proc interrupt_injectstart {iFail} {
276 set ::sqlite_interrupt_count $iFail
278 proc interrupt_injectstop {} {
279 set res [expr $::sqlite_interrupt_count<=0]
280 set ::sqlite_interrupt_count 0
281 set res
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.
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"
297 #--------------------------------------------------------------------------
298 # Usage do_one_faultsim_test NAME ?OPTIONS...?
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.
304 # -injectstart Script to enable fault-injection.
306 # -injectstop Script to disable fault-injection.
308 # -injecterrlist List of generally acceptable test results (i.e. error
309 # messages). Example: [list {1 {out of memory}}]
311 # -injectinstall
313 # -injectuninstall
315 # -prep Script to execute before -body.
317 # -body Script to execute (with fault injection).
319 # -test Script to execute after -body.
321 proc do_one_faultsim_test {testname args} {
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) ""
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" }
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)]
345 eval $O(-injectinstall)
346 eval $O(-install)
348 set stop 0
349 for {set iFail 1} {!$stop} {incr iFail} {
351 # Evaluate the -prep script.
353 eval $O(-prep)
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.
359 eval $O(-injectstart) $iFail
360 set rc [catch $O(-body) res]
361 set nfail [eval $O(-injectstop)]
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).
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}
372 # If no faults where injected this trial, don't bother running
373 # any more. This test is finished.
375 if {$nfail==0} { set stop 1 }
378 eval $O(-uninstall)
379 eval $O(-injectuninstall)
382 # Usage: do_malloc_test <test number> <options...>
384 # The first argument, <test number>, is an integer used to name the
385 # tests executed by this proc. Options are as follows:
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.
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).
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.
406 proc do_malloc_test {tn args} {
407 array unset ::mallocopts
408 array set ::mallocopts $args
410 if {[string is integer $tn]} {
411 set tn malloc-$tn
412 catch { set tn $::testprefix-$tn }
414 if {[info exists ::mallocopts(-start)]} {
415 set start $::mallocopts(-start)
416 } else {
417 set start 0
419 if {[info exists ::mallocopts(-end)]} {
420 set end $::mallocopts(-end)
421 } else {
422 set end 50000
424 save_prng_state
426 foreach ::iRepeat {0 10000000} {
427 set ::go 1
428 for {set ::n $start} {$::go && $::n <= $end} {incr ::n} {
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.
435 set zRepeat "transient"
436 if {$::iRepeat} {set zRepeat "persistent"}
437 restore_prng_state
438 foreach file [glob -nocomplain test.db-mj*] {forcedelete $file}
440 do_test ${tn}.${zRepeat}.${::n} {
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].
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
457 catch { sqlite3 db test.db }
458 if {[info commands db] ne ""} {
459 sqlite3_extended_result_codes db 1
461 sqlite3_db_config_lookaside db 0 0 0
463 # Execute any -tclprep and -sqlprep scripts.
465 if {[info exists ::mallocopts(-tclprep)]} {
466 eval $::mallocopts(-tclprep)
468 if {[info exists ::mallocopts(-sqlprep)]} {
469 execsql $::mallocopts(-sqlprep)
472 # Now set the ${::n}th malloc() to fail and execute the -tclbody
473 # and -sqlbody scripts.
475 sqlite3_memdebug_fail $::n -repeat $::iRepeat
476 set ::mallocbody {}
477 if {[info exists ::mallocopts(-tclbody)]} {
478 append ::mallocbody "$::mallocopts(-tclbody)\n"
480 if {[info exists ::mallocopts(-sqlbody)]} {
481 append ::mallocbody "db eval {$::mallocopts(-sqlbody)}"
484 # The following block sets local variables as follows:
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.
490 set isFail [catch $::mallocbody msg]
491 set nFail [sqlite3_memdebug_fail -1 -benigncnt nBenign]
492 # puts -nonewline " (isFail=$isFail nFail=$nFail nBenign=$nBenign) "
494 # If one or more mallocs failed, run this loop body again.
496 set go [expr {$nFail>0}]
498 if {($nFail-$nBenign)==0} {
499 if {$isFail} {
500 set v2 $msg
501 } else {
502 set isFail 1
503 set v2 1
505 } elseif {!$isFail} {
506 set v2 $msg
507 } elseif {
508 [info command db]=="" ||
509 [db errorcode]==7 ||
510 $msg=="out of memory"
512 set v2 1
513 } else {
514 set v2 $msg
515 puts [db errorcode]
517 lappend isFail $v2
518 } {1 1}
520 if {[info exists ::mallocopts(-cleanup)]} {
521 catch [list uplevel #0 $::mallocopts(-cleanup)] msg
525 unset ::mallocopts
526 sqlite3_memdebug_fail -1
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].
537 # Example:
539 # do_select_test testcase-1.1 "SELECT 1+1, 1+2" {1 2}
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.
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.
551 proc do_select_test {name sql result} {
552 uplevel [list doPassiveTest 0 $name $sql [list 0 [list {*}$result]]]
555 proc do_restart_select_test {name sql result} {
556 uplevel [list doPassiveTest 1 $name $sql [list 0 $result]]
559 proc do_error_test {name sql error} {
560 uplevel [list doPassiveTest 0 $name $sql [list 1 $error]]
563 proc doPassiveTest {isRestart name sql catchres} {
564 if {![info exists ::DO_MALLOC_TEST]} { set ::DO_MALLOC_TEST 1 }
566 if {[info exists ::testprefix]
567 && [string is integer [string range $name 0 0]]
569 set name $::testprefix.$name
572 switch $::DO_MALLOC_TEST {
573 0 { # No malloc failures.
574 do_test $name [list set {} [uplevel [list catchsql $sql]]] $catchres
575 return
577 1 { # Simulate transient failures.
578 set nRepeat 1
579 set zName "transient"
580 set nStartLimit 100000
581 set nBackup 1
583 2 { # Simulate persistent failures.
584 set nRepeat 1
585 set zName "persistent"
586 set nStartLimit 100000
587 set nBackup 1
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
597 # The set of acceptable results from running [catchsql $sql].
599 set answers [list {1 {out of memory}} $catchres]
600 set str [join $answers " OR "]
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} {
607 if {$isRestart} { sqlite3 db test.db }
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
615 set nFail [sqlite3_memdebug_fail -1 -benigncnt nBenign]
622 #-------------------------------------------------------------------------
623 # Test a single write to the database. In this case a "write" is a
624 # DELETE, UPDATE or INSERT statement.
626 # If OOM testing is performed, there are several acceptable outcomes:
628 # 1) The write succeeds. No error is returned.
630 # 2) An "out of memory" exception is thrown and:
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).
638 # If the write operation eventually succeeds, zero is returned. If a
639 # transaction is rolled back, non-zero is returned.
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.
645 proc do_write_test {name tbl sql} {
646 if {![info exists ::DO_MALLOC_TEST]} { set ::DO_MALLOC_TEST 1 }
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"
652 # Calculate the initial table checksum.
653 set cksum1 [db one $cksumsql]
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}
662 } else {
663 set answers [list {0 {}}]
664 set modes [list 0 nofail]
666 set str [join $answers " OR "]
668 foreach {nRepeat zName} $modes {
669 for {set iFail 1} 1 {incr iFail} {
670 if {$::DO_MALLOC_TEST} {sqlite3_memdebug_fail $iFail -repeat $nRepeat}
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
681 do_test $name.$zName.$iFail [list set {} $res] $str
682 set cksum2 [db one $cksumsql]
683 if {$cksum1 != $cksum2} return