diff options
author | dan miller | 2007-10-21 08:36:32 +0000 |
---|---|---|
committer | dan miller | 2007-10-21 08:36:32 +0000 |
commit | 2f8d7092bc2c9609fa98d6888106b96f38b22828 (patch) | |
tree | da6c37579258cc965b52a75aee6135fe44237698 /libraries/sqlite/unix/sqlite-3.5.1/test/malloc_common.tcl | |
parent | * Committing new PolicyManager based on an ACL system. (diff) | |
download | opensim-SC-2f8d7092bc2c9609fa98d6888106b96f38b22828.zip opensim-SC-2f8d7092bc2c9609fa98d6888106b96f38b22828.tar.gz opensim-SC-2f8d7092bc2c9609fa98d6888106b96f38b22828.tar.bz2 opensim-SC-2f8d7092bc2c9609fa98d6888106b96f38b22828.tar.xz |
libraries moved to opensim-libs, a new repository
Diffstat (limited to 'libraries/sqlite/unix/sqlite-3.5.1/test/malloc_common.tcl')
-rw-r--r-- | libraries/sqlite/unix/sqlite-3.5.1/test/malloc_common.tcl | 156 |
1 files changed, 0 insertions, 156 deletions
diff --git a/libraries/sqlite/unix/sqlite-3.5.1/test/malloc_common.tcl b/libraries/sqlite/unix/sqlite-3.5.1/test/malloc_common.tcl deleted file mode 100644 index a055013..0000000 --- a/libraries/sqlite/unix/sqlite-3.5.1/test/malloc_common.tcl +++ /dev/null | |||
@@ -1,156 +0,0 @@ | |||
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.9 2007/10/03 08:46:45 danielk1977 Exp $ | ||
16 | |||
17 | # If we did not compile with malloc testing enabled, then do nothing. | ||
18 | # | ||
19 | ifcapable !memdebug { | ||
20 | return 0 | ||
21 | } | ||
22 | |||
23 | # Usage: do_malloc_test <test number> <options...> | ||
24 | # | ||
25 | # The first argument, <test number>, is an integer used to name the | ||
26 | # tests executed by this proc. Options are as follows: | ||
27 | # | ||
28 | # -tclprep TCL script to run to prepare test. | ||
29 | # -sqlprep SQL script to run to prepare test. | ||
30 | # -tclbody TCL script to run with malloc failure simulation. | ||
31 | # -sqlbody TCL script to run with malloc failure simulation. | ||
32 | # -cleanup TCL script to run after the test. | ||
33 | # | ||
34 | # This command runs a series of tests to verify SQLite's ability | ||
35 | # to handle an out-of-memory condition gracefully. It is assumed | ||
36 | # that if this condition occurs a malloc() call will return a | ||
37 | # NULL pointer. Linux, for example, doesn't do that by default. See | ||
38 | # the "BUGS" section of malloc(3). | ||
39 | # | ||
40 | # Each iteration of a loop, the TCL commands in any argument passed | ||
41 | # to the -tclbody switch, followed by the SQL commands in any argument | ||
42 | # passed to the -sqlbody switch are executed. Each iteration the | ||
43 | # Nth call to sqliteMalloc() is made to fail, where N is increased | ||
44 | # each time the loop runs starting from 1. When all commands execute | ||
45 | # successfully, the loop ends. | ||
46 | # | ||
47 | proc do_malloc_test {tn args} { | ||
48 | array unset ::mallocopts | ||
49 | array set ::mallocopts $args | ||
50 | |||
51 | if {[string is integer $tn]} { | ||
52 | set tn malloc-$tn | ||
53 | } | ||
54 | if {[info exists ::mallocopts(-start)]} { | ||
55 | set start $::mallocopts(-start) | ||
56 | } else { | ||
57 | set start 0 | ||
58 | } | ||
59 | |||
60 | foreach ::iRepeat {0 1} { | ||
61 | set ::go 1 | ||
62 | for {set ::n $start} {$::go && $::n < 50000} {incr ::n} { | ||
63 | |||
64 | # If $::iRepeat is 0, then the malloc() failure is transient - it | ||
65 | # fails and then subsequent calls succeed. If $::iRepeat is 1, | ||
66 | # then the failure is persistent - once malloc() fails it keeps | ||
67 | # failing. | ||
68 | # | ||
69 | set zRepeat "transient" | ||
70 | if {$::iRepeat} {set zRepeat "persistent"} | ||
71 | |||
72 | do_test ${tn}.${zRepeat}.${::n} { | ||
73 | |||
74 | # Remove all traces of database files test.db and test2.db | ||
75 | # from the file-system. Then open (empty database) "test.db" | ||
76 | # with the handle [db]. | ||
77 | # | ||
78 | catch {db close} | ||
79 | catch {file delete -force test.db} | ||
80 | catch {file delete -force test.db-journal} | ||
81 | catch {file delete -force test2.db} | ||
82 | catch {file delete -force test2.db-journal} | ||
83 | if {[info exists ::mallocopts(-testdb)]} { | ||
84 | file copy $::mallocopts(-testdb) test.db | ||
85 | } | ||
86 | catch { sqlite3 db test.db } | ||
87 | if {[info commands db] ne ""} { | ||
88 | sqlite3_extended_result_codes db 1 | ||
89 | } | ||
90 | |||
91 | # Execute any -tclprep and -sqlprep scripts. | ||
92 | # | ||
93 | if {[info exists ::mallocopts(-tclprep)]} { | ||
94 | eval $::mallocopts(-tclprep) | ||
95 | } | ||
96 | if {[info exists ::mallocopts(-sqlprep)]} { | ||
97 | execsql $::mallocopts(-sqlprep) | ||
98 | } | ||
99 | |||
100 | # Now set the ${::n}th malloc() to fail and execute the -tclbody | ||
101 | # and -sqlbody scripts. | ||
102 | # | ||
103 | sqlite3_memdebug_fail $::n -repeat $::iRepeat | ||
104 | set ::mallocbody {} | ||
105 | if {[info exists ::mallocopts(-tclbody)]} { | ||
106 | append ::mallocbody "$::mallocopts(-tclbody)\n" | ||
107 | } | ||
108 | if {[info exists ::mallocopts(-sqlbody)]} { | ||
109 | append ::mallocbody "db eval {$::mallocopts(-sqlbody)}" | ||
110 | } | ||
111 | |||
112 | # The following block sets local variables as follows: | ||
113 | # | ||
114 | # isFail - True if an error (any error) was reported by sqlite. | ||
115 | # nFail - The total number of simulated malloc() failures. | ||
116 | # nBenign - The number of benign simulated malloc() failures. | ||
117 | # | ||
118 | set isFail [catch $::mallocbody msg] | ||
119 | set nFail [sqlite3_memdebug_fail -1 -benigncnt nBenign] | ||
120 | |||
121 | # If one or more mallocs failed, run this loop body again. | ||
122 | # | ||
123 | set go [expr {$nFail>0}] | ||
124 | |||
125 | if {($nFail-$nBenign)==0} { | ||
126 | if {$isFail} { | ||
127 | set v2 $msg | ||
128 | } else { | ||
129 | set isFail 1 | ||
130 | set v2 1 | ||
131 | } | ||
132 | } elseif {!$isFail} { | ||
133 | set v2 $msg | ||
134 | } elseif { | ||
135 | [info command db]=="" || | ||
136 | [db errorcode]==7 || | ||
137 | [db errorcode]==[expr 10+(12<<8)] || | ||
138 | $msg=="out of memory" | ||
139 | } { | ||
140 | set v2 1 | ||
141 | } else { | ||
142 | set v2 $msg | ||
143 | breakpoint | ||
144 | puts [db errorcode] | ||
145 | } | ||
146 | lappend isFail $v2 | ||
147 | } {1 1} | ||
148 | |||
149 | if {[info exists ::mallocopts(-cleanup)]} { | ||
150 | catch [list uplevel #0 $::mallocopts(-cleanup)] msg | ||
151 | } | ||
152 | } | ||
153 | } | ||
154 | unset ::mallocopts | ||
155 | sqlite3_memdebug_fail -1 | ||
156 | } | ||