OLD | NEW |
1 | 1 |
2 | 2 |
3 | 3 |
4 proc bc_find_binaries {zCaption} { | 4 proc bc_find_binaries {zCaption} { |
5 # Search for binaries to test against. Any executable files that match | 5 # Search for binaries to test against. Any executable files that match |
6 # our naming convention are assumed to be testfixture binaries to test | 6 # our naming convention are assumed to be testfixture binaries to test |
7 # against. | 7 # against. |
8 # | 8 # |
9 set binaries [list] | 9 set binaries [list] |
10 set self [file tail [info nameofexec]] | 10 set self [info nameofexec] |
11 set pattern "$self?*" | 11 set pattern "$self?*" |
12 if {$::tcl_platform(platform)=="windows"} { | 12 if {$::tcl_platform(platform)=="windows"} { |
13 set pattern [string map {\.exe {}} $pattern] | 13 set pattern [string map {\.exe {}} $pattern] |
14 } | 14 } |
15 foreach file [glob -nocomplain $pattern] { | 15 foreach file [glob -nocomplain $pattern] { |
16 if {$file==$self} continue | 16 if {$file==$self} continue |
17 if {[file executable $file] && [file isfile $file]} {lappend binaries $file} | 17 if {[file executable $file] && [file isfile $file]} {lappend binaries $file} |
18 } | 18 } |
19 | 19 |
20 if {[llength $binaries]==0} { | 20 if {[llength $binaries]==0} { |
(...skipping 24 matching lines...) Expand all Loading... |
45 set ::bc_chan [launch_testfixture $bin] | 45 set ::bc_chan [launch_testfixture $bin] |
46 | 46 |
47 proc code1 {tcl} { uplevel #0 $tcl } | 47 proc code1 {tcl} { uplevel #0 $tcl } |
48 proc code2 {tcl} { testfixture $::bc_chan $tcl } | 48 proc code2 {tcl} { testfixture $::bc_chan $tcl } |
49 proc sql1 sql { code1 [list db eval $sql] } | 49 proc sql1 sql { code1 [list db eval $sql] } |
50 proc sql2 sql { code2 [list db eval $sql] } | 50 proc sql2 sql { code2 [list db eval $sql] } |
51 | 51 |
52 code1 { sqlite3 db test.db } | 52 code1 { sqlite3 db test.db } |
53 code2 { sqlite3 db test.db } | 53 code2 { sqlite3 db test.db } |
54 | 54 |
55 set bintag [string map {testfixture {}} $bin] | 55 set bintag $bin |
| 56 regsub {.*testfixture\.} $bintag {} bintag |
56 set bintag [string map {\.exe {}} $bintag] | 57 set bintag [string map {\.exe {}} $bintag] |
57 if {$bintag == ""} {set bintag self} | 58 if {$bintag == ""} {set bintag self} |
58 set saved_prefix $::testprefix | 59 set saved_prefix $::testprefix |
59 append ::testprefix ".$bintag" | 60 append ::testprefix ".$bintag" |
60 | 61 |
61 uplevel $script | 62 uplevel $script |
62 | 63 |
63 set ::testprefix $saved_prefix | 64 set ::testprefix $saved_prefix |
64 | 65 |
65 catch { code1 { db close } } | 66 catch { code1 { db close } } |
66 catch { code2 { db close } } | 67 catch { code2 { db close } } |
67 catch { close $::bc_chan } | 68 catch { close $::bc_chan } |
68 } | 69 } |
69 | 70 |
70 proc do_all_bc_test {script} { | 71 proc do_all_bc_test {script} { |
71 foreach bin $::BC(binaries) { | 72 foreach bin $::BC(binaries) { |
72 uplevel [list do_bc_test $bin $script] | 73 uplevel [list do_bc_test $bin $script] |
73 } | 74 } |
74 } | 75 } |
OLD | NEW |