diff options
author | gahr <gahr@gahr.ch> | 2016-04-20 19:27:31 (GMT) |
---|---|---|
committer | gahr <gahr@gahr.ch> | 2016-04-20 19:27:31 (GMT) |
commit | dba0cd17dc6865c239fccdb75c700563aa7deb0d (patch) | |
tree | 94eb211fdf0c09277b9e8bf4ed9d97f87622e4ea /library | |
parent | 3f2f704c28a23ff932110f2eab0daeb1536b7bdd (diff) | |
download | tcl-dba0cd17dc6865c239fccdb75c700563aa7deb0d.zip tcl-dba0cd17dc6865c239fccdb75c700563aa7deb0d.tar.gz tcl-dba0cd17dc6865c239fccdb75c700563aa7deb0d.tar.bz2 |
Implement msec and usec verbosity levels in tcltest::configure
Diffstat (limited to 'library')
-rw-r--r-- | library/tcltest/tcltest.tcl | 36 |
1 files changed, 32 insertions, 4 deletions
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 29ef778..30965b8 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -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,14 @@ proc tcltest::test {name description args} { # Only run the test body if the setup was successful if {!$setupFailure} { + # Register startup time + if {[IsVerbose msec]} { + set msStart [clock milliseconds] + } + if {[IsVerbose usec]} { + set usStart [clock microseconds] + } + # Verbose notification of $body start if {[IsVerbose start]} { puts [outputChannel] "---- $name start" @@ -2076,6 +2095,15 @@ proc tcltest::test {name description args} { } } + if {[IsVerbose msec]} { + set elapsed [expr {[clock milliseconds] - $msStart}] + puts [outputChannel] "++++ $name took $elapsed ms" + } + if {[IsVerbose usec]} { + set elapsed [expr {[clock microseconds] - $usStart}] + puts [outputChannel] "++++ $name took $elapsed μs" + } + # if we didn't experience any failures, then we passed variable numTests if {!($setupFailure || $cleanupFailure || $coreFailure |