diff options
-rw-r--r-- | tcltest.tcl | 31 | ||||
-rw-r--r-- | tests/glob2.test | 28 |
2 files changed, 23 insertions, 36 deletions
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 } diff --git a/tests/glob2.test b/tests/glob2.test index 5e4be31..80fdd12 100644 --- a/tests/glob2.test +++ b/tests/glob2.test @@ -236,34 +236,6 @@ test fileName-20.1 {Bug 1750300} -setup { removeFile TAGS $d removeDirectory foo } -result 1 -test fileName-20.6 {Bug 2837800} -setup { - # Recall that we have $env(HOME) set so that references - # to ~ point to [temporaryDirectory] - makeFile {} test ~ - set dd [makeDirectory isolate] - set d [makeDirectory ./~ $dd] - set savewd [pwd] - cd $dd -} -body { - glob -nocomplain */test -} -cleanup { - cd $savewd - removeDirectory ./~ $dd - removeDirectory isolate - removeFile test ~ -} -result {} -test fileName-20.7 {Bug 2806250} -setup { - set savewd [pwd] - cd [temporaryDirectory] - set d [makeDirectory isolate] - makeFile {} ./~test $d -} -body { - file exists [lindex [glob -nocomplain isolate/*] 0] -} -cleanup { - removeFile ./~test $d - removeDirectory isolate - cd $savewd -} -result 1 # cleanup catch {file delete -force C:/globTest} |