/trunk/test/malloc_common.tcl |
@@ -0,0 +1,660 @@ |
# 2007 May 05 |
# |
# The author disclaims copyright to this source code. In place of |
# a legal notice, here is a blessing: |
# |
# May you do good and not evil. |
# May you find forgiveness for yourself and forgive others. |
# May you share freely, never taking more than you give. |
# |
#*********************************************************************** |
# |
# This file contains common code used by many different malloc tests |
# within the test suite. |
# |
# $Id: malloc_common.tcl,v 1.22 2008/09/23 16:41:30 danielk1977 Exp $ |
|
# If we did not compile with malloc testing enabled, then do nothing. |
# |
ifcapable builtin_test { |
set MEMDEBUG 1 |
} else { |
set MEMDEBUG 0 |
return 0 |
} |
|
# Transient and persistent OOM errors: |
# |
set FAULTSIM(oom-transient) [list \ |
-injectstart {oom_injectstart 0} \ |
-injectstop oom_injectstop \ |
-injecterrlist {{1 {out of memory}}} \ |
] |
set FAULTSIM(oom-persistent) [list \ |
-injectstart {oom_injectstart 1000000} \ |
-injectstop oom_injectstop \ |
-injecterrlist {{1 {out of memory}}} \ |
] |
|
# Transient and persistent IO errors: |
# |
set FAULTSIM(ioerr-transient) [list \ |
-injectstart {ioerr_injectstart 0} \ |
-injectstop ioerr_injectstop \ |
-injecterrlist {{1 {disk I/O error}}} \ |
] |
set FAULTSIM(ioerr-persistent) [list \ |
-injectstart {ioerr_injectstart 1} \ |
-injectstop ioerr_injectstop \ |
-injecterrlist {{1 {disk I/O error}}} \ |
] |
|
# SQLITE_FULL errors (always persistent): |
# |
set FAULTSIM(full) [list \ |
-injectinstall fullerr_injectinstall \ |
-injectstart fullerr_injectstart \ |
-injectstop fullerr_injectstop \ |
-injecterrlist {{1 {database or disk is full}}} \ |
-injectuninstall fullerr_injectuninstall \ |
] |
|
# Transient and persistent SHM errors: |
# |
set FAULTSIM(shmerr-transient) [list \ |
-injectinstall shmerr_injectinstall \ |
-injectstart {shmerr_injectstart 0} \ |
-injectstop shmerr_injectstop \ |
-injecterrlist {{1 {disk I/O error}}} \ |
-injectuninstall shmerr_injectuninstall \ |
] |
set FAULTSIM(shmerr-persistent) [list \ |
-injectinstall shmerr_injectinstall \ |
-injectstart {shmerr_injectstart 1} \ |
-injectstop shmerr_injectstop \ |
-injecterrlist {{1 {disk I/O error}}} \ |
-injectuninstall shmerr_injectuninstall \ |
] |
|
# Transient and persistent CANTOPEN errors: |
# |
set FAULTSIM(cantopen-transient) [list \ |
-injectinstall cantopen_injectinstall \ |
-injectstart {cantopen_injectstart 0} \ |
-injectstop cantopen_injectstop \ |
-injecterrlist {{1 {unable to open database file}}} \ |
-injectuninstall cantopen_injectuninstall \ |
] |
set FAULTSIM(cantopen-persistent) [list \ |
-injectinstall cantopen_injectinstall \ |
-injectstart {cantopen_injectstart 1} \ |
-injectstop cantopen_injectstop \ |
-injecterrlist {{1 {unable to open database file}}} \ |
-injectuninstall cantopen_injectuninstall \ |
] |
|
|
|
#-------------------------------------------------------------------------- |
# Usage do_faultsim_test NAME ?OPTIONS...? |
# |
# -faults List of fault types to simulate. |
# |
# -prep Script to execute before -body. |
# |
# -body Script to execute (with fault injection). |
# |
# -test Script to execute after -body. |
# |
# -install Script to execute after faultsim -injectinstall |
# |
# -uninstall Script to execute after faultsim -uninjectinstall |
# |
proc do_faultsim_test {name args} { |
global FAULTSIM |
|
set DEFAULT(-faults) [array names FAULTSIM] |
set DEFAULT(-prep) "" |
set DEFAULT(-body) "" |
set DEFAULT(-test) "" |
set DEFAULT(-install) "" |
set DEFAULT(-uninstall) "" |
|
fix_testname name |
|
array set O [array get DEFAULT] |
array set O $args |
foreach o [array names O] { |
if {[info exists DEFAULT($o)]==0} { error "unknown option: $o" } |
} |
|
set faultlist [list] |
foreach f $O(-faults) { |
set flist [array names FAULTSIM $f] |
if {[llength $flist]==0} { error "unknown fault: $f" } |
set faultlist [concat $faultlist $flist] |
} |
|
set testspec [list -prep $O(-prep) -body $O(-body) \ |
-test $O(-test) -install $O(-install) -uninstall $O(-uninstall) |
] |
foreach f [lsort -unique $faultlist] { |
eval do_one_faultsim_test "$name-$f" $FAULTSIM($f) $testspec |
} |
} |
|
|
#------------------------------------------------------------------------- |
# Procedures to save and restore the current file-system state: |
# |
# faultsim_save |
# faultsim_restore |
# faultsim_save_and_close |
# faultsim_restore_and_reopen |
# faultsim_delete_and_reopen |
# |
proc faultsim_save {args} { uplevel db_save $args } |
proc faultsim_save_and_close {args} { uplevel db_save_and_close $args } |
proc faultsim_restore {args} { uplevel db_restore $args } |
proc faultsim_restore_and_reopen {args} { |
uplevel db_restore_and_reopen $args |
sqlite3_extended_result_codes db 1 |
sqlite3_db_config_lookaside db 0 0 0 |
} |
proc faultsim_delete_and_reopen {args} { |
uplevel db_delete_and_reopen $args |
sqlite3_extended_result_codes db 1 |
sqlite3_db_config_lookaside db 0 0 0 |
} |
|
proc faultsim_integrity_check {{db db}} { |
set ic [$db eval { PRAGMA integrity_check }] |
if {$ic != "ok"} { error "Integrity check: $ic" } |
} |
|
|
# The following procs are used as [do_one_faultsim_test] callbacks when |
# injecting OOM faults into test cases. |
# |
proc oom_injectstart {nRepeat iFail} { |
sqlite3_memdebug_fail [expr $iFail-1] -repeat $nRepeat |
} |
proc oom_injectstop {} { |
sqlite3_memdebug_fail -1 |
} |
|
# The following procs are used as [do_one_faultsim_test] callbacks when |
# injecting IO error faults into test cases. |
# |
proc ioerr_injectstart {persist iFail} { |
set ::sqlite_io_error_persist $persist |
set ::sqlite_io_error_pending $iFail |
} |
proc ioerr_injectstop {} { |
set sv $::sqlite_io_error_hit |
set ::sqlite_io_error_persist 0 |
set ::sqlite_io_error_pending 0 |
set ::sqlite_io_error_hardhit 0 |
set ::sqlite_io_error_hit 0 |
set ::sqlite_io_error_pending 0 |
return $sv |
} |
|
# The following procs are used as [do_one_faultsim_test] callbacks when |
# injecting shared-memory related error faults into test cases. |
# |
proc shmerr_injectinstall {} { |
testvfs shmfault -default true |
shmfault filter {xShmOpen xShmMap xShmLock} |
} |
proc shmerr_injectuninstall {} { |
catch {db close} |
catch {db2 close} |
shmfault delete |
} |
proc shmerr_injectstart {persist iFail} { |
shmfault ioerr $iFail $persist |
} |
proc shmerr_injectstop {} { |
shmfault ioerr |
} |
|
# The following procs are used as [do_one_faultsim_test] callbacks when |
# injecting SQLITE_FULL error faults into test cases. |
# |
proc fullerr_injectinstall {} { |
testvfs shmfault -default true |
} |
proc fullerr_injectuninstall {} { |
catch {db close} |
catch {db2 close} |
shmfault delete |
} |
proc fullerr_injectstart {iFail} { |
shmfault full $iFail 1 |
} |
proc fullerr_injectstop {} { |
shmfault full |
} |
|
# The following procs are used as [do_one_faultsim_test] callbacks when |
# injecting SQLITE_CANTOPEN error faults into test cases. |
# |
proc cantopen_injectinstall {} { |
testvfs shmfault -default true |
} |
proc cantopen_injectuninstall {} { |
catch {db close} |
catch {db2 close} |
shmfault delete |
} |
proc cantopen_injectstart {persist iFail} { |
shmfault cantopen $iFail $persist |
} |
proc cantopen_injectstop {} { |
shmfault cantopen |
} |
|
# This command is not called directly. It is used by the |
# [faultsim_test_result] command created by [do_faultsim_test] and used |
# by -test scripts. |
# |
proc faultsim_test_result_int {args} { |
upvar testrc testrc testresult testresult testnfail testnfail |
set t [list $testrc $testresult] |
set r $args |
if { ($testnfail==0 && $t != [lindex $r 0]) || [lsearch $r $t]<0 } { |
error "nfail=$testnfail rc=$testrc result=$testresult" |
} |
} |
|
#-------------------------------------------------------------------------- |
# Usage do_one_faultsim_test NAME ?OPTIONS...? |
# |
# The first argument, <test number>, is used as a prefix of the test names |
# taken by tests executed by this command. Options are as follows. All |
# options take a single argument. |
# |
# -injectstart Script to enable fault-injection. |
# |
# -injectstop Script to disable fault-injection. |
# |
# -injecterrlist List of generally acceptable test results (i.e. error |
# messages). Example: [list {1 {out of memory}}] |
# |
# -injectinstall |
# |
# -injectuninstall |
# |
# -prep Script to execute before -body. |
# |
# -body Script to execute (with fault injection). |
# |
# -test Script to execute after -body. |
# |
proc do_one_faultsim_test {testname args} { |
|
set DEFAULT(-injectstart) "expr" |
set DEFAULT(-injectstop) "expr 0" |
set DEFAULT(-injecterrlist) [list] |
set DEFAULT(-injectinstall) "" |
set DEFAULT(-injectuninstall) "" |
set DEFAULT(-prep) "" |
set DEFAULT(-body) "" |
set DEFAULT(-test) "" |
set DEFAULT(-install) "" |
set DEFAULT(-uninstall) "" |
|
array set O [array get DEFAULT] |
array set O $args |
foreach o [array names O] { |
if {[info exists DEFAULT($o)]==0} { error "unknown option: $o" } |
} |
|
proc faultsim_test_proc {testrc testresult testnfail} $O(-test) |
proc faultsim_test_result {args} " |
uplevel faultsim_test_result_int \$args [list $O(-injecterrlist)] |
" |
|
eval $O(-injectinstall) |
eval $O(-install) |
|
set stop 0 |
for {set iFail 1} {!$stop} {incr iFail} { |
|
# Evaluate the -prep script. |
# |
eval $O(-prep) |
|
# Start the fault-injection. Run the -body script. Stop the fault |
# injection. Local var $nfail is set to the total number of faults |
# injected into the system this trial. |
# |
eval $O(-injectstart) $iFail |
set rc [catch $O(-body) res] |
set nfail [eval $O(-injectstop)] |
|
# Run the -test script. If it throws no error, consider this trial |
# sucessful. If it does throw an error, cause a [do_test] test to |
# fail (and print out the unexpected exception thrown by the -test |
# script at the same time). |
# |
set rc [catch [list faultsim_test_proc $rc $res $nfail] res] |
if {$rc == 0} {set res ok} |
do_test $testname.$iFail [list list $rc $res] {0 ok} |
|
# If no faults where injected this trial, don't bother running |
# any more. This test is finished. |
# |
if {$nfail==0} { set stop 1 } |
} |
|
eval $O(-uninstall) |
eval $O(-injectuninstall) |
} |
|
# Usage: do_malloc_test <test number> <options...> |
# |
# The first argument, <test number>, is an integer used to name the |
# tests executed by this proc. Options are as follows: |
# |
# -tclprep TCL script to run to prepare test. |
# -sqlprep SQL script to run to prepare test. |
# -tclbody TCL script to run with malloc failure simulation. |
# -sqlbody TCL script to run with malloc failure simulation. |
# -cleanup TCL script to run after the test. |
# |
# This command runs a series of tests to verify SQLite's ability |
# to handle an out-of-memory condition gracefully. It is assumed |
# that if this condition occurs a malloc() call will return a |
# NULL pointer. Linux, for example, doesn't do that by default. See |
# the "BUGS" section of malloc(3). |
# |
# Each iteration of a loop, the TCL commands in any argument passed |
# to the -tclbody switch, followed by the SQL commands in any argument |
# passed to the -sqlbody switch are executed. Each iteration the |
# Nth call to sqliteMalloc() is made to fail, where N is increased |
# each time the loop runs starting from 1. When all commands execute |
# successfully, the loop ends. |
# |
proc do_malloc_test {tn args} { |
array unset ::mallocopts |
array set ::mallocopts $args |
|
if {[string is integer $tn]} { |
set tn malloc-$tn |
} |
if {[info exists ::mallocopts(-start)]} { |
set start $::mallocopts(-start) |
} else { |
set start 0 |
} |
if {[info exists ::mallocopts(-end)]} { |
set end $::mallocopts(-end) |
} else { |
set end 50000 |
} |
save_prng_state |
|
foreach ::iRepeat {0 10000000} { |
set ::go 1 |
for {set ::n $start} {$::go && $::n <= $end} {incr ::n} { |
|
# If $::iRepeat is 0, then the malloc() failure is transient - it |
# fails and then subsequent calls succeed. If $::iRepeat is 1, |
# then the failure is persistent - once malloc() fails it keeps |
# failing. |
# |
set zRepeat "transient" |
if {$::iRepeat} {set zRepeat "persistent"} |
restore_prng_state |
foreach file [glob -nocomplain test.db-mj*] {file delete -force $file} |
|
do_test ${tn}.${zRepeat}.${::n} { |
|
# Remove all traces of database files test.db and test2.db |
# from the file-system. Then open (empty database) "test.db" |
# with the handle [db]. |
# |
catch {db close} |
catch {db2 close} |
forcedelete test.db |
forcedelete test.db-journal |
forcedelete test.db-wal |
forcedelete test2.db |
forcedelete test2.db-journal |
forcedelete test2.db-wal |
if {[info exists ::mallocopts(-testdb)]} { |
file copy $::mallocopts(-testdb) test.db |
} |
catch { sqlite3 db test.db } |
if {[info commands db] ne ""} { |
sqlite3_extended_result_codes db 1 |
} |
sqlite3_db_config_lookaside db 0 0 0 |
|
# Execute any -tclprep and -sqlprep scripts. |
# |
if {[info exists ::mallocopts(-tclprep)]} { |
eval $::mallocopts(-tclprep) |
} |
if {[info exists ::mallocopts(-sqlprep)]} { |
execsql $::mallocopts(-sqlprep) |
} |
|
# Now set the ${::n}th malloc() to fail and execute the -tclbody |
# and -sqlbody scripts. |
# |
sqlite3_memdebug_fail $::n -repeat $::iRepeat |
set ::mallocbody {} |
if {[info exists ::mallocopts(-tclbody)]} { |
append ::mallocbody "$::mallocopts(-tclbody)\n" |
} |
if {[info exists ::mallocopts(-sqlbody)]} { |
append ::mallocbody "db eval {$::mallocopts(-sqlbody)}" |
} |
|
# The following block sets local variables as follows: |
# |
# isFail - True if an error (any error) was reported by sqlite. |
# nFail - The total number of simulated malloc() failures. |
# nBenign - The number of benign simulated malloc() failures. |
# |
set isFail [catch $::mallocbody msg] |
set nFail [sqlite3_memdebug_fail -1 -benigncnt nBenign] |
# puts -nonewline " (isFail=$isFail nFail=$nFail nBenign=$nBenign) " |
|
# If one or more mallocs failed, run this loop body again. |
# |
set go [expr {$nFail>0}] |
|
if {($nFail-$nBenign)==0} { |
if {$isFail} { |
set v2 $msg |
} else { |
set isFail 1 |
set v2 1 |
} |
} elseif {!$isFail} { |
set v2 $msg |
} elseif { |
[info command db]=="" || |
[db errorcode]==7 || |
$msg=="out of memory" |
} { |
set v2 1 |
} else { |
set v2 $msg |
puts [db errorcode] |
} |
lappend isFail $v2 |
} {1 1} |
|
if {[info exists ::mallocopts(-cleanup)]} { |
catch [list uplevel #0 $::mallocopts(-cleanup)] msg |
} |
} |
} |
unset ::mallocopts |
sqlite3_memdebug_fail -1 |
} |
|
|
#------------------------------------------------------------------------- |
# This proc is used to test a single SELECT statement. Parameter $name is |
# passed a name for the test case (i.e. "fts3_malloc-1.4.1") and parameter |
# $sql is passed the text of the SELECT statement. Parameter $result is |
# set to the expected output if the SELECT statement is successfully |
# executed using [db eval]. |
# |
# Example: |
# |
# do_select_test testcase-1.1 "SELECT 1+1, 1+2" {1 2} |
# |
# If global variable DO_MALLOC_TEST is set to a non-zero value, or if |
# it is not defined at all, then OOM testing is performed on the SELECT |
# statement. Each OOM test case is said to pass if either (a) executing |
# the SELECT statement succeeds and the results match those specified |
# by parameter $result, or (b) TCL throws an "out of memory" error. |
# |
# If DO_MALLOC_TEST is defined and set to zero, then the SELECT statement |
# is executed just once. In this case the test case passes if the results |
# match the expected results passed via parameter $result. |
# |
proc do_select_test {name sql result} { |
uplevel [list doPassiveTest 0 $name $sql [list 0 [list {*}$result]]] |
} |
|
proc do_restart_select_test {name sql result} { |
uplevel [list doPassiveTest 1 $name $sql [list 0 $result]] |
} |
|
proc do_error_test {name sql error} { |
uplevel [list doPassiveTest 0 $name $sql [list 1 $error]] |
} |
|
proc doPassiveTest {isRestart name sql catchres} { |
if {![info exists ::DO_MALLOC_TEST]} { set ::DO_MALLOC_TEST 1 } |
|
if {[info exists ::testprefix] |
&& [string is integer [string range $name 0 0]] |
} { |
set name $::testprefix.$name |
} |
|
switch $::DO_MALLOC_TEST { |
0 { # No malloc failures. |
do_test $name [list set {} [uplevel [list catchsql $sql]]] $catchres |
return |
} |
1 { # Simulate transient failures. |
set nRepeat 1 |
set zName "transient" |
set nStartLimit 100000 |
set nBackup 1 |
} |
2 { # Simulate persistent failures. |
set nRepeat 1 |
set zName "persistent" |
set nStartLimit 100000 |
set nBackup 1 |
} |
3 { # Simulate transient failures with extra brute force. |
set nRepeat 100000 |
set zName "ridiculous" |
set nStartLimit 1 |
set nBackup 10 |
} |
} |
|
# The set of acceptable results from running [catchsql $sql]. |
# |
set answers [list {1 {out of memory}} $catchres] |
set str [join $answers " OR "] |
|
set nFail 1 |
for {set iLimit $nStartLimit} {$nFail} {incr iLimit} { |
for {set iFail 1} {$nFail && $iFail<=$iLimit} {incr iFail} { |
for {set iTest 0} {$iTest<$nBackup && ($iFail-$iTest)>0} {incr iTest} { |
|
if {$isRestart} { sqlite3 db test.db } |
|
sqlite3_memdebug_fail [expr $iFail-$iTest] -repeat $nRepeat |
set res [uplevel [list catchsql $sql]] |
if {[lsearch -exact $answers $res]>=0} { set res $str } |
set testname "$name.$zName.$iFail" |
do_test "$name.$zName.$iLimit.$iFail" [list set {} $res] $str |
|
set nFail [sqlite3_memdebug_fail -1 -benigncnt nBenign] |
} |
} |
} |
} |
|
|
#------------------------------------------------------------------------- |
# Test a single write to the database. In this case a "write" is a |
# DELETE, UPDATE or INSERT statement. |
# |
# If OOM testing is performed, there are several acceptable outcomes: |
# |
# 1) The write succeeds. No error is returned. |
# |
# 2) An "out of memory" exception is thrown and: |
# |
# a) The statement has no effect, OR |
# b) The current transaction is rolled back, OR |
# c) The statement succeeds. This can only happen if the connection |
# is in auto-commit mode (after the statement is executed, so this |
# includes COMMIT statements). |
# |
# If the write operation eventually succeeds, zero is returned. If a |
# transaction is rolled back, non-zero is returned. |
# |
# Parameter $name is the name to use for the test case (or test cases). |
# The second parameter, $tbl, should be the name of the database table |
# being modified. Parameter $sql contains the SQL statement to test. |
# |
proc do_write_test {name tbl sql} { |
if {![info exists ::DO_MALLOC_TEST]} { set ::DO_MALLOC_TEST 1 } |
|
# Figure out an statement to get a checksum for table $tbl. |
db eval "SELECT * FROM $tbl" V break |
set cksumsql "SELECT md5sum([join [concat rowid $V(*)] ,]) FROM $tbl" |
|
# Calculate the initial table checksum. |
set cksum1 [db one $cksumsql] |
|
if {$::DO_MALLOC_TEST } { |
set answers [list {1 {out of memory}} {0 {}}] |
if {$::DO_MALLOC_TEST==1} { |
set modes {100000 persistent} |
} else { |
set modes {1 transient} |
} |
} else { |
set answers [list {0 {}}] |
set modes [list 0 nofail] |
} |
set str [join $answers " OR "] |
|
foreach {nRepeat zName} $modes { |
for {set iFail 1} 1 {incr iFail} { |
if {$::DO_MALLOC_TEST} {sqlite3_memdebug_fail $iFail -repeat $nRepeat} |
|
set res [uplevel [list catchsql $sql]] |
set nFail [sqlite3_memdebug_fail -1 -benigncnt nBenign] |
if {$nFail==0} { |
do_test $name.$zName.$iFail [list set {} $res] {0 {}} |
return |
} else { |
if {[lsearch $answers $res]>=0} { |
set res $str |
} |
do_test $name.$zName.$iFail [list set {} $res] $str |
set cksum2 [db one $cksumsql] |
if {$cksum1 != $cksum2} return |
} |
} |
} |
} |