summaryrefslogtreecommitdiffstats
path: root/generic/tclTest.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r--generic/tclTest.c175
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) {
generated by cgit v0.12 at 2024-11-20 16:04:13 (GMT)