Annotation of embedaddon/sqlite3/test/malloc_common.tcl, revision 1.1.1.1
1.1 misho 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:
97:
98: #--------------------------------------------------------------------------
99: # Usage do_faultsim_test NAME ?OPTIONS...?
100: #
101: # -faults List of fault types to simulate.
102: #
103: # -prep Script to execute before -body.
104: #
105: # -body Script to execute (with fault injection).
106: #
107: # -test Script to execute after -body.
108: #
109: # -install Script to execute after faultsim -injectinstall
110: #
111: # -uninstall Script to execute after faultsim -uninjectinstall
112: #
113: proc do_faultsim_test {name args} {
114: global FAULTSIM
115:
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) ""
122:
123: fix_testname name
124:
125: array set O [array get DEFAULT]
126: array set O $args
127: foreach o [array names O] {
128: if {[info exists DEFAULT($o)]==0} { error "unknown option: $o" }
129: }
130:
131: set faultlist [list]
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]
136: }
137:
138: set testspec [list -prep $O(-prep) -body $O(-body) \
139: -test $O(-test) -install $O(-install) -uninstall $O(-uninstall)
140: ]
141: foreach f [lsort -unique $faultlist] {
142: eval do_one_faultsim_test "$name-$f" $FAULTSIM($f) $testspec
143: }
144: }
145:
146:
147: #-------------------------------------------------------------------------
148: # Procedures to save and restore the current file-system state:
149: #
150: # faultsim_save
151: # faultsim_restore
152: # faultsim_save_and_close
153: # faultsim_restore_and_reopen
154: # faultsim_delete_and_reopen
155: #
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
163: }
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
168: }
169:
170: proc faultsim_integrity_check {{db db}} {
171: set ic [$db eval { PRAGMA integrity_check }]
172: if {$ic != "ok"} { error "Integrity check: $ic" }
173: }
174:
175:
176: # The following procs are used as [do_one_faultsim_test] callbacks when
177: # injecting OOM faults into test cases.
178: #
179: proc oom_injectstart {nRepeat iFail} {
180: sqlite3_memdebug_fail [expr $iFail-1] -repeat $nRepeat
181: }
182: proc oom_injectstop {} {
183: sqlite3_memdebug_fail -1
184: }
185:
186: # The following procs are used as [do_one_faultsim_test] callbacks when
187: # injecting IO error faults into test cases.
188: #
189: proc ioerr_injectstart {persist iFail} {
190: set ::sqlite_io_error_persist $persist
191: set ::sqlite_io_error_pending $iFail
192: }
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
200: return $sv
201: }
202:
203: # The following procs are used as [do_one_faultsim_test] callbacks when
204: # injecting shared-memory related error faults into test cases.
205: #
206: proc shmerr_injectinstall {} {
207: testvfs shmfault -default true
208: shmfault filter {xShmOpen xShmMap xShmLock}
209: }
210: proc shmerr_injectuninstall {} {
211: catch {db close}
212: catch {db2 close}
213: shmfault delete
214: }
215: proc shmerr_injectstart {persist iFail} {
216: shmfault ioerr $iFail $persist
217: }
218: proc shmerr_injectstop {} {
219: shmfault ioerr
220: }
221:
222: # The following procs are used as [do_one_faultsim_test] callbacks when
223: # injecting SQLITE_FULL error faults into test cases.
224: #
225: proc fullerr_injectinstall {} {
226: testvfs shmfault -default true
227: }
228: proc fullerr_injectuninstall {} {
229: catch {db close}
230: catch {db2 close}
231: shmfault delete
232: }
233: proc fullerr_injectstart {iFail} {
234: shmfault full $iFail 1
235: }
236: proc fullerr_injectstop {} {
237: shmfault full
238: }
239:
240: # The following procs are used as [do_one_faultsim_test] callbacks when
241: # injecting SQLITE_CANTOPEN error faults into test cases.
242: #
243: proc cantopen_injectinstall {} {
244: testvfs shmfault -default true
245: }
246: proc cantopen_injectuninstall {} {
247: catch {db close}
248: catch {db2 close}
249: shmfault delete
250: }
251: proc cantopen_injectstart {persist iFail} {
252: shmfault cantopen $iFail $persist
253: }
254: proc cantopen_injectstop {} {
255: shmfault cantopen
256: }
257:
258: # This command is not called directly. It is used by the
259: # [faultsim_test_result] command created by [do_faultsim_test] and used
260: # by -test scripts.
261: #
262: proc faultsim_test_result_int {args} {
263: upvar testrc testrc testresult testresult testnfail testnfail
264: set t [list $testrc $testresult]
265: set r $args
266: if { ($testnfail==0 && $t != [lindex $r 0]) || [lsearch $r $t]<0 } {
267: error "nfail=$testnfail rc=$testrc result=$testresult"
268: }
269: }
270:
271: #--------------------------------------------------------------------------
272: # Usage do_one_faultsim_test NAME ?OPTIONS...?
273: #
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.
277: #
278: # -injectstart Script to enable fault-injection.
279: #
280: # -injectstop Script to disable fault-injection.
281: #
282: # -injecterrlist List of generally acceptable test results (i.e. error
283: # messages). Example: [list {1 {out of memory}}]
284: #
285: # -injectinstall
286: #
287: # -injectuninstall
288: #
289: # -prep Script to execute before -body.
290: #
291: # -body Script to execute (with fault injection).
292: #
293: # -test Script to execute after -body.
294: #
295: proc do_one_faultsim_test {testname args} {
296:
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) ""
307:
308: array set O [array get DEFAULT]
309: array set O $args
310: foreach o [array names O] {
311: if {[info exists DEFAULT($o)]==0} { error "unknown option: $o" }
312: }
313:
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)]
317: "
318:
319: eval $O(-injectinstall)
320: eval $O(-install)
321:
322: set stop 0
323: for {set iFail 1} {!$stop} {incr iFail} {
324:
325: # Evaluate the -prep script.
326: #
327: eval $O(-prep)
328:
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.
332: #
333: eval $O(-injectstart) $iFail
334: set rc [catch $O(-body) res]
335: set nfail [eval $O(-injectstop)]
336:
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).
341: #
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}
345:
346: # If no faults where injected this trial, don't bother running
347: # any more. This test is finished.
348: #
349: if {$nfail==0} { set stop 1 }
350: }
351:
352: eval $O(-uninstall)
353: eval $O(-injectuninstall)
354: }
355:
356: # Usage: do_malloc_test <test number> <options...>
357: #
358: # The first argument, <test number>, is an integer used to name the
359: # tests executed by this proc. Options are as follows:
360: #
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.
366: #
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).
372: #
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.
379: #
380: proc do_malloc_test {tn args} {
381: array unset ::mallocopts
382: array set ::mallocopts $args
383:
384: if {[string is integer $tn]} {
385: set tn malloc-$tn
386: }
387: if {[info exists ::mallocopts(-start)]} {
388: set start $::mallocopts(-start)
389: } else {
390: set start 0
391: }
392: if {[info exists ::mallocopts(-end)]} {
393: set end $::mallocopts(-end)
394: } else {
395: set end 50000
396: }
397: save_prng_state
398:
399: foreach ::iRepeat {0 10000000} {
400: set ::go 1
401: for {set ::n $start} {$::go && $::n <= $end} {incr ::n} {
402:
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
406: # failing.
407: #
408: set zRepeat "transient"
409: if {$::iRepeat} {set zRepeat "persistent"}
410: restore_prng_state
411: foreach file [glob -nocomplain test.db-mj*] {forcedelete $file}
412:
413: do_test ${tn}.${zRepeat}.${::n} {
414:
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].
418: #
419: catch {db close}
420: catch {db2 close}
421: forcedelete test.db
422: forcedelete test.db-journal
423: forcedelete test.db-wal
424: forcedelete test2.db
425: forcedelete test2.db-journal
426: forcedelete test2.db-wal
427: if {[info exists ::mallocopts(-testdb)]} {
428: copy_file $::mallocopts(-testdb) test.db
429: }
430: catch { sqlite3 db test.db }
431: if {[info commands db] ne ""} {
432: sqlite3_extended_result_codes db 1
433: }
434: sqlite3_db_config_lookaside db 0 0 0
435:
436: # Execute any -tclprep and -sqlprep scripts.
437: #
438: if {[info exists ::mallocopts(-tclprep)]} {
439: eval $::mallocopts(-tclprep)
440: }
441: if {[info exists ::mallocopts(-sqlprep)]} {
442: execsql $::mallocopts(-sqlprep)
443: }
444:
445: # Now set the ${::n}th malloc() to fail and execute the -tclbody
446: # and -sqlbody scripts.
447: #
448: sqlite3_memdebug_fail $::n -repeat $::iRepeat
449: set ::mallocbody {}
450: if {[info exists ::mallocopts(-tclbody)]} {
451: append ::mallocbody "$::mallocopts(-tclbody)\n"
452: }
453: if {[info exists ::mallocopts(-sqlbody)]} {
454: append ::mallocbody "db eval {$::mallocopts(-sqlbody)}"
455: }
456:
457: # The following block sets local variables as follows:
458: #
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.
462: #
463: set isFail [catch $::mallocbody msg]
464: set nFail [sqlite3_memdebug_fail -1 -benigncnt nBenign]
465: # puts -nonewline " (isFail=$isFail nFail=$nFail nBenign=$nBenign) "
466:
467: # If one or more mallocs failed, run this loop body again.
468: #
469: set go [expr {$nFail>0}]
470:
471: if {($nFail-$nBenign)==0} {
472: if {$isFail} {
473: set v2 $msg
474: } else {
475: set isFail 1
476: set v2 1
477: }
478: } elseif {!$isFail} {
479: set v2 $msg
480: } elseif {
481: [info command db]=="" ||
482: [db errorcode]==7 ||
483: $msg=="out of memory"
484: } {
485: set v2 1
486: } else {
487: set v2 $msg
488: puts [db errorcode]
489: }
490: lappend isFail $v2
491: } {1 1}
492:
493: if {[info exists ::mallocopts(-cleanup)]} {
494: catch [list uplevel #0 $::mallocopts(-cleanup)] msg
495: }
496: }
497: }
498: unset ::mallocopts
499: sqlite3_memdebug_fail -1
500: }
501:
502:
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].
509: #
510: # Example:
511: #
512: # do_select_test testcase-1.1 "SELECT 1+1, 1+2" {1 2}
513: #
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.
519: #
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.
523: #
524: proc do_select_test {name sql result} {
525: uplevel [list doPassiveTest 0 $name $sql [list 0 [list {*}$result]]]
526: }
527:
528: proc do_restart_select_test {name sql result} {
529: uplevel [list doPassiveTest 1 $name $sql [list 0 $result]]
530: }
531:
532: proc do_error_test {name sql error} {
533: uplevel [list doPassiveTest 0 $name $sql [list 1 $error]]
534: }
535:
536: proc doPassiveTest {isRestart name sql catchres} {
537: if {![info exists ::DO_MALLOC_TEST]} { set ::DO_MALLOC_TEST 1 }
538:
539: if {[info exists ::testprefix]
540: && [string is integer [string range $name 0 0]]
541: } {
542: set name $::testprefix.$name
543: }
544:
545: switch $::DO_MALLOC_TEST {
546: 0 { # No malloc failures.
547: do_test $name [list set {} [uplevel [list catchsql $sql]]] $catchres
548: return
549: }
550: 1 { # Simulate transient failures.
551: set nRepeat 1
552: set zName "transient"
553: set nStartLimit 100000
554: set nBackup 1
555: }
556: 2 { # Simulate persistent failures.
557: set nRepeat 1
558: set zName "persistent"
559: set nStartLimit 100000
560: set nBackup 1
561: }
562: 3 { # Simulate transient failures with extra brute force.
563: set nRepeat 100000
564: set zName "ridiculous"
565: set nStartLimit 1
566: set nBackup 10
567: }
568: }
569:
570: # The set of acceptable results from running [catchsql $sql].
571: #
572: set answers [list {1 {out of memory}} $catchres]
573: set str [join $answers " OR "]
574:
575: set nFail 1
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} {
579:
580: if {$isRestart} { sqlite3 db test.db }
581:
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
587:
588: set nFail [sqlite3_memdebug_fail -1 -benigncnt nBenign]
589: }
590: }
591: }
592: }
593:
594:
595: #-------------------------------------------------------------------------
596: # Test a single write to the database. In this case a "write" is a
597: # DELETE, UPDATE or INSERT statement.
598: #
599: # If OOM testing is performed, there are several acceptable outcomes:
600: #
601: # 1) The write succeeds. No error is returned.
602: #
603: # 2) An "out of memory" exception is thrown and:
604: #
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).
610: #
611: # If the write operation eventually succeeds, zero is returned. If a
612: # transaction is rolled back, non-zero is returned.
613: #
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.
617: #
618: proc do_write_test {name tbl sql} {
619: if {![info exists ::DO_MALLOC_TEST]} { set ::DO_MALLOC_TEST 1 }
620:
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"
624:
625: # Calculate the initial table checksum.
626: set cksum1 [db one $cksumsql]
627:
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}
632: } else {
633: set modes {1 transient}
634: }
635: } else {
636: set answers [list {0 {}}]
637: set modes [list 0 nofail]
638: }
639: set str [join $answers " OR "]
640:
641: foreach {nRepeat zName} $modes {
642: for {set iFail 1} 1 {incr iFail} {
643: if {$::DO_MALLOC_TEST} {sqlite3_memdebug_fail $iFail -repeat $nRepeat}
644:
645: set res [uplevel [list catchsql $sql]]
646: set nFail [sqlite3_memdebug_fail -1 -benigncnt nBenign]
647: if {$nFail==0} {
648: do_test $name.$zName.$iFail [list set {} $res] {0 {}}
649: return
650: } else {
651: if {[lsearch $answers $res]>=0} {
652: set res $str
653: }
654: do_test $name.$zName.$iFail [list set {} $res] $str
655: set cksum2 [db one $cksumsql]
656: if {$cksum1 != $cksum2} return
657: }
658: }
659: }
660: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to malloc_common.tcl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / sqlite3 / test