diff options
author | dkf <dkf@noemail.net> | 2009-12-12 19:46:32 (GMT) |
---|---|---|
committer | dkf <dkf@noemail.net> | 2009-12-12 19:46:32 (GMT) |
commit | 4776f1b5f02cf3a972346478f4c6110a4ddc77cd (patch) | |
tree | b72e790e9779b24957baae326129dfccc593133b /generic/tclTest.c | |
parent | cbee144cf95bbb33fb1d3e3f487907b5cbac2a31 (diff) | |
download | tcl-4776f1b5f02cf3a972346478f4c6110a4ddc77cd.zip tcl-4776f1b5f02cf3a972346478f4c6110a4ddc77cd.tar.gz tcl-4776f1b5f02cf3a972346478f4c6110a4ddc77cd.tar.bz2 |
Plug testing memleak. [Bug 2895367]
FossilOrigin-Name: f1b36a4349192107f7a25f464f0ee847b881c902
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r-- | generic/tclTest.c | 199 |
1 files changed, 110 insertions, 89 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index b50f6af..1da98b8 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.114.2.2 2008/08/20 11:45:34 das Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.114.2.3 2009/12/12 19:46:32 dkf Exp $ */ #define TCL_TEST @@ -7099,19 +7099,19 @@ TestconcatobjCmd( * Set the start of the error message as obj result; it will be cleared at * the end if no errors were found. */ - + Tcl_SetObjResult(interp, Tcl_NewStringObj("Tcl_ConcatObj is unsafe:", -1)); - + emptyPtr = Tcl_NewObj(); - + list1Ptr = Tcl_NewStringObj("foo bar sum", -1); Tcl_ListObjLength(NULL, list1Ptr, &len); if (list1Ptr->bytes != NULL) { ckfree((char *) list1Ptr->bytes); list1Ptr->bytes = NULL; } - + list2Ptr = Tcl_NewStringObj("eeny meeny", -1); Tcl_ListObjLength(NULL, list2Ptr, &len); if (list2Ptr->bytes != NULL) { @@ -7125,27 +7125,29 @@ TestconcatobjCmd( */ tmpPtr = Tcl_DuplicateObj(list1Ptr); - + objv[0] = tmpPtr; objv[1] = emptyPtr; 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; @@ -7156,84 +7158,89 @@ 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; } Tcl_DecrRefCount(concatPtr); - + Tcl_IncrRefCount(tmpPtr); 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; @@ -7250,26 +7257,28 @@ 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); } - tmpPtr = Tcl_DuplicateObj(list1Ptr); + tmpPtr = Tcl_DuplicateObj(list1Ptr); objv[0] = tmpPtr; } Tcl_DecrRefCount(concatPtr); @@ -7280,26 +7289,28 @@ 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); } - tmpPtr = Tcl_DuplicateObj(list1Ptr); + tmpPtr = Tcl_DuplicateObj(list1Ptr); objv[0] = tmpPtr; } Tcl_DecrRefCount(concatPtr); @@ -7311,35 +7322,45 @@ 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)) { Tcl_DecrRefCount(tmpPtr); } - tmpPtr = Tcl_DuplicateObj(list1Ptr); + tmpPtr = Tcl_DuplicateObj(list1Ptr); objv[0] = tmpPtr; } 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) { |