Imported from /home/lorry/working-area/delta_berkeleydb/db-6.1.23.tar.gz.HEADdb-6.1.23master

1 files changed, 72 insertions, 0 deletions

diff --git a/lang/sql/sqlite/test/bc_common.tcl b/lang/sql/sqlite/test/bc_common.tcl
new file mode 100644
index 00000000..eb9b6db9
--- /dev/null
+++ b/lang/sql/sqlite/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]
+  }
+}