[Bug 3384840]: Fix memory leaks in the assembler due to Tcl_Obj reference

ownership error.

3 files changed, 96 insertions, 18 deletions

diff --git a/ChangeLog b/ChangeLog
index 3e3bbec..e6bf629 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2011-08-04  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclAssembly.c (AssembleOneLine, GetBooleanOperand)
+	(GetIntegerOperand, GetListIndexOperand, FindLocalVar): [Bug 3384840]:
+	A Tcl_Obj is allocated by GetNextOperand, so callers of it must not
+	hold a reference to one in the 'out' parameter when calling it. This
+	was causing a great many memory leaks.
+	* tests/assemble.test (assemble-51.*): Added group of memory leak
+	tests.
+
 2011-08-02  Don Porter  <dgp@users.sourceforge.net>
 
 	* changes:	Updates for 8.6b2 release.
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 1b87886..e12d0f8 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -1244,8 +1244,6 @@ AssembleOneLine(
      */
 
     tokenPtr = parsePtr->tokenPtr;
-    instNameObj = Tcl_NewObj();
-    Tcl_IncrRefCount(instNameObj);
     if (GetNextOperand(assemEnvPtr, &tokenPtr, &instNameObj) != TCL_OK) {
 	return TCL_ERROR;
     }
@@ -2087,17 +2085,14 @@ GetBooleanOperand(
     Tcl_Token* tokenPtr = *tokenPtrPtr;
 				/* INOUT: Pointer to the next token in the
 				 * source code */
-    Tcl_Obj* intObj = Tcl_NewObj();
-				/* Integer from the source code */
+    Tcl_Obj* intObj;		/* Integer from the source code */
     int status;			/* Tcl status return */
 
     /*
      * Extract the next token as a string.
      */
 
-    Tcl_IncrRefCount(intObj);
     if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
-	Tcl_DecrRefCount(intObj);
 	return TCL_ERROR;
     }
 
@@ -2143,17 +2138,14 @@ GetIntegerOperand(
     Tcl_Token* tokenPtr = *tokenPtrPtr;
 				/* INOUT: Pointer to the next token in the
 				 * source code */
-    Tcl_Obj* intObj = Tcl_NewObj();
-				/* Integer from the source code */
+    Tcl_Obj* intObj;		/* Integer from the source code */
     int status;			/* Tcl status return */
 
     /*
      * Extract the next token as a string.
      */
 
-    Tcl_IncrRefCount(intObj);
     if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
-	Tcl_DecrRefCount(intObj);
 	return TCL_ERROR;
     }
 
@@ -2199,17 +2191,14 @@ GetListIndexOperand(
     Tcl_Token* tokenPtr = *tokenPtrPtr;
 				/* INOUT: Pointer to the next token in the
 				 * source code */
-    Tcl_Obj* intObj = Tcl_NewObj();
-				/* Integer from the source code */
+    Tcl_Obj* intObj;		/* Integer from the source code */
     int status;			/* Tcl status return */
 
     /*
      * Extract the next token as a string.
      */
 
-    Tcl_IncrRefCount(intObj);
     if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
-	Tcl_DecrRefCount(intObj);
 	return TCL_ERROR;
     }
 
@@ -2256,15 +2245,12 @@ FindLocalVar(
     Tcl_Token* tokenPtr = *tokenPtrPtr;
 				/* INOUT: Pointer to the next token
 				 * in the source code */
-    Tcl_Obj* varNameObj = Tcl_NewObj();
-				/* Name of the variable */
+    Tcl_Obj* varNameObj;	/* Name of the variable */
     const char* varNameStr;
     int varNameLen;
     int localVar;		/* Index of the variable in the LVT */
 
-    Tcl_IncrRefCount(varNameObj);
     if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) {
-	Tcl_DecrRefCount(varNameObj);
 	return -1;
     }
     varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen);
diff --git a/tests/assemble.test b/tests/assemble.test
index dae4821..7d4e5d1 100644
--- a/tests/assemble.test
+++ b/tests/assemble.test
@@ -30,6 +30,23 @@ proc fillTables {} {
     }
     return $s
 }
+
+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}]
+    }
+}
 
 # assemble-1 - TclNRAssembleObjCmd
 
@@ -3198,6 +3215,71 @@ test assemble-50.1 {Ulam's 3n+1 problem, TAL implementation} {
     }
     -result {1 2 16 4 16 16 52 8 52 16 52 16 40 52 160 16 52 52 88 20 64 52 160 24 88 40 9232 52 88}
 }
+
+test assemble-51.1 {memory leak testing} memory {
+    leaktest {
+	apply {{} {assemble {push hello}}}
+    }
+} 0
+test assemble-51.2 {memory leak testing} memory {
+    leaktest {
+	apply {{{x 0}} {assemble {incrImm x 1}}}
+    }
+} 0
+test assemble-51.3 {memory leak testing} memory {
+    leaktest {
+	apply {{n} {
+	    assemble {
+		load n;		# max
+		dup;		# max n
+		jump start;     # max n
+	    
+		label loop;	# max n
+		over 1;         # max n max
+		over 1;		# max in max n
+		ge;             # man n max>=n
+		jumpTrue skip;  # max n
+
+		reverse 2;      # n max
+		pop;            # n
+		dup;            # n n
+	    
+		label skip;	# max n
+		dup;            # max n n
+		push 2;         # max n n 2
+		mod;            # max n n%2
+		jumpTrue odd;   # max n
+	    
+		push 2;         # max n 2
+		div;            # max n/2 -> max n
+		jump start;     # max n
+	     
+		label odd;	# max n
+		push 3;         # max n 3
+		mult;           # max 3*n
+		push 1;         # max 3*n 1
+		add;            # max 3*n+1
+	    
+		label start;	# max n
+		dup;		# max n n
+		push 1;		# max n n 1
+		neq;		# max n n>1
+		jumpTrue loop;	# max n
+	    
+		pop;		# max
+	    }
+	}} 1
+    }
+} 0
+test assemble-51.4 {memory leak testing} memory {
+    leaktest {
+	catch {
+	    apply {{} {
+		assemble {reverse polish notation}
+	    }}
+	}
+    }
+} 0
 
 rename fillTables {}
 rename assemble {}