Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Update Eagle script library in externals to support logging of test setting overrides to the test log file. |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
62de6a56130931a3c1a06f89c7ef9720 |
User & Date: | mistachkin 2012-05-05 00:25:39.606 |
Context
2012-05-05
| ||
01:22 | Fix some comments. check-in: 3e63eb3d59 user: mistachkin tags: trunk | |
00:25 | Update Eagle script library in externals to support logging of test setting overrides to the test log file. check-in: 62de6a5613 user: mistachkin tags: trunk | |
2012-05-04
| ||
20:09 | Commit any changes back to the original connection pool list prior to returning the connection handle from the pool. check-in: 35b8195272 user: mistachkin tags: trunk | |
Changes
Changes to Externals/Eagle/lib/Eagle1.0/init.eagle.
︙ | ︙ | |||
221 222 223 224 225 226 227 228 229 230 231 232 233 234 | # NOTE: Grab the value at the specified column. # set result [getColumnValue $row $column $default $wrap] } return $result } proc readFile { fileName } { # # NOTE: This should work properly in both Tcl and Eagle. # set file_id [open $fileName RDONLY] fconfigure $file_id -encoding binary -translation binary; # BINARY DATA | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 | # NOTE: Grab the value at the specified column. # set result [getColumnValue $row $column $default $wrap] } return $result } proc tqputs { channel string } { # # NOTE: If an output channel was provided, use it; otherwise, ignore the # message. # if {[string length $channel] > 0} then { puts -nonewline $channel $string } tqlog $string } proc tqlog { string } { # # NOTE: If an empty string is supplied by the caller, do nothing. # if {[string length $string] > 0} then { # # NOTE: *SPECIAL* The special global variable "test_log_queue" is used # by the [tlog] script library procedure from the test package to # enable it to emit "queued" data into the test log file prior to # emitting the string requested by its caller. The only job for # this procedure is to populate the "test_log_queue" variable for # later use by the test package. # if {[info exists ::test_log_queue]} then { # # NOTE: Use the next queued test log entry. # set entry [expr {[array size ::test_log_queue] + 1}] } else { # # NOTE: Use the first queued test log entry. # set entry 1 } # # NOTE: Add the new entry to the test log queue. All entries will be # sent to the actual test log file the very next time the [tlog] # command from the test package is executed. # set ::test_log_queue($entry) $string } return "" } proc readFile { fileName } { # # NOTE: This should work properly in both Tcl and Eagle. # set file_id [open $fileName RDONLY] fconfigure $file_id -encoding binary -translation binary; # BINARY DATA |
︙ | ︙ | |||
1703 1704 1705 1706 1707 1708 1709 | # NOTE: Exports the necessary commands from this package and import them # into the global namespace. # exportAndImportPackageCommands [namespace current] [list \ exportAndImportPackageCommands isEagle isMono getEnvironmentVariable \ getPluginPath getDictionaryValue getColumnValue getRowColumnValue \ appendArgs haveGaruda lappendArgs readFile filter map reduce \ | | | 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 | # NOTE: Exports the necessary commands from this package and import them # into the global namespace. # exportAndImportPackageCommands [namespace current] [list \ exportAndImportPackageCommands isEagle isMono getEnvironmentVariable \ getPluginPath getDictionaryValue getColumnValue getRowColumnValue \ appendArgs haveGaruda lappendArgs readFile filter map reduce \ getPlatformInfo execShell combineFlags tqputs tqlog] false false ########################################################################### ############################## END Tcl ONLY ############################### ########################################################################### } # # NOTE: Provide the Eagle library package to the interpreter. # package provide Eagle.Library \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Changes to Externals/Eagle/lib/Eagle1.0/test.eagle.
︙ | ︙ | |||
38 39 40 41 42 43 44 | } tlog $string } proc tlog { string } { # | | | > > > > > > > > > > > > > > > > > > > > > > > > > > | > | 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 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 | } tlog $string } proc tlog { string } { # # NOTE: If a test log file was configured, use it; otherwise, ignore the # message. # set fileName [getTestLog] if {[string length $fileName] > 0} then { # # NOTE: Check for any queued test log data that needs to be sent to the # log file prior to sending the current string. # if {[info exists ::test_log_queue]} then { # # NOTE: Process each queued test log entry, in order, sending them to # the test log file (as long as they are not empty strings). # Each entry is removed from the queue after it is sent to the # test log file. # foreach entry [lsort -integer [array names ::test_log_queue]] { set newString $::test_log_queue($entry) if {[string length $newString] > 0} then { appendSharedLogFile $fileName $newString } unset ::test_log_queue($entry) } } # # NOTE: If an empty string is supplied by the caller, do nothing. # if {[string length $string] > 0} then { appendSharedLogFile $fileName $string } } } proc getSoftwareRegistryKey { wow64 } { if {$wow64 && [info exists ::tcl_platform(machine)] && \ $::tcl_platform(machine) eq "amd64"} then { # |
︙ | ︙ | |||
225 226 227 228 229 230 231 | "\", it does not exist\n"] } } } proc processTestArguments { varName args } { # | | | < > > > > > > > | | > > > > > | 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 | "\", it does not exist\n"] } } } proc processTestArguments { varName args } { # # NOTE: We are going to place the configured options in the variable # identified by the name provided by the caller. # upvar 1 $varName array # # TODO: Add more support for standard tcltest options here. # set options [list -configuration -constraints -exitOnComplete -file \ -logFile -match -no -notFile -postTest -preTest -skip -stopOnFailure \ -suffix -threshold] foreach {name value} $args { # # NOTE: Use the [tqputs] command here just in case the test log file # has not been setup yet (i.e. by default, this procedure is # almost always called by the test prologue file prior to the # test log file having been setup and we do not want to just # lose this output). # if {[lsearch -exact $options $name] != -1} then { set array($name) $value tqputs $::test_channel [appendArgs \ "---- overrode test option \"" $name "\" with value \"" $value \ \"\n] } else { tqputs $::test_channel [appendArgs \ "---- unknown test option \"" $name "\" with value \"" $value \ "\" ignored\n"] } } # # NOTE: Now, attempt to flush the test log queue, if available. # tlog "" } proc getTemporaryPath {} { # # NOTE: Build the list of "temporary directory" override # environment variables to check. # |
︙ | ︙ | |||
540 541 542 543 544 545 546 | if {[lindex $args 0] eq "-nonewline"} then { set channel [lindex $args 1] set newLine "" } } } | | < | | | | | < | 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 | if {[lindex $args 0] eq "-nonewline"} then { set channel [lindex $args 1] set newLine "" } } } if {[info exists channel] && $channel eq "stdout"} then { # # NOTE: Write output for stdout to the test channel. # return [tputs $::test_channel [appendArgs [lindex $args end] \ $newLine]] } # # NOTE: If we haven't returned by now, we don't know how to # handle the input. Let puts handle it. # return [eval ::tcl::save::puts $args] |
︙ | ︙ |
Changes to Externals/Eagle/lib/Eagle1.0/vendor.eagle.
︙ | ︙ | |||
37 38 39 40 41 42 43 | set result 0 foreach varName $varNames { if {[uplevel 1 [list info exists $varName]]} then { incr result if {!$quiet} then { | | | | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | set result 0 foreach varName $varNames { if {[uplevel 1 [list info exists $varName]]} then { incr result if {!$quiet} then { tqputs $channel [appendArgs \ "---- found vendor-specific test override \"" $varName "\".\n"] } } } return $result } |
︙ | ︙ | |||
93 94 95 96 97 98 99 | # if {![info exists ::env(EAGLELIBPATH)] || \ [lsearch -exact $::env(EAGLELIBPATH) $dir2] == -1} then { # # NOTE: If we have NOT been instructed to be quiet, report now. # if {!$quiet} then { | | | | | 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 | # if {![info exists ::env(EAGLELIBPATH)] || \ [lsearch -exact $::env(EAGLELIBPATH) $dir2] == -1} then { # # NOTE: If we have NOT been instructed to be quiet, report now. # if {!$quiet} then { tqputs $channel [appendArgs \ "---- found vendor-specific test package directory \"" \ $dir2 "\", adding...\n"] } # # 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). # |
︙ | ︙ | |||
128 129 130 131 132 133 134 | set dir [file dirname $dir] } # # NOTE: If we have NOT been instructed to be quiet, report now. # if {!$quiet} then { | | | | | | 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 159 160 161 | set dir [file dirname $dir] } # # NOTE: If we have NOT been instructed to be quiet, report now. # if {!$quiet} then { tqputs $channel \ "---- could not find vendor-specific test package directory.\n" } # # NOTE: Directory not found, return failure. # return false } proc setupInterpreterTestPath { channel dir quiet } { 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 { tqputs $channel [appendArgs \ "---- set interpreter test path to \"" $dir \".\n] } } } checkForTestOverrides stdout \ [list binary_directory build_base_directory build_directory \ common_directory connection_flags database_directory \ |
︙ | ︙ |
Changes to Tests/tkt-996d13cd87.eagle.
︙ | ︙ | |||
34 35 36 37 38 39 40 | object invoke -flags +NonPublic \ System.Data.SQLite.SQLiteConnectionPool _poolClosed 0 }] == 0} then { set havePoolCounts true } else { set havePoolCounts false | | | | 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 | object invoke -flags +NonPublic \ System.Data.SQLite.SQLiteConnectionPool _poolClosed 0 }] == 0} then { set havePoolCounts true } else { set havePoolCounts false tputs $test_channel \ "==== WARNING: connection pool counts are not available\n" } proc getPoolCounts {} { # # NOTE: If we have the ability to determine the opened/closed pool # counts, fetch them now; otherwise, just set them to zero. # |
︙ | ︙ |