diff options
author | dkf <dkf@noemail.net> | 2011-08-04 13:16:22 (GMT) |
---|---|---|
committer | dkf <dkf@noemail.net> | 2011-08-04 13:16:22 (GMT) |
commit | de32d87523a41ddce8083b538b597f38126d4bbc (patch) | |
tree | 5be866fb0c0f23fc5056a35a31e6aa2fa468f9cd | |
parent | 442a252c62646472eef339a30ddea68e97b10d70 (diff) | |
download | tcl-de32d87523a41ddce8083b538b597f38126d4bbc.zip tcl-de32d87523a41ddce8083b538b597f38126d4bbc.tar.gz tcl-de32d87523a41ddce8083b538b597f38126d4bbc.tar.bz2 |
[Bug 3384840]: Fix memory leaks in the assembler due to Tcl_Obj reference
ownership error.
FossilOrigin-Name: a8ffe21e9271ab6b0ffab29939887e98e655b5e4
-rw-r--r-- | ChangeLog | 10 | ||||
-rw-r--r-- | generic/tclAssembly.c | 22 | ||||
-rw-r--r-- | tests/assemble.test | 82 |
3 files changed, 96 insertions, 18 deletions
@@ -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 {} |