From 9a625d23f10c30494d1e132eb1bb57bf7486d26b Mon Sep 17 00:00:00 2001
From: gahr <gahr@gahr.ch>
Date: Wed, 20 Apr 2016 19:27:31 +0000
Subject: Implement msec and usec verbosity levels in tcltest::configure

---
 doc/tcltest.n               |  8 ++++++--
 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
-- 
cgit v0.12