From 02a59998a6536997e03b502cc55bc8f343c87ef2 Mon Sep 17 00:00:00 2001
From: Steve Bennett <steveb@workware.net.au>
Date: Thu, 15 Sep 2016 21:02:53 +1000
Subject: tcltest: do a better job of cleanup up after tests

In particular, glob2.test was leaving a lot of litter

Signed-off-by: Steve Bennett <steveb@workware.net.au>
---
 tcltest.tcl | 31 +++++++++++++++++++++++--------
 1 file changed, 23 insertions(+), 8 deletions(-)

(limited to 'tcltest.tcl')

diff --git a/tcltest.tcl b/tcltest.tcl
index 1542d85..083f951 100644
--- a/tcltest.tcl
+++ b/tcltest.tcl
@@ -95,14 +95,20 @@ proc makeDirectory {name} {
 	return $name
 }
 
-proc temporaryDirectory {} {
-	set name [format "%s/tcltmp-%04x" [env TMPDIR /tmp] [rand 65536]]
-	file mkdir $name
-	return $name
+proc temporaryDirectory {} {{dir {}}} {
+	if {$dir eq ""} {
+		set dir [file join [env TMPDIR /tmp] [format "tcltmp-%04x" [rand 65536]]]
+		file mkdir $dir
+	}
+	return $dir
+}
+
+proc removeFile {args} {
+	file delete -force {*}$args
 }
 
-proc removeFile {name} {
-	file delete $name
+proc removeDirectory {name} {
+	file delete -force $name
 }
 
 # In case tclcompat is not selected
@@ -199,9 +205,17 @@ proc test {id descr args} {
 		}
 	}
 
-	catch {uplevel 1 $a(-setup)}
+	if {[catch {uplevel 1 $a(-setup)} msg]} {
+		if {$::testinfo(verbose)} {
+			puts "-setup failed: $msg"
+		}
+	}
 	set rc [catch {uplevel 1 $a(-body)} result opts]
-	catch {uplevel 1 $a(-cleanup)}
+	if {[catch {uplevel 1 $a(-cleanup)} msg]} {
+		if {$::testinfo(verbose)} {
+			puts "-cleanup failed: $msg"
+		}
+	}
 
 	if {[info return $rc] ni $a(-returnCodes) && $rc ni $a(-returnCodes)} {
 		set ok 0
@@ -248,6 +262,7 @@ proc test {id descr args} {
 }
 
 proc ::tcltest::cleanupTests {} {
+	file delete [temporaryDirectory]
 	tailcall testreport
 }
 
-- 
cgit v1.1