Backport changes in tcltest package from higher Tcl versions.

Rename (internal, undocumented) tcltest::loadIntoSlaveInterpreter into tcltest::loadIntoChildInterpreter
tcltest 2.5.1 -> 2.5.3

2 files changed, 24 insertions, 13 deletions

diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl
index ca93725..a56a0d6 100644
--- a/library/tcltest/pkgIndex.tcl
+++ b/library/tcltest/pkgIndex.tcl
@@ -9,4 +9,4 @@
 # full path name of this file's directory.
 
 if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
-package ifneeded tcltest 2.5.1 [list source [file join $dir tcltest.tcl]]
+package ifneeded tcltest 2.5.3 [list source [file join $dir tcltest.tcl]]
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 1394949..c894ff1 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -22,7 +22,7 @@ namespace eval tcltest {
     # When the version number changes, be sure to update the pkgIndex.tcl file,
     # and the install directory in the Makefiles.  When the minor version
     # changes (new feature) be sure to update the man page as well.
-    variable Version 2.5.1
+    variable Version 2.5.3
 
     # Compatibility support for dumb variables defined in tcltest 1
     # Do not use these.  Call [package provide Tcl] and [info patchlevel]
@@ -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
@@ -1982,7 +1982,10 @@ proc tcltest::test {name description args} {
 	}
     }
 
-    # First, run the setup script
+    # First, run the setup script (or a hook if it presents):
+    if {[set cmd [namespace which -command [namespace current]::SetupTest]] ne ""} {
+	set setup [list $cmd $setup]
+    }
     set processTest 1
     set code [catch {uplevel 1 $setup} setupMsg]
     if {$code == 1} {
@@ -2077,7 +2080,10 @@ proc tcltest::test {name description args} {
 	set scriptFailure 1
     }
 
-    # Always run the cleanup script
+    # Always run the cleanup script (or a hook if it presents):
+    if {[set cmd [namespace which -command [namespace current]::CleanupTest]] ne ""} {
+	set cleanup [list $cmd $cleanup]
+    }
     set code [catch {uplevel 1 $cleanup} cleanupMsg]
     if {$code == 1} {
 	set errorInfo(cleanup) $::errorInfo
@@ -2390,6 +2396,10 @@ proc tcltest::RunTest {name script} {
 	memory tag $name
     }
 
+    # run the test script (or a hook if it presents):
+    if {[set cmd [namespace which -command [namespace current]::EvalTest]] ne ""} {
+	set script [list $cmd $script]
+    }
     set code [catch {uplevel 1 $script} actualAnswer]
 
     return [list $actualAnswer $code]
@@ -2452,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
@@ -3097,11 +3107,12 @@ 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]
-    set filesMade [lreplace $filesMade $idx $idx]
     if {$idx == -1} {
 	DebugDo 1 {
 	    Warn "removeFile removing \"$fullName\":\n  not created by makeFile"
 	}
+    } else {
+	set filesMade [lreplace $filesMade $idx $idx]
     }
     if {![file isfile $fullName]} {
 	DebugDo 1 {