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

From: das <das>
Date: Fri, 8 Dec 2006 03:37:44 +0000

---
 ChangeLog                   |  8 ++++++--
 library/tcltest/tcltest.tcl | 25 +++++++++++++++++--------
 2 files changed, 23 insertions(+), 10 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 0e35c78..e40a74a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2006-12-08  Daniel Steffen  <[email-masked]>
+
+	* library/tcltest/tcltest.tcl: use [info frame] for "-verbose line".
+
 2006-12-07  Don Porter  <[email-masked]>
 
 	* generic/tclCompCmds.c:	Additional commits correct most
@@ -193,8 +197,8 @@
 
 2006-11-26  Daniel Steffen  <[email-masked]>
 
-	* tcl.m4 (Linux): --enable-64bit support. [Patch 1597389] [Bug 1230558]
-	* configure: autoconf-2.59
+	* unix/tcl.m4 (Linux): --enable-64bit support.	[Patch 1597389]
+	* unix/configure: autoconf-2.59			[Bug 1230558]
 
 2006-11-25  Donal K. Fellows  <[email-masked]>
 
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]"
 	}
     }	
-- 
cgit v0.12