From f54d3f332f829b3cb261d4f8d46cb7f8b49fd5d9 Mon Sep 17 00:00:00 2001 From: das Date: Fri, 8 Dec 2006 03:37:44 +0000 Subject: * library/tcltest/tcltest.tcl: use [info frame] for "-verbose line". --- 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 + + * library/tcltest/tcltest.tcl: use [info frame] for "-verbose line". + 2006-12-07 Don Porter * generic/tclCompCmds.c: Additional commits correct most @@ -193,8 +197,8 @@ 2006-11-26 Daniel Steffen - * 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 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