Attachment "1334947-8-4.patch" to
ticket [1334947fff]
added by
msofer
2005-10-24 05:05:26.
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.75.2.17
diff -u -r1.75.2.17 tclBasic.c
--- generic/tclBasic.c 26 Jul 2005 17:05:43 -0000 1.75.2.17
+++ generic/tclBasic.c 23 Oct 2005 21:47:46 -0000
@@ -5284,7 +5284,7 @@
* NULL byte. */
{
register Interp *iPtr = (Interp *) interp;
- Tcl_Obj *messagePtr;
+ Tcl_Obj *objPtr;
/*
* If we are just starting to log an error, errorInfo is initialized
@@ -5298,8 +5298,11 @@
Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorInfo, NULL,
iPtr->objResultPtr, TCL_GLOBAL_ONLY);
} else { /* use the string result */
+ objPtr = Tcl_NewStringObj(interp->result, -1);
+ Tcl_IncrRefCount(objPtr);
Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorInfo, NULL,
- Tcl_NewStringObj(interp->result, -1), TCL_GLOBAL_ONLY);
+ objPtr, TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(objPtr);
}
/*
@@ -5308,8 +5311,11 @@
*/
if (!(iPtr->flags & ERROR_CODE_SET)) {
+ objPtr = Tcl_NewStringObj("NONE", -1);
+ Tcl_IncrRefCount(objPtr);
Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorCode, NULL,
- Tcl_NewStringObj("NONE", -1), TCL_GLOBAL_ONLY);
+ objPtr, TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(objPtr);
}
}
@@ -5318,11 +5324,11 @@
*/
if (length != 0) {
- messagePtr = Tcl_NewStringObj(message, length);
- Tcl_IncrRefCount(messagePtr);
+ objPtr = Tcl_NewStringObj(message, length);
+ Tcl_IncrRefCount(objPtr);
Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorInfo, NULL,
- messagePtr, (TCL_GLOBAL_ONLY | TCL_APPEND_VALUE));
- Tcl_DecrRefCount(messagePtr); /* free msg object appended above */
+ objPtr, (TCL_GLOBAL_ONLY | TCL_APPEND_VALUE));
+ Tcl_DecrRefCount(objPtr); /* free msg object appended above */
}
}
Index: generic/tclBinary.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBinary.c,v
retrieving revision 1.13.2.3
diff -u -r1.13.2.3 tclBinary.c
--- generic/tclBinary.c 27 Sep 2005 15:44:13 -0000 1.13.2.3
+++ generic/tclBinary.c 23 Oct 2005 21:47:46 -0000
@@ -1083,12 +1083,13 @@
}
}
valuePtr = Tcl_NewByteArrayObj(src, size);
+ Tcl_IncrRefCount(valuePtr);
resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
NULL, valuePtr, TCL_LEAVE_ERR_MSG);
+ Tcl_DecrRefCount(valuePtr);
arg++;
if (resultPtr == NULL) {
DeleteScanNumberCache(numberCachePtr);
- Tcl_DecrRefCount(valuePtr); /* unneeded */
return TCL_ERROR;
}
offset += count;
@@ -1137,13 +1138,14 @@
*dest++ = (char) ((value & 0x80) ? '1' : '0');
}
}
-
+
+ Tcl_IncrRefCount(valuePtr);
resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
NULL, valuePtr, TCL_LEAVE_ERR_MSG);
+ Tcl_DecrRefCount(valuePtr);
arg++;
if (resultPtr == NULL) {
DeleteScanNumberCache(numberCachePtr);
- Tcl_DecrRefCount(valuePtr); /* unneeded */
return TCL_ERROR;
}
offset += (count + 7 ) / 8;
@@ -1195,12 +1197,13 @@
}
}
+ Tcl_IncrRefCount(valuePtr);
resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
NULL, valuePtr, TCL_LEAVE_ERR_MSG);
+ Tcl_DecrRefCount(valuePtr);
arg++;
if (resultPtr == NULL) {
DeleteScanNumberCache(numberCachePtr);
- Tcl_DecrRefCount(valuePtr); /* unneeded */
return TCL_ERROR;
}
offset += (count + 1) / 2;
@@ -1266,12 +1269,13 @@
offset += count*size;
}
+ Tcl_IncrRefCount(valuePtr);
resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
NULL, valuePtr, TCL_LEAVE_ERR_MSG);
+ Tcl_DecrRefCount(valuePtr);
arg++;
if (resultPtr == NULL) {
DeleteScanNumberCache(numberCachePtr);
- Tcl_DecrRefCount(valuePtr); /* unneeded */
return TCL_ERROR;
}
break;
Index: generic/tclCmdAH.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdAH.c,v
retrieving revision 1.27.2.14
diff -u -r1.27.2.14 tclCmdAH.c
--- generic/tclCmdAH.c 13 Oct 2005 21:45:32 -0000 1.27.2.14
+++ generic/tclCmdAH.c 23 Oct 2005 21:47:48 -0000
@@ -1826,20 +1826,17 @@
for (v = 0; v < varcList[i]; v++) {
int k = index[i]++;
Tcl_Obj *valuePtr, *varValuePtr;
- int isEmptyObj = 0;
if (k < argcList[i]) {
valuePtr = argvList[i][k];
} else {
valuePtr = Tcl_NewObj(); /* empty string */
- isEmptyObj = 1;
}
+ Tcl_IncrRefCount(valuePtr);
varValuePtr = Tcl_ObjSetVar2(interp, varvList[i][v],
NULL, valuePtr, 0);
+ Tcl_DecrRefCount(valuePtr);
if (varValuePtr == NULL) {
- if (isEmptyObj) {
- Tcl_DecrRefCount(valuePtr);
- }
Tcl_ResetResult(interp);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"couldn't set loop variable: \"",
Index: generic/tclCmdIL.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdIL.c,v
retrieving revision 1.47.2.6
diff -u -r1.47.2.6 tclCmdIL.c
--- generic/tclCmdIL.c 29 Jul 2005 14:57:26 -0000 1.47.2.6
+++ generic/tclCmdIL.c 23 Oct 2005 21:47:49 -0000
@@ -933,10 +933,11 @@
Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
} else {
Tcl_Obj *nullObjPtr = Tcl_NewObj();
+ Tcl_IncrRefCount(nullObjPtr);
valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
nullObjPtr, 0);
+ Tcl_DecrRefCount(nullObjPtr); /* free unneeded obj */
if (valueObjPtr == NULL) {
- Tcl_DecrRefCount(nullObjPtr); /* free unneeded obj */
goto defStoreError;
}
Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
Index: generic/tclCmdMZ.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdMZ.c,v
retrieving revision 1.82.2.20
diff -u -r1.82.2.20 tclCmdMZ.c
--- generic/tclCmdMZ.c 21 Jun 2005 17:19:42 -0000 1.82.2.20
+++ generic/tclCmdMZ.c 23 Oct 2005 21:47:53 -0000
@@ -461,9 +461,10 @@
}
} else {
Tcl_Obj *valuePtr;
+ Tcl_IncrRefCount(newPtr);
valuePtr = Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr, 0);
+ Tcl_DecrRefCount(newPtr);
if (valuePtr == NULL) {
- Tcl_DecrRefCount(newPtr);
Tcl_AppendResult(interp, "couldn't set variable \"",
Tcl_GetString(objv[i]), "\"", (char *) NULL);
return TCL_ERROR;
@@ -1758,10 +1759,16 @@
* Only set the failVarObj when we will return 0
* and we have indicated a valid fail index (>= 0)
*/
- if ((result == 0) && (failVarObj != NULL) &&
- Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewIntObj(failat),
- TCL_LEAVE_ERR_MSG) == NULL) {
- return TCL_ERROR;
+ if ((result == 0) && (failVarObj != NULL)) {
+ Tcl_Obj *resPtr, *tmpPtr = Tcl_NewIntObj(failat);
+
+ Tcl_IncrRefCount(tmpPtr);
+ resPtr = Tcl_ObjSetVar2(interp, failVarObj, NULL, tmpPtr,
+ TCL_LEAVE_ERR_MSG);
+ Tcl_DecrRefCount(tmpPtr);
+ if (resPtr == NULL) {
+ return TCL_ERROR;
+ }
}
Tcl_SetBooleanObj(resultPtr, result);
break;
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.94.2.15
diff -u -r1.94.2.15 tclExecute.c
--- generic/tclExecute.c 22 Oct 2005 03:07:45 -0000 1.94.2.15
+++ generic/tclExecute.c 23 Oct 2005 21:47:56 -0000
@@ -4038,9 +4038,7 @@
valIndex = (iterNum * numVars);
for (j = 0; j < numVars; j++) {
- int setEmptyStr = 0;
if (valIndex >= listLen) {
- setEmptyStr = 1;
TclNewObj(valuePtr);
} else {
valuePtr = listRepPtr->elements[valIndex];
@@ -4068,16 +4066,15 @@
}
} else {
DECACHE_STACK_INFO();
+ Tcl_IncrRefCount(valuePtr);
value2Ptr = TclPtrSetVar(interp, varPtr, NULL, part1,
NULL, valuePtr, TCL_LEAVE_ERR_MSG);
+ TclDecrRefCount(valuePtr);
CACHE_STACK_INFO();
if (value2Ptr == NULL) {
TRACE_WITH_OBJ(("%u => ERROR init. index temp %d: ",
opnd, varIndex),
Tcl_GetObjResult(interp));
- if (setEmptyStr) {
- TclDecrRefCount(valuePtr);
- }
result = TCL_ERROR;
goto checkForCatch;
}
Index: generic/tclLink.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclLink.c,v
retrieving revision 1.8
diff -u -r1.8 tclLink.c
--- generic/tclLink.c 5 Aug 2002 03:24:41 -0000 1.8
+++ generic/tclLink.c 23 Oct 2005 21:47:56 -0000
@@ -95,7 +95,7 @@
* Also may have TCL_LINK_READ_ONLY
* OR'ed in. */
{
- Tcl_Obj *objPtr;
+ Tcl_Obj *objPtr, *resPtr;
Link *linkPtr;
int code;
@@ -111,10 +111,12 @@
linkPtr->flags = 0;
}
objPtr = ObjValue(linkPtr);
- if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
- TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ Tcl_IncrRefCount(objPtr);
+ resPtr = Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
+ Tcl_DecrRefCount(objPtr);
+ if (resPtr == NULL) {
Tcl_DecrRefCount(linkPtr->varName);
- Tcl_DecrRefCount(objPtr);
ckfree((char *) linkPtr);
return TCL_ERROR;
}
@@ -191,6 +193,7 @@
{
Link *linkPtr;
int savedFlag;
+ Tcl_Obj *objPtr;
linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
LinkTraceProc, (ClientData) NULL);
@@ -199,8 +202,10 @@
}
savedFlag = linkPtr->flags & LINK_BEING_UPDATED;
linkPtr->flags |= LINK_BEING_UPDATED;
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
- TCL_GLOBAL_ONLY);
+ objPtr = ObjValue(linkPtr);
+ Tcl_IncrRefCount(objPtr);
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr, TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(objPtr);
linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
}
@@ -237,7 +242,7 @@
int changed, valueLength;
CONST char *value;
char **pp, *result;
- Tcl_Obj *objPtr, *valueObj;
+ Tcl_Obj *objPtr, *valueObj, *tmpPtr;
/*
* If the variable is being unset, then just re-create it (with a
@@ -249,8 +254,11 @@
Tcl_DecrRefCount(linkPtr->varName);
ckfree((char *) linkPtr);
} else if (flags & TCL_TRACE_DESTROYED) {
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ tmpPtr = ObjValue(linkPtr);
+ Tcl_IncrRefCount(tmpPtr);
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(tmpPtr);
Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName),
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
|TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr);
@@ -293,8 +301,11 @@
return "internal error: bad linked variable type";
}
if (changed) {
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ tmpPtr = ObjValue(linkPtr);
+ Tcl_IncrRefCount(tmpPtr);
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(tmpPtr);
}
return NULL;
}
@@ -309,8 +320,11 @@
*/
if (linkPtr->flags & LINK_READ_ONLY) {
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ tmpPtr = ObjValue(linkPtr);
+ Tcl_IncrRefCount(tmpPtr);
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(tmpPtr);
return "linked variable is read-only";
}
valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY);
@@ -331,8 +345,11 @@
if (Tcl_GetIntFromObj(interp, valueObj, &linkPtr->lastValue.i)
!= TCL_OK) {
Tcl_SetObjResult(interp, objPtr);
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ tmpPtr = ObjValue(linkPtr);
+ Tcl_IncrRefCount(tmpPtr);
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(tmpPtr);
result = "variable must have integer value";
goto end;
}
@@ -343,8 +360,11 @@
if (Tcl_GetWideIntFromObj(interp, valueObj, &linkPtr->lastValue.w)
!= TCL_OK) {
Tcl_SetObjResult(interp, objPtr);
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ tmpPtr = ObjValue(linkPtr);
+ Tcl_IncrRefCount(tmpPtr);
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(tmpPtr);
result = "variable must have integer value";
goto end;
}
@@ -355,8 +375,11 @@
if (Tcl_GetDoubleFromObj(interp, valueObj, &linkPtr->lastValue.d)
!= TCL_OK) {
Tcl_SetObjResult(interp, objPtr);
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ tmpPtr = ObjValue(linkPtr);
+ Tcl_IncrRefCount(tmpPtr);
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(tmpPtr);
result = "variable must have real value";
goto end;
}
@@ -367,8 +390,11 @@
if (Tcl_GetBooleanFromObj(interp, valueObj, &linkPtr->lastValue.i)
!= TCL_OK) {
Tcl_SetObjResult(interp, objPtr);
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ tmpPtr = ObjValue(linkPtr);
+ Tcl_IncrRefCount(tmpPtr);
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(tmpPtr);
result = "variable must have boolean value";
goto end;
}
Index: generic/tclMain.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclMain.c,v
retrieving revision 1.20.2.1
diff -u -r1.20.2.1 tclMain.c
--- generic/tclMain.c 30 Sep 2005 19:28:55 -0000 1.20.2.1
+++ generic/tclMain.c 23 Oct 2005 21:47:57 -0000
@@ -210,6 +210,7 @@
Tcl_Channel inChannel, outChannel, errChannel;
Tcl_Interp *interp;
Tcl_DString appName;
+ Tcl_Obj *objPtr;
Tcl_FindExecutable(argv[0]);
@@ -241,8 +242,11 @@
argc--;
argv++;
- Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY);
-
+ objPtr = Tcl_NewIntObj(argc);
+ Tcl_IncrRefCount(objPtr);
+ Tcl_SetVar2Ex(interp, "argc", NULL, objPtr, TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(objPtr);
+
argvPtr = Tcl_NewListObj(0, NULL);
while (argc--) {
Tcl_DString ds;
@@ -251,7 +255,9 @@
Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
Tcl_DStringFree(&ds);
}
+ Tcl_IncrRefCount(argvPtr);
Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(argvPtr);
/*
* Set the "tcl_interactive" variable.
Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.44.2.2
diff -u -r1.44.2.2 tclProc.c
--- generic/tclProc.c 2 May 2004 21:07:16 -0000 1.44.2.2
+++ generic/tclProc.c 23 Oct 2005 21:47:58 -0000
@@ -1464,19 +1464,24 @@
{
int code;
char *errorCode;
+ Tcl_Obj *objPtr;
code = iPtr->returnCode;
iPtr->returnCode = TCL_OK;
if (code == TCL_ERROR) {
errorCode = ((iPtr->errorCode != NULL) ? iPtr->errorCode : "NONE");
+ objPtr = Tcl_NewStringObj(errorCode, -1);
+ Tcl_IncrRefCount(objPtr);
Tcl_ObjSetVar2((Tcl_Interp *) iPtr, iPtr->execEnvPtr->errorCode,
- NULL, Tcl_NewStringObj(errorCode, -1),
- TCL_GLOBAL_ONLY);
+ NULL, objPtr, TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(objPtr);
iPtr->flags |= ERROR_CODE_SET;
if (iPtr->errorInfo != NULL) {
+ objPtr = Tcl_NewStringObj(iPtr->errorInfo, -1);
+ Tcl_IncrRefCount(objPtr);
Tcl_ObjSetVar2((Tcl_Interp *) iPtr, iPtr->execEnvPtr->errorInfo,
- NULL, Tcl_NewStringObj(iPtr->errorInfo, -1),
- TCL_GLOBAL_ONLY);
+ NULL, objPtr, TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(objPtr);
iPtr->flags |= ERR_IN_PROGRESS;
}
}
Index: generic/tclScan.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclScan.c,v
retrieving revision 1.12.2.1
diff -u -r1.12.2.1 tclScan.c
--- generic/tclScan.c 19 Aug 2004 21:12:04 -0000 1.12.2.1
+++ generic/tclScan.c 23 Oct 2005 21:47:58 -0000
@@ -1168,15 +1168,17 @@
*/
for (i = 0; i < totalVars; i++) {
if (objs[i] != NULL) {
+ Tcl_Obj *tmpPtr;
+
result++;
- if (Tcl_ObjSetVar2(interp, objv[i+3], NULL,
- objs[i], 0) == NULL) {
+ tmpPtr = Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i], 0);
+ Tcl_DecrRefCount(objs[i]);
+ if (tmpPtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"couldn't set variable \"",
Tcl_GetString(objv[i+3]), "\"", (char *) NULL);
code = TCL_ERROR;
}
- Tcl_DecrRefCount(objs[i]);
}
}
} else {
Index: generic/tclTest.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTest.c,v
retrieving revision 1.62.2.9
diff -u -r1.62.2.9 tclTest.c
--- generic/tclTest.c 16 Aug 2004 14:18:25 -0000 1.62.2.9
+++ generic/tclTest.c 23 Oct 2005 21:48:00 -0000
@@ -3437,9 +3437,10 @@
info.matches[ii].end - 1);
}
}
+ Tcl_IncrRefCount(newPtr);
valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, 0);
+ Tcl_DecrRefCount(newPtr);
if (valuePtr == NULL) {
- Tcl_DecrRefCount(newPtr);
Tcl_AppendResult(interp, "couldn't set variable \"",
Tcl_GetString(varPtr), "\"", (char *) NULL);
return TCL_ERROR;
Index: generic/tclVar.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclVar.c,v
retrieving revision 1.69.2.8
diff -u -r1.69.2.8 tclVar.c
--- generic/tclVar.c 1 Oct 2004 00:09:36 -0000 1.69.2.8
+++ generic/tclVar.c 23 Oct 2005 21:48:04 -0000
@@ -2686,7 +2686,7 @@
Tcl_Obj *varValuePtr, *newValuePtr;
register List *listRepPtr;
register Tcl_Obj **elemPtrs;
- int numElems, numRequired, createdNewObj, createVar, i, j;
+ int numElems, numRequired, createdNewObj, i, j;
Var *varPtr, *arrayPtr;
char *part1;
@@ -2703,10 +2703,11 @@
*/
varValuePtr = Tcl_NewObj();
+ Tcl_IncrRefCount(varValuePtr);
newValuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL, varValuePtr,
TCL_LEAVE_ERR_MSG);
+ Tcl_DecrRefCount(varValuePtr);
if (newValuePtr == NULL) {
- Tcl_DecrRefCount(varValuePtr); /* free unneeded object */
return TCL_ERROR;
}
}
@@ -2719,12 +2720,7 @@
* the variable will now each only be called once. Also, if the
* variable's old value is unshared we modify it directly, otherwise
* we create a new copy to modify: this is "copy on write".
- */
-
- createdNewObj = 0;
- createVar = 1;
-
- /*
+ *
* Use the TCL_TRACE_READS flag to ensure that if we have an
* array with no elements set yet, but with a read trace on it,
* we will create the variable and get read traces triggered.
@@ -2750,6 +2746,7 @@
arrayPtr->refCount--;
}
+ createdNewObj = 0;
if (varValuePtr == NULL) {
/*
* We couldn't read the old value: either the var doesn't yet
@@ -2757,7 +2754,6 @@
* create it with Tcl_ObjSetVar2 below.
*/
- createVar = (TclIsVarUndefined(varPtr));
varValuePtr = Tcl_NewObj();
createdNewObj = 1;
} else if (Tcl_IsShared(varValuePtr)) {
@@ -2824,12 +2820,11 @@
* was new and we didn't create the variable.
*/
+ Tcl_IncrRefCount(varValuePtr);
newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL,
varValuePtr, TCL_LEAVE_ERR_MSG);
+ Tcl_DecrRefCount(varValuePtr);
if (newValuePtr == NULL) {
- if (createdNewObj && !createVar) {
- Tcl_DecrRefCount(varValuePtr); /* free unneeded obj */
- }
return TCL_ERROR;
}
}
Index: mac/tclMacInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/Attic/tclMacInit.c,v
retrieving revision 1.9.2.1
diff -u -r1.9.2.1 tclMacInit.c
--- mac/tclMacInit.c 29 Mar 2004 18:49:36 -0000 1.9.2.1
+++ mac/tclMacInit.c 23 Oct 2005 21:48:04 -0000
@@ -712,7 +712,9 @@
if (pathPtr == NULL) {
pathPtr = Tcl_NewObj();
}
+ Tcl_IncrRefCount(pathPtr);
Tcl_SetVar2Ex(interp, "auto_path", NULL, pathPtr, TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(pathPtr);
return Tcl_Eval(interp, initCmd);
}
Index: unix/tclUnixInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixInit.c,v
retrieving revision 1.34.2.9
diff -u -r1.34.2.9 tclUnixInit.c
--- unix/tclUnixInit.c 5 Aug 2005 20:48:19 -0000 1.34.2.9
+++ unix/tclUnixInit.c 23 Oct 2005 21:48:05 -0000
@@ -963,7 +963,9 @@
if (pathPtr == NULL) {
pathPtr = Tcl_NewObj();
}
+ Tcl_IncrRefCount(pathPtr);
Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(pathPtr);
return Tcl_Eval(interp, initScript);
}
Index: win/tclWinInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinInit.c,v
retrieving revision 1.40.2.5
diff -u -r1.40.2.5 tclWinInit.c
--- win/tclWinInit.c 29 Mar 2004 18:49:36 -0000 1.40.2.5
+++ win/tclWinInit.c 23 Oct 2005 21:48:11 -0000
@@ -847,7 +847,9 @@
if (pathPtr == NULL) {
pathPtr = Tcl_NewObj();
}
+ Tcl_IncrRefCount(pathPtr);
Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY);
+ Tcl_DecrRefCount(pathPtr);
return Tcl_Eval(interp, initScript);
}
