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