From 3435c9713f7b20d9061a5b2758728e66846c8989 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Sun, 1 Dec 2019 11:59:41 +0000
Subject: add tcltest::SetupTest to make it easier to customize the -setup step
of a test
---
library/tcltest/tcltest.tcl | 18 +++++++++++++++++-
1 file changed, 17 insertions(+), 1 deletion(-)
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 --
--
cgit v0.12