diff options
| -rw-r--r-- | doc/tcltest.n | 8 | ||||
| -rw-r--r-- | library/tcltest/tcltest.tcl | 36 |
2 files changed, 38 insertions, 6 deletions
diff --git a/doc/tcltest.n b/doc/tcltest.n index cedc763..ac8b73b 100644 --- a/doc/tcltest.n +++ b/doc/tcltest.n @@ -872,8 +872,8 @@ harness are doing. . Sets the type of output verbosity desired to \fIlevel\fR, a list of zero or more of the elements \fBbody\fR, \fBpass\fR, -\fBskip\fR, \fBstart\fR, \fBerror\fR and \fBline\fR. Default value -is +\fBskip\fR, \fBstart\fR, \fBerror\fR, \fBline\fR, \fBmsec\fR and \fBusec\fR. +Default value is .QW "\fBbody error\fR" . Levels are defined as: .RS @@ -890,6 +890,10 @@ Print errorInfo and errorCode, if they exist, when a test return code does not match its expected return code .IP "line (\fBl\fR)" Print source file line information of failed tests +.IP "msec (\fBm\fR)" +Print each test's execution time in milliseconds +.IP "usec (\fBu\fR)" +Print each test's execution time in microseconds .PP The single letter abbreviations noted above are also recognized so that 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 |