summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorgahr <gahr@gahr.ch>2016-06-01 09:55:40 (GMT)
committergahr <gahr@gahr.ch>2016-06-01 09:55:40 (GMT)
commit68e030c1017b44bc5b0f1a625f06350058bea3ed (patch)
tree5295d0896a7123e219e604d3b4d6032d9043f9f2
parentcbcbd348f992ab2ae52e313fe1bb8cb51e69027d (diff)
parent350efb174951691350ccfae2352f7a59775d604e (diff)
downloadtcl-68e030c1017b44bc5b0f1a625f06350058bea3ed.zip
tcl-68e030c1017b44bc5b0f1a625f06350058bea3ed.tar.gz
tcl-68e030c1017b44bc5b0f1a625f06350058bea3ed.tar.bz2
Merge TIP #447: Execution Time Verbosity Levels in tcltest::configure
-rw-r--r--doc/tcltest.n14
-rw-r--r--library/tcltest/pkgIndex.tcl2
-rw-r--r--library/tcltest/tcltest.tcl36
-rw-r--r--unix/Makefile.in4
-rw-r--r--win/Makefile.in4
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..06097fd 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.3.9 [list source [file join $dir tcltest.tcl]]
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 29ef778..1ba3c41 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.3.9
# 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 d9f8bbc..2c96973 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.3.9 as a Tcl Module";
+ @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.9.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..9743511 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.3.9 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.9.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";