summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2005-10-23 22:01:27 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2005-10-23 22:01:27 (GMT)
commit337481bde00a01912f25ffeda6d5bd4351057c7d (patch)
treec2da79f4e5a542014dab31edea47e6bd46a22b4c
parent352f9db6131a948693af4acd7d5ae471c54635c2 (diff)
downloadtcl-337481bde00a01912f25ffeda6d5bd4351057c7d.zip
tcl-337481bde00a01912f25ffeda6d5bd4351057c7d.tar.gz
tcl-337481bde00a01912f25ffeda6d5bd4351057c7d.tar.bz2
* generic/tclBasic.c:
* generic/tclBinary.c: * generic/tclCmdAH.c: * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclExecute.c: * generic/tclLink.c: * generic/tclMain.c: * generic/tclProc.c: * generic/tclScan.c: * generic/tclTest.c: * generic/tclVar.c: * mac/tclMacInit.c: * unix/tclUnixInit.c: * win/tclWinInit.c: Insure that the core never calls TclPtrSetVar, Tcl_SetVar2Ex, Tcl_ObjSetVar2 or Tcl_SetObjErrorCode with a 0-ref new value. It is not possible to handle error returns correctly in that case [Bug 1334947], one has the choice of leaking the object in some cases, or else risk crashing in some others.
-rw-r--r--ChangeLog22
-rw-r--r--generic/tclBasic.c22
-rw-r--r--generic/tclBinary.c16
-rw-r--r--generic/tclCmdAH.c9
-rw-r--r--generic/tclCmdIL.c5
-rw-r--r--generic/tclCmdMZ.c19
-rw-r--r--generic/tclExecute.c9
-rw-r--r--generic/tclLink.c56
-rw-r--r--generic/tclMain.c12
-rw-r--r--generic/tclProc.c15
-rw-r--r--generic/tclScan.c10
-rw-r--r--generic/tclTest.c5
-rw-r--r--generic/tclVar.c21
-rw-r--r--mac/tclMacInit.c4
-rw-r--r--unix/tclUnixInit.c4
-rw-r--r--win/tclWinInit.c4
16 files changed, 154 insertions, 79 deletions
diff --git a/ChangeLog b/ChangeLog
index 095edc1..cc4795c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,25 @@
+2005-10-23 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c:
+ * generic/tclBinary.c:
+ * generic/tclCmdAH.c:
+ * generic/tclCmdIL.c:
+ * generic/tclCmdMZ.c:
+ * generic/tclExecute.c:
+ * generic/tclLink.c:
+ * generic/tclMain.c:
+ * generic/tclProc.c:
+ * generic/tclScan.c:
+ * generic/tclTest.c:
+ * generic/tclVar.c:
+ * mac/tclMacInit.c:
+ * unix/tclUnixInit.c:
+ * win/tclWinInit.c: Insure that the core never calls TclPtrSetVar,
+ Tcl_SetVar2Ex, Tcl_ObjSetVar2 or Tcl_SetObjErrorCode with a 0-ref
+ new value. It is not possible to handle error returns correctly in
+ that case [Bug 1334947], one has the choice of leaking the object
+ in some cases, or else risk crashing in some others.
+
2005-10-22 Miguel Sofer <msofer@users.sf.net>
* generic/tclExecute.c (INST_CONCAT): disable the optimisation for
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 00673d5..4871844 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.75.2.17 2005/07/26 17:05:43 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.75.2.18 2005/10/23 22:01:28 msofer Exp $
*/
#include "tclInt.h"
@@ -5284,7 +5284,7 @@ Tcl_AddObjErrorInfo(interp, message, length)
* 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_AddObjErrorInfo(interp, message, length)
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 @@ Tcl_AddObjErrorInfo(interp, message, length)
*/
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 @@ Tcl_AddObjErrorInfo(interp, message, length)
*/
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 */
}
}
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index cf83b99..fcc0061 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBinary.c,v 1.13.2.3 2005/09/27 15:44:13 dkf Exp $
+ * RCS: @(#) $Id: tclBinary.c,v 1.13.2.4 2005/10/23 22:01:29 msofer Exp $
*/
#include "tclInt.h"
@@ -1083,12 +1083,13 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
}
}
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 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
*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_BinaryObjCmd(dummy, interp, objc, objv)
}
}
+ 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 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
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;
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index aaf37ac..c3402ef 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdAH.c,v 1.27.2.14 2005/10/13 21:45:32 dkf Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.27.2.15 2005/10/23 22:01:29 msofer Exp $
*/
#include "tclInt.h"
@@ -1826,20 +1826,17 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
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: \"",
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index ab5c876..f38011b 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdIL.c,v 1.47.2.6 2005/07/29 14:57:26 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.47.2.7 2005/10/23 22:01:29 msofer Exp $
*/
#include "tclInt.h"
@@ -933,10 +933,11 @@ InfoDefaultCmd(dummy, interp, objc, objv)
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);
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 1ab108f..d1cb609 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.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: tclCmdMZ.c,v 1.82.2.20 2005/06/21 17:19:42 dgp Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.82.2.21 2005/10/23 22:01:29 msofer Exp $
*/
#include "tclInt.h"
@@ -461,9 +461,10 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
}
} 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 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
* 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;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index ef4b7d4..20f34e6 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.94.2.15 2005/10/22 03:07:45 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.94.2.16 2005/10/23 22:01:29 msofer Exp $
*/
#include "tclInt.h"
@@ -4038,9 +4038,7 @@ TclExecuteByteCode(interp, codePtr)
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 @@ TclExecuteByteCode(interp, codePtr)
}
} 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;
}
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 3476766..f31ad8e 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclLink.c,v 1.8 2002/08/05 03:24:41 dgp Exp $
+ * RCS: @(#) $Id: tclLink.c,v 1.8.2.1 2005/10/23 22:01:30 msofer Exp $
*/
#include "tclInt.h"
@@ -95,7 +95,7 @@ Tcl_LinkVar(interp, varName, addr, type)
* 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 @@ Tcl_LinkVar(interp, varName, addr, type)
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 @@ Tcl_UpdateLinkedVar(interp, varName)
{
Link *linkPtr;
int savedFlag;
+ Tcl_Obj *objPtr;
linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
LinkTraceProc, (ClientData) NULL);
@@ -199,8 +202,10 @@ Tcl_UpdateLinkedVar(interp, varName)
}
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 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
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 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
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 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
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 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
*/
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 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
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 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
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 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
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 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
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;
}
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 1b73be6..2847bd8 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMain.c,v 1.20.2.1 2005/09/30 19:28:55 dgp Exp $
+ * RCS: @(#) $Id: tclMain.c,v 1.20.2.2 2005/10/23 22:01:30 msofer Exp $
*/
#include "tcl.h"
@@ -210,6 +210,7 @@ Tcl_Main(argc, argv, appInitProc)
Tcl_Channel inChannel, outChannel, errChannel;
Tcl_Interp *interp;
Tcl_DString appName;
+ Tcl_Obj *objPtr;
Tcl_FindExecutable(argv[0]);
@@ -241,8 +242,11 @@ Tcl_Main(argc, argv, appInitProc)
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_Main(argc, argv, appInitProc)
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.
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 40c8ceb..2cb8be2 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclProc.c,v 1.44.2.2 2004/05/02 21:07:16 msofer Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.44.2.3 2005/10/23 22:01:30 msofer Exp $
*/
#include "tclInt.h"
@@ -1464,19 +1464,24 @@ TclUpdateReturnInfo(iPtr)
{
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;
}
}
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 693fa60..19cec54 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclScan.c,v 1.12.2.1 2004/08/19 21:12:04 dkf Exp $
+ * RCS: @(#) $Id: tclScan.c,v 1.12.2.2 2005/10/23 22:01:30 msofer Exp $
*/
#include "tclInt.h"
@@ -1168,15 +1168,17 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
*/
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 {
diff --git a/generic/tclTest.c b/generic/tclTest.c
index dbd2b8e..e02ba13 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.62.2.9 2004/08/16 14:18:25 msofer Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.62.2.10 2005/10/23 22:01:30 msofer Exp $
*/
#define TCL_TEST
@@ -3437,9 +3437,10 @@ TestregexpObjCmd(dummy, interp, objc, objv)
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;
diff --git a/generic/tclVar.c b/generic/tclVar.c
index a78b3f6..52fec78 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclVar.c,v 1.69.2.8 2004/10/01 00:09:36 dgp Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.69.2.9 2005/10/23 22:01:31 msofer Exp $
*/
#include "tclInt.h"
@@ -2686,7 +2686,7 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
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 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
*/
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 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
* 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 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
arrayPtr->refCount--;
}
+ createdNewObj = 0;
if (varValuePtr == NULL) {
/*
* We couldn't read the old value: either the var doesn't yet
@@ -2757,7 +2754,6 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
* create it with Tcl_ObjSetVar2 below.
*/
- createVar = (TclIsVarUndefined(varPtr));
varValuePtr = Tcl_NewObj();
createdNewObj = 1;
} else if (Tcl_IsShared(varValuePtr)) {
@@ -2824,12 +2820,11 @@ Tcl_LappendObjCmd(dummy, interp, objc, objv)
* 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;
}
}
diff --git a/mac/tclMacInit.c b/mac/tclMacInit.c
index a319713..afae114 100644
--- a/mac/tclMacInit.c
+++ b/mac/tclMacInit.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMacInit.c,v 1.9.2.1 2004/03/29 18:49:36 hobbs Exp $
+ * RCS: @(#) $Id: tclMacInit.c,v 1.9.2.2 2005/10/23 22:01:31 msofer Exp $
*/
#include <AppleEvents.h>
@@ -712,7 +712,9 @@ Tcl_Init(
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);
}
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index e63160d..3f4b454 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -7,7 +7,7 @@
* Copyright (c) 1999 by Scriptics Corporation.
* All rights reserved.
*
- * RCS: @(#) $Id: tclUnixInit.c,v 1.34.2.9 2005/08/05 20:48:19 dkf Exp $
+ * RCS: @(#) $Id: tclUnixInit.c,v 1.34.2.10 2005/10/23 22:01:31 msofer Exp $
*/
#if defined(HAVE_COREFOUNDATION)
@@ -963,7 +963,9 @@ Tcl_Init(interp)
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);
}
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index d7ddbb5..7fb65c2 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -7,7 +7,7 @@
* Copyright (c) 1998-1999 by Scriptics Corporation.
* All rights reserved.
*
- * RCS: @(#) $Id: tclWinInit.c,v 1.40.2.5 2004/03/29 18:49:36 hobbs Exp $
+ * RCS: @(#) $Id: tclWinInit.c,v 1.40.2.6 2005/10/23 22:01:31 msofer Exp $
*/
#include "tclWinInt.h"
@@ -847,7 +847,9 @@ Tcl_Init(interp)
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);
}