proc bc_find_binaries {zCaption} { # 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] set pattern "[file tail [info nameofexec]]?*" if {$::tcl_platform(platform)=="windows"} { set pattern [string map {\.exe {}} $pattern] } foreach file [glob -nocomplain $pattern] { if {[file executable $file] && [file isfile $file]} {lappend binaries $file} } if {[llength $binaries]==0} { puts "WARNING: No historical binaries to test against." puts "WARNING: Omitting backwards-compatibility tests $zFile" } foreach bin $binaries { puts -nonewline "Testing against $bin - " flush stdout puts "version [get_version $bin]" } set ::BC(binaries) $binaries return $binaries } proc get_version {binary} { set chan [launch_testfixture $binary] set v [testfixture $chan { sqlite3 -version }] close $chan set v } proc do_bc_test {bin script} { forcedelete test.db set ::bc_chan [launch_testfixture $bin] proc code1 {tcl} { uplevel #0 $tcl } proc code2 {tcl} { testfixture $::bc_chan $tcl } 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 } set bintag [string map {testfixture {}} $bin] set bintag [string map {\.exe {}} $bintag] if {$bintag == ""} {set bintag self} set saved_prefix $::testprefix append ::testprefix ".$bintag" uplevel $script set ::testprefix $saved_prefix catch { code1 { db close } } catch { code2 { db close } } catch { close $::bc_chan } } proc do_all_bc_test {script} { foreach bin $::BC(binaries) { uplevel [list do_bc_test $bin $script] } }