|
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 # Usage: do_malloc_test <test number> <options...> |
|
27 # |
|
28 # The first argument, <test number>, is an integer used to name the |
|
29 # tests executed by this proc. Options are as follows: |
|
30 # |
|
31 # -tclprep TCL script to run to prepare test. |
|
32 # -sqlprep SQL script to run to prepare test. |
|
33 # -tclbody TCL script to run with malloc failure simulation. |
|
34 # -sqlbody TCL script to run with malloc failure simulation. |
|
35 # -cleanup TCL script to run after the test. |
|
36 # |
|
37 # This command runs a series of tests to verify SQLite's ability |
|
38 # to handle an out-of-memory condition gracefully. It is assumed |
|
39 # that if this condition occurs a malloc() call will return a |
|
40 # NULL pointer. Linux, for example, doesn't do that by default. See |
|
41 # the "BUGS" section of malloc(3). |
|
42 # |
|
43 # Each iteration of a loop, the TCL commands in any argument passed |
|
44 # to the -tclbody switch, followed by the SQL commands in any argument |
|
45 # passed to the -sqlbody switch are executed. Each iteration the |
|
46 # Nth call to sqliteMalloc() is made to fail, where N is increased |
|
47 # each time the loop runs starting from 1. When all commands execute |
|
48 # successfully, the loop ends. |
|
49 # |
|
50 proc do_malloc_test {tn args} { |
|
51 array unset ::mallocopts |
|
52 array set ::mallocopts $args |
|
53 |
|
54 if {[string is integer $tn]} { |
|
55 set tn malloc-$tn |
|
56 } |
|
57 if {[info exists ::mallocopts(-start)]} { |
|
58 set start $::mallocopts(-start) |
|
59 } else { |
|
60 set start 0 |
|
61 } |
|
62 if {[info exists ::mallocopts(-end)]} { |
|
63 set end $::mallocopts(-end) |
|
64 } else { |
|
65 set end 50000 |
|
66 } |
|
67 save_prng_state |
|
68 |
|
69 foreach ::iRepeat {0 10000000} { |
|
70 set ::go 1 |
|
71 for {set ::n $start} {$::go && $::n <= $end} {incr ::n} { |
|
72 |
|
73 # If $::iRepeat is 0, then the malloc() failure is transient - it |
|
74 # fails and then subsequent calls succeed. If $::iRepeat is 1, |
|
75 # then the failure is persistent - once malloc() fails it keeps |
|
76 # failing. |
|
77 # |
|
78 set zRepeat "transient" |
|
79 if {$::iRepeat} {set zRepeat "persistent"} |
|
80 restore_prng_state |
|
81 foreach file [glob -nocomplain test.db-mj*] {file delete -force $file} |
|
82 |
|
83 do_test ${tn}.${zRepeat}.${::n} { |
|
84 |
|
85 # Remove all traces of database files test.db and test2.db |
|
86 # from the file-system. Then open (empty database) "test.db" |
|
87 # with the handle [db]. |
|
88 # |
|
89 catch {db close} |
|
90 catch {file delete -force test.db} |
|
91 catch {file delete -force test.db-journal} |
|
92 catch {file delete -force test2.db} |
|
93 catch {file delete -force test2.db-journal} |
|
94 if {[info exists ::mallocopts(-testdb)]} { |
|
95 file copy $::mallocopts(-testdb) test.db |
|
96 } |
|
97 catch { sqlite3 db test.db } |
|
98 if {[info commands db] ne ""} { |
|
99 sqlite3_extended_result_codes db 1 |
|
100 } |
|
101 sqlite3_db_config_lookaside db 0 0 0 |
|
102 |
|
103 # Execute any -tclprep and -sqlprep scripts. |
|
104 # |
|
105 if {[info exists ::mallocopts(-tclprep)]} { |
|
106 eval $::mallocopts(-tclprep) |
|
107 } |
|
108 if {[info exists ::mallocopts(-sqlprep)]} { |
|
109 execsql $::mallocopts(-sqlprep) |
|
110 } |
|
111 |
|
112 # Now set the ${::n}th malloc() to fail and execute the -tclbody |
|
113 # and -sqlbody scripts. |
|
114 # |
|
115 sqlite3_memdebug_fail $::n -repeat $::iRepeat |
|
116 set ::mallocbody {} |
|
117 if {[info exists ::mallocopts(-tclbody)]} { |
|
118 append ::mallocbody "$::mallocopts(-tclbody)\n" |
|
119 } |
|
120 if {[info exists ::mallocopts(-sqlbody)]} { |
|
121 append ::mallocbody "db eval {$::mallocopts(-sqlbody)}" |
|
122 } |
|
123 |
|
124 # The following block sets local variables as follows: |
|
125 # |
|
126 # isFail - True if an error (any error) was reported by sqlite. |
|
127 # nFail - The total number of simulated malloc() failures. |
|
128 # nBenign - The number of benign simulated malloc() failures. |
|
129 # |
|
130 set isFail [catch $::mallocbody msg] |
|
131 set nFail [sqlite3_memdebug_fail -1 -benigncnt nBenign] |
|
132 # puts -nonewline " (isFail=$isFail nFail=$nFail nBenign=$nBenign) " |
|
133 |
|
134 # If one or more mallocs failed, run this loop body again. |
|
135 # |
|
136 set go [expr {$nFail>0}] |
|
137 |
|
138 if {($nFail-$nBenign)==0} { |
|
139 if {$isFail} { |
|
140 set v2 $msg |
|
141 } else { |
|
142 set isFail 1 |
|
143 set v2 1 |
|
144 } |
|
145 } elseif {!$isFail} { |
|
146 set v2 $msg |
|
147 } elseif { |
|
148 [info command db]=="" || |
|
149 [db errorcode]==7 || |
|
150 $msg=="out of memory" |
|
151 } { |
|
152 set v2 1 |
|
153 } else { |
|
154 set v2 $msg |
|
155 puts [db errorcode] |
|
156 } |
|
157 lappend isFail $v2 |
|
158 } {1 1} |
|
159 |
|
160 if {[info exists ::mallocopts(-cleanup)]} { |
|
161 catch [list uplevel #0 $::mallocopts(-cleanup)] msg |
|
162 } |
|
163 } |
|
164 } |
|
165 unset ::mallocopts |
|
166 sqlite3_memdebug_fail -1 |
|
167 } |