summaryrefslogtreecommitdiffstats
path: root/generic/tclTest.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclTest.c')
-rw-r--r--generic/tclTest.c199
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) {
generated by cgit v0.12 at 2024-12-25 05:31:07 (GMT)