1
0
mirror of https://github.com/sqlite/sqlite.git synced 2025-07-30 19:03:16 +03:00

Bring the ancient malloc3.test file closer into relevance with the latest core code.

FossilOrigin-Name: 9793a21c13a1188383b4be64df86629f196ca330
This commit is contained in:
mistachkin
2012-12-06 04:19:24 +00:00
parent 0590552811
commit f44d4b41bd
3 changed files with 43 additions and 33 deletions

View File

@ -147,6 +147,7 @@ if {!$MEMDEBUG} {
# ::run_test_script. At the end of this file, the proc [run_test] is used
# to execute the program (and all test cases contained therein).
#
set ::run_test_sql_id 0
set ::run_test_script [list]
proc TEST {id t} {lappend ::run_test_script -test [list $id $t]}
proc PREP {p} {lappend ::run_test_script -prep [string trim $p]}
@ -162,13 +163,14 @@ proc DEBUG {s} {lappend ::run_test_script -debug $s}
# transaction only.
#
proc SQL {a1 {a2 ""}} {
# An SQL primitive parameter is a list of two elements, a boolean value
# indicating if the statement may cause transaction rollback when malloc()
# fails, and the sql statement itself.
# An SQL primitive parameter is a list of three elements, an id, a boolean
# value indicating if the statement may cause transaction rollback when
# malloc() fails, and the sql statement itself.
set id [incr ::run_test_sql_id]
if {$a2 == ""} {
lappend ::run_test_script -sql [list true [string trim $a1]]
lappend ::run_test_script -sql [list $id true [string trim $a1]]
} else {
lappend ::run_test_script -sql [list false [string trim $a2]]
lappend ::run_test_script -sql [list $id false [string trim $a2]]
}
}
@ -258,7 +260,7 @@ TEST 5 {
set sql {
BEGIN;DELETE FROM abc;
}
for {set i 1} {$i < 15} {incr i} {
for {set i 1} {$i < 100} {incr i} {
set a $i
set b "String value $i"
set c [string repeat X $i]
@ -529,12 +531,13 @@ proc run_test {arglist iRepeat {pcstart 0} {iFailStart 1}} {
}
for {set i 0} {$i < $pcstart} {incr i} {
set k2 [lindex $arglist [expr 2 * $i]]
set v2 [lindex $arglist [expr 2 * $i + 1]]
set k2 [lindex $arglist [expr {2 * $i}]]
set v2 [lindex $arglist [expr {2 * $i + 1}]]
set ac [sqlite3_get_autocommit $::DB] ;# Auto-Commit
switch -- $k2 {
-sql {db eval [lindex $v2 1]}
-sql {db eval [lindex $v2 2]}
-prep {db eval $v2}
-debug {eval $v2}
}
set nac [sqlite3_get_autocommit $::DB] ;# New Auto-Commit
if {$ac && !$nac} {set begin_pc $i}
@ -545,25 +548,31 @@ proc run_test {arglist iRepeat {pcstart 0} {iFailStart 1}} {
set iFail $iFailStart
set pc $pcstart
while {$pc*2 < [llength $arglist]} {
# Fetch the current instruction type and payload.
set k [lindex $arglist [expr {2 * $pc}]]
set v [lindex $arglist [expr {2 * $pc + 1}]]
# Id of this iteration:
set k [lindex $arglist [expr 2 * $pc]]
set iterid "pc=$pc.iFail=$iFail$k"
set v [lindex $arglist [expr 2 * $pc + 1]]
switch -- $k {
-test {
foreach {id script} $v {}
set testid "malloc3-(test $id).$iterid"
eval $script
incr pc
}
-sql {
set ::rollback_hook_count 0
set id [lindex $v 0]
set testid "malloc3-(integrity $id).$iterid"
set ac [sqlite3_get_autocommit $::DB] ;# Auto-Commit
sqlite3_memdebug_fail $iFail -repeat 0
set rc [catch {db eval [lindex $v 1]} msg] ;# True error occurs
set rc [catch {db eval [lindex $v 2]} msg] ;# True error occurs
set nac [sqlite3_get_autocommit $::DB] ;# New Auto-Commit
if {$rc != 0 && $nac && !$ac} {
@ -571,7 +580,7 @@ proc run_test {arglist iRepeat {pcstart 0} {iFailStart 1}} {
# is set. Since an error occured we assume this was not a
# commit - therefore a rollback occured. Check that the
# rollback-hook was invoked.
do_test malloc3-rollback_hook.$iterid {
do_test malloc3-rollback_hook_count.$iterid {
set ::rollback_hook_count
} {1}
}
@ -582,8 +591,9 @@ proc run_test {arglist iRepeat {pcstart 0} {iFailStart 1}} {
# calls should be equal to the number of benign failures.
# Otherwise a malloc() failed and the error was not reported.
#
if {$nFail!=$nBenign} {
error "Unreported malloc() failure"
set expr {$nFail!=$nBenign}
if {[expr $expr]} {
error "Unreported malloc() failure, test \"$testid\", $expr"
}
if {$ac && !$nac} {
@ -595,24 +605,23 @@ proc run_test {arglist iRepeat {pcstart 0} {iFailStart 1}} {
incr pc
set iFail 1
integrity_check "malloc3-(integrity).$iterid"
integrity_check $testid
} elseif {[regexp {.*out of memory} $msg] || [db errorcode] == 3082} {
# Out of memory error, as expected.
#
integrity_check "malloc3-(integrity).$iterid"
integrity_check $testid
incr iFail
if {$nac && !$ac} {
if {![lindex $v 0] && [db errorcode] != 3082} {
# error "Statement \"[lindex $v 1]\" caused a rollback"
if {![lindex $v 1] && [db errorcode] != 3082} {
# error "Statement \"[lindex $v 2]\" caused a rollback"
}
for {set i $begin_pc} {$i < $pc} {incr i} {
set k2 [lindex $arglist [expr 2 * $i]]
set v2 [lindex $arglist [expr 2 * $i + 1]]
set k2 [lindex $arglist [expr {2 * $i}]]
set v2 [lindex $arglist [expr {2 * $i + 1}]]
set catchupsql ""
switch -- $k2 {
-sql {set catchupsql [lindex $v2 1]}
-sql {set catchupsql [lindex $v2 2]}
-prep {set catchupsql $v2}
}
db eval $catchupsql
@ -622,7 +631,8 @@ proc run_test {arglist iRepeat {pcstart 0} {iFailStart 1}} {
error $msg
}
while {[lindex $arglist [expr 2 * ($pc -1)]] == "-test"} {
# back up to the previous "-test" block.
while {[lindex $arglist [expr {2 * ($pc - 1)}]] == "-test"} {
incr pc -1
}
}
@ -642,7 +652,7 @@ proc run_test {arglist iRepeat {pcstart 0} {iFailStart 1}} {
}
}
# Turn of the Tcl interface's prepared statement caching facility. Then
# Turn off the Tcl interface's prepared statement caching facility. Then
# run the tests with "persistent" malloc failures.
sqlite3_extended_result_codes db 1
db cache size 0