summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorgahr <gahr@gahr.ch>2016-04-20 19:27:31 (GMT)
committergahr <gahr@gahr.ch>2016-04-20 19:27:31 (GMT)
commit9a625d23f10c30494d1e132eb1bb57bf7486d26b (patch)
tree94eb211fdf0c09277b9e8bf4ed9d97f87622e4ea
parent5f08f4b52618056de417f6d543d5bd596d9197eb (diff)
downloadtcl-9a625d23f10c30494d1e132eb1bb57bf7486d26b.zip
tcl-9a625d23f10c30494d1e132eb1bb57bf7486d26b.tar.gz
tcl-9a625d23f10c30494d1e132eb1bb57bf7486d26b.tar.bz2
Implement msec and usec verbosity levels in tcltest::configure
-rw-r--r--doc/tcltest.n8
-rw-r--r--library/tcltest/tcltest.tcl36
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