[82e7f67325] Fix an evil refcount problem in compiled [string replace].

2 files changed, 45 insertions, 3 deletions

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 2c136d7..4ecca5b 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5702,11 +5702,21 @@ TEBCresume(
 			length - toIdx);
 	    }
 	} else {
-	    objResultPtr = value3Ptr;
+	    /*
+	     * Be careful with splicing the stack in this case; we have a
+	     * refCount:1 object in value3Ptr and we want to append to it and
+	     * make it be the refCount:1 object at the top of the stack
+	     * afterwards. [Bug 82e7f67325]
+	     */
+
 	    if (toIdx < length) {
-		Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
+		Tcl_AppendUnicodeToObj(value3Ptr, ustring1 + toIdx + 1,
 			length - toIdx);
 	    }
+	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
+	    TclDecrRefCount(valuePtr);
+	    OBJ_AT_TOS = value3Ptr;	/* Tricky! */
+	    NEXT_INST_F(1, 0, 0);
 	}
 	TclDecrRefCount(value3Ptr);
 	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
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