From 87d7d0f11c17176fdca0ff935983866a2f9ec3aa Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 2 Jun 2016 12:27:55 +0000 Subject: (cherry-pick) Merge TIP #447: Execution Time Verbosity Levels in tcltest::configure. Tcltest 2.3.8 -> 2.4.0. --- doc/tcltest.n | 14 ++++++++++++-- library/tcltest/pkgIndex.tcl | 2 +- library/tcltest/tcltest.tcl | 36 +++++++++++++++++++++++++++++++----- unix/Makefile.in | 4 ++-- win/Makefile.in | 4 ++-- 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"; -- cgit v0.12