diff options
author | dkf <dkf@noemail.net> | 2009-12-12 19:57:26 (GMT) |
---|---|---|
committer | dkf <dkf@noemail.net> | 2009-12-12 19:57:26 (GMT) |
commit | 6754ce46e56551c7c3c9d47c8cdc981ce459499b (patch) | |
tree | 985edcceb609ab8c0e161d85046e737f78256890 /generic/tclTest.c | |
parent | c6a47ac52b1068df1ec80d15e784fb3c68f6de3c (diff) | |
download | tcl-6754ce46e56551c7c3c9d47c8cdc981ce459499b.zip tcl-6754ce46e56551c7c3c9d47c8cdc981ce459499b.tar.gz tcl-6754ce46e56551c7c3c9d47c8cdc981ce459499b.tar.bz2 |
Plug testing memleak. [Bug 2895367]
FossilOrigin-Name: d1d07b5a23328aa59d6ee68ae1464f750ab99316
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r-- | generic/tclTest.c | 175 |
1 files changed, 98 insertions, 77 deletions
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) { |