(cherry-pick) Merge TIP #447: Execution Time Verbosity Levels in tcltest::configure. Tcltest 2.3.8 -> 2.4.0.

5 files changed, 48 insertions, 12 deletions

diff --git a/doc/tcltest.n b/doc/tcltest.n
index cedc763..05c1922 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,16 @@ 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
+Note that the \fBmsec\fR and \fBusec\fR verbosity levels are provided as
+indicative measures only. They do not tackle the problem of repeatibility which
+should be considered in performance tests or benchmarks. To use these verbosity
+levels to thoroughly track performance degradations, consider wrapping your
+test bodies with \fBtime\fR commands.
 .PP
 The single letter abbreviations noted above are also recognized
 so that
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
diff --git a/unix/Makefile.in b/unix/Makefile.in
index b336074..7b3d820 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -849,8 +849,8 @@ install-libraries: libraries
 	    done;
 	@echo "Installing package msgcat 1.6.0 as a Tcl Module";
 	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.6.0.tm;
-	@echo "Installing package tcltest 2.3.8 as a Tcl Module";
-	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.8.tm;
+	@echo "Installing package tcltest 2.4.0 as a Tcl Module";
+	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.4.0.tm;
 
 	@echo "Installing package platform 1.0.14 as a Tcl Module";
 	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.14.tm;
diff --git a/win/Makefile.in b/win/Makefile.in
index cf72e1c..28ffe0a 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -660,8 +660,8 @@ install-libraries: libraries install-tzdata install-msgs
 	    done;
 	@echo "Installing package msgcat 1.6.0 as a Tcl Module";
 	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.6.0.tm;
-	@echo "Installing package tcltest 2.3.8 as a Tcl Module";
-	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.8.tm;
+	@echo "Installing package tcltest 2.4.0 as a Tcl Module";
+	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.4.0.tm;
 	@echo "Installing package platform 1.0.14 as a Tcl Module";
 	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.tm;
 	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";