Index: third_party/sqlite/src/test/bc_common.tcl |
diff --git a/third_party/sqlite/src/test/bc_common.tcl b/third_party/sqlite/src/test/bc_common.tcl |
new file mode 100644 |
index 0000000000000000000000000000000000000000..eb9b6db9d3536ef9bbbe7d4eb7e03d2042967c3b |
--- /dev/null |
+++ b/third_party/sqlite/src/test/bc_common.tcl |
@@ -0,0 +1,72 @@ |
+ |
+ |
+ |
+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" |
+ } |
+ |
+ 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] |
+ } |
+} |