| # 2005 September 19 |
| # |
| # The author disclaims copyright to this source code. In place of |
| # a legal notice, here is a blessing: |
| # |
| # May you do good and not evil. |
| # May you find forgiveness for yourself and forgive others. |
| # May you share freely, never taking more than you give. |
| # |
| #************************************************************************* |
| # This file implements regression tests for SQLite library. The |
| # focus of this script is testing the ATTACH statement and |
| # specifically out-of-memory conditions within that command. |
| # |
| # $Id: attachmalloc.test,v 1.2 2005/08/21 18:21:50 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]==""} { |
| puts "Skipping malloc tests: not compiled with -DSQLITE_DEBUG..." |
| finish_test |
| return |
| } |
| |
| |
| # Usage: do_malloc_test <test name> <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 set ::mallocopts $args |
| |
| set ::go 1 |
| for {set ::n 1} {$::go} {incr ::n} { |
| |
| do_test $tn.$::n { |
| |
| sqlite_malloc_fail 0 |
| catch {db close} |
| catch {file delete -force test.db} |
| catch {file delete -force test.db-journal} |
| catch {file delete -force test2.db} |
| catch {file delete -force test2.db-journal} |
| set ::DB [sqlite3 db test.db] |
| |
| if {[info exists ::mallocopts(-tclprep)]} { |
| eval $::mallocopts(-tclprep) |
| } |
| if {[info exists ::mallocopts(-sqlprep)]} { |
| execsql $::mallocopts(-sqlprep) |
| } |
| |
| 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] |
| |
| set leftover [lindex [sqlite_malloc_stat] 2] |
| if {$leftover>0} { |
| if {$leftover>1} {puts "\nLeftover: $leftover\nReturn=$v Message=$msg"} |
| set ::go 0 |
| set v {1 1} |
| } else { |
| set v2 [expr {$msg=="" || $msg=="out of memory"}] |
| if {!$v2} {puts "\nError message returned: $msg"} |
| lappend v $v2 |
| } |
| } {1 1} |
| sqlite_malloc_fail 0 |
| |
| if {[info exists ::mallocopts(-cleanup)]} { |
| catch $::mallocopts(-cleanup) |
| } |
| } |
| unset ::mallocopts |
| } |
| |
| do_malloc_test attachmalloc-1 -tclprep { |
| db close |
| for {set i 2} {$i<=4} {incr i} { |
| file delete -force test$i.db |
| file delete -force test$i.db-journal |
| } |
| } -tclbody { |
| if {[catch {sqlite3 db test.db}]} { |
| error "out of memory" |
| } |
| } -sqlbody { |
| ATTACH 'test2.db' AS two; |
| CREATE TABLE two.t1(x); |
| ATTACH 'test3.db' AS three; |
| CREATE TABLE three.t1(x); |
| ATTACH 'test4.db' AS four; |
| CREATE TABLE four.t1(x); |
| } |
| |
| finish_test |