summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2013-01-14 19:56:43 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2013-01-14 19:56:43 (GMT)
commitea654cca69bc5e2bc539a27b0d7322f20466134f (patch)
tree55eda7fdbc9face1592531a010869f1673fa7634 /generic
parentb2d00eb8176d84863a75aa771036a478115dbf57 (diff)
parentd64b6707b4b91c88d56b0147c0237411f47caa39 (diff)
downloadtcl-ea654cca69bc5e2bc539a27b0d7322f20466134f.zip
tcl-ea654cca69bc5e2bc539a27b0d7322f20466134f.tar.gz
tcl-ea654cca69bc5e2bc539a27b0d7322f20466134f.tar.bz2
merge trunk
remove some EXTERN and CONST usages in tclUnixPort.h
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.decls3
-rw-r--r--generic/tclDecls.h162
-rw-r--r--generic/tclExecute.c6
-rw-r--r--generic/tclIntDecls.h52
-rw-r--r--generic/tclListObj.c17
-rw-r--r--generic/tclStubInit.c52
-rw-r--r--generic/tclTestObj.c11
-rw-r--r--generic/tclThreadTest.c17
-rw-r--r--generic/tclTomMathInterface.c6
-rw-r--r--generic/tclUtil.c4
-rw-r--r--generic/tclVar.c111
11 files changed, 356 insertions, 85 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 256701d..7f49002 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2108,6 +2108,9 @@ declare 578 {
declare 579 {
void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr, const char *format, ...)
}
+declare 630 {
+ void TclUnusedStubEntry(void)
+}
##############################################################################
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 4225c96..8cb939c 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -3408,6 +3408,61 @@ EXTERN Tcl_Obj * Tcl_ObjPrintf(CONST char *format, ...);
EXTERN void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr,
CONST char *format, ...);
#endif
+/* Slot 580 is reserved */
+/* Slot 581 is reserved */
+/* Slot 582 is reserved */
+/* Slot 583 is reserved */
+/* Slot 584 is reserved */
+/* Slot 585 is reserved */
+/* Slot 586 is reserved */
+/* Slot 587 is reserved */
+/* Slot 588 is reserved */
+/* Slot 589 is reserved */
+/* Slot 590 is reserved */
+/* Slot 591 is reserved */
+/* Slot 592 is reserved */
+/* Slot 593 is reserved */
+/* Slot 594 is reserved */
+/* Slot 595 is reserved */
+/* Slot 596 is reserved */
+/* Slot 597 is reserved */
+/* Slot 598 is reserved */
+/* Slot 599 is reserved */
+/* Slot 600 is reserved */
+/* Slot 601 is reserved */
+/* Slot 602 is reserved */
+/* Slot 603 is reserved */
+/* Slot 604 is reserved */
+/* Slot 605 is reserved */
+/* Slot 606 is reserved */
+/* Slot 607 is reserved */
+/* Slot 608 is reserved */
+/* Slot 609 is reserved */
+/* Slot 610 is reserved */
+/* Slot 611 is reserved */
+/* Slot 612 is reserved */
+/* Slot 613 is reserved */
+/* Slot 614 is reserved */
+/* Slot 615 is reserved */
+/* Slot 616 is reserved */
+/* Slot 617 is reserved */
+/* Slot 618 is reserved */
+/* Slot 619 is reserved */
+/* Slot 620 is reserved */
+/* Slot 621 is reserved */
+/* Slot 622 is reserved */
+/* Slot 623 is reserved */
+/* Slot 624 is reserved */
+/* Slot 625 is reserved */
+/* Slot 626 is reserved */
+/* Slot 627 is reserved */
+/* Slot 628 is reserved */
+/* Slot 629 is reserved */
+#ifndef TclUnusedStubEntry_TCL_DECLARED
+#define TclUnusedStubEntry_TCL_DECLARED
+/* 630 */
+EXTERN void TclUnusedStubEntry(void);
+#endif
typedef struct TclStubHooks {
struct TclPlatStubs *tclPlatStubs;
@@ -4023,6 +4078,57 @@ typedef struct TclStubs {
int (*tcl_AppendFormatToObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST char *format, int objc, Tcl_Obj *CONST objv[]); /* 577 */
Tcl_Obj * (*tcl_ObjPrintf) (CONST char *format, ...); /* 578 */
void (*tcl_AppendPrintfToObj) (Tcl_Obj *objPtr, CONST char *format, ...); /* 579 */
+ VOID *reserved580;
+ VOID *reserved581;
+ VOID *reserved582;
+ VOID *reserved583;
+ VOID *reserved584;
+ VOID *reserved585;
+ VOID *reserved586;
+ VOID *reserved587;
+ VOID *reserved588;
+ VOID *reserved589;
+ VOID *reserved590;
+ VOID *reserved591;
+ VOID *reserved592;
+ VOID *reserved593;
+ VOID *reserved594;
+ VOID *reserved595;
+ VOID *reserved596;
+ VOID *reserved597;
+ VOID *reserved598;
+ VOID *reserved599;
+ VOID *reserved600;
+ VOID *reserved601;
+ VOID *reserved602;
+ VOID *reserved603;
+ VOID *reserved604;
+ VOID *reserved605;
+ VOID *reserved606;
+ VOID *reserved607;
+ VOID *reserved608;
+ VOID *reserved609;
+ VOID *reserved610;
+ VOID *reserved611;
+ VOID *reserved612;
+ VOID *reserved613;
+ VOID *reserved614;
+ VOID *reserved615;
+ VOID *reserved616;
+ VOID *reserved617;
+ VOID *reserved618;
+ VOID *reserved619;
+ VOID *reserved620;
+ VOID *reserved621;
+ VOID *reserved622;
+ VOID *reserved623;
+ VOID *reserved624;
+ VOID *reserved625;
+ VOID *reserved626;
+ VOID *reserved627;
+ VOID *reserved628;
+ VOID *reserved629;
+ void (*tclUnusedStubEntry) (void); /* 630 */
} TclStubs;
#ifdef __cplusplus
@@ -6377,11 +6483,67 @@ extern TclStubs *tclStubsPtr;
#define Tcl_AppendPrintfToObj \
(tclStubsPtr->tcl_AppendPrintfToObj) /* 579 */
#endif
+/* Slot 580 is reserved */
+/* Slot 581 is reserved */
+/* Slot 582 is reserved */
+/* Slot 583 is reserved */
+/* Slot 584 is reserved */
+/* Slot 585 is reserved */
+/* Slot 586 is reserved */
+/* Slot 587 is reserved */
+/* Slot 588 is reserved */
+/* Slot 589 is reserved */
+/* Slot 590 is reserved */
+/* Slot 591 is reserved */
+/* Slot 592 is reserved */
+/* Slot 593 is reserved */
+/* Slot 594 is reserved */
+/* Slot 595 is reserved */
+/* Slot 596 is reserved */
+/* Slot 597 is reserved */
+/* Slot 598 is reserved */
+/* Slot 599 is reserved */
+/* Slot 600 is reserved */
+/* Slot 601 is reserved */
+/* Slot 602 is reserved */
+/* Slot 603 is reserved */
+/* Slot 604 is reserved */
+/* Slot 605 is reserved */
+/* Slot 606 is reserved */
+/* Slot 607 is reserved */
+/* Slot 608 is reserved */
+/* Slot 609 is reserved */
+/* Slot 610 is reserved */
+/* Slot 611 is reserved */
+/* Slot 612 is reserved */
+/* Slot 613 is reserved */
+/* Slot 614 is reserved */
+/* Slot 615 is reserved */
+/* Slot 616 is reserved */
+/* Slot 617 is reserved */
+/* Slot 618 is reserved */
+/* Slot 619 is reserved */
+/* Slot 620 is reserved */
+/* Slot 621 is reserved */
+/* Slot 622 is reserved */
+/* Slot 623 is reserved */
+/* Slot 624 is reserved */
+/* Slot 625 is reserved */
+/* Slot 626 is reserved */
+/* Slot 627 is reserved */
+/* Slot 628 is reserved */
+/* Slot 629 is reserved */
+#ifndef TclUnusedStubEntry
+#define TclUnusedStubEntry \
+ (tclStubsPtr->tclUnusedStubEntry) /* 630 */
+#endif
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
/* !END!: Do not edit above this line. */
+#undef TclUnusedStubEntry
+
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index f2efa0f..229d7c6 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1063,7 +1063,7 @@ TclStackFree(
Tcl_Obj **markerPtr;
if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
- Tcl_Free((char *) freePtr);
+ ckfree((char *) freePtr);
return;
}
@@ -1112,7 +1112,7 @@ TclStackAlloc(
int numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
- return (void *) Tcl_Alloc(numBytes);
+ return (void *) ckalloc(numBytes);
}
return (void *) StackAllocWords(interp, numWords);
@@ -1131,7 +1131,7 @@ TclStackRealloc(
int numWords;
if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
- return (void *) Tcl_Realloc((char *) ptr, numBytes);
+ return (void *) ckrealloc((char *) ptr, numBytes);
}
eePtr = iPtr->execEnvPtr;
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 3ccc50a..1dc797a 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -29,19 +29,18 @@
#endif
/* [Bug #803489] Tcl_FindNamespace problem in the Stubs table */
-#undef Tcl_AppendExportList
#undef Tcl_CreateNamespace
#undef Tcl_DeleteNamespace
+#undef Tcl_AppendExportList
#undef Tcl_Export
-#undef Tcl_FindCommand
-#undef Tcl_FindNamespace
-#undef Tcl_FindNamespaceVar
+#undef Tcl_Import
#undef Tcl_ForgetImport
-#undef Tcl_GetCommandFromObj
-#undef Tcl_GetCommandFullName
#undef Tcl_GetCurrentNamespace
#undef Tcl_GetGlobalNamespace
-#undef Tcl_Import
+#undef Tcl_FindNamespace
+#undef Tcl_FindCommand
+#undef Tcl_GetCommandFromObj
+#undef Tcl_GetCommandFullName
/*
* WARNING: This file is automatically generated by the tools/genStubs.tcl
@@ -2053,4 +2052,43 @@ extern TclIntStubs *tclIntStubsPtr;
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
+#if defined(USE_TCL_STUBS) && defined(TCL_NO_DEPRECATED)
+# undef Tcl_CreateNamespace
+# define Tcl_CreateNamespace \
+ (tclStubsPtr->tcl_CreateNamespace) /* 506 */
+# undef Tcl_DeleteNamespace
+# define Tcl_DeleteNamespace \
+ (tclStubsPtr->tcl_DeleteNamespace) /* 507 */
+# undef Tcl_AppendExportList
+# define Tcl_AppendExportList \
+ (tclStubsPtr->tcl_AppendExportList) /* 508 */
+# undef Tcl_Export
+# define Tcl_Export \
+ (tclStubsPtr->tcl_Export) /* 509 */
+# undef Tcl_Import
+# define Tcl_Import \
+ (tclStubsPtr->tcl_Import) /* 510 */
+# undef Tcl_ForgetImport
+# define Tcl_ForgetImport \
+ (tclStubsPtr->tcl_ForgetImport) /* 511 */
+# undef Tcl_GetCurrentNamespace
+# define Tcl_GetCurrentNamespace \
+ (tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */
+# undef Tcl_GetGlobalNamespace
+# define Tcl_GetGlobalNamespace \
+ (tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */
+# undef Tcl_FindNamespace
+# define Tcl_FindNamespace \
+ (tclStubsPtr->tcl_FindNamespace) /* 514 */
+# undef Tcl_FindCommand
+# define Tcl_FindCommand \
+ (tclStubsPtr->tcl_FindCommand) /* 515 */
+# undef Tcl_GetCommandFromObj
+# define Tcl_GetCommandFromObj \
+ (tclStubsPtr->tcl_GetCommandFromObj) /* 516 */
+# undef Tcl_GetCommandFullName
+# define Tcl_GetCommandFullName \
+ (tclStubsPtr->tcl_GetCommandFullName) /* 517 */
+#endif
+
#endif /* _TCLINTDECLS */
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 17aa256..20b6ec1 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -857,6 +857,10 @@ Tcl_ListObjReplace(
isShared = (listRepPtr->refCount > 1);
numRequired = numElems - count + objc;
+ for (i = 0; i < objc; i++) {
+ Tcl_IncrRefCount(objv[i]);
+ }
+
if ((numRequired <= listRepPtr->maxElemCount) && !isShared) {
int shift;
@@ -902,6 +906,14 @@ Tcl_ListObjReplace(
listRepPtr = AttemptNewList(interp, newMax, NULL);
if (listRepPtr == NULL) {
+ for (i = 0; i < objc; i++) {
+ /* See bug 3598580 */
+#if TCL_MAJOR_VERSION > 8
+ Tcl_DecrRefCount(objv[i]);
+#else
+ objv[i]->refCount--;
+#endif
+ }
return TCL_ERROR;
}
@@ -964,14 +976,11 @@ Tcl_ListObjReplace(
}
/*
- * Insert the new elements into elemPtrs before "first". We don't do a
- * memcpy here because we must increment the reference counts for the
- * added elements, so we must explicitly loop anyway.
+ * Insert the new elements into elemPtrs before "first".
*/
for (i=0,j=first ; i<objc ; i++,j++) {
elemPtrs[j] = objv[i];
- Tcl_IncrRefCount(objv[i]);
}
/*
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index d06e174..fd4a222 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -33,6 +33,7 @@
#undef Tcl_CreateHashEntry
#undef TclpGetPid
#undef TclSockMinimumBuffers
+#define TclUnusedStubEntry NULL
/*
* Keep a record of the original Notifier procedures, created in the
@@ -1254,6 +1255,57 @@ TclStubs tclStubs = {
Tcl_AppendFormatToObj, /* 577 */
Tcl_ObjPrintf, /* 578 */
Tcl_AppendPrintfToObj, /* 579 */
+ NULL, /* 580 */
+ NULL, /* 581 */
+ NULL, /* 582 */
+ NULL, /* 583 */
+ NULL, /* 584 */
+ NULL, /* 585 */
+ NULL, /* 586 */
+ NULL, /* 587 */
+ NULL, /* 588 */
+ NULL, /* 589 */
+ NULL, /* 590 */
+ NULL, /* 591 */
+ NULL, /* 592 */
+ NULL, /* 593 */
+ NULL, /* 594 */
+ NULL, /* 595 */
+ NULL, /* 596 */
+ NULL, /* 597 */
+ NULL, /* 598 */
+ NULL, /* 599 */
+ NULL, /* 600 */
+ NULL, /* 601 */
+ NULL, /* 602 */
+ NULL, /* 603 */
+ NULL, /* 604 */
+ NULL, /* 605 */
+ NULL, /* 606 */
+ NULL, /* 607 */
+ NULL, /* 608 */
+ NULL, /* 609 */
+ NULL, /* 610 */
+ NULL, /* 611 */
+ NULL, /* 612 */
+ NULL, /* 613 */
+ NULL, /* 614 */
+ NULL, /* 615 */
+ NULL, /* 616 */
+ NULL, /* 617 */
+ NULL, /* 618 */
+ NULL, /* 619 */
+ NULL, /* 620 */
+ NULL, /* 621 */
+ NULL, /* 622 */
+ NULL, /* 623 */
+ NULL, /* 624 */
+ NULL, /* 625 */
+ NULL, /* 626 */
+ NULL, /* 627 */
+ NULL, /* 628 */
+ NULL, /* 629 */
+ TclUnusedStubEntry, /* 630 */
};
/* !END!: Do not edit above this line. */
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 37286e3..8597bbc 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -925,6 +925,17 @@ TestobjCmd(
}
SetVarToObj(destIndex, varPtr[varIndex]);
Tcl_SetObjResult(interp, varPtr[destIndex]);
+ } else if (strcmp(subCmd, "bug3598580") == 0) {
+ Tcl_Obj *listObjPtr, *elemObjPtr;
+ if (objc != 2) {
+ goto wrongNumArgs;
+ }
+ elemObjPtr = Tcl_NewIntObj(123);
+ listObjPtr = Tcl_NewListObj(1, &elemObjPtr);
+ /* Replace the single list element through itself, nonsense but legal. */
+ Tcl_ListObjReplace(interp, listObjPtr, 0, 1, 1, &elemObjPtr);
+ Tcl_SetObjResult(interp, listObjPtr);
+ return TCL_OK;
} else if (strcmp(subCmd, "convert") == 0) {
char *typeName;
if (objc != 4) {
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 960c7dc..d032cc6 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -57,7 +57,7 @@ static struct ThreadSpecificData *threadList;
*/
typedef struct ThreadCtrl {
- char *script; /* The Tcl command this thread should
+ const char *script; /* The Tcl command this thread should
* execute */
int flags; /* Initial value of the "flags" field in the
* ThreadSpecificData structure for the new
@@ -120,11 +120,11 @@ EXTERN int TclThread_Init(Tcl_Interp *interp);
EXTERN int Tcl_ThreadObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-EXTERN int TclCreateThread(Tcl_Interp *interp, char *script,
+EXTERN int TclCreateThread(Tcl_Interp *interp, const char *script,
int joinable);
EXTERN int TclThreadList(Tcl_Interp *interp);
EXTERN int TclThreadSend(Tcl_Interp *interp, Tcl_ThreadId id,
- char *script, int wait);
+ const char *script, int wait);
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
@@ -234,7 +234,7 @@ Tcl_ThreadObjCmd(
switch ((enum options)option) {
case THREAD_CREATE: {
- char *script;
+ const char *script;
int joinable, len;
if (objc == 2) {
@@ -331,7 +331,7 @@ Tcl_ThreadObjCmd(
return TclThreadList(interp);
case THREAD_SEND: {
long id;
- char *script;
+ const char *script;
int wait, arg;
if ((objc != 4) && (objc != 5)) {
@@ -407,7 +407,7 @@ Tcl_ThreadObjCmd(
int
TclCreateThread(
Tcl_Interp *interp, /* Current interpreter. */
- char *script, /* Script to execute */
+ const char *script, /* Script to execute */
int joinable) /* Flag, joinable thread or not */
{
ThreadCtrl ctrl;
@@ -424,7 +424,6 @@ TclCreateThread(
TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) {
Tcl_MutexUnlock(&threadMutex);
Tcl_AppendResult(interp, "can't create a new thread", NULL);
- ckfree((char *) ctrl.script);
return TCL_ERROR;
}
@@ -705,7 +704,7 @@ int
TclThreadSend(
Tcl_Interp *interp, /* The current interpreter. */
Tcl_ThreadId id, /* Thread Id of other interpreter. */
- char *script, /* The script to evaluate. */
+ const char *script, /* The script to evaluate. */
int wait) /* If 1, we block for the result. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -1035,7 +1034,7 @@ ThreadExitProc(
* going to call free on it.
*/
- char *msg = "target thread died";
+ const char *msg = "target thread died";
resultPtr->result = ckalloc(strlen(msg)+1);
strcpy(resultPtr->result, msg);
diff --git a/generic/tclTomMathInterface.c b/generic/tclTomMathInterface.c
index 6e5dac3..89c1132 100644
--- a/generic/tclTomMathInterface.c
+++ b/generic/tclTomMathInterface.c
@@ -112,7 +112,7 @@ extern void *
TclBNAlloc(
size_t x)
{
- return (void *) Tcl_Alloc((unsigned int) x);
+ return (void *) ckalloc((unsigned int) x);
}
/*
@@ -136,7 +136,7 @@ TclBNRealloc(
void *p,
size_t s)
{
- return (void *) Tcl_Realloc((char *) p, (unsigned int) s);
+ return (void *) ckrealloc((char *) p, (unsigned int) s);
}
/*
@@ -162,7 +162,7 @@ extern void
TclBNFree(
void *p)
{
- Tcl_Free((char *) p);
+ ckfree((char *) p);
}
#endif
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 866b6ae..5f4cdae 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -167,7 +167,7 @@ Tcl_ObjType tclEndOffsetType = {
* separating whitespace, or a string terminator. It is just
* another character in a list element.
*
- * The interpretaton of a formatted substring as a list element follows
+ * The interpretation of a formatted substring as a list element follows
* rules similar to the parsing of the words of a command in a Tcl script.
* Backslash substitution plays a key role, and is defined exactly as it is
* in command parsing. The same routine, TclParseBackslash() is used in both
@@ -180,7 +180,7 @@ Tcl_ObjType tclEndOffsetType = {
* Backslash substitution replaces an "escape sequence" of one or more
* characters starting with
* \u005c \ BACKSLASH
- * with a single character. The one character escape sequent case happens
+ * with a single character. The one character escape sequence case happens
* only when BACKSLASH is the last character in the string. In all other
* cases, the escape sequence is at least two characters long.
*
diff --git a/generic/tclVar.c b/generic/tclVar.c
index aaf1cb9..7622675 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -47,6 +47,13 @@ static inline void CleanupVar(Var *varPtr, Var *arrayPtr);
#define VarHashGetValue(hPtr) \
((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))
+/*
+ * NOTE: VarHashCreateVar increments the recount of its key argument.
+ * All callers that will call Tcl_DecrRefCount on that argument must
+ * call Tcl_IncrRefCount on it before passing it in. This requirement
+ * can bubble up to callers of callers .... etc.
+ */
+
static inline Var *
VarHashCreateVar(
TclVarHashTable *tablePtr,
@@ -381,11 +388,12 @@ TclLookupVar(
* address of array variable. Otherwise this
* is set to NULL. */
{
- Tcl_Obj *part1Ptr;
Var *varPtr;
+ Tcl_Obj *part1Ptr = Tcl_NewStringObj(part1, -1);
- part1Ptr = Tcl_NewStringObj(part1, -1);
- Tcl_IncrRefCount(part1Ptr);
+ if (createPart1) {
+ Tcl_IncrRefCount(part1Ptr);
+ }
varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, msg,
createPart1, createPart2, arrayPtrPtr);
@@ -430,6 +438,8 @@ TclLookupVar(
* are 1. The object part1Ptr is converted to one of localVarNameType,
* tclNsVarNameType or tclParsedVarNameType and caches as much of the
* lookup as it can.
+ * When createPart1 is 1, callers must IncrRefCount part1Ptr if they
+ * plan to DecrRefCount it.
*
*----------------------------------------------------------------------
*/
@@ -458,14 +468,11 @@ TclObjLookupVar(
* address of array variable. Otherwise this
* is set to NULL. */
{
- Tcl_Obj *part2Ptr;
+ Tcl_Obj *part2Ptr = NULL;
Var *resPtr;
if (part2) {
part2Ptr = Tcl_NewStringObj(part2, -1);
- Tcl_IncrRefCount(part2Ptr);
- } else {
- part2Ptr = NULL;
}
resPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
@@ -840,6 +847,7 @@ TclObjLookupVarEx(
*
* Side effects:
* A new hashtable entry may be created if create is 1.
+ * Callers must Incr varNamePtr if they plan to Decr it if create is 1.
*
*----------------------------------------------------------------------
*/
@@ -1277,15 +1285,10 @@ Tcl_GetVar2Ex(
int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and
* TCL_LEAVE_ERR_MSG bits. */
{
- Tcl_Obj *part1Ptr, *part2Ptr, *resPtr;
+ Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
- part1Ptr = Tcl_NewStringObj(part1, -1);
- Tcl_IncrRefCount(part1Ptr);
if (part2) {
part2Ptr = Tcl_NewStringObj(part2, -1);
- Tcl_IncrRefCount(part2Ptr);
- } else {
- part2Ptr = NULL;
}
resPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
@@ -1566,18 +1569,8 @@ Tcl_SetVar2(
* TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or
* TCL_LEAVE_ERR_MSG. */
{
- register Tcl_Obj *valuePtr;
- Tcl_Obj *varValuePtr;
-
- /*
- * Create an object holding the variable's new value and use Tcl_SetVar2Ex
- * to actually set the variable.
- */
-
- valuePtr = Tcl_NewStringObj(newValue, -1);
- Tcl_IncrRefCount(valuePtr);
- varValuePtr = Tcl_SetVar2Ex(interp, part1, part2, valuePtr, flags);
- Tcl_DecrRefCount(valuePtr);
+ Tcl_Obj *varValuePtr = Tcl_SetVar2Ex(interp, part1, part2,
+ Tcl_NewStringObj(newValue, -1), flags);
if (varValuePtr == NULL) {
return NULL;
@@ -1637,15 +1630,12 @@ Tcl_SetVar2Ex(
* TCL_APPEND_VALUE, TCL_LIST_ELEMENT or
* TCL_LEAVE_ERR_MSG. */
{
- Tcl_Obj *part1Ptr, *part2Ptr, *resPtr;
+ Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
- part1Ptr = Tcl_NewStringObj(part1, -1);
Tcl_IncrRefCount(part1Ptr);
if (part2) {
part2Ptr = Tcl_NewStringObj(part2, -1);
Tcl_IncrRefCount(part2Ptr);
- } else {
- part2Ptr = NULL;
}
resPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags);
@@ -1678,6 +1668,7 @@ Tcl_SetVar2Ex(
* Side effects:
* The value of the given variable is set. If either the array or the
* entry didn't exist then a new variable is created.
+ * Callers must Incr part1Ptr if they plan to Decr it.
*
*----------------------------------------------------------------------
*/
@@ -1965,6 +1956,7 @@ TclPtrSetVar(
* variable is created. The ref count for the returned object is _not_
* incremented to reflect the returned reference; if you want to keep a
* reference to the object you must increment its ref count yourself.
+ * Callers must Incr part1Ptr if they plan to Decr it.
*
*----------------------------------------------------------------------
*/
@@ -2047,8 +2039,7 @@ TclPtrIncrObjVar(
* variable, or -1. Only used when part1Ptr is
* NULL. */
{
- register Tcl_Obj *varValuePtr, *newValuePtr = NULL;
- int duplicated, code;
+ register Tcl_Obj *varValuePtr;
if (TclIsVarInHash(varPtr)) {
VarHashRefCount(varPtr)++;
@@ -2062,19 +2053,33 @@ TclPtrIncrObjVar(
varValuePtr = Tcl_NewIntObj(0);
}
if (Tcl_IsShared(varValuePtr)) {
- duplicated = 1;
+ /* Copy on write */
varValuePtr = Tcl_DuplicateObj(varValuePtr);
+
+ if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
+ return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+ varValuePtr, flags, index);
+ } else {
+ Tcl_DecrRefCount(varValuePtr);
+ return NULL;
+ }
} else {
- duplicated = 0;
- }
- code = TclIncrObj(interp, varValuePtr, incrPtr);
- if (code == TCL_OK) {
- newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr,
- part2Ptr, varValuePtr, flags, index);
- } else if (duplicated) {
- Tcl_DecrRefCount(varValuePtr);
+ /* Unshared - can Incr in place */
+ if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
+
+ /*
+ * This seems dumb to write the incremeted value into the var
+ * after we just adjusted the value in place, but the spec for
+ * [incr] requires that write traces fire, and making this call
+ * is the way to make that happen.
+ */
+
+ return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+ varValuePtr, flags, index);
+ } else {
+ return NULL;
+ }
}
- return newValuePtr;
}
/*
@@ -2143,13 +2148,10 @@ Tcl_UnsetVar2(
* TCL_LEAVE_ERR_MSG. */
{
int result;
- Tcl_Obj *part1Ptr, *part2Ptr = NULL;
+ Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
- part1Ptr = Tcl_NewStringObj(part1, -1);
- Tcl_IncrRefCount(part1Ptr);
if (part2) {
part2Ptr = Tcl_NewStringObj(part2, -1);
- Tcl_IncrRefCount(part2Ptr);
}
/*
@@ -3318,6 +3320,7 @@ Tcl_ArrayObjCmd(
*
* Side effects:
* A variable will be created if one does not already exist.
+ * Callers must Incr arrayNameObj if they pland to Decr it.
*
*----------------------------------------------------------------------
*/
@@ -3485,6 +3488,8 @@ TclArraySet(
* The variable given by myName is linked to the variable in framePtr
* given by otherP1 and otherP2, so that references to myName are
* redirected to the other variable like a symbolic link.
+ * Callers must Incr myNamePtr if they plan to Decr it.
+ * Callers must Incr otherP1Ptr if they plan to Decr it.
*
*----------------------------------------------------------------------
*/
@@ -3592,14 +3597,12 @@ TclPtrMakeUpvar(
int index) /* If the variable to be linked is an indexed
* scalar, this is its index. Otherwise, -1 */
{
- Tcl_Obj *myNamePtr;
+ Tcl_Obj *myNamePtr = NULL;
int result;
if (myName) {
myNamePtr = Tcl_NewStringObj(myName, -1);
Tcl_IncrRefCount(myNamePtr);
- } else {
- myNamePtr = NULL;
}
result = TclPtrObjMakeUpvar(interp, otherPtr, myNamePtr, myFlags, index);
if (myNamePtr) {
@@ -3608,6 +3611,8 @@ TclPtrMakeUpvar(
return result;
}
+/* Callers must Incr myNamePtr if they plan to Decr it. */
+
int
TclPtrObjMakeUpvar(
Tcl_Interp *interp, /* Interpreter containing variables. Used for
@@ -4425,7 +4430,6 @@ TclDeleteNamespaceVars(
for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL;
varPtr = VarHashFirstVar(tablePtr, &search)) {
Tcl_Obj *objPtr = Tcl_NewObj();
- Tcl_IncrRefCount(objPtr);
VarHashRefCount(varPtr)++; /* Make sure we get to remove from
* hash. */
@@ -4689,15 +4693,10 @@ TclVarErrMsg(
* e.g. "read", "set", or "unset". */
const char *reason) /* String describing why operation failed. */
{
- Tcl_Obj *part1Ptr = NULL, *part2Ptr = NULL;
+ Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
- part1Ptr = Tcl_NewStringObj(part1, -1);
- Tcl_IncrRefCount(part1Ptr);
if (part2) {
part2Ptr = Tcl_NewStringObj(part2, -1);
- Tcl_IncrRefCount(part2Ptr);
- } else {
- part2 = NULL;
}
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, operation, reason, -1);
@@ -4965,7 +4964,6 @@ Tcl_FindNamespaceVar(
Tcl_Obj *namePtr = Tcl_NewStringObj(name, -1);
Tcl_Var var;
- Tcl_IncrRefCount(namePtr);
var = ObjFindNamespaceVar(interp, namePtr, contextNsPtr, flags);
Tcl_DecrRefCount(namePtr);
return var;
@@ -5060,7 +5058,6 @@ ObjFindNamespaceVar(
varPtr = NULL;
if (simpleName != name) {
simpleNamePtr = Tcl_NewStringObj(simpleName, -1);
- Tcl_IncrRefCount(simpleNamePtr);
} else {
simpleNamePtr = namePtr;
}