← Back to branch summary

~ubuntu-branches/ubuntu/karmic/gears/karmic

« back to all changes in this revision

Viewing changes to third_party/sqlite_google/test/malloc_common.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Stefan Lesicnik
  • Date: 2009-04-30 19:15:25 UTC
  • Revision ID: james.westby@ubuntu.com-20090430191525-0790sb5wzg8ou0xb
Tags: upstream-0.5.21.0~svn3334+dfsg
Import upstream version 0.5.21.0~svn3334+dfsg

Show diffs side-by-side

added added

removed removed

Lines of Context:
third_party/sqlite_google/test/malloc_common.tcl
 
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.21 2008/08/04 20:13:27 drh 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
          [db errorcode]==[expr 10+(12<<8)] ||
 
151
          $msg=="out of memory"
 
152
        } {
 
153
          set v2 1
 
154
        } else {
 
155
          set v2 $msg
 
156
          puts [db errorcode]
 
157
        }
 
158
        lappend isFail $v2
 
159
      } {1 1}
 
160
  
 
161
      if {[info exists ::mallocopts(-cleanup)]} {
 
162
        catch [list uplevel #0 $::mallocopts(-cleanup)] msg
 
163
      }
 
164
    }
 
165
  }
 
166
  unset ::mallocopts
 
167
  sqlite3_memdebug_fail -1
 
168
}