Test script changes: Bug fix and cleanup on ioerr tests. Also, don't use TCL "file copy" command on windows. (CVS 2264)

FossilOrigin-Name: 764b55adb5dff944db36d0d19ce5e7cc758b3a9e
This commit is contained in:
danielk1977
2005-01-22 03:39:39 +00:00
parent d89bd007ba
commit 32554c10d0
11 changed files with 291 additions and 340 deletions
+68 -145
View File
@@ -15,7 +15,7 @@
# The tests in this file use special facilities that are only
# available in the SQLite test fixture.
#
# $Id: autovacuum_ioerr2.test,v 1.3 2005/01/16 09:06:34 danielk1977 Exp $
# $Id: autovacuum_ioerr2.test,v 1.4 2005/01/22 03:39:39 danielk1977 Exp $
set testdir [file dirname $argv0]
source $testdir/tester.tcl
@@ -27,169 +27,92 @@ ifcapable {!autovacuum} {
return
}
proc opendb {} {
catch {file delete -force test.db}
catch {file delete -force test.db-journal}
sqlite3 db test.db
execsql {pragma auto_vacuum = 1}
execsql {SELECT * FROM sqlite_master}
do_ioerr_test autovacuum-ioerr2-1 -sqlprep {
PRAGMA auto_vacuum = 1;
CREATE TABLE abc(a);
INSERT INTO abc VALUES(randstr(1500,1500));
} -sqlbody {
CREATE TABLE abc2(a);
BEGIN;
DELETE FROM abc;
INSERT INTO abc VALUES(randstr(1500,1500));
CREATE TABLE abc3(a);
COMMIT;
}
set ::go 1
for {set n 1} {$go} {incr n} {
do_test autovacuum-ioerr2-1.$n.1 {
set ::sqlite_io_error_pending 0
db close
opendb
execsql {
CREATE TABLE abc(a);
INSERT INTO abc VALUES(randstr(1500,1500));
}
expr [file size test.db]/1024
} {4}
do_test autovacuum-ioerr2-1.$n.2 [subst {
set ::sqlite_io_error_pending $n
}] $n
do_test autovacuum-ioerr2-1.$n.3 {
set r [catch {db eval {
CREATE TABLE abc2(a);
BEGIN;
DELETE FROM abc;
INSERT INTO abc VALUES(randstr(1500,1500));
CREATE TABLE abc3(a);
COMMIT;
}} msg]
set ::go [expr {$::sqlite_io_error_pending<=0}]
expr {$::sqlite_io_error_pending>0 || $r!=0}
} {1}
}
set ::sqlite_io_error_pending 0
set ::go 1
for {set n 1} {$go} {incr n} {
do_test autovacuum-ioerr2-2.$n.1 {
set ::sqlite_io_error_pending 0
db close
opendb
execsql {
PRAGMA cache_size = 10;
BEGIN;
CREATE TABLE abc(a);
INSERT INTO abc VALUES(randstr(1100,1100)); -- Page 4 is overflow
INSERT INTO abc VALUES(randstr(1100,1100)); -- Page 5 is overflow
}
for {set i 0} {$i<150} {incr i} {
execsql {
INSERT INTO abc VALUES(randstr(100,100));
}
}
execsql COMMIT
} {}
do_test autovacuum-ioerr2-2.$n.2 [subst {
set ::sqlite_io_error_pending $n
}] $n
do_test autovacuum-ioerr2-2.$n.3 {
set r [catch {db eval {
BEGIN;
DELETE FROM abc WHERE length(a)>100;
UPDATE abc SET a = randstr(90,90);
CREATE TABLE abc3(a);
COMMIT;
}} msg]
set ::go [expr {$::sqlite_io_error_pending<=0}]
expr {$::sqlite_io_error_pending>0 || $r!=0}
} {1}
}
set ::sqlite_io_error_pending 0
set ::go 1
for {set n 1} {$go} {incr n} {
do_test autovacuum-ioerr2-3.$n.1 {
set ::sqlite_io_error_pending 0
db close
opendb
execsql {
CREATE TABLE abc(a);
CREATE TABLE abc2(b);
}
} {}
do_test autovacuum-ioerr2-3.$n.2 [subst {
set ::sqlite_io_error_pending $n
}] $n
do_test autovacuum-ioerr2-3.$n.3 {
set r [catch {db eval {
BEGIN;
INSERT INTO abc2 VALUES(10);
DROP TABLE abc;
COMMIT;
DROP TABLE abc2;
}} msg]
set ::go [expr {$::sqlite_io_error_pending<=0}]
expr {$::sqlite_io_error_pending>0 || $r!=0}
} {1}
}
set ::sqlite_io_error_pending 0
do_test autovacuum-ioerr2.4.0 {
db close
opendb
do_ioerr_test autovacuum-ioerr2-2 -tclprep {
execsql {
PRAGMA auto_vacuum = 1;
PRAGMA cache_size = 10;
BEGIN;
CREATE TABLE abc(a);
INSERT INTO abc VALUES(randstr(1100,1100)); -- Page 4 is overflow
INSERT INTO abc VALUES(randstr(1100,1100)); -- Page 5 is overflow
}
for {set i 0} {$i<2500} {incr i} {
for {set i 0} {$i<150} {incr i} {
execsql {
INSERT INTO abc VALUES(randstr(100,100));
}
}
execsql COMMIT
file copy -force test.db backup.db
} {}
proc opendb2 {} {
catch {file delete -force test.db}
catch {file delete -force test.db-journal}
file copy backup.db test.db
sqlite3 db test.db
execsql {select * from sqlite_master}
execsql {PRAGMA cache_size = 10}
return ""
} -sqlbody {
BEGIN;
DELETE FROM abc WHERE length(a)>100;
UPDATE abc SET a = randstr(90,90);
CREATE TABLE abc3(a);
COMMIT;
}
set ::go 1
for {set n 1} {$go} {incr n} {
do_test autovacuum-ioerr2-4.$n.1 {
set ::sqlite_io_error_pending 0
db close
opendb2
} {}
do_test autovacuum-ioerr2-4.$n.2 [subst {
set ::sqlite_io_error_pending $n
}] $n
do_test autovacuum-ioerr2-4.$n.3 {
set r [catch {db eval {
do_ioerr_test autovacuum-ioerr2-3 -sqlprep {
PRAGMA auto_vacuum = 1;
CREATE TABLE abc(a);
CREATE TABLE abc2(b);
} -sqlbody {
BEGIN;
INSERT INTO abc2 VALUES(10);
DROP TABLE abc;
COMMIT;
DROP TABLE abc2;
}
file delete -force backup.db
do_ioerr_test autovacuum-ioerr2-4 -tclprep {
if {![file exists backup.db]} {
sqlite3 dbb backup.db
execsql {
PRAGMA auto_vacuum = 1;
BEGIN;
DELETE FROM abc WHERE oid < 3;
UPDATE abc SET a = randstr(100,100) WHERE oid > 2300;
UPDATE abc SET a = randstr(1100,1100) WHERE oid =
(select max(oid) from abc);
CREATE TABLE abc(a);
INSERT INTO abc VALUES(randstr(1100,1100)); -- Page 4 is overflow
INSERT INTO abc VALUES(randstr(1100,1100)); -- Page 5 is overflow
} dbb
for {set i 0} {$i<2500} {incr i} {
execsql {
INSERT INTO abc VALUES(randstr(100,100));
} dbb
}
execsql {
COMMIT;
}} msg]
set ::go [expr {$::sqlite_io_error_pending<=0}]
expr {$::sqlite_io_error_pending>0 || $r!=0}
} {1}
PRAGMA cache_size = 10;
} dbb
dbb close
}
db close
file delete -force test.db
file delete -force test.db-journal
copy_file backup.db test.db
set ::DB [sqlite3 db test.db]
execsql {
PRAGMA cache_size = 10;
}
} -sqlbody {
BEGIN;
DELETE FROM abc WHERE oid < 3;
UPDATE abc SET a = randstr(100,100) WHERE oid > 2300;
UPDATE abc SET a = randstr(1100,1100) WHERE oid =
(select max(oid) from abc);
COMMIT;
}
set ::sqlite_io_error_pending 0
rename opendb ""
db close
catch {file delete -force test.db}
catch {file delete -force test.db-journal}
finish_test
+1 -2
View File
@@ -11,7 +11,7 @@
# This file implements regression tests for SQLite library. The
# focus of this script is page cache subsystem.
#
# $Id: collate3.test,v 1.7 2005/01/03 02:26:55 drh Exp $
# $Id: collate3.test,v 1.8 2005/01/22 03:39:39 danielk1977 Exp $
set testdir [file dirname $argv0]
source $testdir/tester.tcl
@@ -197,7 +197,6 @@ do_test collate3-3.0 {
expr 0
} 0
db eval {select * from collate3t1}
breakpoint
do_test collate3-3.1 {
catchsql {
INSERT INTO collate3t1 VALUES('xxx', 0);
+5 -5
View File
@@ -13,7 +13,7 @@
# This file implements tests to make sure SQLite does not crash or
# segfault if it sees a corrupt database file.
#
# $Id: corrupt2.test,v 1.1 2005/01/11 10:25:07 danielk1977 Exp $
# $Id: corrupt2.test,v 1.2 2005/01/22 03:39:39 danielk1977 Exp $
set testdir [file dirname $argv0]
source $testdir/tester.tcl
@@ -32,7 +32,7 @@ do_test corrupt2-1.2 {
# Corrupt the 16 byte magic string at the start of the file
file delete -force corrupt.db
file delete -force corrupt.db-journal
file copy test.db corrupt.db
copy_file test.db corrupt.db
set f [open corrupt.db a]
seek $f 8 start
puts $f blah
@@ -50,7 +50,7 @@ do_test corrupt2-1.3 {
# Corrupt the page-size (bytes 16 and 17 of page 1).
file delete -force corrupt.db
file delete -force corrupt.db-journal
file copy test.db corrupt.db
copy_file test.db corrupt.db
set f [open corrupt.db a]
fconfigure $f -encoding binary
seek $f 16 start
@@ -69,7 +69,7 @@ do_test corrupt2-1.4 {
# Corrupt the free-block list on page 1.
file delete -force corrupt.db
file delete -force corrupt.db-journal
file copy test.db corrupt.db
copy_file test.db corrupt.db
set f [open corrupt.db a]
fconfigure $f -encoding binary
seek $f 101 start
@@ -88,7 +88,7 @@ do_test corrupt2-1.5 {
# Corrupt the free-block list on page 1.
file delete -force corrupt.db
file delete -force corrupt.db-journal
file copy test.db corrupt.db
copy_file test.db corrupt.db
set f [open corrupt.db a]
fconfigure $f -encoding binary
seek $f 101 start
+49 -155
View File
@@ -15,76 +15,11 @@
# The tests in this file use special facilities that are only
# available in the SQLite test fixture.
#
# $Id: ioerr.test,v 1.16 2005/01/19 03:47:16 danielk1977 Exp $
# $Id: ioerr.test,v 1.17 2005/01/22 03:39:39 danielk1977 Exp $
set testdir [file dirname $argv0]
source $testdir/tester.tcl
# Usage: do_ioerr_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 IO error simulation.
# -sqlbody TCL script to run with IO error simulation.
# -exclude List of 'N' values not to test.
# -start Value of 'N' to begin with (default 1)
#
proc do_ioerr_test {tn args} {
array set ::ioerropts $args
set ::go 1
if {![info exists ::ioerropts(-start)]} {
set ::ioerropts(-start) 1
}
for {set n $::ioerropts(-start)} {$::go} {incr n} {
if {[info exists ::ioerropts(-exclude)]} {
if {[lsearch $::ioerropts(-exclude) $n]!=-1} continue
}
do_test ioerr-$tn.$n.1 {
set ::sqlite_io_error_pending 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 ::ioerropts(-tclprep)]} {
eval $::ioerropts(-tclprep)
}
if {[info exists ::ioerropts(-sqlprep)]} {
execsql $::ioerropts(-sqlprep)
}
expr 0
} {0}
do_test ioerr-$tn.$n.2 [subst {
set ::sqlite_io_error_pending $n
}] $n
set ::ioerrorbody {}
if {[info exists ::ioerropts(-tclbody)]} {
append ::ioerrorbody "$::ioerropts(-tclbody)\n"
}
if {[info exists ::ioerropts(-sqlbody)]} {
append ::ioerrorbody "db eval {$::ioerropts(-sqlbody)}"
}
do_test ioerr-$tn.$n.3 {
set r [catch $::ioerrorbody msg]
set ::go [expr {$::sqlite_io_error_pending<=0}]
expr {$::sqlite_io_error_pending>0 || $r!=0}
} {1}
}
set ::sqlite_io_error_pending 0
unset ::ioerropts
}
# If SQLITE_DEFAULT_AUTOVACUUM is set to true, then a simulated IO error
# on the 8th IO operation in the SQL script below doesn't report an error.
#
@@ -92,7 +27,7 @@ proc do_ioerr_test {tn args} {
# file when the file on disk is only 1 page. The pager layer detects that
# this has happened and suppresses the error returned by the OS layer.
#
do_ioerr_test 1 -sqlprep {
do_ioerr_test ioerr-1 -sqlprep {
SELECT * FROM sqlite_master;
} -sqlbody {
CREATE TABLE t1(a,b,c);
@@ -110,76 +45,40 @@ do_ioerr_test 1 -sqlprep {
DELETE FROM t1 WHERE a<100;
} -exclude [expr [string match [execsql {pragma auto_vacuum}] 1] ? 8 : 0]
# Test for IO errors during a VACUUM.
#
# The first IO call is excluded from the test. This call attempts to read
# the file-header of the temporary database used by VACUUM. Since the
# database doesn't exist at that point, the IO error is not detected.
#
# Additionally, if auto-vacuum is enabled, the 12th IO error is not
# detected. Same reason as the 8th in the test case above.
#
# IO error 134 is omitted because this occurs while closing the
# temporary database used by vacuum and is not reported.
#
do_ioerr_test ioerr-2 -cksum true -sqlprep {
BEGIN;
CREATE TABLE t1(a, b, c);
INSERT INTO t1 VALUES(1, randstr(5,50), randstr(5,50));
INSERT INTO t1 SELECT a+2, b||'-'||rowid, c||'-'||rowid FROM t1;
INSERT INTO t1 SELECT a+4, b||'-'||rowid, c||'-'||rowid FROM t1;
INSERT INTO t1 SELECT a+8, b||'-'||rowid, c||'-'||rowid FROM t1;
INSERT INTO t1 SELECT a+16, b||'-'||rowid, c||'-'||rowid FROM t1;
INSERT INTO t1 SELECT a+32, b||'-'||rowid, c||'-'||rowid FROM t1;
INSERT INTO t1 SELECT a+64, b||'-'||rowid, c||'-'||rowid FROM t1;
INSERT INTO t1 SELECT a+128, b||'-'||rowid, c||'-'||rowid FROM t1;
INSERT INTO t1 VALUES(1, randstr(600,600), randstr(600,600));
CREATE TABLE t2 AS SELECT * FROM t1;
CREATE TABLE t3 AS SELECT * FROM t1;
COMMIT;
DROP TABLE t2;
} -sqlbody {
VACUUM;
} -exclude [list \
1 134 [expr [string match [execsql {pragma auto_vacuum}] 1]?12:-1]]
proc cksum {{db db}} {
set txt [$db eval {
SELECT name, type, sql FROM sqlite_master order by name
}]\n
foreach tbl [$db eval {
SELECT name FROM sqlite_master WHERE type='table' order by name
}] {
append txt [$db eval "SELECT * FROM $tbl"]\n
}
foreach prag {default_synchronous default_cache_size} {
append txt $prag-[$db eval "PRAGMA $prag"]\n
}
set cksum [string length $txt]-[md5 $txt]
# puts $cksum-[file size test.db]
return $cksum
}
set ::go 1
for {set n 1} {$go} {incr n} {
if {$n==24} breakpoint
do_test ioerr-2.$n.1 {
set ::sqlite_io_error_pending 0
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}
sqlite3 db test.db
execsql {
BEGIN;
CREATE TABLE t1(a, b, c);
INSERT INTO t1 VALUES(1, randstr(5,50), randstr(5,50));
INSERT INTO t1 SELECT a+2, b||'-'||rowid, c||'-'||rowid FROM t1;
INSERT INTO t1 SELECT a+4, b||'-'||rowid, c||'-'||rowid FROM t1;
INSERT INTO t1 SELECT a+8, b||'-'||rowid, c||'-'||rowid FROM t1;
INSERT INTO t1 SELECT a+16, b||'-'||rowid, c||'-'||rowid FROM t1;
INSERT INTO t1 SELECT a+32, b||'-'||rowid, c||'-'||rowid FROM t1;
INSERT INTO t1 SELECT a+64, b||'-'||rowid, c||'-'||rowid FROM t1;
INSERT INTO t1 SELECT a+128, b||'-'||rowid, c||'-'||rowid FROM t1;
INSERT INTO t1 VALUES(1, randstr(600,600), randstr(600,600));
CREATE TABLE t2 AS SELECT * FROM t1;
CREATE TABLE t3 AS SELECT * FROM t1;
COMMIT;
DROP TABLE t2;
}
set ::cksum [cksum]
execsql {
SELECT name FROM sqlite_master WHERE type='table'
}
} {t1 t3}
do_test ioerr-2.$n.2 [subst {
set ::sqlite_io_error_pending $n
}] $n
do_test ioerr-2.$n.3 {
set r [catch {db eval {
VACUUM;
}} msg]
set ::go [expr {$::sqlite_io_error_pending<=0}]
expr {$::sqlite_io_error_pending>0 || $r!=0}
set ::sqlite_io_error_pending 0
db close
sqlite3 db test.db
cksum
} $cksum
}
set ::sqlite_io_error_pending 0
do_ioerr_test 3 -tclprep {
do_ioerr_test ioerr-3 -tclprep {
execsql {
PRAGMA cache_size = 10;
BEGIN;
@@ -203,7 +102,7 @@ do_ioerr_test 3 -tclprep {
# Test IO errors that can occur retrieving a record header that flows over
# onto an overflow page.
do_ioerr_test 4 -tclprep {
do_ioerr_test ioerr-4 -tclprep {
set sql "CREATE TABLE abc(a1"
for {set i 2} {$i<1300} {incr i} {
append sql ", a$i"
@@ -223,7 +122,7 @@ set ex ""
if {[string match [execsql {pragma auto_vacuum}] 1]} {
set ex [list 8 17]
}
do_ioerr_test 5 -sqlprep {
do_ioerr_test ioerr-5 -sqlprep {
ATTACH 'test2.db' AS test2;
} -sqlbody {
BEGIN;
@@ -235,7 +134,12 @@ do_ioerr_test 5 -sqlprep {
# Test IO errors when replaying two hot journals from a 2-file
# transaction. This test only runs on UNIX.
if {$tcl_platform(platform)=="unix" && [file exists ./crashtest]} {
do_ioerr_test 6 -tclprep {
do_ioerr_test ioerr-6 -tclprep {
execsql {
ATTACH 'test2.db' as aux;
CREATE TABLE tx(a, b);
CREATE TABLE aux.ty(a, b);
}
set rc [crashsql 2 test2.db-journal {
ATTACH 'test2.db' as aux;
PRAGMA cache_size = 10;
@@ -248,11 +152,10 @@ if {$tcl_platform(platform)=="unix" && [file exists ./crashtest]} {
error "Wrong error message: $rc"
}
} -sqlbody {
ATTACH 'test2.db' as aux;
SELECT * FROM t1;
SELECT * FROM t2;
SELECT * FROM sqlite_master;
SELECT * FROM aux.sqlite_master;
}
}
}
# Test handling of IO errors that occur while rolling back hot journal
# files.
@@ -261,7 +164,7 @@ if {$tcl_platform(platform)=="unix" && [file exists ./crashtest]} {
# SQLite holds a mandatory exclusive lock on journal files it has open.
#
if {$tcl_platform(platform)!="windows"} {
do_ioerr_test 7 -tclprep {
do_ioerr_test ioerr-7 -tclprep {
db close
sqlite3 db2 test2.db
db2 eval {
@@ -271,8 +174,8 @@ if {$tcl_platform(platform)!="windows"} {
BEGIN;
INSERT INTO t1 VALUES(3, 4);
}
file copy -force test2.db test.db
file copy -force test2.db-journal test.db-journal
copy_file test2.db test.db
copy_file test2.db-journal test.db-journal
db2 close
} -tclbody {
sqlite3 db test.db
@@ -282,15 +185,6 @@ if {$tcl_platform(platform)!="windows"} {
} -exclude 1
}
# do_ioerr_test 15 -sqlprep {
# CREATE TABLE abc(a UNIQUE, b, c);
# INSERT INTO abc VALUES(1, 2, 3);
# } -sqlbody {
# BEGIN;
# INSERT INTO abc VALUES(1, 2, 3);
# COMMIT;
# }
finish_test
+3 -3
View File
@@ -14,7 +14,7 @@
# special feature is used to see what happens in the library if a malloc
# were to really fail due to an out-of-memory situation.
#
# $Id: malloc.test,v 1.21 2005/01/19 03:52:55 danielk1977 Exp $
# $Id: malloc.test,v 1.22 2005/01/22 03:39:39 danielk1977 Exp $
set testdir [file dirname $argv0]
source $testdir/tester.tcl
@@ -365,8 +365,8 @@ do_malloc_test 14 -tclprep {
BEGIN;
INSERT INTO t1 VALUES(3, 4);
}
file copy -force test2.db test.db
file copy -force test2.db-journal test.db-journal
copy_file test2.db test.db
copy_file test2.db-journal test.db-journal
db2 close
} -tclbody {
sqlite3 db test.db
+7 -7
View File
@@ -11,7 +11,7 @@
# This file implements regression tests for SQLite library. The
# focus of this script is page cache subsystem.
#
# $Id: pager.test,v 1.22 2005/01/20 02:17:02 danielk1977 Exp $
# $Id: pager.test,v 1.23 2005/01/22 03:39:39 danielk1977 Exp $
set testdir [file dirname $argv0]
@@ -471,8 +471,8 @@ do_test pager-6.1 {
BEGIN;
UPDATE abc SET c = randstr(200,200);
} db2
file copy -force test2.db test.db
file copy -force test2.db-journal test.db-journal
copy_file test2.db test.db
copy_file test2.db-journal test.db-journal
set f [open test.db-journal a]
fconfigure $f -encoding binary
@@ -487,8 +487,8 @@ do_test pager-6.1 {
} {{CREATE TABLE abc(a, b, c)}}
do_test pager-6.2 {
file copy -force test2.db test.db
file copy -force test2.db-journal test.db-journal
copy_file test2.db test.db
copy_file test2.db-journal test.db-journal
set f [open test.db-journal a]
fconfigure $f -encoding binary
@@ -503,8 +503,8 @@ do_test pager-6.2 {
} {{CREATE TABLE abc(a, b, c)}}
do_test pager-6.3 {
file copy -force test2.db test.db
file copy -force test2.db-journal test.db-journal
copy_file test2.db test.db
copy_file test2.db-journal test.db-journal
set f [open test.db-journal a]
fconfigure $f -encoding binary
+1 -2
View File
@@ -11,7 +11,7 @@
# This file implements regression tests for SQLite library. The
# focus of this file is testing the CREATE TABLE statement.
#
# $Id: table.test,v 1.36 2005/01/21 03:12:16 danielk1977 Exp $
# $Id: table.test,v 1.37 2005/01/22 03:39:39 danielk1977 Exp $
set testdir [file dirname $argv0]
source $testdir/tester.tcl
@@ -309,7 +309,6 @@ do_test table-7.3 {
# Try out the CREATE TABLE AS syntax
#
do_test table-8.1 {
breakpoint
execsql2 {
CREATE TABLE t2 AS SELECT * FROM weird;
SELECT * FROM t2;
+138 -1
View File
@@ -11,7 +11,7 @@
# This file implements some common TCL routines used for regression
# testing the SQLite library
#
# $Id: tester.tcl,v 1.45 2005/01/21 03:12:16 danielk1977 Exp $
# $Id: tester.tcl,v 1.46 2005/01/22 03:39:39 danielk1977 Exp $
# Make sure tclsqlite3 was compiled correctly. Abort now with an
# error message if not.
@@ -285,6 +285,143 @@ proc crashsql {crashdelay crashfile sql} {
lappend r $msg
}
# Usage: do_ioerr_test <test number> <options...>
#
# This proc is used to implement test cases that check that IO errors
# are correctly handled. 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 IO error simulation.
# -sqlbody TCL script to run with IO error simulation.
# -exclude List of 'N' values not to test.
# -start Value of 'N' to begin with (default 1)
#
# -cksum Boolean. If true, test that the database does
# not change during the execution of the test case.
#
proc do_ioerr_test {testname args} {
if {$testname=="ioerr-2"} {
breakpoint
}
set ::ioerropts(-start) 1
set ::ioerropts(-cksum) 0
array set ::ioerropts $args
set ::go 1
for {set n $::ioerropts(-start)} {$::go} {incr n} {
# Skip this IO error if it was specified with the "-exclude" option.
if {[info exists ::ioerropts(-exclude)]} {
if {[lsearch $::ioerropts(-exclude) $n]!=-1} continue
}
# 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 {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 ::ioerropts(-tclprep)]} {
eval $::ioerropts(-tclprep)
}
if {[info exists ::ioerropts(-sqlprep)]} {
execsql $::ioerropts(-sqlprep)
}
expr 0
} {0}
# Read the 'checksum' of the database.
if {$::ioerropts(-cksum)} {
set checksum [cksum]
}
# Set the Nth IO error to fail.
do_test $testname.$n.2 [subst {
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.
do_test $testname.$n.3 {
set r [catch $::ioerrorbody msg]
set ::go [expr {$::sqlite_io_error_pending<=0}]
set s [expr $::sqlite_io_error_pending>0]
# puts "$::sqlite_io_error_pending $r $msg"
expr { ($s && !$r) || (!$s && $r) }
# expr {$::sqlite_io_error_pending>0 || $r!=0}
} {1}
# If an IO error occured, then the checksum of the database should
# be the same as before the script that caused the IO error was run.
if {$::go && $::ioerropts(-cksum)} {
do_test $testname.$n.4 {
catch {db close}
set ::DB [sqlite3 db test.db]
cksum
} $checksum
}
}
set ::sqlite_io_error_pending 0
unset ::ioerropts
}
# Return a checksum based on the contents of database 'db'.
#
proc cksum {{db db}} {
set txt [$db eval {
SELECT name, type, sql FROM sqlite_master order by name
}]\n
foreach tbl [$db eval {
SELECT name FROM sqlite_master WHERE type='table' order by name
}] {
append txt [$db eval "SELECT * FROM $tbl"]\n
}
foreach prag {default_synchronous default_cache_size} {
append txt $prag-[$db eval "PRAGMA $prag"]\n
}
set cksum [string length $txt]-[md5 $txt]
# puts $cksum-[file size test.db]
return $cksum
}
# Copy file $from into $to. This is used because some versions of
# TCL for windows (notably the 8.4.1 binary package shipped with the
# current mingw release) have a broken "file copy" command.
#
proc copy_file {from to} {
if {$::tcl_platform(platform)=="unix"} {
file copy -force $from $to
} else {
set f [open $from]
fconfigure $f -translation binary
set t [open $to w]
fconfigure $t -translation binary
puts -nonewline $t [read $f [file size $from]]
close $t
close $f
}
}
# If the library is compiled with the SQLITE_DEFAULT_AUTOVACUUM macro set
# to non-zero, then set the global variable $AUTOVACUUM to 1.
set AUTOVACUUM $sqlite_options(default_autovacuum)