add tcltest::SetupTest to make it easier to customize the -setup step of a test

1 files changed, 17 insertions, 1 deletions

diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index a7a68c7..2d36d13 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -1983,7 +1983,8 @@ proc tcltest::test {name description args} {
     }
 
     # First, run the setup script
-    set code [catch {uplevel 1 $setup} setupMsg]
+    lassign [uplevel 1 [list [
+		namespace which SetupScript] $setup]] code setupMsg
     if {$code == 1} {
 	set errorInfo(setup) $::errorInfo
 	set errorCodeRes(setup) $::errorCode
@@ -2338,6 +2339,8 @@ proc tcltest::Skipped {name constraints} {
     return 0
 }
 
+
+
 # RunTest --
 #
 # This is where the body of a test is evaluated.  The combination of
@@ -2359,6 +2362,19 @@ proc tcltest::RunTest {name script} {
     return [list $actualAnswer $code]
 }
 
+
+
+# SetupTest --
+#
+# Evaluates the -setup script for a test
+
+proc tcltest::SetupTest {name script} {
+    DebugPuts 3 [list Setup Script for $name $script]
+
+    set code [catch {uplevel 1 $setup} setupMsg]
+	return [list $code $setupMsg]
+}
+
 #####################################################################
 
 # tcltest::cleanupTestsHook --