summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2016-06-02 12:27:55 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2016-06-02 12:27:55 (GMT)
commit87d7d0f11c17176fdca0ff935983866a2f9ec3aa (patch)
treed55f9f5dbf419a13b6ba5d779dcf8ea41ff917e5 /library
parent5937053b54cde66ba71209b74b6d6732275cafec (diff)
downloadtcl-87d7d0f11c17176fdca0ff935983866a2f9ec3aa.zip
tcl-87d7d0f11c17176fdca0ff935983866a2f9ec3aa.tar.gz
tcl-87d7d0f11c17176fdca0ff935983866a2f9ec3aa.tar.bz2
(cherry-pick) Merge TIP #447: Execution Time Verbosity Levels in tcltest::configure. Tcltest 2.3.8 -> 2.4.0.
Diffstat (limited to 'library')
-rw-r--r--library/tcltest/pkgIndex.tcl2
-rw-r--r--library/tcltest/tcltest.tcl36
2 files changed, 32 insertions, 6 deletions
diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl
index 987725f..5ac8823 100644
--- a/library/tcltest/pkgIndex.tcl
+++ b/library/tcltest/pkgIndex.tcl
@@ -9,4 +9,4 @@
# full path name of this file's directory.
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
-package ifneeded tcltest 2.3.8 [list source [file join $dir tcltest.tcl]]
+package ifneeded tcltest 2.4.0 [list source [file join $dir tcltest.tcl]]
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 29ef778..169b7d4 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -22,7 +22,7 @@ namespace eval tcltest {
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the install directory in the Makefiles. When the minor version
# changes (new feature) be sure to update the man page as well.
- variable Version 2.3.8
+ variable Version 2.4.0
# Compatibility support for dumb variables defined in tcltest 1
# Do not use these. Call [package provide Tcl] and [info patchlevel]
@@ -611,16 +611,27 @@ namespace eval tcltest {
proc AcceptVerbose { level } {
set level [AcceptList $level]
+ set levelMap {
+ l list
+ p pass
+ b body
+ s skip
+ t start
+ e error
+ l line
+ m msec
+ u usec
+ }
+ set levelRegexp "^([join [dict values $levelMap] |])\$"
if {[llength $level] == 1} {
- if {![regexp {^(pass|body|skip|start|error|line)$} $level]} {
+ if {![regexp $levelRegexp $level]} {
# translate single characters abbreviations to expanded list
- set level [string map {p pass b body s skip t start e error l line} \
- [split $level {}]]
+ set level [string map $levelMap [split $level {}]]
}
}
set valid [list]
foreach v $level {
- if {[regexp {^(pass|body|skip|start|error|line)$} $v]} {
+ if {[regexp $levelRegexp $v]} {
lappend valid $v
}
}
@@ -1972,6 +1983,11 @@ proc tcltest::test {name description args} {
# Only run the test body if the setup was successful
if {!$setupFailure} {
+ # Register startup time
+ if {[IsVerbose msec] || [IsVerbose usec]} {
+ set timeStart [clock microseconds]
+ }
+
# Verbose notification of $body start
if {[IsVerbose start]} {
puts [outputChannel] "---- $name start"
@@ -2076,6 +2092,16 @@ proc tcltest::test {name description args} {
}
}
+ if {[IsVerbose msec] || [IsVerbose usec]} {
+ set t [expr {[clock microseconds] - $timeStart}]
+ if {[IsVerbose usec]} {
+ puts [outputChannel] "++++ $name took $t μs"
+ }
+ if {[IsVerbose msec]} {
+ puts [outputChannel] "++++ $name took [expr {round($t/1000.)}] ms"
+ }
+ }
+
# if we didn't experience any failures, then we passed
variable numTests
if {!($setupFailure || $cleanupFailure || $coreFailure