1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TclScript/malloc_common.tcl Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,167 @@
1.4 +# 2007 May 05
1.5 +#
1.6 +# The author disclaims copyright to this source code. In place of
1.7 +# a legal notice, here is a blessing:
1.8 +#
1.9 +# May you do good and not evil.
1.10 +# May you find forgiveness for yourself and forgive others.
1.11 +# May you share freely, never taking more than you give.
1.12 +#
1.13 +#***********************************************************************
1.14 +#
1.15 +# This file contains common code used by many different malloc tests
1.16 +# within the test suite.
1.17 +#
1.18 +# $Id: malloc_common.tcl,v 1.22 2008/09/23 16:41:30 danielk1977 Exp $
1.19 +
1.20 +# If we did not compile with malloc testing enabled, then do nothing.
1.21 +#
1.22 +ifcapable builtin_test {
1.23 + set MEMDEBUG 1
1.24 +} else {
1.25 + set MEMDEBUG 0
1.26 + return 0
1.27 +}
1.28 +
1.29 +# Usage: do_malloc_test <test number> <options...>
1.30 +#
1.31 +# The first argument, <test number>, is an integer used to name the
1.32 +# tests executed by this proc. Options are as follows:
1.33 +#
1.34 +# -tclprep TCL script to run to prepare test.
1.35 +# -sqlprep SQL script to run to prepare test.
1.36 +# -tclbody TCL script to run with malloc failure simulation.
1.37 +# -sqlbody TCL script to run with malloc failure simulation.
1.38 +# -cleanup TCL script to run after the test.
1.39 +#
1.40 +# This command runs a series of tests to verify SQLite's ability
1.41 +# to handle an out-of-memory condition gracefully. It is assumed
1.42 +# that if this condition occurs a malloc() call will return a
1.43 +# NULL pointer. Linux, for example, doesn't do that by default. See
1.44 +# the "BUGS" section of malloc(3).
1.45 +#
1.46 +# Each iteration of a loop, the TCL commands in any argument passed
1.47 +# to the -tclbody switch, followed by the SQL commands in any argument
1.48 +# passed to the -sqlbody switch are executed. Each iteration the
1.49 +# Nth call to sqliteMalloc() is made to fail, where N is increased
1.50 +# each time the loop runs starting from 1. When all commands execute
1.51 +# successfully, the loop ends.
1.52 +#
1.53 +proc do_malloc_test {tn args} {
1.54 + array unset ::mallocopts
1.55 + array set ::mallocopts $args
1.56 +
1.57 + if {[string is integer $tn]} {
1.58 + set tn malloc-$tn
1.59 + }
1.60 + if {[info exists ::mallocopts(-start)]} {
1.61 + set start $::mallocopts(-start)
1.62 + } else {
1.63 + set start 0
1.64 + }
1.65 + if {[info exists ::mallocopts(-end)]} {
1.66 + set end $::mallocopts(-end)
1.67 + } else {
1.68 + set end 50000
1.69 + }
1.70 + save_prng_state
1.71 +
1.72 + foreach ::iRepeat {0 10000000} {
1.73 + set ::go 1
1.74 + for {set ::n $start} {$::go && $::n <= $end} {incr ::n} {
1.75 +
1.76 + # If $::iRepeat is 0, then the malloc() failure is transient - it
1.77 + # fails and then subsequent calls succeed. If $::iRepeat is 1,
1.78 + # then the failure is persistent - once malloc() fails it keeps
1.79 + # failing.
1.80 + #
1.81 + set zRepeat "transient"
1.82 + if {$::iRepeat} {set zRepeat "persistent"}
1.83 + restore_prng_state
1.84 + foreach file [glob -nocomplain test.db-mj*] {file delete -force $file}
1.85 +
1.86 + do_test ${tn}.${zRepeat}.${::n} {
1.87 +
1.88 + # Remove all traces of database files test.db and test2.db
1.89 + # from the file-system. Then open (empty database) "test.db"
1.90 + # with the handle [db].
1.91 + #
1.92 + catch {db close}
1.93 + catch {file delete -force test.db}
1.94 + catch {file delete -force test.db-journal}
1.95 + catch {file delete -force test2.db}
1.96 + catch {file delete -force test2.db-journal}
1.97 + if {[info exists ::mallocopts(-testdb)]} {
1.98 + file copy $::mallocopts(-testdb) test.db
1.99 + }
1.100 + catch { sqlite3 db test.db }
1.101 + if {[info commands db] ne ""} {
1.102 + sqlite3_extended_result_codes db 1
1.103 + }
1.104 + sqlite3_db_config_lookaside db 0 0 0
1.105 +
1.106 + # Execute any -tclprep and -sqlprep scripts.
1.107 + #
1.108 + if {[info exists ::mallocopts(-tclprep)]} {
1.109 + eval $::mallocopts(-tclprep)
1.110 + }
1.111 + if {[info exists ::mallocopts(-sqlprep)]} {
1.112 + execsql $::mallocopts(-sqlprep)
1.113 + }
1.114 +
1.115 + # Now set the ${::n}th malloc() to fail and execute the -tclbody
1.116 + # and -sqlbody scripts.
1.117 + #
1.118 + sqlite3_memdebug_fail $::n -repeat $::iRepeat
1.119 + set ::mallocbody {}
1.120 + if {[info exists ::mallocopts(-tclbody)]} {
1.121 + append ::mallocbody "$::mallocopts(-tclbody)\n"
1.122 + }
1.123 + if {[info exists ::mallocopts(-sqlbody)]} {
1.124 + append ::mallocbody "db eval {$::mallocopts(-sqlbody)}"
1.125 + }
1.126 +
1.127 + # The following block sets local variables as follows:
1.128 + #
1.129 + # isFail - True if an error (any error) was reported by sqlite.
1.130 + # nFail - The total number of simulated malloc() failures.
1.131 + # nBenign - The number of benign simulated malloc() failures.
1.132 + #
1.133 + set isFail [catch $::mallocbody msg]
1.134 + set nFail [sqlite3_memdebug_fail -1 -benigncnt nBenign]
1.135 + # puts -nonewline " (isFail=$isFail nFail=$nFail nBenign=$nBenign) "
1.136 +
1.137 + # If one or more mallocs failed, run this loop body again.
1.138 + #
1.139 + set go [expr {$nFail>0}]
1.140 +
1.141 + if {($nFail-$nBenign)==0} {
1.142 + if {$isFail} {
1.143 + set v2 $msg
1.144 + } else {
1.145 + set isFail 1
1.146 + set v2 1
1.147 + }
1.148 + } elseif {!$isFail} {
1.149 + set v2 $msg
1.150 + } elseif {
1.151 + [info command db]=="" ||
1.152 + [db errorcode]==7 ||
1.153 + $msg=="out of memory"
1.154 + } {
1.155 + set v2 1
1.156 + } else {
1.157 + set v2 $msg
1.158 + puts [db errorcode]
1.159 + }
1.160 + lappend isFail $v2
1.161 + } {1 1}
1.162 +
1.163 + if {[info exists ::mallocopts(-cleanup)]} {
1.164 + catch [list uplevel #0 $::mallocopts(-cleanup)] msg
1.165 + }
1.166 + }
1.167 + }
1.168 + unset ::mallocopts
1.169 + sqlite3_memdebug_fail -1
1.170 +}