summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
Diffstat (limited to 'library')
-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]"
}
}