third_party/sqlite/sqlite-src-3080704/test/bc_common.tcl

   1
   2
   3
   4 proc bc_find_binaries {zCaption} {
   5   # Search for binaries to test against. Any executable files that match
   6   # our naming convention are assumed to be testfixture binaries to test
   7   # against.
   8   #
   9   set binaries [list]
  10   set pattern "[file tail [info nameofexec]]?*"
  11   if {$::tcl_platform(platform)=="windows"} {
  12     set pattern [string map {\.exe {}} $pattern]
  13   }
  14   foreach file [glob -nocomplain $pattern] {
  15     if {[file executable $file] && [file isfile $file]} {lappend binaries $file}
  16   }
  17
  18   if {[llength $binaries]==0} {
  19     puts "WARNING: No historical binaries to test against."
  20     puts "WARNING: Omitting backwards-compatibility tests"
  21   }
  22
  23   foreach bin $binaries {
  24     puts -nonewline "Testing against $bin - "
  25     flush stdout
  26     puts "version [get_version $bin]"
  27   }
  28
  29   set ::BC(binaries) $binaries
  30   return $binaries
  31 }
  32
  33 proc get_version {binary} {
  34   set chan [launch_testfixture $binary]
  35   set v [testfixture $chan { sqlite3 -version }]
  36   close $chan
  37   set v
  38 }
  39
  40 proc do_bc_test {bin script} {
  41
  42   forcedelete test.db
  43   set ::bc_chan [launch_testfixture $bin]
  44
  45   proc code1 {tcl} { uplevel #0 $tcl }
  46   proc code2 {tcl} { testfixture $::bc_chan $tcl }
  47   proc sql1 sql { code1 [list db eval $sql] }
  48   proc sql2 sql { code2 [list db eval $sql] }
  49
  50   code1 { sqlite3 db test.db }
  51   code2 { sqlite3 db test.db }
  52
  53   set bintag [string map {testfixture {}} $bin]
  54   set bintag [string map {\.exe {}} $bintag]
  55   if {$bintag == ""} {set bintag self}
  56   set saved_prefix $::testprefix
  57   append ::testprefix ".$bintag"
  58
  59   uplevel $script
  60
  61   set ::testprefix $saved_prefix
  62
  63   catch { code1 { db close } }
  64   catch { code2 { db close } }
  65   catch { close $::bc_chan }
  66 }
  67
  68 proc do_all_bc_test {script} {
  69   foreach bin $::BC(binaries) {
  70     uplevel [list do_bc_test $bin $script]
  71   }
  72 }