2010-08-19 13:05:53 +02:00
|
|
|
# 2010 August 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 file is testing that the current version of SQLite
|
|
|
|
# is capable of reading and writing databases created by previous
|
|
|
|
# versions, and vice-versa.
|
|
|
|
#
|
|
|
|
# To use this test, old versions of the testfixture process should be
|
|
|
|
# copied into the working directory alongside the new version. The old
|
|
|
|
# versions should be named "testfixtureXXX" (or testfixtureXXX.exe on
|
|
|
|
# windows), where XXX can be any string.
|
|
|
|
#
|
|
|
|
# This test file uses the tcl code for controlling a second testfixture
|
|
|
|
# process located in lock_common.tcl. See the commments in lock_common.tcl
|
|
|
|
# for documentation of the available commands.
|
|
|
|
#
|
|
|
|
|
|
|
|
set testdir [file dirname $argv0]
|
|
|
|
source $testdir/tester.tcl
|
|
|
|
source $testdir/lock_common.tcl
|
|
|
|
source $testdir/malloc_common.tcl
|
2010-08-19 17:11:34 +02:00
|
|
|
db close
|
2010-08-19 13:05:53 +02:00
|
|
|
|
|
|
|
# Search for binaries to test against. Any executable files that match
|
|
|
|
# our naming convention are assumed to be testfixture binaries to test
|
|
|
|
# against.
|
|
|
|
#
|
|
|
|
set binaries [list]
|
2010-08-19 17:11:34 +02:00
|
|
|
set pattern "[file tail [info nameofexec]]*"
|
2010-08-19 13:05:53 +02:00
|
|
|
foreach file [glob $pattern] {
|
|
|
|
if {[file executable $file]} {lappend binaries $file}
|
|
|
|
}
|
|
|
|
if {[llength $binaries]==0} {
|
|
|
|
puts "WARNING: No binaries to test against. No tests have been run."
|
|
|
|
finish_test
|
|
|
|
return
|
|
|
|
}
|
|
|
|
proc get_version {binary} {
|
|
|
|
set chan [launch_testfixture $binary]
|
|
|
|
set v [testfixture $chan { sqlite3 -version }]
|
|
|
|
close $chan
|
|
|
|
set v
|
|
|
|
}
|
|
|
|
foreach bin $binaries {
|
|
|
|
puts "Testing against $bin - version [get_version $bin]"
|
|
|
|
}
|
|
|
|
|
2010-08-19 17:11:34 +02:00
|
|
|
proc do_backcompat_test {rv bin1 bin2 script} {
|
2010-08-19 13:05:53 +02:00
|
|
|
|
2010-08-19 17:11:34 +02:00
|
|
|
file delete -force test.db
|
|
|
|
|
|
|
|
if {$bin1 != ""} { set ::bc_chan1 [launch_testfixture $bin1] }
|
|
|
|
set ::bc_chan2 [launch_testfixture $bin2]
|
2010-08-19 13:05:53 +02:00
|
|
|
|
|
|
|
if { $rv } {
|
|
|
|
proc code2 {tcl} { uplevel #0 $tcl }
|
2010-08-19 17:11:34 +02:00
|
|
|
if {$bin1 != ""} { proc code2 {tcl} { testfixture $::bc_chan1 $tcl } }
|
|
|
|
proc code1 {tcl} { testfixture $::bc_chan2 $tcl }
|
2010-08-19 13:05:53 +02:00
|
|
|
} else {
|
|
|
|
proc code1 {tcl} { uplevel #0 $tcl }
|
2010-08-19 17:11:34 +02:00
|
|
|
if {$bin1 != ""} { proc code1 {tcl} { testfixture $::bc_chan1 $tcl } }
|
|
|
|
proc code2 {tcl} { testfixture $::bc_chan2 $tcl }
|
2010-08-19 13:05:53 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
proc sql1 sql { code1 [list db eval $sql] }
|
|
|
|
proc sql2 sql { code2 [list db eval $sql] }
|
|
|
|
|
|
|
|
code1 { sqlite3 db test.db }
|
|
|
|
code2 { sqlite3 db test.db }
|
|
|
|
|
|
|
|
uplevel $script
|
|
|
|
|
|
|
|
catch { code1 { db close } }
|
|
|
|
catch { code2 { db close } }
|
2010-08-19 17:11:34 +02:00
|
|
|
catch { close $::bc_chan2 }
|
|
|
|
catch { close $::bc_chan1 }
|
2010-08-19 13:05:53 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
array set ::incompatible [list]
|
|
|
|
proc do_allbackcompat_test {script} {
|
|
|
|
|
|
|
|
foreach bin $::binaries {
|
|
|
|
set nErr [set_test_counter errors]
|
|
|
|
foreach dir {0 1} {
|
|
|
|
|
2010-08-19 17:11:34 +02:00
|
|
|
set ::bcname ".[string map {testfixture {}} $bin].$dir."
|
2010-08-19 13:05:53 +02:00
|
|
|
|
|
|
|
rename do_test _do_test
|
|
|
|
proc do_test {nm sql res} {
|
|
|
|
set nm [regsub {\.} $nm $::bcname]
|
|
|
|
uplevel [list _do_test $nm $sql $res]
|
|
|
|
}
|
|
|
|
|
2010-08-19 17:11:34 +02:00
|
|
|
do_backcompat_test $dir {} $bin $script
|
2010-08-19 13:05:53 +02:00
|
|
|
|
|
|
|
rename do_test {}
|
|
|
|
rename _do_test do_test
|
|
|
|
}
|
|
|
|
if { $nErr < [set_test_counter errors] } {
|
|
|
|
set ::incompatible([get_version $bin]) 1
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
proc read_file {zFile} {
|
|
|
|
set zData {}
|
|
|
|
catch {
|
|
|
|
set fd [open $zFile]
|
|
|
|
fconfigure $fd -translation binary -encoding binary
|
|
|
|
set zData [read $fd]
|
|
|
|
close $fd
|
|
|
|
}
|
|
|
|
return $zData
|
|
|
|
}
|
|
|
|
proc write_file {zFile zData} {
|
|
|
|
set fd [open $zFile w]
|
|
|
|
fconfigure $fd -translation binary -encoding binary
|
|
|
|
puts -nonewline $fd $zData
|
|
|
|
close $fd
|
|
|
|
}
|
|
|
|
proc read_file_system {} {
|
|
|
|
set ret [list]
|
|
|
|
foreach f {test.db test.db-journal test.db-wal} { lappend ret [read_file $f] }
|
|
|
|
set ret
|
|
|
|
}
|
|
|
|
proc write_file_system {data} {
|
|
|
|
foreach f {test.db test.db-journal test.db-wal} d $data {
|
|
|
|
if {[string length $d] == 0} {
|
|
|
|
file delete -force $f
|
|
|
|
} else {
|
|
|
|
write_file $f $d
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
#-------------------------------------------------------------------------
|
|
|
|
# Actual tests begin here.
|
|
|
|
#
|
|
|
|
do_allbackcompat_test {
|
|
|
|
|
|
|
|
# Test that database files are backwards compatible.
|
|
|
|
#
|
|
|
|
do_test backcompat-1.1.1 { sql1 {
|
|
|
|
CREATE TABLE t1(a PRIMARY KEY, b UNIQUE);
|
|
|
|
INSERT INTO t1 VALUES('abc', 'def');
|
|
|
|
} } {}
|
|
|
|
do_test backcompat-1.1.2 { sql2 { SELECT * FROM t1; } } {abc def}
|
|
|
|
do_test backcompat-1.1.3 { sql2 { INSERT INTO t1 VALUES('ghi', 'jkl'); } } {}
|
|
|
|
do_test backcompat-1.1.4 { sql1 { SELECT * FROM t1; } } {abc def ghi jkl}
|
|
|
|
do_test backcompat-1.1.5 { sql1 { PRAGMA integrity_check } } {ok}
|
|
|
|
do_test backcompat-1.1.6 { sql2 { PRAGMA integrity_check } } {ok}
|
|
|
|
|
|
|
|
# Test that one version can roll back a hot-journal file left in the
|
|
|
|
# file-system by the other version.
|
|
|
|
#
|
2010-08-19 17:11:34 +02:00
|
|
|
# Each test case is named "backcompat-1.X...", where X is either 0 or
|
|
|
|
# 1. If it is 0, then the current version creates a journal file that
|
|
|
|
# the old versions try to read. Otherwise, if X is 1, then the old version
|
|
|
|
# creates the journal file and we try to read it with the current version.
|
|
|
|
#
|
2010-08-19 13:05:53 +02:00
|
|
|
do_test backcompat-1.2.1 { sql1 {
|
|
|
|
PRAGMA cache_size = 10;
|
|
|
|
BEGIN;
|
|
|
|
INSERT INTO t1 VALUES(randomblob(400), randomblob(400));
|
|
|
|
INSERT INTO t1 SELECT randomblob(400), randomblob(400) FROM t1;
|
|
|
|
INSERT INTO t1 SELECT randomblob(400), randomblob(400) FROM t1;
|
|
|
|
INSERT INTO t1 SELECT randomblob(400), randomblob(400) FROM t1;
|
|
|
|
INSERT INTO t1 SELECT randomblob(400), randomblob(400) FROM t1;
|
|
|
|
COMMIT;
|
|
|
|
} } {}
|
|
|
|
set cksum1 [sql1 {SELECT md5sum(a), md5sum(b) FROM t1}]
|
|
|
|
set cksum2 [sql2 {SELECT md5sum(a), md5sum(b) FROM t1}]
|
|
|
|
do_test backcompat-1.2.2 [list string compare $cksum1 $cksum2] 0
|
|
|
|
|
|
|
|
do_test backcompat-1.2.3 { sql1 {
|
|
|
|
BEGIN;
|
|
|
|
UPDATE t1 SET a = randomblob(500);
|
|
|
|
} } {}
|
|
|
|
set data [read_file_system]
|
2010-08-19 17:11:34 +02:00
|
|
|
|
|
|
|
set f "test.db-journal[incr x]"
|
|
|
|
file copy -force test.db-journal $f
|
|
|
|
|
2010-08-19 13:05:53 +02:00
|
|
|
do_test backcompat-1.2.4 { sql1 { COMMIT } } {}
|
|
|
|
|
|
|
|
set same [expr {[sql2 {SELECT md5sum(a), md5sum(b) FROM t1}] == $cksum2}]
|
|
|
|
do_test backcompat-1.2.5 [list set {} $same] 0
|
|
|
|
|
2010-08-19 17:11:34 +02:00
|
|
|
code1 { db close }
|
|
|
|
code2 { db close }
|
2010-08-19 13:05:53 +02:00
|
|
|
write_file_system $data
|
2010-08-19 17:11:34 +02:00
|
|
|
code1 { sqlite3 db test.db }
|
|
|
|
code2 { sqlite3 db test.db }
|
|
|
|
|
2010-08-19 13:05:53 +02:00
|
|
|
set same [expr {[sql2 {SELECT md5sum(a), md5sum(b) FROM t1}] == $cksum2}]
|
|
|
|
do_test backcompat-1.2.6 [list set {} $same] 1
|
|
|
|
|
2010-08-19 17:11:34 +02:00
|
|
|
do_test backcompat-1.2.7 { sql1 { PRAGMA integrity_check } } {ok}
|
2010-08-19 13:05:53 +02:00
|
|
|
do_test backcompat-1.2.8 { sql2 { PRAGMA integrity_check } } {ok}
|
|
|
|
}
|
|
|
|
|
|
|
|
foreach k [lsort [array names ::incompatible]] {
|
|
|
|
puts "ERROR: Detected incompatibility with version $k"
|
|
|
|
}
|
|
|
|
|
|
|
|
finish_test
|