diff options
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/tclStubLib.c | 33 | ||||
-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 |
11 files changed, 311 insertions, 52 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/tclStubLib.c b/generic/tclStubLib.c index c98956e..31fc865 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -19,28 +19,11 @@ TclIntStubs *tclIntStubsPtr = NULL; TclIntPlatStubs *tclIntPlatStubsPtr = NULL; TclTomMathStubs* tclTomMathStubsPtr = NULL; -static TclStubs * -HasStubSupport( - Tcl_Interp *interp) -{ - Interp *iPtr = (Interp *) interp; - - if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) { - return iPtr->stubTable; - } - interp->result = "interpreter uses an incompatible stubs mechanism"; - interp->freeProc = TCL_STATIC; - return NULL; -} - /* - * Use our own isdigit to avoid linking to libc on windows + * Use our own ISDIGIT to avoid linking to libc on windows */ -static int isDigit(const int c) -{ - return (c >= '0' && c <= '9'); -} +#define ISDIGIT(c) (((unsigned)((c)-'0')) <= 9) /* *---------------------------------------------------------------------- @@ -66,9 +49,10 @@ Tcl_InitStubs( CONST char *version, int exact) { + Interp *iPtr = (Interp *) interp; CONST char *actualVersion = NULL; ClientData pkgData = NULL; - TclStubs *stubsPtr; + TclStubs *stubsPtr = iPtr->stubTable; /* * We can't optimize this check by caching tclStubsPtr because that @@ -76,8 +60,9 @@ Tcl_InitStubs( * times. [Bug 615304] */ - stubsPtr = HasStubSupport(interp); - if (!stubsPtr) { + if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) { + iPtr->result = "interpreter uses an incompatible stubs mechanism"; + iPtr->freeProc = TCL_STATIC; return NULL; } @@ -90,7 +75,7 @@ Tcl_InitStubs( int count = 0; while (*p) { - count += !isDigit(*p++); + count += !ISDIGIT(*p++); } if (count == 1) { CONST char *q = actualVersion; @@ -99,7 +84,7 @@ Tcl_InitStubs( while (*p && (*p == *q)) { p++; q++; } - if (*p || isDigit(*q)) { + if (*p || ISDIGIT(*q)) { /* Construct error message */ stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); return NULL; 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. * |