1
0
mirror of https://github.com/sqlite/sqlite.git synced 2025-07-29 08:01:23 +03:00

Enhancements to test scripts. No code changes.

FossilOrigin-Name: ccab94c10d54e585de918bbf82dec188287d93b2
This commit is contained in:
dan
2013-02-23 18:58:11 +00:00
parent 87ade19eb9
commit b88e24fd59
5 changed files with 78 additions and 59 deletions

View File

@ -1118,6 +1118,25 @@ proc crashsql {args} {
lappend r $msg
}
proc run_ioerr_prep {} {
set ::sqlite_io_error_pending 0
catch {db close}
catch {db2 close}
catch {forcedelete test.db}
catch {forcedelete test.db-journal}
catch {forcedelete test2.db}
catch {forcedelete test2.db-journal}
set ::DB [sqlite3 db test.db; sqlite3_connection_pointer db]
sqlite3_extended_result_codes $::DB $::ioerropts(-erc)
if {[info exists ::ioerropts(-tclprep)]} {
eval $::ioerropts(-tclprep)
}
if {[info exists ::ioerropts(-sqlprep)]} {
execsql $::ioerropts(-sqlprep)
}
expr 0
}
# Usage: do_ioerr_test <test number> <options...>
#
# This proc is used to implement test cases that check that IO errors
@ -1150,10 +1169,26 @@ proc do_ioerr_test {testname args} {
# TEMPORARY: For 3.5.9, disable testing of extended result codes. There are
# a couple of obscure IO errors that do not return them.
set ::ioerropts(-erc) 0
# Create a single TCL script from the TCL and SQL specified
# as the body of the test.
set ::ioerrorbody {}
if {[info exists ::ioerropts(-tclbody)]} {
append ::ioerrorbody "$::ioerropts(-tclbody)\n"
}
if {[info exists ::ioerropts(-sqlbody)]} {
append ::ioerrorbody "db eval {$::ioerropts(-sqlbody)}"
}
save_prng_state
if {$::ioerropts(-cksum)} {
run_ioerr_prep
eval $::ioerrorbody
set ::goodcksum [cksum]
}
set ::go 1
#reset_prng_state
save_prng_state
for {set n $::ioerropts(-start)} {$::go} {incr n} {
set ::TN $n
incr ::ioerropts(-count) -1
@ -1170,27 +1205,12 @@ proc do_ioerr_test {testname args} {
# Delete the files test.db and test2.db, then execute the TCL and
# SQL (in that order) to prepare for the test case.
do_test $testname.$n.1 {
set ::sqlite_io_error_pending 0
catch {db close}
catch {db2 close}
catch {forcedelete test.db}
catch {forcedelete test.db-journal}
catch {forcedelete test2.db}
catch {forcedelete test2.db-journal}
set ::DB [sqlite3 db test.db; sqlite3_connection_pointer db]
sqlite3_extended_result_codes $::DB $::ioerropts(-erc)
if {[info exists ::ioerropts(-tclprep)]} {
eval $::ioerropts(-tclprep)
}
if {[info exists ::ioerropts(-sqlprep)]} {
execsql $::ioerropts(-sqlprep)
}
expr 0
run_ioerr_prep
} {0}
# Read the 'checksum' of the database.
if {$::ioerropts(-cksum)} {
set checksum [cksum]
set ::checksum [cksum]
}
# Set the Nth IO error to fail.
@ -1198,20 +1218,10 @@ proc do_ioerr_test {testname args} {
set ::sqlite_io_error_persist $::ioerropts(-persist)
set ::sqlite_io_error_pending $n
}] $n
# Create a single TCL script from the TCL and SQL specified
# as the body of the test.
set ::ioerrorbody {}
if {[info exists ::ioerropts(-tclbody)]} {
append ::ioerrorbody "$::ioerropts(-tclbody)\n"
}
if {[info exists ::ioerropts(-sqlbody)]} {
append ::ioerrorbody "db eval {$::ioerropts(-sqlbody)}"
}
# Execute the TCL Script created in the above block. If
# there are at least N IO operations performed by SQLite as
# a result of the script, the Nth will fail.
# Execute the TCL script created for the body of this test. If
# at least N IO operations performed by SQLite as a result of
# the script, the Nth will fail.
do_test $testname.$n.3 {
set ::sqlite_io_error_hit 0
set ::sqlite_io_error_hardhit 0
@ -1315,8 +1325,15 @@ proc do_ioerr_test {testname args} {
catch {db close}
catch {db2 close}
set ::DB [sqlite3 db test.db; sqlite3_connection_pointer db]
cksum
} $checksum
set nowcksum [cksum]
set res [expr {$nowcksum==$::checksum || $nowcksum==$::goodcksum}]
if {$res==0} {
puts "now=$nowcksum"
puts "the=$::checksum"
puts "fwd=$::goodcksum"
}
set res
} 1
}
set ::sqlite_io_error_hardhit 0