From fabb640c47623974e09d5cce7939adc9dedd59ef Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 12 Dec 2009 19:57:26 +0000 Subject: Plug testing memleak. [Bug 2895367] --- ChangeLog | 20 ++++--- generic/tclTest.c | 175 ++++++++++++++++++++++++++++++------------------------ 2 files changed, 111 insertions(+), 84 deletions(-) diff --git a/ChangeLog b/ChangeLog index 01747ca..9b13adb 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,12 +1,18 @@ +2009-12-12 Donal K. Fellows + + * generic/tclTest.c (TestconcatobjCmd): [Bug 2895367]: Stop memory + leak when testing. We don't need extra noise of this sort when + tracking down real problems! + 2009-12-11 Jan Nijtmans - * generic/tclBinary.c: Fix gcc warning, using gcc-4.3.4 on cygwin - * generic/tclCompExpr.c warning: array subscript has type 'char' - * generic/tclPkg.c - * libtommath/bn_mp_read_radix.c - * win/makefile.vc Revert to version 1.203 [Bug #2912773] - * unix/tclUnixCompat.c Fix gcc warning: signed and unsigned type - in conditional expression + * generic/tclBinary.c: Fix gcc warning, using gcc-4.3.4 on cygwin + * generic/tclCompExpr.c:warning: array subscript has type 'char' + * generic/tclPkg.c: + * libtommath/bn_mp_read_radix.c: + * win/makefile.vc: [Bug 2912773]: Revert to version 1.203 + * unix/tclUnixCompat.c: Fix gcc warning: signed and unsigned type + in conditional expression. 2009-12-11 Donal K. Fellows diff --git a/generic/tclTest.c b/generic/tclTest.c index 07f1511..812a610 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTest.c,v 1.141 2009/11/23 20:17:36 nijtmans Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.142 2009/12/12 19:57:26 dkf Exp $ */ #undef STATIC_BUILD @@ -6723,21 +6723,23 @@ TestconcatobjCmd( concatPtr = Tcl_ConcatObj(2, objv); if (concatPtr->refCount != 0) { result = TCL_ERROR; - Tcl_AppendResult(interp, "\n\t* (a) concatObj does not have refCount 0", NULL); + Tcl_AppendResult(interp, + "\n\t* (a) concatObj does not have refCount 0", NULL); } if (concatPtr == tmpPtr) { result = TCL_ERROR; - Tcl_AppendResult(interp, "\n\t* (a) concatObj is not a new obj ", NULL); + Tcl_AppendResult(interp, "\n\t* (a) concatObj is not a new obj ", + NULL); switch (tmpPtr->refCount) { - case 0: - Tcl_AppendResult(interp, "(no new refCount)", NULL); - break; - case 1: - Tcl_AppendResult(interp, "(refCount added)", NULL); - break; - default: - Tcl_AppendResult(interp, "(more than one refCount added!)", NULL); - Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); + case 0: + Tcl_AppendResult(interp, "(no new refCount)", NULL); + break; + case 1: + Tcl_AppendResult(interp, "(refCount added)", NULL); + break; + default: + Tcl_AppendResult(interp, "(more than one refCount added!)", NULL); + Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); } tmpPtr = Tcl_DuplicateObj(list1Ptr); objv[0] = tmpPtr; @@ -6748,54 +6750,57 @@ TestconcatobjCmd( concatPtr = Tcl_ConcatObj(2, objv); if (concatPtr->refCount != 0) { result = TCL_ERROR; - Tcl_AppendResult(interp, "\n\t* (b) concatObj does not have refCount 0", NULL); + Tcl_AppendResult(interp, + "\n\t* (b) concatObj does not have refCount 0", NULL); } if (concatPtr == tmpPtr) { result = TCL_ERROR; - Tcl_AppendResult(interp, "\n\t* (b) concatObj is not a new obj ", NULL); + Tcl_AppendResult(interp, "\n\t* (b) concatObj is not a new obj ", + NULL); switch (tmpPtr->refCount) { - case 0: - Tcl_AppendResult(interp, "(refCount removed?)", NULL); - Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); - break; - case 1: - Tcl_AppendResult(interp, "(no new refCount)", NULL); - break; - case 2: - Tcl_AppendResult(interp, "(refCount added)", NULL); - Tcl_DecrRefCount(tmpPtr); - break; - default: - Tcl_AppendResult(interp, "(more than one refCount added!)", NULL); - Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); + case 0: + Tcl_AppendResult(interp, "(refCount removed?)", NULL); + Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); + break; + case 1: + Tcl_AppendResult(interp, "(no new refCount)", NULL); + break; + case 2: + Tcl_AppendResult(interp, "(refCount added)", NULL); + Tcl_DecrRefCount(tmpPtr); + break; + default: + Tcl_AppendResult(interp, "(more than one refCount added!)", NULL); + Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); } tmpPtr = Tcl_DuplicateObj(list1Ptr); objv[0] = tmpPtr; } Tcl_DecrRefCount(concatPtr); - objv[0] = emptyPtr; objv[1] = tmpPtr; objv[2] = emptyPtr; concatPtr = Tcl_ConcatObj(3, objv); if (concatPtr->refCount != 0) { result = TCL_ERROR; - Tcl_AppendResult(interp, "\n\t* (c) concatObj does not have refCount 0", NULL); + Tcl_AppendResult(interp, + "\n\t* (c) concatObj does not have refCount 0", NULL); } if (concatPtr == tmpPtr) { result = TCL_ERROR; - Tcl_AppendResult(interp, "\n\t* (c) concatObj is not a new obj ", NULL); + Tcl_AppendResult(interp, "\n\t* (c) concatObj is not a new obj ", + NULL); switch (tmpPtr->refCount) { - case 0: - Tcl_AppendResult(interp, "(no new refCount)", NULL); - break; - case 1: - Tcl_AppendResult(interp, "(refCount added)", NULL); - break; - default: - Tcl_AppendResult(interp, "(more than one refCount added!)", NULL); - Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); + case 0: + Tcl_AppendResult(interp, "(no new refCount)", NULL); + break; + case 1: + Tcl_AppendResult(interp, "(refCount added)", NULL); + break; + default: + Tcl_AppendResult(interp, "(more than one refCount added!)", NULL); + Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); } tmpPtr = Tcl_DuplicateObj(list1Ptr); objv[1] = tmpPtr; @@ -6806,26 +6811,28 @@ TestconcatobjCmd( concatPtr = Tcl_ConcatObj(3, objv); if (concatPtr->refCount != 0) { result = TCL_ERROR; - Tcl_AppendResult(interp, "\n\t* (d) concatObj does not have refCount 0", NULL); + Tcl_AppendResult(interp, + "\n\t* (d) concatObj does not have refCount 0", NULL); } if (concatPtr == tmpPtr) { result = TCL_ERROR; - Tcl_AppendResult(interp, "\n\t* (d) concatObj is not a new obj ", NULL); + Tcl_AppendResult(interp, "\n\t* (d) concatObj is not a new obj ", + NULL); switch (tmpPtr->refCount) { - case 0: - Tcl_AppendResult(interp, "(refCount removed?)", NULL); - Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); - break; - case 1: - Tcl_AppendResult(interp, "(no new refCount)", NULL); - break; - case 2: - Tcl_AppendResult(interp, "(refCount added)", NULL); - Tcl_DecrRefCount(tmpPtr); - break; - default: - Tcl_AppendResult(interp, "(more than one refCount added!)", NULL); - Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); + case 0: + Tcl_AppendResult(interp, "(refCount removed?)", NULL); + Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); + break; + case 1: + Tcl_AppendResult(interp, "(no new refCount)", NULL); + break; + case 2: + Tcl_AppendResult(interp, "(refCount added)", NULL); + Tcl_DecrRefCount(tmpPtr); + break; + default: + Tcl_AppendResult(interp, "(more than one refCount added!)", NULL); + Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); } tmpPtr = Tcl_DuplicateObj(list1Ptr); objv[1] = tmpPtr; @@ -6842,21 +6849,23 @@ TestconcatobjCmd( concatPtr = Tcl_ConcatObj(2, objv); if (concatPtr->refCount != 0) { result = TCL_ERROR; - Tcl_AppendResult(interp, "\n\t* (e) concatObj does not have refCount 0", NULL); + Tcl_AppendResult(interp, + "\n\t* (e) concatObj does not have refCount 0", NULL); } if (concatPtr == tmpPtr) { int len; result = TCL_ERROR; - Tcl_AppendResult(interp, "\n\t* (e) concatObj is not a new obj ", NULL); + Tcl_AppendResult(interp, "\n\t* (e) concatObj is not a new obj ", + NULL); (void) Tcl_ListObjLength(NULL, concatPtr, &len); switch (tmpPtr->refCount) { - case 3: - Tcl_AppendResult(interp, "(failed to concat)", NULL); - break; - default: - Tcl_AppendResult(interp, "(corrupted input!)", NULL); + case 3: + Tcl_AppendResult(interp, "(failed to concat)", NULL); + break; + default: + Tcl_AppendResult(interp, "(corrupted input!)", NULL); } if (Tcl_IsShared(tmpPtr)) { Tcl_DecrRefCount(tmpPtr); @@ -6872,21 +6881,23 @@ TestconcatobjCmd( concatPtr = Tcl_ConcatObj(2, objv); if (concatPtr->refCount != 0) { result = TCL_ERROR; - Tcl_AppendResult(interp, "\n\t* (f) concatObj does not have refCount 0", NULL); + Tcl_AppendResult(interp, + "\n\t* (f) concatObj does not have refCount 0", NULL); } if (concatPtr == tmpPtr) { int len; result = TCL_ERROR; - Tcl_AppendResult(interp, "\n\t* (f) concatObj is not a new obj ", NULL); + Tcl_AppendResult(interp, "\n\t* (f) concatObj is not a new obj ", + NULL); (void) Tcl_ListObjLength(NULL, concatPtr, &len); switch (tmpPtr->refCount) { - case 3: - Tcl_AppendResult(interp, "(failed to concat)", NULL); - break; - default: - Tcl_AppendResult(interp, "(corrupted input!)", NULL); + case 3: + Tcl_AppendResult(interp, "(failed to concat)", NULL); + break; + default: + Tcl_AppendResult(interp, "(corrupted input!)", NULL); } if (Tcl_IsShared(tmpPtr)) { Tcl_DecrRefCount(tmpPtr); @@ -6903,21 +6914,23 @@ TestconcatobjCmd( concatPtr = Tcl_ConcatObj(2, objv); if (concatPtr->refCount != 0) { result = TCL_ERROR; - Tcl_AppendResult(interp, "\n\t* (g) concatObj does not have refCount 0", NULL); + Tcl_AppendResult(interp, + "\n\t* (g) concatObj does not have refCount 0", NULL); } if (concatPtr == tmpPtr) { int len; result = TCL_ERROR; - Tcl_AppendResult(interp, "\n\t* (g) concatObj is not a new obj ", NULL); + Tcl_AppendResult(interp, "\n\t* (g) concatObj is not a new obj ", + NULL); (void) Tcl_ListObjLength(NULL, concatPtr, &len); switch (tmpPtr->refCount) { - case 3: - Tcl_AppendResult(interp, "(failed to concat)", NULL); - break; - default: - Tcl_AppendResult(interp, "(corrupted input!)", NULL); + case 3: + Tcl_AppendResult(interp, "(failed to concat)", NULL); + break; + default: + Tcl_AppendResult(interp, "(corrupted input!)", NULL); } Tcl_DecrRefCount(tmpPtr); if (Tcl_IsShared(tmpPtr)) { @@ -6928,10 +6941,18 @@ TestconcatobjCmd( } Tcl_DecrRefCount(concatPtr); + /* + * Clean everything up. Note that we don't actually know how many + * references there are to tmpPtr here; in the no-error case, it should be + * five... [Bug 2895367] + */ Tcl_DecrRefCount(list1Ptr); Tcl_DecrRefCount(list2Ptr); Tcl_DecrRefCount(emptyPtr); + while (tmpPtr->refCount > 1) { + Tcl_DecrRefCount(tmpPtr); + } Tcl_DecrRefCount(tmpPtr); if (result == TCL_OK) { -- cgit v0.12