summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog23
-rw-r--r--generic/tclTest.c199
2 files changed, 125 insertions, 97 deletions
diff --git a/ChangeLog b/ChangeLog
index 08e49d9..3e0c650 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,23 +1,30 @@
+2009-12-12 Donal K. Fellows <dkf@users.sf.net>
+
+ * 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-10 Andreas Kupries <andreask@activestate.com>
* generic/tclObj.c (TclContinuationsEnter): [Bug 2895323]: Updated
comments to describe when the function can be entered for the same
Tcl_Obj* multiple times. This is a continuation of the 2009-11-10
- entry where a memory leak was plugged, but where not sure if that
- was just a band-aid to paper over some other error. It isn't, this
- is a legal situation.
+ entry where a memory leak was plugged, but where not sure if that was
+ just a band-aid to paper over some other error. It isn't, this is a
+ legal situation.
2009-12-09 Andreas Kupries <andreask@activestate.com>
* library/safe.tcl: Backport of the streamlined safe base from
- * tests/safe.test: head to the 8.5 branch (See head changelog
- entries 2009-11-05, 2009-11-06, 2009-12-03).
+ * tests/safe.test: head to the 8.5 branch (See head changelog entries
+ 2009-11-05, 2009-11-06, 2009-12-03).
2009-12-07 Don Porter <dgp@users.sourceforge.net>
- * generic/tclStrToD.c: Correct conditional compile directives to
- better detect the toolchain that needs extra work for proper underflow
- treatment instead of merely detecting the mips platform. [Bug 2902010].
+ * generic/tclStrToD.c: [Bug 2902010]: Correct conditional compile
+ directives to better detect the toolchain that needs extra work for
+ proper underflow treatment instead of merely detecting the MIPS
+ platform.
2009-12-02 Jan Nijtmans <nijtmans@users.sf.net>
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) {
generated by cgit v0.12 at 2024-12-25 05:58:33 (GMT)