summaryrefslogtreecommitdiffstats
path: root/tests/stringComp.test
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2014-04-30 21:24:39 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2014-04-30 21:24:39 (GMT)
commite0c1d41f5eb0239c68067f4f8e185e066da6cdb5 (patch)
tree08c5eda3675c80490c1e1f9f7f25a90deaf7b3f0 /tests/stringComp.test
parentab5b2feda0ba89dbf619dce261b193bd953cf540 (diff)
downloadtcl-e0c1d41f5eb0239c68067f4f8e185e066da6cdb5.zip
tcl-e0c1d41f5eb0239c68067f4f8e185e066da6cdb5.tar.gz
tcl-e0c1d41f5eb0239c68067f4f8e185e066da6cdb5.tar.bz2
[82e7f67325] Fix an evil refcount problem in compiled [string replace].
Diffstat (limited to 'tests/stringComp.test')
-rw-r--r--tests/stringComp.test34
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