Update test file walprotocol.test to account for the changes in the wal
[sqlite.git] / test / malloc_common.tcl
blob2d0e57e4fcaf0bac561519f1723172c6a4bfe601
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) ""
132 set DEFAULT(-start) 1
133 set DEFAULT(-end) 0
135 fix_testname name
137 array set O [array get DEFAULT]
138 array set O $args
139 foreach o [array names O] {
140 if {[info exists DEFAULT($o)]==0} { error "unknown option: $o" }
143 set faultlist [list]
144 foreach f $O(-faults) {
145 set flist [array names FAULTSIM $f]
146 if {[llength $flist]==0} { error "unknown fault: $f" }
147 set faultlist [concat $faultlist $flist]
150 set testspec [list -prep $O(-prep) -body $O(-body) \
151 -test $O(-test) -install $O(-install) -uninstall $O(-uninstall) \
152 -start $O(-start) -end $O(-end)
154 foreach f [lsort -unique $faultlist] {
155 eval do_one_faultsim_test "$name-$f" $FAULTSIM($f) $testspec
160 #-------------------------------------------------------------------------
161 # Procedures to save and restore the current file-system state:
163 # faultsim_save
164 # faultsim_restore
165 # faultsim_save_and_close
166 # faultsim_restore_and_reopen
167 # faultsim_delete_and_reopen
169 proc faultsim_save {args} { uplevel db_save $args }
170 proc faultsim_save_and_close {args} { uplevel db_save_and_close $args }
171 proc faultsim_restore {args} { uplevel db_restore $args }
172 proc faultsim_restore_and_reopen {args} {
173 uplevel db_restore_and_reopen $args
174 sqlite3_extended_result_codes db 1
175 sqlite3_db_config_lookaside db 0 0 0
177 proc faultsim_delete_and_reopen {args} {
178 uplevel db_delete_and_reopen $args
179 sqlite3_extended_result_codes db 1
180 sqlite3_db_config_lookaside db 0 0 0
183 proc faultsim_integrity_check {{db db}} {
184 set ic [$db eval { PRAGMA integrity_check }]
185 if {$ic != "ok"} { error "Integrity check: $ic" }
189 # The following procs are used as [do_one_faultsim_test] callbacks when
190 # injecting OOM faults into test cases.
192 proc oom_injectstart {nRepeat iFail} {
193 sqlite3_memdebug_fail [expr $iFail-1] -repeat $nRepeat
195 proc oom_injectstop {} {
196 sqlite3_memdebug_fail -1
199 # The following procs are used as [do_one_faultsim_test] callbacks when
200 # injecting IO error faults into test cases.
202 proc ioerr_injectstart {persist iFail} {
203 set ::sqlite_io_error_persist $persist
204 set ::sqlite_io_error_pending $iFail
206 proc ioerr_injectstop {} {
207 set sv $::sqlite_io_error_hit
208 set ::sqlite_io_error_persist 0
209 set ::sqlite_io_error_pending 0
210 set ::sqlite_io_error_hardhit 0
211 set ::sqlite_io_error_hit 0
212 set ::sqlite_io_error_pending 0
213 return $sv
216 # The following procs are used as [do_one_faultsim_test] callbacks when
217 # injecting shared-memory related error faults into test cases.
219 proc shmerr_injectinstall {} {
220 testvfs shmfault -default true
221 shmfault filter {xShmOpen xShmMap xShmLock}
223 proc shmerr_injectuninstall {} {
224 catch {db close}
225 catch {db2 close}
226 shmfault delete
228 proc shmerr_injectstart {persist iFail} {
229 shmfault ioerr $iFail $persist
231 proc shmerr_injectstop {} {
232 shmfault ioerr
235 # The following procs are used as [do_one_faultsim_test] callbacks when
236 # injecting SQLITE_FULL error faults into test cases.
238 proc fullerr_injectinstall {} {
239 testvfs shmfault -default true
241 proc fullerr_injectuninstall {} {
242 catch {db close}
243 catch {db2 close}
244 shmfault delete
246 proc fullerr_injectstart {iFail} {
247 shmfault full $iFail 1
249 proc fullerr_injectstop {} {
250 shmfault full
253 # The following procs are used as [do_one_faultsim_test] callbacks when
254 # injecting SQLITE_CANTOPEN error faults into test cases.
256 proc cantopen_injectinstall {} {
257 testvfs shmfault -default true
259 proc cantopen_injectuninstall {} {
260 catch {db close}
261 catch {db2 close}
262 shmfault delete
264 proc cantopen_injectstart {persist iFail} {
265 shmfault cantopen $iFail $persist
267 proc cantopen_injectstop {} {
268 shmfault cantopen
271 # The following procs are used as [do_one_faultsim_test] callbacks
272 # when injecting SQLITE_INTERRUPT error faults into test cases.
274 proc interrupt_injectinstall {} {
276 proc interrupt_injectuninstall {} {
278 proc interrupt_injectstart {iFail} {
279 set ::sqlite_interrupt_count $iFail
281 proc interrupt_injectstop {} {
282 set res [expr $::sqlite_interrupt_count<=0]
283 set ::sqlite_interrupt_count 0
284 set res
287 # This command is not called directly. It is used by the
288 # [faultsim_test_result] command created by [do_faultsim_test] and used
289 # by -test scripts.
291 proc faultsim_test_result_int {args} {
292 upvar testrc testrc testresult testresult testnfail testnfail
293 set t [list $testrc $testresult]
294 set r $args
295 if { ($testnfail==0 && $t != [lindex $r 0]) || [lsearch -exact $r $t]<0 } {
296 error "nfail=$testnfail rc=$testrc result=$testresult list=$r"
300 #--------------------------------------------------------------------------
301 # Usage do_one_faultsim_test NAME ?OPTIONS...?
303 # The first argument, <test number>, is used as a prefix of the test names
304 # taken by tests executed by this command. Options are as follows. All
305 # options take a single argument.
307 # -injectstart Script to enable fault-injection.
309 # -injectstop Script to disable fault-injection.
311 # -injecterrlist List of generally acceptable test results (i.e. error
312 # messages). Example: [list {1 {out of memory}}]
314 # -injectinstall
316 # -injectuninstall
318 # -prep Script to execute before -body.
320 # -body Script to execute (with fault injection).
322 # -test Script to execute after -body.
324 # -start Index of first fault to inject (default 1)
326 proc do_one_faultsim_test {testname args} {
328 set DEFAULT(-injectstart) "expr"
329 set DEFAULT(-injectstop) "expr 0"
330 set DEFAULT(-injecterrlist) [list]
331 set DEFAULT(-injectinstall) ""
332 set DEFAULT(-injectuninstall) ""
333 set DEFAULT(-prep) ""
334 set DEFAULT(-body) ""
335 set DEFAULT(-test) ""
336 set DEFAULT(-install) ""
337 set DEFAULT(-uninstall) ""
338 set DEFAULT(-start) 1
339 set DEFAULT(-end) 0
341 array set O [array get DEFAULT]
342 array set O $args
343 foreach o [array names O] {
344 if {[info exists DEFAULT($o)]==0} { error "unknown option: $o" }
347 proc faultsim_test_proc {testrc testresult testnfail} $O(-test)
348 proc faultsim_test_result {args} "
349 uplevel faultsim_test_result_int \$args [list $O(-injecterrlist)]
352 eval $O(-injectinstall)
353 eval $O(-install)
355 set stop 0
356 for {set iFail $O(-start)} \
357 {!$stop && ($O(-end)==0 || $iFail<=$O(-end))} \
358 {incr iFail} \
361 # Evaluate the -prep script.
363 eval $O(-prep)
365 # Start the fault-injection. Run the -body script. Stop the fault
366 # injection. Local var $nfail is set to the total number of faults
367 # injected into the system this trial.
369 eval $O(-injectstart) $iFail
370 set rc [catch $O(-body) res]
371 set nfail [eval $O(-injectstop)]
373 # Run the -test script. If it throws no error, consider this trial
374 # sucessful. If it does throw an error, cause a [do_test] test to
375 # fail (and print out the unexpected exception thrown by the -test
376 # script at the same time).
378 set rc [catch [list faultsim_test_proc $rc $res $nfail] res]
379 if {$rc == 0} {set res ok}
380 do_test $testname.$iFail [list list $rc $res] {0 ok}
382 # If no faults where injected this trial, don't bother running
383 # any more. This test is finished.
385 if {$nfail==0} { set stop 1 }
388 eval $O(-uninstall)
389 eval $O(-injectuninstall)
392 # Usage: do_malloc_test <test number> <options...>
394 # The first argument, <test number>, is an integer used to name the
395 # tests executed by this proc. Options are as follows:
397 # -tclprep TCL script to run to prepare test.
398 # -sqlprep SQL script to run to prepare test.
399 # -tclbody TCL script to run with malloc failure simulation.
400 # -sqlbody TCL script to run with malloc failure simulation.
401 # -cleanup TCL script to run after the test.
403 # This command runs a series of tests to verify SQLite's ability
404 # to handle an out-of-memory condition gracefully. It is assumed
405 # that if this condition occurs a malloc() call will return a
406 # NULL pointer. Linux, for example, doesn't do that by default. See
407 # the "BUGS" section of malloc(3).
409 # Each iteration of a loop, the TCL commands in any argument passed
410 # to the -tclbody switch, followed by the SQL commands in any argument
411 # passed to the -sqlbody switch are executed. Each iteration the
412 # Nth call to sqliteMalloc() is made to fail, where N is increased
413 # each time the loop runs starting from 1. When all commands execute
414 # successfully, the loop ends.
416 proc do_malloc_test {tn args} {
417 array unset ::mallocopts
418 array set ::mallocopts $args
420 if {[string is integer $tn]} {
421 set tn malloc-$tn
422 catch { set tn $::testprefix-$tn }
424 if {[info exists ::mallocopts(-start)]} {
425 set start $::mallocopts(-start)
426 } else {
427 set start 0
429 if {[info exists ::mallocopts(-end)]} {
430 set end $::mallocopts(-end)
431 } else {
432 set end 50000
434 save_prng_state
436 foreach ::iRepeat {0 10000000} {
437 set ::go 1
438 for {set ::n $start} {$::go && $::n <= $end} {incr ::n} {
440 # If $::iRepeat is 0, then the malloc() failure is transient - it
441 # fails and then subsequent calls succeed. If $::iRepeat is 1,
442 # then the failure is persistent - once malloc() fails it keeps
443 # failing.
445 set zRepeat "transient"
446 if {$::iRepeat} {set zRepeat "persistent"}
447 restore_prng_state
448 foreach file [glob -nocomplain test.db-mj*] {forcedelete $file}
450 do_test ${tn}.${zRepeat}.${::n} {
452 # Remove all traces of database files test.db and test2.db
453 # from the file-system. Then open (empty database) "test.db"
454 # with the handle [db].
456 catch {db close}
457 catch {db2 close}
458 forcedelete test.db
459 forcedelete test.db-journal
460 forcedelete test.db-wal
461 forcedelete test2.db
462 forcedelete test2.db-journal
463 forcedelete test2.db-wal
464 if {[info exists ::mallocopts(-testdb)]} {
465 copy_file $::mallocopts(-testdb) test.db
467 catch { sqlite3 db test.db }
468 if {[info commands db] ne ""} {
469 sqlite3_extended_result_codes db 1
471 sqlite3_db_config_lookaside db 0 0 0
473 # Execute any -tclprep and -sqlprep scripts.
475 if {[info exists ::mallocopts(-tclprep)]} {
476 eval $::mallocopts(-tclprep)
478 if {[info exists ::mallocopts(-sqlprep)]} {
479 execsql $::mallocopts(-sqlprep)
482 # Now set the ${::n}th malloc() to fail and execute the -tclbody
483 # and -sqlbody scripts.
485 sqlite3_memdebug_fail $::n -repeat $::iRepeat
486 set ::mallocbody {}
487 if {[info exists ::mallocopts(-tclbody)]} {
488 append ::mallocbody "$::mallocopts(-tclbody)\n"
490 if {[info exists ::mallocopts(-sqlbody)]} {
491 append ::mallocbody "db eval {$::mallocopts(-sqlbody)}"
494 # The following block sets local variables as follows:
496 # isFail - True if an error (any error) was reported by sqlite.
497 # nFail - The total number of simulated malloc() failures.
498 # nBenign - The number of benign simulated malloc() failures.
500 set isFail [catch $::mallocbody msg]
501 set nFail [sqlite3_memdebug_fail -1 -benigncnt nBenign]
502 # puts -nonewline " (isFail=$isFail nFail=$nFail nBenign=$nBenign) "
504 # If one or more mallocs failed, run this loop body again.
506 set go [expr {$nFail>0}]
508 if {($nFail-$nBenign)==0} {
509 if {$isFail} {
510 set v2 $msg
511 } else {
512 set isFail 1
513 set v2 1
515 } elseif {!$isFail} {
516 set v2 $msg
517 } elseif {
518 [info command db]=="" ||
519 [db errorcode]==7 ||
520 $msg=="out of memory"
522 set v2 1
523 } else {
524 set v2 $msg
525 puts [db errorcode]
527 lappend isFail $v2
528 } {1 1}
530 if {[info exists ::mallocopts(-cleanup)]} {
531 catch [list uplevel #0 $::mallocopts(-cleanup)] msg
535 unset ::mallocopts
536 sqlite3_memdebug_fail -1
540 #-------------------------------------------------------------------------
541 # This proc is used to test a single SELECT statement. Parameter $name is
542 # passed a name for the test case (i.e. "fts3_malloc-1.4.1") and parameter
543 # $sql is passed the text of the SELECT statement. Parameter $result is
544 # set to the expected output if the SELECT statement is successfully
545 # executed using [db eval].
547 # Example:
549 # do_select_test testcase-1.1 "SELECT 1+1, 1+2" {1 2}
551 # If global variable DO_MALLOC_TEST is set to a non-zero value, or if
552 # it is not defined at all, then OOM testing is performed on the SELECT
553 # statement. Each OOM test case is said to pass if either (a) executing
554 # the SELECT statement succeeds and the results match those specified
555 # by parameter $result, or (b) TCL throws an "out of memory" error.
557 # If DO_MALLOC_TEST is defined and set to zero, then the SELECT statement
558 # is executed just once. In this case the test case passes if the results
559 # match the expected results passed via parameter $result.
561 proc do_select_test {name sql result} {
562 uplevel [list doPassiveTest 0 $name $sql [list 0 [list {*}$result]]]
565 proc do_restart_select_test {name sql result} {
566 uplevel [list doPassiveTest 1 $name $sql [list 0 $result]]
569 proc do_error_test {name sql error} {
570 uplevel [list doPassiveTest 0 $name $sql [list 1 $error]]
573 proc doPassiveTest {isRestart name sql catchres} {
574 if {![info exists ::DO_MALLOC_TEST]} { set ::DO_MALLOC_TEST 1 }
576 if {[info exists ::testprefix]
577 && [string is integer [string range $name 0 0]]
579 set name $::testprefix.$name
582 switch $::DO_MALLOC_TEST {
583 0 { # No malloc failures.
584 do_test $name [list set {} [uplevel [list catchsql $sql]]] $catchres
585 return
587 1 { # Simulate transient failures.
588 set nRepeat 1
589 set zName "transient"
590 set nStartLimit 100000
591 set nBackup 1
593 2 { # Simulate persistent failures.
594 set nRepeat 1
595 set zName "persistent"
596 set nStartLimit 100000
597 set nBackup 1
599 3 { # Simulate transient failures with extra brute force.
600 set nRepeat 100000
601 set zName "ridiculous"
602 set nStartLimit 1
603 set nBackup 10
607 # The set of acceptable results from running [catchsql $sql].
609 set answers [list {1 {out of memory}} $catchres]
610 set str [join $answers " OR "]
612 set nFail 1
613 for {set iLimit $nStartLimit} {$nFail} {incr iLimit} {
614 for {set iFail 1} {$nFail && $iFail<=$iLimit} {incr iFail} {
615 for {set iTest 0} {$iTest<$nBackup && ($iFail-$iTest)>0} {incr iTest} {
617 if {$isRestart} { sqlite3 db test.db }
619 sqlite3_memdebug_fail [expr $iFail-$iTest] -repeat $nRepeat
620 set res [uplevel [list catchsql $sql]]
621 if {[lsearch -exact $answers $res]>=0} { set res $str }
622 set testname "$name.$zName.$iFail"
623 do_test "$name.$zName.$iLimit.$iFail" [list set {} $res] $str
625 set nFail [sqlite3_memdebug_fail -1 -benigncnt nBenign]
632 #-------------------------------------------------------------------------
633 # Test a single write to the database. In this case a "write" is a
634 # DELETE, UPDATE or INSERT statement.
636 # If OOM testing is performed, there are several acceptable outcomes:
638 # 1) The write succeeds. No error is returned.
640 # 2) An "out of memory" exception is thrown and:
642 # a) The statement has no effect, OR
643 # b) The current transaction is rolled back, OR
644 # c) The statement succeeds. This can only happen if the connection
645 # is in auto-commit mode (after the statement is executed, so this
646 # includes COMMIT statements).
648 # If the write operation eventually succeeds, zero is returned. If a
649 # transaction is rolled back, non-zero is returned.
651 # Parameter $name is the name to use for the test case (or test cases).
652 # The second parameter, $tbl, should be the name of the database table
653 # being modified. Parameter $sql contains the SQL statement to test.
655 proc do_write_test {name tbl sql} {
656 if {![info exists ::DO_MALLOC_TEST]} { set ::DO_MALLOC_TEST 1 }
658 # Figure out an statement to get a checksum for table $tbl.
659 db eval "SELECT * FROM $tbl" V break
660 set cksumsql "SELECT md5sum([join [concat rowid $V(*)] ,]) FROM $tbl"
662 # Calculate the initial table checksum.
663 set cksum1 [db one $cksumsql]
665 if {$::DO_MALLOC_TEST } {
666 set answers [list {1 {out of memory}} {0 {}}]
667 if {$::DO_MALLOC_TEST==1} {
668 set modes {100000 persistent}
669 } else {
670 set modes {1 transient}
672 } else {
673 set answers [list {0 {}}]
674 set modes [list 0 nofail]
676 set str [join $answers " OR "]
678 foreach {nRepeat zName} $modes {
679 for {set iFail 1} 1 {incr iFail} {
680 if {$::DO_MALLOC_TEST} {sqlite3_memdebug_fail $iFail -repeat $nRepeat}
682 set res [uplevel [list catchsql $sql]]
683 set nFail [sqlite3_memdebug_fail -1 -benigncnt nBenign]
684 if {$nFail==0} {
685 do_test $name.$zName.$iFail [list set {} $res] {0 {}}
686 return
687 } else {
688 if {[lsearch $answers $res]>=0} {
689 set res $str
691 do_test $name.$zName.$iFail [list set {} $res] $str
692 set cksum2 [db one $cksumsql]
693 if {$cksum1 != $cksum2} return