OLD | NEW |
(Empty) | |
| 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 } |
OLD | NEW |