summaryrefslogtreecommitdiffstats
path: root/library/tcltest
diff options
context:
space:
mode:
authordas <das>2006-12-08 03:37:44 (GMT)
committerdas <das>2006-12-08 03:37:44 (GMT)
commitf54d3f332f829b3cb261d4f8d46cb7f8b49fd5d9 (patch)
treebb4315f01e4888c1aa455f1b9d6d8c0fbd8fc177 /library/tcltest
parent3956ac10bc7eb76aeae3705e041bef841361d208 (diff)
downloadtcl-f54d3f332f829b3cb261d4f8d46cb7f8b49fd5d9.zip
tcl-f54d3f332f829b3cb261d4f8d46cb7f8b49fd5d9.tar.gz
tcl-f54d3f332f829b3cb261d4f8d46cb7f8b49fd5d9.tar.bz2
* library/tcltest/tcltest.tcl: use [info frame] for "-verbose line".
Diffstat (limited to 'library/tcltest')
-rw-r--r--library/tcltest/tcltest.tcl25
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]"
}
}