summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2020-09-17 07:47:24 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2020-09-17 07:47:24 (GMT)
commit23520a764859890cb326fdc38a68180f11081549 (patch)
treed0c5589ef9ce43677d9df2777c97f5ecec606a9d
parent264c84606b485bb031fbd8ac6b3eba23938b0d7f (diff)
parent1dc3124160fd7c59519c640c0704be7ba6bf7259 (diff)
downloadtcl-23520a764859890cb326fdc38a68180f11081549.zip
tcl-23520a764859890cb326fdc38a68180f11081549.tar.gz
tcl-23520a764859890cb326fdc38a68180f11081549.tar.bz2
Fix [835c93c000]: TIP #525 only implemented for non-singleproc case
-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 c894ff1..e7f4288 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -640,7 +640,7 @@ namespace eval tcltest {
proc IsVerbose {level} {
variable Option
- return [expr {[lsearch -exact $Option(-verbose) $level] != -1}]
+ return [expr {[lsearch -exact $Option(-verbose) $level] >= 0}]
}
# Default verbosity is to show bodies of failed tests
@@ -2798,7 +2798,6 @@ proc tcltest::runAllTests { {shell ""} } {
variable numTests
variable failFiles
variable DefaultValue
- set failFilesAccum {}
FillFilesExisted
if {[llength [info level 0]] == 1} {
@@ -2854,8 +2853,18 @@ proc tcltest::runAllTests { {shell ""} } {
flush [outputChannel]
if {[singleProcess]} {
- incr numTestFiles
- uplevel 1 [list ::source $file]
+ if {[catch {
+ incr numTestFiles
+ uplevel 1 [list ::source $file]
+ } msg]} {
+ puts [outputChannel] "Test file error: $msg"
+ # append the name of the test to a list to be reported
+ # later
+ lappend testFileFailures $file
+ }
+ if {$numTests(Failed) > 0} {
+ set failFilesSet 1
+ }
} else {
# Pass along our configuration to the child processes.
# EXCEPT for the -outfile, because the parent process
@@ -2888,7 +2897,7 @@ proc tcltest::runAllTests { {shell ""} } {
}
if {$Failed > 0} {
lappend failFiles $testFile
- lappend failFilesAccum $testFile
+ set failFilesSet 1
}
} elseif {[regexp [join {
{^Number of tests skipped }
@@ -2935,7 +2944,7 @@ proc tcltest::runAllTests { {shell ""} } {
puts [outputChannel] ""
puts [outputChannel] [string repeat ~ 44]
}
- return [expr {[info exists testFileFailures] || [llength $failFilesAccum]}]
+ return [expr {[info exists testFileFailures] || [info exists failFilesSet]}]
}
#####################################################################
@@ -3107,7 +3116,7 @@ proc tcltest::removeFile {name {directory ""}} {
set fullName [file join $directory $name]
DebugPuts 3 "[lindex [info level 0] 0]: removing $fullName"
set idx [lsearch -exact $filesMade $fullName]
- if {$idx == -1} {
+ if {$idx < 0} {
DebugDo 1 {
Warn "removeFile removing \"$fullName\":\n not created by makeFile"
}
@@ -3184,7 +3193,7 @@ proc tcltest::removeDirectory {name {directory ""}} {
DebugPuts 3 "[lindex [info level 0] 0]: deleting $fullName"
set idx [lsearch -exact $filesMade $fullName]
set filesMade [lreplace $filesMade $idx $idx]
- if {$idx == -1} {
+ if {$idx < 0} {
DebugDo 1 {
Warn "removeDirectory removing \"$fullName\":\n not created\
by makeDirectory"