* library/tcltest/tcltest.tcl: use [info frame] for "-verbose line".

FossilOrigin-Name: dac0c90d2cefc59cd0853a74ceef34ba0aa20d4a

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]"
 	}
     }