diff options
Diffstat (limited to 'test/malloc9.test')
| -rw-r--r-- | test/malloc9.test | 97 |
1 files changed, 3 insertions, 94 deletions
diff --git a/test/malloc9.test b/test/malloc9.test index 5df82e4e1..e5e734a22 100644 --- a/test/malloc9.test +++ b/test/malloc9.test @@ -11,110 +11,20 @@ # This file contains additional out-of-memory checks (see malloc.tcl) # added to expose a bug in out-of-memory handling for sqlite3_prepare(). # -# $Id: malloc9.test,v 1.1 2007/04/30 21:39:16 drh Exp $ +# $Id: malloc9.test,v 1.2 2007/08/22 22:04:37 drh Exp $ set testdir [file dirname $argv0] source $testdir/tester.tcl # Only run these tests if memory debugging is turned on. # -if {[info command sqlite_malloc_stat]==""} { +ifcapable !memdebug { puts "Skipping malloc tests: not compiled with -DSQLITE_MEMDEBUG..." finish_test return } -# Usage: do_malloc_test <test number> <options...> -# -# The first argument, <test number>, is an integer used to name the -# tests executed by this proc. Options are as follows: -# -# -tclprep TCL script to run to prepare test. -# -sqlprep SQL script to run to prepare test. -# -tclbody TCL script to run with malloc failure simulation. -# -sqlbody TCL script to run with malloc failure simulation. -# -cleanup TCL script to run after the test. -# -# This command runs a series of tests to verify SQLite's ability -# to handle an out-of-memory condition gracefully. It is assumed -# that if this condition occurs a malloc() call will return a -# NULL pointer. Linux, for example, doesn't do that by default. See -# the "BUGS" section of malloc(3). -# -# Each iteration of a loop, the TCL commands in any argument passed -# to the -tclbody switch, followed by the SQL commands in any argument -# passed to the -sqlbody switch are executed. Each iteration the -# Nth call to sqliteMalloc() is made to fail, where N is increased -# each time the loop runs starting from 1. When all commands execute -# successfully, the loop ends. -# -proc do_malloc_test {tn args} { - array unset ::mallocopts - array set ::mallocopts $args - - set ::go 1 - for {set ::n 1} {$::go && $::n < 50000} {incr ::n} { - do_test malloc9-$tn.$::n { - - sqlite_malloc_fail 0 - catch {db close} - catch {file delete -force test.db} - catch {file delete -force test.db-journal} - sqlite3 db test.db - set ::DB [sqlite3_connection_pointer db] - - # Execute any -tclprep and -sqlprep scripts. - # - if {[info exists ::mallocopts(-tclprep)]} { - eval $::mallocopts(-tclprep) - } - if {[info exists ::mallocopts(-sqlprep)]} { - execsql $::mallocopts(-sqlprep) - } - - # Now set the ${::n}th malloc() to fail and execute the -tclbody and - # -sqlbody scripts. - # - sqlite_malloc_fail $::n - set ::mallocbody {} - if {[info exists ::mallocopts(-tclbody)]} { - append ::mallocbody "$::mallocopts(-tclbody)\n" - } - if {[info exists ::mallocopts(-sqlbody)]} { - append ::mallocbody "db eval {$::mallocopts(-sqlbody)}" - } - set v [catch $::mallocbody msg] - - # If the test fails (if $v!=0) and the database connection actually - # exists, make sure the failure code is SQLITE_NOMEM. - if {$v && [info command db]=="db" && [info exists ::mallocopts(-sqlbody)] - && [db errorcode]!=7} { - set v 999 - } - - set leftover [lindex [sqlite_malloc_stat] 2] - if {$leftover>0} { - if {$leftover>1} {puts "\nLeftover: $leftover\nReturn=$v Message=$msg"} - set ::go 0 - if {$v} { - puts "\nError message returned: $msg" - } else { - set v {1 1} - } - } else { - set v2 [expr {$msg=="" || [regexp {out of memory} $msg]}] - if {!$v2} {puts "\nError message returned: $msg"} - lappend v $v2 - } - } {1 1} - - if {[info exists ::mallocopts(-cleanup)]} { - catch [list uplevel #0 $::mallocopts(-cleanup)] msg - } - } - unset ::mallocopts -} - +source $testdir/malloc_common.tcl do_malloc_test 1 -tclprep { set sql {CREATE TABLE t1(x)} @@ -138,5 +48,4 @@ do_test malloc-99.X { set sqlite_open_file_count } {0} -sqlite_malloc_fail 0 finish_test |