Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Modify test suite initialization to optionally (and carefully) take advantage of the new 'debug' sub-commands from Eagle beta 33. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
6b46295db1927f5380e1db9590052128 |
| User & Date: | mistachkin 2015-04-09 01:37:55 |
Context
|
2015-04-09
| ||
| 01:50 | Improve comments and diagnostic message from the previous check-in. check-in: 3a7cd19856 user: mistachkin tags: trunk | |
| 01:37 | Modify test suite initialization to optionally (and carefully) take advantage of the new 'debug' sub-commands from Eagle beta 33. check-in: 6b46295db1 user: mistachkin tags: trunk | |
| 01:06 | Fix test suite usage of the haveSQLiteObjectCommand procedure. check-in: b93bd7e4d2 user: mistachkin tags: trunk | |
Changes
Changes to Externals/Eagle/lib/Eagle1.0/vendor.eagle.
60 61 62 63 64 65 66 67 68 69 70 71 72 73 ... 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 ... 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 |
#
if {![uplevel 1 [list info exists test_overrides]]} then {
uplevel 1 [list set test_overrides $varNames]
}
return $result
}
proc addTestSuiteToAutoPath { channel varName quiet } {
#
# NOTE: Start with the directory containing this file.
#
set dir [file normalize [file dirname [info script]]]
................................................................................
# NOTE: Append the directory to the necessary environment variable
# so that it will get picked up when Eagle actually rebuilds
# the auto-path list (below).
#
lappend ::env(EAGLELIBPATH) $dir2
#
# NOTE: Force Eagle to rebuild the auto-path list for the current
# interpreter right now.
#
if {[catch {
object invoke Utility RefreshAutoPathList true
}]} then {
#
# NOTE: Ok, maybe the [object] command is not available. Rescan
# the package indexes using the [package scan] sub-command
# in that case. The directories within EAGLELIBPATH will
# not be added to the auto-path; however, all the package
# indexes and their associated packages will be available.
#
if {!$quiet} then {
catch {
tqputs $channel [appendArgs \
"---- unable to refresh auto-path list, scanning \"" \
$::env(EAGLELIBPATH) "\" instead...\n"]
}
}
eval package scan -host -normal -refresh -- $::env(EAGLELIBPATH)
}
}
#
# NOTE: We are done, return success.
#
return true
................................................................................
#
# NOTE: Directory not found, return failure.
#
return false
}
proc setupInterpreterTestPath { channel dir quiet } {
if {[llength [info commands object]] > 0} then {
set testPath [object invoke -flags +NonPublic Interpreter.GetActive \
TestPath]
if {$dir ne $testPath} then {
object invoke -flags +NonPublic Interpreter.GetActive TestPath $dir
if {!$quiet} then {
catch {
tqputs $channel [appendArgs \
"---- set interpreter test path to \"" $dir \"\n]
}
}
}
} else {
if {!$quiet} then {
catch {
tqputs $channel "---- cannot set interpreter test path\n"
|
> > > > > > > > > > > > > > | | | < > | | | > > > > > > > > > > > > > > > > > > > > > | | | < | > |
60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 ... 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 ... 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 |
#
if {![uplevel 1 [list info exists test_overrides]]} then {
uplevel 1 [list set test_overrides $varNames]
}
return $result
}
proc refreshAutoPath {} {
if {[llength [info subcommands debug refreshautopath]] > 0 && \
[catch {debug refreshautopath true}] == 0} then {
return debug
}
if {[llength [info commands object]] > 0 && \
[catch {object invoke Utility RefreshAutoPathList true}] == 0} then {
return object
}
return ""
}
proc addTestSuiteToAutoPath { channel varName quiet } {
#
# NOTE: Start with the directory containing this file.
#
set dir [file normalize [file dirname [info script]]]
................................................................................
# NOTE: Append the directory to the necessary environment variable
# so that it will get picked up when Eagle actually rebuilds
# the auto-path list (below).
#
lappend ::env(EAGLELIBPATH) $dir2
#
# NOTE: Attempt to force Eagle to rebuild the auto-path for the
# current interpreter right now.
#
set refresh [refreshAutoPath]
if {[string length $refresh] == 0} then {
#
# NOTE: Ok, maybe the [object] command is not available. Rescan
# the package indexes using the [package scan] sub-command
# in that case. The directories within EAGLELIBPATH will
# not be added to the auto-path; however, all the package
# indexes and their associated packages will be available.
#
if {!$quiet} then {
catch {
tqputs $channel [appendArgs \
"---- unable to forcibly refresh auto-path list, " \
"scanning \"" $::env(EAGLELIBPATH) "\" instead...\n"]
}
}
eval package scan -host -normal -refresh -- $::env(EAGLELIBPATH)
} else {
if {!$quiet} then {
catch {
tqputs $channel [appendArgs \
"---- refreshed auto-path list via \"" $refresh \
"\" command\n"]
}
}
}
}
#
# NOTE: We are done, return success.
#
return true
................................................................................
#
# NOTE: Directory not found, return failure.
#
return false
}
proc setupInterpreterTestPath { channel dir quiet } {
if {[llength [info subcommands debug testpath]] > 0 && \
[catch {debug testpath} testPath] == 0} then {
if {$dir ne $testPath} then {
debug testpath $dir
if {!$quiet} then {
catch {
tqputs $channel [appendArgs \
"---- set interpreter test path to \"" $dir \
"\" via \"debug\" command\n"]
}
}
}
} elseif {[llength [info commands object]] > 0 && [catch {
object invoke -flags +NonPublic Interpreter.GetActive TestPath
} testPath] == 0} then {
if {$dir ne $testPath} then {
object invoke -flags +NonPublic Interpreter.GetActive TestPath $dir
if {!$quiet} then {
catch {
tqputs $channel [appendArgs \
"---- set interpreter test path to \"" $dir \
"\" via \"object\" command\n"]
}
}
}
} else {
if {!$quiet} then {
catch {
tqputs $channel "---- cannot set interpreter test path\n"
|