diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2020-09-17 07:47:24 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2020-09-17 07:47:24 (GMT) |
commit | 23520a764859890cb326fdc38a68180f11081549 (patch) | |
tree | d0c5589ef9ce43677d9df2777c97f5ecec606a9d /library | |
parent | 264c84606b485bb031fbd8ac6b3eba23938b0d7f (diff) | |
parent | 1dc3124160fd7c59519c640c0704be7ba6bf7259 (diff) | |
download | tcl-23520a764859890cb326fdc38a68180f11081549.zip tcl-23520a764859890cb326fdc38a68180f11081549.tar.gz tcl-23520a764859890cb326fdc38a68180f11081549.tar.bz2 |
Fix [835c93c000]: TIP #525 only implemented for non-singleproc case
Diffstat (limited to 'library')
-rw-r--r-- | library/tcltest/tcltest.tcl | 25 |
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" |