drh | 85c23c6 | 2005-08-20 03:03:04 +0000 | [diff] [blame] | 1 | # 2005 September 19 |
| 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 | # This file implements regression tests for SQLite library. The |
| 12 | # focus of this script is testing the ATTACH statement and |
| 13 | # specifically out-of-memory conditions within that command. |
| 14 | # |
drh | 788581d | 2005-08-21 18:21:50 +0000 | [diff] [blame^] | 15 | # $Id: attachmalloc.test,v 1.2 2005/08/21 18:21:50 drh Exp $ |
drh | 85c23c6 | 2005-08-20 03:03:04 +0000 | [diff] [blame] | 16 | # |
| 17 | |
| 18 | set testdir [file dirname $argv0] |
| 19 | source $testdir/tester.tcl |
| 20 | |
drh | 788581d | 2005-08-21 18:21:50 +0000 | [diff] [blame^] | 21 | # Only run these tests if memory debugging is turned on. |
| 22 | # |
| 23 | if {[info command sqlite_malloc_stat]==""} { |
| 24 | puts "Skipping malloc tests: not compiled with -DSQLITE_DEBUG..." |
| 25 | finish_test |
| 26 | return |
| 27 | } |
| 28 | |
| 29 | |
drh | 85c23c6 | 2005-08-20 03:03:04 +0000 | [diff] [blame] | 30 | # Usage: do_malloc_test <test name> <options...> |
| 31 | # |
| 32 | # The first argument, <test number>, is an integer used to name the |
| 33 | # tests executed by this proc. Options are as follows: |
| 34 | # |
| 35 | # -tclprep TCL script to run to prepare test. |
| 36 | # -sqlprep SQL script to run to prepare test. |
| 37 | # -tclbody TCL script to run with malloc failure simulation. |
| 38 | # -sqlbody TCL script to run with malloc failure simulation. |
| 39 | # -cleanup TCL script to run after the test. |
| 40 | # |
| 41 | # This command runs a series of tests to verify SQLite's ability |
| 42 | # to handle an out-of-memory condition gracefully. It is assumed |
| 43 | # that if this condition occurs a malloc() call will return a |
| 44 | # NULL pointer. Linux, for example, doesn't do that by default. See |
| 45 | # the "BUGS" section of malloc(3). |
| 46 | # |
| 47 | # Each iteration of a loop, the TCL commands in any argument passed |
| 48 | # to the -tclbody switch, followed by the SQL commands in any argument |
| 49 | # passed to the -sqlbody switch are executed. Each iteration the |
| 50 | # Nth call to sqliteMalloc() is made to fail, where N is increased |
| 51 | # each time the loop runs starting from 1. When all commands execute |
| 52 | # successfully, the loop ends. |
| 53 | # |
| 54 | proc do_malloc_test {tn args} { |
| 55 | array set ::mallocopts $args |
| 56 | |
| 57 | set ::go 1 |
| 58 | for {set ::n 1} {$::go} {incr ::n} { |
| 59 | |
| 60 | do_test $tn.$::n { |
| 61 | |
| 62 | sqlite_malloc_fail 0 |
| 63 | catch {db close} |
| 64 | catch {file delete -force test.db} |
| 65 | catch {file delete -force test.db-journal} |
| 66 | catch {file delete -force test2.db} |
| 67 | catch {file delete -force test2.db-journal} |
| 68 | set ::DB [sqlite3 db test.db] |
| 69 | |
| 70 | if {[info exists ::mallocopts(-tclprep)]} { |
| 71 | eval $::mallocopts(-tclprep) |
| 72 | } |
| 73 | if {[info exists ::mallocopts(-sqlprep)]} { |
| 74 | execsql $::mallocopts(-sqlprep) |
| 75 | } |
| 76 | |
| 77 | sqlite_malloc_fail $::n |
| 78 | set ::mallocbody {} |
| 79 | if {[info exists ::mallocopts(-tclbody)]} { |
| 80 | append ::mallocbody "$::mallocopts(-tclbody)\n" |
| 81 | } |
| 82 | if {[info exists ::mallocopts(-sqlbody)]} { |
| 83 | append ::mallocbody "db eval {$::mallocopts(-sqlbody)}" |
| 84 | } |
| 85 | |
| 86 | set v [catch $::mallocbody msg] |
| 87 | |
| 88 | set leftover [lindex [sqlite_malloc_stat] 2] |
| 89 | if {$leftover>0} { |
| 90 | if {$leftover>1} {puts "\nLeftover: $leftover\nReturn=$v Message=$msg"} |
| 91 | set ::go 0 |
| 92 | set v {1 1} |
| 93 | } else { |
| 94 | set v2 [expr {$msg=="" || $msg=="out of memory"}] |
| 95 | if {!$v2} {puts "\nError message returned: $msg"} |
| 96 | lappend v $v2 |
| 97 | } |
| 98 | } {1 1} |
| 99 | sqlite_malloc_fail 0 |
| 100 | |
| 101 | if {[info exists ::mallocopts(-cleanup)]} { |
| 102 | catch $::mallocopts(-cleanup) |
| 103 | } |
| 104 | } |
| 105 | unset ::mallocopts |
| 106 | } |
| 107 | |
| 108 | do_malloc_test attachmalloc-1 -tclprep { |
| 109 | db close |
| 110 | for {set i 2} {$i<=4} {incr i} { |
| 111 | file delete -force test$i.db |
| 112 | file delete -force test$i.db-journal |
| 113 | } |
| 114 | } -tclbody { |
| 115 | if {[catch {sqlite3 db test.db}]} { |
| 116 | error "out of memory" |
| 117 | } |
| 118 | } -sqlbody { |
| 119 | ATTACH 'test2.db' AS two; |
| 120 | CREATE TABLE two.t1(x); |
| 121 | ATTACH 'test3.db' AS three; |
| 122 | CREATE TABLE three.t1(x); |
| 123 | ATTACH 'test4.db' AS four; |
| 124 | CREATE TABLE four.t1(x); |
| 125 | } |
| 126 | |
| 127 | finish_test |