1# 2010 August 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 file is testing that the current version of SQLite 13# is capable of reading and writing databases created by previous 14# versions, and vice-versa. 15# 16# To use this test, old versions of the testfixture process should be 17# copied into the working directory alongside the new version. The old 18# versions should be named "testfixtureXXX" (or testfixtureXXX.exe on 19# windows), where XXX can be any string. 20# 21# This test file uses the tcl code for controlling a second testfixture 22# process located in lock_common.tcl. See the commments in lock_common.tcl 23# for documentation of the available commands. 24# 25 26set testdir [file dirname $argv0] 27source $testdir/tester.tcl 28source $testdir/lock_common.tcl 29source $testdir/malloc_common.tcl 30 31# Search for binaries to test against. Any executable files that match 32# our naming convention are assumed to be testfixture binaries to test 33# against. 34# 35set binaries [list] 36set pattern "[file tail [info nameofexec]]?*" 37foreach file [glob $pattern] { 38 if {[file executable $file]} {lappend binaries $file} 39} 40if {[llength $binaries]==0} { 41 puts "WARNING: No binaries to test against. No tests have been run." 42 finish_test 43 return 44} 45proc get_version {binary} { 46 set chan [launch_testfixture $binary] 47 set v [testfixture $chan { sqlite3 -version }] 48 close $chan 49 set v 50} 51foreach bin $binaries { 52 puts "Testing against $bin - version [get_version $bin]" 53} 54 55#set binaries testfixture 56 57proc do_backcompat_test {rv binary script} { 58 59 if { $rv } { 60 proc code1 {tcl} { testfixture $::bc_chan $tcl } 61 proc code2 {tcl} { uplevel #0 $tcl } 62 } else { 63 proc code1 {tcl} { uplevel #0 $tcl } 64 proc code2 {tcl} { testfixture $::bc_chan $tcl } 65 } 66 67 proc sql1 sql { code1 [list db eval $sql] } 68 proc sql2 sql { code2 [list db eval $sql] } 69 70 file delete -force test.db 71 72 set ::bc_chan [launch_testfixture $binary] 73 code1 { sqlite3 db test.db } 74 code2 { sqlite3 db test.db } 75 76 uplevel $script 77 78 catch { code1 { db close } } 79 catch { code2 { db close } } 80 catch { close $::bc_chan } 81} 82 83array set ::incompatible [list] 84proc do_allbackcompat_test {script} { 85 86 foreach bin $::binaries { 87 set nErr [set_test_counter errors] 88 foreach dir {0 1} { 89 90 set ::bcname ".$dir.[string map {testfixture {}} $bin]." 91 92 rename do_test _do_test 93 proc do_test {nm sql res} { 94 set nm [regsub {\.} $nm $::bcname] 95 uplevel [list _do_test $nm $sql $res] 96 } 97 98 do_backcompat_test $dir $bin $script 99 100 rename do_test {} 101 rename _do_test do_test 102 } 103 if { $nErr < [set_test_counter errors] } { 104 set ::incompatible([get_version $bin]) 1 105 } 106 } 107} 108 109proc read_file {zFile} { 110 set zData {} 111 catch { 112 set fd [open $zFile] 113 fconfigure $fd -translation binary -encoding binary 114 set zData [read $fd] 115 close $fd 116 } 117 return $zData 118} 119proc write_file {zFile zData} { 120 set fd [open $zFile w] 121 fconfigure $fd -translation binary -encoding binary 122 puts -nonewline $fd $zData 123 close $fd 124} 125proc read_file_system {} { 126 set ret [list] 127 foreach f {test.db test.db-journal test.db-wal} { lappend ret [read_file $f] } 128 set ret 129} 130proc write_file_system {data} { 131 foreach f {test.db test.db-journal test.db-wal} d $data { 132 if {[string length $d] == 0} { 133 file delete -force $f 134 } else { 135 write_file $f $d 136 } 137 } 138} 139 140#------------------------------------------------------------------------- 141# Actual tests begin here. 142# 143do_allbackcompat_test { 144 145 # Test that database files are backwards compatible. 146 # 147 do_test backcompat-1.1.1 { sql1 { 148 CREATE TABLE t1(a PRIMARY KEY, b UNIQUE); 149 INSERT INTO t1 VALUES('abc', 'def'); 150 } } {} 151 do_test backcompat-1.1.2 { sql2 { SELECT * FROM t1; } } {abc def} 152 do_test backcompat-1.1.3 { sql2 { INSERT INTO t1 VALUES('ghi', 'jkl'); } } {} 153 do_test backcompat-1.1.4 { sql1 { SELECT * FROM t1; } } {abc def ghi jkl} 154 do_test backcompat-1.1.5 { sql1 { PRAGMA integrity_check } } {ok} 155 do_test backcompat-1.1.6 { sql2 { PRAGMA integrity_check } } {ok} 156 157 # Test that one version can roll back a hot-journal file left in the 158 # file-system by the other version. 159 # 160 do_test backcompat-1.2.1 { sql1 { 161 PRAGMA cache_size = 10; 162 BEGIN; 163 INSERT INTO t1 VALUES(randomblob(400), randomblob(400)); 164 INSERT INTO t1 SELECT randomblob(400), randomblob(400) FROM t1; 165 INSERT INTO t1 SELECT randomblob(400), randomblob(400) FROM t1; 166 INSERT INTO t1 SELECT randomblob(400), randomblob(400) FROM t1; 167 INSERT INTO t1 SELECT randomblob(400), randomblob(400) FROM t1; 168 COMMIT; 169 } } {} 170 set cksum1 [sql1 {SELECT md5sum(a), md5sum(b) FROM t1}] 171 set cksum2 [sql2 {SELECT md5sum(a), md5sum(b) FROM t1}] 172 do_test backcompat-1.2.2 [list string compare $cksum1 $cksum2] 0 173 174 do_test backcompat-1.2.3 { sql1 { 175 BEGIN; 176 UPDATE t1 SET a = randomblob(500); 177 } } {} 178 set data [read_file_system] 179 do_test backcompat-1.2.4 { sql1 { COMMIT } } {} 180 181 set same [expr {[sql2 {SELECT md5sum(a), md5sum(b) FROM t1}] == $cksum2}] 182 do_test backcompat-1.2.5 [list set {} $same] 0 183 184 write_file_system $data 185 set same [expr {[sql2 {SELECT md5sum(a), md5sum(b) FROM t1}] == $cksum2}] 186 do_test backcompat-1.2.6 [list set {} $same] 1 187 188 do_test backcompat-1.2.7 { sql2 { PRAGMA integrity_check } } {ok} 189 do_test backcompat-1.2.8 { sql2 { PRAGMA integrity_check } } {ok} 190} 191 192foreach k [lsort [array names ::incompatible]] { 193 puts "ERROR: Detected incompatibility with version $k" 194} 195 196finish_test 197