diff options
| -rw-r--r-- | tests/fileName.test | 61 | ||||
| -rw-r--r-- | tests/tcltests.tcl | 12 |
2 files changed, 73 insertions, 0 deletions
diff --git a/tests/fileName.test b/tests/fileName.test index 575a17f..09662ff 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -18,6 +18,7 @@ if {"::tcltest" ni [namespace children]} { ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] +source [file join [file dirname [info script]] tcltests.tcl] testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testtranslatefilename [llength [info commands testtranslatefilename]] @@ -1629,6 +1630,66 @@ test fileName-20.10 {globbing for special chars} -setup { removeFile fileName-20.10 $s removeDirectory sub ~ } -result ~/sub/fileName-20.10 + + +apply [list {} { + test fileName-6d4e9d1af5bf5b7d { + memory leak in SetFsPathFromAny + + Runs under both a TCL_DEBUG_MEM build and a -DPURIFY build for + valgrind, which is useful since Valgrind provides information about the + error location, but [memory] doesn't. + } -setup { + makeFile {puts "In script"} script + + if {[namespace which ::memory] eq {}} { + set memcheckcmd [list ::apply [list script { + uplevel 1 $script + return 0 + } [namespace current]]] + } else { + set memcheckcmd ::tcltests::scriptmemcheck + } + } -body { + {*}$memcheckcmd { + set interp [interp create] + interp eval $interp { + apply [list {} { + upvar 1 f f + + # A unique name so that no internal representation of this + # literal value has been picked up from any other script + # that has alredy been sourced into this interpreter. + set variableUniqueInTheEntireTclCodebase a + set name variableUniqueInTheEntireTclCodebase + + # give the Tcl_Obj for "var1" an internal representation of + # type 'localVarNameType'. + set $name + + set f [open variableUniqueInTheEntireTclCodebase w] + try { + puts $f {some data} + } finally { + close $f + } + + set f [open variableUniqueInTheEntireTclCodebase] + try { + read $f + } finally { + catch {file delete variableUniqueInTheEntireTclCodebase} + close $f + } + } [namespace current]] + } + interp delete $interp + } + } -result 0 +} [namespace current]] + + + # cleanup catch {file delete -force C:/globTest} diff --git a/tests/tcltests.tcl b/tests/tcltests.tcl index a2251bf..61366a4 100644 --- a/tests/tcltests.tcl +++ b/tests/tcltests.tcl @@ -34,6 +34,18 @@ namespace eval ::tcltests { } + # Stolen from dict.test + proc scriptmemcheck script { + set end [lindex [split [memory info] \n] 3 3] + for {set i 0} {$i < 5} {incr i} { + uplevel 1 $script + set tmp $end + set end [lindex [split [memory info] \n] 3 3] + } + expr {$end - $tmp} + } + + proc tempdir_alternate {} { close [file tempfile tempfile] set tmpdir [file dirname $tempfile] |