diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2013-01-14 19:56:43 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2013-01-14 19:56:43 (GMT) |
commit | ea654cca69bc5e2bc539a27b0d7322f20466134f (patch) | |
tree | 55eda7fdbc9face1592531a010869f1673fa7634 /generic | |
parent | b2d00eb8176d84863a75aa771036a478115dbf57 (diff) | |
parent | d64b6707b4b91c88d56b0147c0237411f47caa39 (diff) | |
download | tcl-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.decls | 3 | ||||
-rw-r--r-- | generic/tclDecls.h | 162 | ||||
-rw-r--r-- | generic/tclExecute.c | 6 | ||||
-rw-r--r-- | generic/tclIntDecls.h | 52 | ||||
-rw-r--r-- | generic/tclListObj.c | 17 | ||||
-rw-r--r-- | generic/tclStubInit.c | 52 | ||||
-rw-r--r-- | generic/tclTestObj.c | 11 | ||||
-rw-r--r-- | generic/tclThreadTest.c | 17 | ||||
-rw-r--r-- | generic/tclTomMathInterface.c | 6 | ||||
-rw-r--r-- | generic/tclUtil.c | 4 | ||||
-rw-r--r-- | generic/tclVar.c | 111 |
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; } |