From 36f4518f890ff81b22fbf1575775ffaf1c1a149b Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Mon, 2 Dec 2019 22:04:41 +0000
Subject: Add tcltest::CleanupTest to make it easier to customize behaviour.

---
 library/tcltest/tcltest.tcl | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 4171965..28c50ef 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -2069,7 +2069,9 @@ proc tcltest::test {name description args} {
     }
 
     # Always run the cleanup script
-    set code [catch {uplevel 1 $cleanup} cleanupMsg]
+    set code [catch {
+	uplevel 1 [list [namespace which CleanupTest] $cleanup]
+    } cleanupMsg]
     if {$code == 1} {
 	set errorInfo(cleanup) $::errorInfo
 	set errorCodeRes(cleanup) $::errorCode
@@ -2382,6 +2384,14 @@ proc tcltest::SetupTest setup {
     uplevel 1 $setup
 }
 
+
+# CleanupTest --
+#
+# Evaluates the -cleanup script for a test
+proc tcltest::CleanupTest cleanup {
+    uplevel 1 $cleanup
+}
+
 #####################################################################
 
 # tcltest::cleanupTestsHook --
-- 
cgit v0.12