diff options
Diffstat (limited to 'library/tcltest/tcltest.tcl')
| -rw-r--r-- | library/tcltest/tcltest.tcl | 27 |
1 files changed, 20 insertions, 7 deletions
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 0e7f549..9ec1471 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -16,7 +16,7 @@ # Contributions from Don Porter, NIST, 2002. (not subject to US copyright) # All rights reserved. # -# RCS: @(#) $Id: tcltest.tcl,v 1.95 2005/05/10 18:34:54 kennykb Exp $ +# RCS: @(#) $Id: tcltest.tcl,v 1.96 2006/09/10 17:04:06 das Exp $ package require Tcl 8.3 ;# uses [glob -directory] namespace eval tcltest { @@ -609,15 +609,15 @@ namespace eval tcltest { proc AcceptVerbose { level } { set level [AcceptList $level] if {[llength $level] == 1} { - if {![regexp {^(pass|body|skip|start|error)$} $level]} { + if {![regexp {^(pass|body|skip|start|error|line)$} $level]} { # translate single characters abbreviations to expanded list - set level [string map {p pass b body s skip t start e error} \ + set level [string map {p pass b body s skip t start e error l line} \ [split $level {}]] } } set valid [list] foreach v $level { - if {[regexp {^(pass|body|skip|start|error)$} $v]} { + if {[regexp {^(pass|body|skip|start|error|line)$} $v]} { lappend valid $v } } @@ -631,11 +631,12 @@ namespace eval tcltest { # Default verbosity is to show bodies of failed tests Option -verbose {body error} { - Takes any combination of the values 'p', 's', 'b', 't' and 'e'. + Takes any combination of the values 'p', 's', 'b', 't', 'e' and 'l'. Test suite will display all passed tests if 'p' is specified, all skipped tests if 's' is specified, the bodies of failed tests if 'b' is specified, and when tests start if 't' is specified. - ErrorInfo is displayed if 'e' is specified. + ErrorInfo is displayed if 'e' is specified. Source file line + information of failed tests is displayed if 'l' is specified. } AcceptVerbose verbose # Match and skip patterns default to the empty list, except for @@ -2087,7 +2088,19 @@ proc tcltest::test {name description args} { if {![IsVerbose body]} { set body "" } - puts [outputChannel] "\n==== $name\ + puts [outputChannel] "\n" + if {[IsVerbose line]} { + set testFile [file normalize [uplevel 1 {info script}]] + if {[file readable $testFile]} { + set testFd [open $testFile r] + set lineNo [expr {[lsearch -regexp [split [read $testFd] "\n"] \ + "^\[ \t\]*test [string map {. \\.} $name] "]+1}] + close $testFd + puts [outputChannel] "$testFile:$lineNo: test failed:\ + $name [string trim $description]" + } + } + puts [outputChannel] "==== $name\ [string trim $description] FAILED" if {[string length $body]} { puts [outputChannel] "==== Contents of test case:" |