Merge 8.6

1 files changed, 28 insertions, 32 deletions

diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index c6d318f..4df25e4 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
@@ -811,14 +811,14 @@ namespace eval tcltest {
     trace add variable Option(-errfile) write \
 	    [namespace code {errorChannel $Option(-errfile) ;#}]
 
-    proc loadIntoSlaveInterpreter {slave args} {
+    proc loadIntoChildInterpreter {child args} {
 	variable Version
-	interp eval $slave [package ifneeded tcltest $Version]
-	interp eval $slave "tcltest::configure {*}{$args}"
-	interp alias $slave ::tcltest::ReportToMaster \
-	    {} ::tcltest::ReportedFromSlave
+	interp eval $child [package ifneeded tcltest $Version]
+	interp eval $child "tcltest::configure {*}{$args}"
+	interp alias $child ::tcltest::ReportToParent \
+	    {} ::tcltest::ReportedFromChild
     }
-    proc ReportedFromSlave {total passed skipped failed because newfiles} {
+    proc ReportedFromChild {total passed skipped failed because newfiles} {
 	variable numTests
 	variable skippedBecause
 	variable createdNewFiles
@@ -2462,8 +2462,8 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} {
     set testFileName [file tail [info script]]
 
     # Hook to handle reporting to a parent interpreter
-    if {[llength [info commands [namespace current]::ReportToMaster]]} {
-	ReportToMaster $numTests(Total) $numTests(Passed) $numTests(Skipped) \
+    if {[llength [info commands [namespace current]::ReportToParent]]} {
+	ReportToParent $numTests(Total) $numTests(Passed) $numTests(Skipped) \
 	    $numTests(Failed) [array get skippedBecause] \
 	    [array get createdNewFiles]
 	set testSingleFile false
@@ -2660,18 +2660,6 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} {
     return
 }
 
-proc tcltest::__SortFiles {lst} {
-    set slst {}
-    foreach f $lst {
-	lappend slst [list [file rootname $f] $f]
-    }
-    set lst {}
-    foreach f [lsort -dictionary -index 0 $slst] {
-	lappend lst [lindex $f 1]
-    }
-    return $lst
-}
-
 #####################################################################
 
 # Procs that determine which tests/test files to run
@@ -2736,7 +2724,6 @@ proc tcltest::GetMatchingFiles { args } {
 	PrintError "No test files remain after applying your match and\
 		skip patterns!"
     }
-    
     return $matchingFiles
 }
 
@@ -2811,7 +2798,6 @@ proc tcltest::runAllTests { {shell ""} } {
     variable numTests
     variable failFiles
     variable DefaultValue
-    set failFilesAccum {}
 
     FillFilesExisted
     if {[llength [info level 0]] == 1} {
@@ -2861,14 +2847,24 @@ proc tcltest::runAllTests { {shell ""} } {
     puts [outputChannel] "Tests began at [eval $timeCmd]"
 
     # Run each of the specified tests
-    foreach file [__SortFiles [GetMatchingFiles]] {
+    foreach file [lsort [GetMatchingFiles]] {
 	set tail [file tail $file]
 	puts [outputChannel] $tail
 	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
@@ -2901,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 }
@@ -2948,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]}]
 }
 
 #####################################################################
@@ -3120,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"
 	}
@@ -3197,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"
@@ -3246,8 +3242,8 @@ proc tcltest::viewFile {name {directory ""}} {
 #    procedures that are supposed to accept strings with embedded NULL
 #    bytes.
 # 2. Confirm that a string result has a certain pattern of bytes, for
-#    instance to confirm that "\xe0\0" in a Tcl script is stored
-#    internally in UTF-8 as the sequence of bytes "\xc3\xa0\xc0\x80".
+#    instance to confirm that "\xE0\0" in a Tcl script is stored
+#    internally in UTF-8 as the sequence of bytes "\xC3\xA0\xC0\x80".
 #
 # Generally, it's a bad idea to examine the bytes in a Tcl string or to
 # construct improperly formed strings in this manner, because it involves