diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2014-04-30 21:24:39 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2014-04-30 21:24:39 (GMT) |
commit | 10d7a2ac566063ffdd10a932a0d610ae6ecd62dd (patch) | |
tree | 08c5eda3675c80490c1e1f9f7f25a90deaf7b3f0 /tests/stringComp.test | |
parent | b648be8b339531ac4f5f2aadd42094bccaa7b758 (diff) | |
download | tcl-10d7a2ac566063ffdd10a932a0d610ae6ecd62dd.zip tcl-10d7a2ac566063ffdd10a932a0d610ae6ecd62dd.tar.gz tcl-10d7a2ac566063ffdd10a932a0d610ae6ecd62dd.tar.bz2 |
[82e7f67325] Fix an evil refcount problem in compiled [string replace].
Diffstat (limited to 'tests/stringComp.test')
-rw-r--r-- | tests/stringComp.test | 34 |
1 files changed, 33 insertions, 1 deletions
diff --git a/tests/stringComp.test b/tests/stringComp.test index 9e00ce7..39dac78 100644 --- a/tests/stringComp.test +++ b/tests/stringComp.test @@ -26,6 +26,22 @@ catch [list package require -exact Tcltest [info patchlevel]] # Some tests require the testobj command testConstraint testobj [expr {[info commands testobj] != {}}] +testConstraint memory [llength [info commands memory]] +if {[testConstraint memory]} { + proc getbytes {} { + set lines [split [memory info] \n] + return [lindex $lines 3 3] + } + proc leaktest {script {iterations 3}} { + set end [getbytes] + for {set i 0} {$i < $iterations} {incr i} { + uplevel 1 $script + set tmp $end + set end [getbytes] + } + return [expr {$end - $tmp}] + } +} test stringComp-1.1 {error conditions} { proc foo {} {string gorp a b} @@ -687,7 +703,23 @@ test stringComp-12.1 {Bug 3588366: end-offsets before start} { ## not yet bc ## string replace -## not yet bc +test stringComp-14.1 {Bug 82e7f67325} { + apply {{} { + set a [join {a b} {}] + lappend b [string length [string replace ___! 0 2 $a]] + lappend b [string length [string replace ___! 0 2 $a[unset a]]] + }} +} {3 3} +test stringComp-14.2 {Bug 82e7f67325} { + # As in stringComp-14.1, but make sure we don't retain too many refs + leaktest { + apply {{} { + set a [join {a b} {}] + lappend b [string length [string replace ___! 0 2 $a]] + lappend b [string length [string replace ___! 0 2 $a[unset a]]] + }} + } +} {0} ## string tolower ## not yet bc |