diff options
author | das <das> | 2006-12-08 03:37:44 (GMT) |
---|---|---|
committer | das <das> | 2006-12-08 03:37:44 (GMT) |
commit | f54d3f332f829b3cb261d4f8d46cb7f8b49fd5d9 (patch) | |
tree | bb4315f01e4888c1aa455f1b9d6d8c0fbd8fc177 /library | |
parent | 3956ac10bc7eb76aeae3705e041bef841361d208 (diff) | |
download | tcl-f54d3f332f829b3cb261d4f8d46cb7f8b49fd5d9.zip tcl-f54d3f332f829b3cb261d4f8d46cb7f8b49fd5d9.tar.gz tcl-f54d3f332f829b3cb261d4f8d46cb7f8b49fd5d9.tar.bz2 |
* library/tcltest/tcltest.tcl: use [info frame] for "-verbose line".
Diffstat (limited to 'library')
-rw-r--r-- | library/tcltest/tcltest.tcl | 25 |
1 files changed, 17 insertions, 8 deletions
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 8399565..1469b25 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.99 2006/11/28 22:20:29 andreas_kupries Exp $ +# RCS: @(#) $Id: tcltest.tcl,v 1.100 2006/12/08 03:37:44 das Exp $ package require Tcl 8.5 ;# To provide an alpha version package require Tcl 8.3 ;# uses [glob -directory] @@ -2090,13 +2090,22 @@ proc tcltest::test {name description args} { } 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:\ + if {![catch {set testFrame [info frame -1]}] && + [dict get $testFrame type] eq "source"} { + set testFile [dict get $testFrame file] + set testLine [dict get $testFrame line] + } else { + set testFile [file normalize [uplevel 1 {info script}]] + if {[file readable $testFile]} { + set testFd [open $testFile r] + set testLine [expr {[lsearch -regexp \ + [split [read $testFd] "\n"] \ + "^\[ \t\]*test [string map {. \\.} $name] "]+1}] + close $testFd + } + } + if {[info exists testLine]} { + puts [outputChannel] "$testFile:$testLine: test failed:\ $name [string trim $description]" } } |