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
{
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
\
98 #--------------------------------------------------------------------------
99 # Usage do_faultsim_test NAME ?OPTIONS...?
101 # -faults List of fault types to simulate.
103 # -prep Script to execute before -body.
105 # -body Script to execute (with fault injection).
107 # -test Script to execute after -body.
109 # -install Script to execute after faultsim -injectinstall
111 # -uninstall Script to execute after faultsim -uninjectinstall
113 proc do_faultsim_test
{name args
} {
116 set DEFAULT
(-faults) [array names FAULTSIM
]
117 set DEFAULT
(-prep) ""
118 set DEFAULT
(-body) ""
119 set DEFAULT
(-test) ""
120 set DEFAULT
(-install) ""
121 set DEFAULT
(-uninstall) ""
125 array set O
[array get DEFAULT
]
127 foreach o
[array names O
] {
128 if {[info exists DEFAULT
($o)]==0} { error "unknown option: $o" }
132 foreach f
$O(-faults) {
133 set flist
[array names FAULTSIM
$f]
134 if {[llength $flist]==0} { error "unknown fault: $f" }
135 set faultlist
[concat $faultlist $flist]
138 set testspec
[list -prep $O(-prep) -body $O(-body) \
139 -test $O(-test) -install $O(-install) -uninstall $O(-uninstall)
141 foreach f
[lsort -unique $faultlist] {
142 eval do_one_faultsim_test
"$name-$f" $FAULTSIM($f) $testspec
147 #-------------------------------------------------------------------------
148 # Procedures to save and restore the current file-system state:
152 # faultsim_save_and_close
153 # faultsim_restore_and_reopen
154 # faultsim_delete_and_reopen
156 proc faultsim_save
{args
} { uplevel db_save
$args }
157 proc faultsim_save_and_close
{args
} { uplevel db_save_and_close
$args }
158 proc faultsim_restore
{args
} { uplevel db_restore
$args }
159 proc faultsim_restore_and_reopen
{args
} {
160 uplevel db_restore_and_reopen
$args
161 sqlite3_extended_result_codes db
1
162 sqlite3_db_config_lookaside db
0 0 0
164 proc faultsim_delete_and_reopen
{args
} {
165 uplevel db_delete_and_reopen
$args
166 sqlite3_extended_result_codes db
1
167 sqlite3_db_config_lookaside db
0 0 0
170 proc faultsim_integrity_check
{{db db
}} {
171 set ic
[$db eval { PRAGMA integrity_check
}]
172 if {$ic != "ok"} { error "Integrity check: $ic" }
176 # The following procs are used as [do_one_faultsim_test] callbacks when
177 # injecting OOM faults into test cases.
179 proc oom_injectstart
{nRepeat iFail
} {
180 sqlite3_memdebug_fail
[expr $iFail-1] -repeat $nRepeat
182 proc oom_injectstop
{} {
183 sqlite3_memdebug_fail
-1
186 # The following procs are used as [do_one_faultsim_test] callbacks when
187 # injecting IO error faults into test cases.
189 proc ioerr_injectstart
{persist iFail
} {
190 set ::sqlite_io_error_persist $persist
191 set ::sqlite_io_error_pending $iFail
193 proc ioerr_injectstop
{} {
194 set sv
$::sqlite_io_error_hit
195 set ::sqlite_io_error_persist 0
196 set ::sqlite_io_error_pending 0
197 set ::sqlite_io_error_hardhit 0
198 set ::sqlite_io_error_hit 0
199 set ::sqlite_io_error_pending 0
203 # The following procs are used as [do_one_faultsim_test] callbacks when
204 # injecting shared-memory related error faults into test cases.
206 proc shmerr_injectinstall
{} {
207 testvfs shmfault
-default true
208 shmfault filter
{xShmOpen xShmMap xShmLock
}
210 proc shmerr_injectuninstall
{} {
215 proc shmerr_injectstart
{persist iFail
} {
216 shmfault ioerr
$iFail $persist
218 proc shmerr_injectstop
{} {
222 # The following procs are used as [do_one_faultsim_test] callbacks when
223 # injecting SQLITE_FULL error faults into test cases.
225 proc fullerr_injectinstall
{} {
226 testvfs shmfault
-default true
228 proc fullerr_injectuninstall
{} {
233 proc fullerr_injectstart
{iFail
} {
234 shmfault full
$iFail 1
236 proc fullerr_injectstop
{} {
240 # The following procs are used as [do_one_faultsim_test] callbacks when
241 # injecting SQLITE_CANTOPEN error faults into test cases.
243 proc cantopen_injectinstall
{} {
244 testvfs shmfault
-default true
246 proc cantopen_injectuninstall
{} {
251 proc cantopen_injectstart
{persist iFail
} {
252 shmfault cantopen
$iFail $persist
254 proc cantopen_injectstop
{} {
258 # This command is not called directly. It is used by the
259 # [faultsim_test_result] command created by [do_faultsim_test] and used
262 proc faultsim_test_result_int
{args
} {
263 upvar testrc testrc testresult testresult testnfail testnfail
264 set t
[list $testrc $testresult]
266 if { ($testnfail==0 && $t != [lindex $r 0]) ||
[lsearch $r $t]<0 } {
267 error "nfail=$testnfail rc=$testrc result=$testresult"
271 #--------------------------------------------------------------------------
272 # Usage do_one_faultsim_test NAME ?OPTIONS...?
274 # The first argument, <test number>, is used as a prefix of the test names
275 # taken by tests executed by this command. Options are as follows. All
276 # options take a single argument.
278 # -injectstart Script to enable fault-injection.
280 # -injectstop Script to disable fault-injection.
282 # -injecterrlist List of generally acceptable test results (i.e. error
283 # messages). Example: [list {1 {out of memory}}]
289 # -prep Script to execute before -body.
291 # -body Script to execute (with fault injection).
293 # -test Script to execute after -body.
295 proc do_one_faultsim_test
{testname args
} {
297 set DEFAULT
(-injectstart) "expr"
298 set DEFAULT
(-injectstop) "expr 0"
299 set DEFAULT
(-injecterrlist) [list]
300 set DEFAULT
(-injectinstall) ""
301 set DEFAULT
(-injectuninstall) ""
302 set DEFAULT
(-prep) ""
303 set DEFAULT
(-body) ""
304 set DEFAULT
(-test) ""
305 set DEFAULT
(-install) ""
306 set DEFAULT
(-uninstall) ""
308 array set O
[array get DEFAULT
]
310 foreach o
[array names O
] {
311 if {[info exists DEFAULT
($o)]==0} { error "unknown option: $o" }
314 proc faultsim_test_proc
{testrc testresult testnfail
} $O(-test)
315 proc faultsim_test_result
{args
} "
316 uplevel faultsim_test_result_int \$args [list $O(-injecterrlist)]
319 eval $O(-injectinstall)
323 for {set iFail
1} {!$stop} {incr iFail
} {
325 # Evaluate the -prep script.
329 # Start the fault-injection. Run the -body script. Stop the fault
330 # injection. Local var $nfail is set to the total number of faults
331 # injected into the system this trial.
333 eval $O(-injectstart) $iFail
334 set rc
[catch $O(-body) res
]
335 set nfail
[eval $O(-injectstop)]
337 # Run the -test script. If it throws no error, consider this trial
338 # sucessful. If it does throw an error, cause a [do_test] test to
339 # fail (and print out the unexpected exception thrown by the -test
340 # script at the same time).
342 set rc
[catch [list faultsim_test_proc
$rc $res $nfail] res
]
343 if {$rc == 0} {set res ok
}
344 do_test
$testname.
$iFail [list list $rc $res] {0 ok
}
346 # If no faults where injected this trial, don't bother running
347 # any more. This test is finished.
349 if {$nfail==0} { set stop
1 }
353 eval $O(-injectuninstall)
356 # Usage: do_malloc_test <test number> <options...>
358 # The first argument, <test number>, is an integer used to name the
359 # tests executed by this proc. Options are as follows:
361 # -tclprep TCL script to run to prepare test.
362 # -sqlprep SQL script to run to prepare test.
363 # -tclbody TCL script to run with malloc failure simulation.
364 # -sqlbody TCL script to run with malloc failure simulation.
365 # -cleanup TCL script to run after the test.
367 # This command runs a series of tests to verify SQLite's ability
368 # to handle an out-of-memory condition gracefully. It is assumed
369 # that if this condition occurs a malloc() call will return a
370 # NULL pointer. Linux, for example, doesn't do that by default. See
371 # the "BUGS" section of malloc(3).
373 # Each iteration of a loop, the TCL commands in any argument passed
374 # to the -tclbody switch, followed by the SQL commands in any argument
375 # passed to the -sqlbody switch are executed. Each iteration the
376 # Nth call to sqliteMalloc() is made to fail, where N is increased
377 # each time the loop runs starting from 1. When all commands execute
378 # successfully, the loop ends.
380 proc do_malloc_test
{tn args
} {
381 array unset ::mallocopts
382 array set ::mallocopts $args
384 if {[string is integer
$tn]} {
387 if {[info exists
::mallocopts(-start)]} {
388 set start
$::mallocopts(-start)
392 if {[info exists
::mallocopts(-end)]} {
393 set end
$::mallocopts(-end)
399 foreach ::iRepeat {0 10000000} {
401 for {set ::n $start} {$::go && $::n <= $end} {incr ::n} {
403 # If $::iRepeat is 0, then the malloc() failure is transient - it
404 # fails and then subsequent calls succeed. If $::iRepeat is 1,
405 # then the failure is persistent - once malloc() fails it keeps
408 set zRepeat
"transient"
409 if {$::iRepeat} {set zRepeat
"persistent"}
411 foreach file [glob -nocomplain test.db-mj
*] {file delete
-force $file}
413 do_test
${tn
}.
${zRepeat
}.
${::n} {
415 # Remove all traces of database files test.db and test2.db
416 # from the file-system. Then open (empty database) "test.db"
417 # with the handle [db].
422 forcedelete test.db-journal
423 forcedelete test.db-wal
425 forcedelete test2.db-journal
426 forcedelete test2.db-wal
427 if {[info exists
::mallocopts(-testdb)]} {
428 file copy
$::mallocopts(-testdb) test.db
430 catch { sqlite3 db test.db
}
431 if {[info commands db
] ne
""} {
432 sqlite3_extended_result_codes db
1
434 sqlite3_db_config_lookaside db
0 0 0
436 # Execute any -tclprep and -sqlprep scripts.
438 if {[info exists
::mallocopts(-tclprep)]} {
439 eval $::mallocopts(-tclprep)
441 if {[info exists
::mallocopts(-sqlprep)]} {
442 execsql
$::mallocopts(-sqlprep)
445 # Now set the ${::n}th malloc() to fail and execute the -tclbody
446 # and -sqlbody scripts.
448 sqlite3_memdebug_fail
$::n -repeat $::iRepeat
450 if {[info exists
::mallocopts(-tclbody)]} {
451 append ::mallocbody "$::mallocopts(-tclbody)\n"
453 if {[info exists
::mallocopts(-sqlbody)]} {
454 append ::mallocbody "db eval {$::mallocopts(-sqlbody)}"
457 # The following block sets local variables as follows:
459 # isFail - True if an error (any error) was reported by sqlite.
460 # nFail - The total number of simulated malloc() failures.
461 # nBenign - The number of benign simulated malloc() failures.
463 set isFail
[catch $::mallocbody msg
]
464 set nFail
[sqlite3_memdebug_fail
-1 -benigncnt nBenign
]
465 # puts -nonewline " (isFail=$isFail nFail=$nFail nBenign=$nBenign) "
467 # If one or more mallocs failed, run this loop body again.
469 set go
[expr {$nFail>0}]
471 if {($nFail-$nBenign)==0} {
478 } elseif
{!$isFail} {
481 [info command db
]=="" ||
483 $msg=="out of memory"
493 if {[info exists
::mallocopts(-cleanup)]} {
494 catch [list uplevel #0 $::mallocopts(-cleanup)] msg
499 sqlite3_memdebug_fail
-1
503 #-------------------------------------------------------------------------
504 # This proc is used to test a single SELECT statement. Parameter $name is
505 # passed a name for the test case (i.e. "fts3_malloc-1.4.1") and parameter
506 # $sql is passed the text of the SELECT statement. Parameter $result is
507 # set to the expected output if the SELECT statement is successfully
508 # executed using [db eval].
512 # do_select_test testcase-1.1 "SELECT 1+1, 1+2" {1 2}
514 # If global variable DO_MALLOC_TEST is set to a non-zero value, or if
515 # it is not defined at all, then OOM testing is performed on the SELECT
516 # statement. Each OOM test case is said to pass if either (a) executing
517 # the SELECT statement succeeds and the results match those specified
518 # by parameter $result, or (b) TCL throws an "out of memory" error.
520 # If DO_MALLOC_TEST is defined and set to zero, then the SELECT statement
521 # is executed just once. In this case the test case passes if the results
522 # match the expected results passed via parameter $result.
524 proc do_select_test
{name sql result
} {
525 uplevel [list doPassiveTest
0 $name $sql [list 0 [list {*}$result]]]
528 proc do_restart_select_test
{name sql result
} {
529 uplevel [list doPassiveTest
1 $name $sql [list 0 $result]]
532 proc do_error_test
{name sql
error} {
533 uplevel [list doPassiveTest
0 $name $sql [list 1 $error]]
536 proc doPassiveTest
{isRestart name sql catchres
} {
537 if {![info exists
::DO_MALLOC_TEST]} { set ::DO_MALLOC_TEST 1 }
539 if {[info exists
::testprefix]
540 && [string is integer
[string range
$name 0 0]]
542 set name
$::testprefix.
$name
545 switch $::DO_MALLOC_TEST {
546 0 { # No malloc failures.
547 do_test
$name [list set {} [uplevel [list catchsql
$sql]]] $catchres
550 1 { # Simulate transient failures.
552 set zName
"transient"
553 set nStartLimit
100000
556 2 { # Simulate persistent failures.
558 set zName
"persistent"
559 set nStartLimit
100000
562 3 { # Simulate transient failures with extra brute force.
564 set zName
"ridiculous"
570 # The set of acceptable results from running [catchsql $sql].
572 set answers
[list {1 {out of
memory}} $catchres]
573 set str
[join $answers " OR "]
576 for {set iLimit
$nStartLimit} {$nFail} {incr iLimit
} {
577 for {set iFail
1} {$nFail && $iFail<=$iLimit} {incr iFail
} {
578 for {set iTest
0} {$iTest<$nBackup && ($iFail-$iTest)>0} {incr iTest
} {
580 if {$isRestart} { sqlite3 db test.db
}
582 sqlite3_memdebug_fail
[expr $iFail-$iTest] -repeat $nRepeat
583 set res
[uplevel [list catchsql
$sql]]
584 if {[lsearch -exact $answers $res]>=0} { set res
$str }
585 set testname
"$name.$zName.$iFail"
586 do_test
"$name.$zName.$iLimit.$iFail" [list set {} $res] $str
588 set nFail
[sqlite3_memdebug_fail
-1 -benigncnt nBenign
]
595 #-------------------------------------------------------------------------
596 # Test a single write to the database. In this case a "write" is a
597 # DELETE, UPDATE or INSERT statement.
599 # If OOM testing is performed, there are several acceptable outcomes:
601 # 1) The write succeeds. No error is returned.
603 # 2) An "out of memory" exception is thrown and:
605 # a) The statement has no effect, OR
606 # b) The current transaction is rolled back, OR
607 # c) The statement succeeds. This can only happen if the connection
608 # is in auto-commit mode (after the statement is executed, so this
609 # includes COMMIT statements).
611 # If the write operation eventually succeeds, zero is returned. If a
612 # transaction is rolled back, non-zero is returned.
614 # Parameter $name is the name to use for the test case (or test cases).
615 # The second parameter, $tbl, should be the name of the database table
616 # being modified. Parameter $sql contains the SQL statement to test.
618 proc do_write_test
{name tbl sql
} {
619 if {![info exists
::DO_MALLOC_TEST]} { set ::DO_MALLOC_TEST 1 }
621 # Figure out an statement to get a checksum for table $tbl.
622 db
eval "SELECT * FROM $tbl" V
break
623 set cksumsql
"SELECT md5sum([join [concat rowid $V(*)] ,]) FROM $tbl"
625 # Calculate the initial table checksum.
626 set cksum1
[db one
$cksumsql]
628 if {$::DO_MALLOC_TEST } {
629 set answers
[list {1 {out of
memory}} {0 {}}]
630 if {$::DO_MALLOC_TEST==1} {
631 set modes
{100000 persistent
}
633 set modes
{1 transient
}
636 set answers
[list {0 {}}]
637 set modes
[list 0 nofail
]
639 set str
[join $answers " OR "]
641 foreach {nRepeat zName
} $modes {
642 for {set iFail
1} 1 {incr iFail
} {
643 if {$::DO_MALLOC_TEST} {sqlite3_memdebug_fail
$iFail -repeat $nRepeat}
645 set res
[uplevel [list catchsql
$sql]]
646 set nFail
[sqlite3_memdebug_fail
-1 -benigncnt nBenign
]
648 do_test
$name.
$zName.
$iFail [list set {} $res] {0 {}}
651 if {[lsearch $answers $res]>=0} {
654 do_test
$name.
$zName.
$iFail [list set {} $res] $str
655 set cksum2
[db one
$cksumsql]
656 if {$cksum1 != $cksum2} return