From 96af7fcd51a853aac2eb09b6de444a9789e04638 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 16 Aug 2011 11:23:10 +0000 Subject: [Bug 3388350] mingw64 compiler warnings --- ChangeLog | 5 ++++- win/tclWin32Dll.c | 2 +- win/tclWinChan.c | 2 +- win/tclWinDde.c | 2 +- win/tclWinFCmd.c | 4 ++-- 5 files changed, 9 insertions(+), 6 deletions(-) diff --git a/ChangeLog b/ChangeLog index 8640993..1f36fe3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -5,7 +5,10 @@ * generic/tclFileName.c before winsock2.h, so make sure of that. * generic/tclIOUtil.c * generic/tclTest.c - * win/tclWinFile.c + * win/tclWin32Dll.c + * win/tclWinChan.c + * win/tclWinDde.c + * win/tclWinFCmd.c 2011-08-15 Don Porter diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index 4bfd046..ba3af7c 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -529,7 +529,7 @@ int TclpCheckStackSpace() { -#ifdef HAVE_NO_SEH +#if defined(HAVE_NO_SEH) && !defined(__WIN64__) EXCEPTION_REGISTRATION registration; #endif int retval = 0; diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 67a12a0..d06ff50 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -962,7 +962,7 @@ Tcl_MakeFileChannel(rawHandle, mode) int mode; /* ORed combination of TCL_READABLE and * TCL_WRITABLE to indicate file mode. */ { -#ifdef HAVE_NO_SEH +#if defined(HAVE_NO_SEH) && !defined(_WIN64) EXCEPTION_REGISTRATION registration; #endif char channelName[16 + TCL_INTEGER_SPACE]; diff --git a/win/tclWinDde.c b/win/tclWinDde.c index f5882c6..d180878 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -173,7 +173,7 @@ Initialize(void) if (ddeInstance == 0) { Tcl_MutexLock(&ddeMutex); if (ddeInstance == 0) { - if (DdeInitialize(&ddeInstance, DdeServerProc, + if (DdeInitialize(&ddeInstance, (PFNCALLBACK) DdeServerProc, CBF_SKIP_REGISTRATIONS | CBF_SKIP_UNREGISTRATIONS | CBF_FAIL_POKES, 0) diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index e0861f2..231e4b7 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -180,7 +180,7 @@ DoRenameFile( CONST TCHAR *nativeDst) /* New pathname for file or directory * (native). */ { -#ifdef HAVE_NO_SEH +#if defined(HAVE_NO_SEH) && !defined(_WIN64) EXCEPTION_REGISTRATION registration; #endif DWORD srcAttr, dstAttr; @@ -554,7 +554,7 @@ DoCopyFile( CONST TCHAR *nativeSrc, /* Pathname of file to be copied (native). */ CONST TCHAR *nativeDst) /* Pathname of file to copy to (native). */ { -#ifdef HAVE_NO_SEH +#if defined(HAVE_NO_SEH) && !defined(_WIN64) EXCEPTION_REGISTRATION registration; #endif int retval = -1; -- cgit v0.12 From 754781a8ca6a7ff2617e2dea8f8fc569c868445e Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 16 Aug 2011 13:55:06 +0000 Subject: Small changes to quell gcc warnings and make message generation less ugly. --- ChangeLog | 14 +++++-- generic/tclCmdIL.c | 9 ++--- generic/tclIndexObj.c | 44 ++++++++++----------- generic/tclListObj.c | 106 +++++++++++++++++++++++++++++++++----------------- generic/tclVar.c | 7 +--- 5 files changed, 108 insertions(+), 72 deletions(-) diff --git a/ChangeLog b/ChangeLog index 28c66aa..b8832e6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,10 +1,18 @@ +2011-08-16 Donal K. Fellows + + * generic/tclListObj.c (TclLindexList, TclLsetFlat): Silence warnings + about (unreachable) cases of uninitialized variables. + * generic/tclCmdIL.c (SelectObjFromSublist): Improve the generation of + * generic/tclIndexObj.c (Tcl_ParseArgsObjv): messages through the use + * generic/tclVar.c (ArrayStartSearchCmd): of Tcl_ObjPrintf. + 2011-08-15 Don Porter - * generic/tclBasic.c: [Bug 3390272] Leak of [info script] value. + * generic/tclBasic.c: [Bug 3390272]: Leak of [info script] value. 2011-08-15 Jan Nijtmans - * generic/tclPosixStr.c: [Bug 3388350] mingw64 compiler warnings + * generic/tclPosixStr.c: [Bug 3388350]: mingw64 compiler warnings * win/tclWinPort.h: * win/configure.in * win/configure @@ -16,7 +24,7 @@ 2011-08-12 Don Porter - * generic/tclPathObj.c: [Bug 3389764] Eliminate possibility that dup + * generic/tclPathObj.c: [Bug 3389764]: Eliminate possibility that dup of a "path" value can create reference cycle. 2011-08-12 Donal K. Fellows diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 64348ad..95532d3 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -4446,12 +4446,9 @@ SelectObjFromSublist( return NULL; } if (currentObj == NULL) { - char buffer[TCL_INTEGER_SPACE]; - - TclFormatInt(buffer, index); - Tcl_AppendResult(infoPtr->interp, "element ", buffer, - " missing from sublist \"", TclGetString(objPtr), "\"", - NULL); + Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf( + "element %d missing from sublist \"%s\"", + index, TclGetString(objPtr))); Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT", "INDEXFAILED", NULL); infoPtr->resultCode = TCL_ERROR; diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 76c2dea..6f378a4 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -359,7 +359,6 @@ Tcl_GetIndexFromObjStruct( int count; TclNewObj(resultPtr); - Tcl_SetObjResult(interp, resultPtr); Tcl_AppendStringsToObj(resultPtr, (numAbbrev>1 && !(flags & TCL_EXACT) ? "ambiguous " : "bad "), msg, " \"", key, NULL); @@ -379,6 +378,7 @@ Tcl_GetIndexFromObjStruct( } } } + Tcl_SetObjResult(interp, resultPtr); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, NULL); } return TCL_ERROR; @@ -410,7 +410,7 @@ SetIndexFromAny( register Tcl_Obj *objPtr) /* The object to convert. */ { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't convert value to index except via Tcl_GetIndexFromObj API", -1)); } @@ -593,14 +593,16 @@ PrefixMatchObjCmd( case PRFMATCH_MESSAGE: if (i > (objc - 4)) { Tcl_AppendResult(interp, "missing message", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL); return TCL_ERROR; } i++; message = Tcl_GetString(objv[i]); break; case PRFMATCH_ERROR: - if (i > (objc - 4)) { + if (i > objc-4) { Tcl_AppendResult(interp, "missing error options", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL); return TCL_ERROR; } i++; @@ -611,6 +613,7 @@ PrefixMatchObjCmd( if ((errorLength % 2) != 0) { Tcl_AppendResult(interp, "error options must have an even" " number of elements", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL); return TCL_ERROR; } errorPtr = objv[i]; @@ -1093,7 +1096,7 @@ Tcl_ParseArgsObjv( /* Pointer to the current entry in the table * of argument descriptions. */ const Tcl_ArgvInfo *matchPtr; - /* Descriptor that matches current argument. */ + /* Descriptor that matches current argument */ Tcl_Obj *curArg; /* Current argument */ const char *str = NULL; register char c; /* Second character of current arg (used for @@ -1106,7 +1109,7 @@ Tcl_ParseArgsObjv( * being processed, primarily for error * reporting. */ int objc; /* # arguments in objv still to process. */ - int length; /* Number of characters in current argument. */ + int length; /* Number of characters in current argument */ if (remObjv != NULL) { /* @@ -1147,8 +1150,7 @@ Tcl_ParseArgsObjv( matchPtr = NULL; infoPtr = argTable; - for (; (infoPtr != NULL) && (infoPtr->type != TCL_ARGV_END); - infoPtr++) { + for (; infoPtr != NULL && infoPtr->type != TCL_ARGV_END ; infoPtr++) { if (infoPtr->keyStr == NULL) { continue; } @@ -1242,7 +1244,8 @@ Tcl_ParseArgsObjv( objc--; break; case TCL_ARGV_FUNC: { - Tcl_ArgvFuncProc *handlerProc; + Tcl_ArgvFuncProc *handlerProc = (Tcl_ArgvFuncProc *) + infoPtr->srcPtr; Tcl_Obj *argObj; if (objc == 0) { @@ -1250,7 +1253,6 @@ Tcl_ParseArgsObjv( } else { argObj = objv[srcIndex]; } - handlerProc = (Tcl_ArgvFuncProc *) infoPtr->srcPtr; if (handlerProc(infoPtr->clientData, argObj, infoPtr->dstPtr)) { srcIndex++; objc--; @@ -1258,9 +1260,9 @@ Tcl_ParseArgsObjv( break; } case TCL_ARGV_GENFUNC: { - Tcl_ArgvGenFuncProc *handlerProc; + Tcl_ArgvGenFuncProc *handlerProc = (Tcl_ArgvGenFuncProc *) + infoPtr->srcPtr; - handlerProc = (Tcl_ArgvGenFuncProc *) infoPtr->srcPtr; objc = handlerProc(infoPtr->clientData, interp, objc, &objv[srcIndex], infoPtr->dstPtr); if (objc < 0) { @@ -1271,15 +1273,11 @@ Tcl_ParseArgsObjv( case TCL_ARGV_HELP: PrintUsage(interp, argTable); goto error; - default: { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "bad argument type %d in Tcl_ArgvInfo", - infoPtr->type); - Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); + default: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument type %d in Tcl_ArgvInfo", infoPtr->type)); goto error; } - } } /* @@ -1444,18 +1442,18 @@ int TclGetCompletionCodeFromObj( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *value, - int *code) /* Argument objects. */ + int *code) /* Argument objects. */ { static const char *const returnCodes[] = { - "ok", "error", "return", "break", "continue", NULL + "ok", "error", "return", "break", "continue", NULL }; if ((value->typePtr != &indexType) && (TCL_OK == TclGetIntFromObj(NULL, value, code))) { return TCL_OK; } - if (TCL_OK == Tcl_GetIndexFromObj( - NULL, value, returnCodes, NULL, TCL_EXACT, code)) { + if (TCL_OK == Tcl_GetIndexFromObj(NULL, value, returnCodes, NULL, + TCL_EXACT, code)) { return TCL_OK; } /* @@ -1472,7 +1470,7 @@ TclGetCompletionCodeFromObj( } return TCL_ERROR; } - + /* * Local Variables: * mode: c diff --git a/generic/tclListObj.c b/generic/tclListObj.c index ac87628..3668b45 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -49,7 +49,6 @@ const Tcl_ObjType tclListType = { #ifndef TCL_MIN_ELEMENT_GROWTH #define TCL_MIN_ELEMENT_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Obj *) #endif - /* *---------------------------------------------------------------------- @@ -518,7 +517,10 @@ Tcl_ListObjAppendList( Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList"); } - /* Pull the elements to append from elemListPtr */ + /* + * Pull the elements to append from elemListPtr. + */ + if (TCL_OK != TclListObjGetElements(interp, elemListPtr, &objc, &objv)) { return TCL_ERROR; } @@ -600,7 +602,10 @@ Tcl_ListObjAppendElement( } if (needGrow && !isShared) { - /* Need to grow + unshared intrep => try to realloc */ + /* + * Need to grow + unshared intrep => try to realloc + */ + attempt = 2 * numRequired; if (attempt <= LIST_MAX) { newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); @@ -626,10 +631,10 @@ Tcl_ListObjAppendElement( Tcl_Obj **dst, **src = &listRepPtr->elements; /* - * Either we have a shared intrep and we must copy to write, - * or we need to grow and realloc attempts failed. - * Attempt intrep copy. + * Either we have a shared intrep and we must copy to write, or we + * need to grow and realloc attempts failed. Attempt intrep copy. */ + attempt = 2 * numRequired; newPtr = AttemptNewList(NULL, attempt, NULL); if (newPtr == NULL) { @@ -644,7 +649,10 @@ Tcl_ListObjAppendElement( newPtr = AttemptNewList(interp, attempt, NULL); } if (newPtr == NULL) { - /* All growth attempts failed; throw the error */ + /* + * All growth attempts failed; throw the error. + */ + return TCL_ERROR; } @@ -655,8 +663,8 @@ Tcl_ListObjAppendElement( if (isShared) { /* - * The original intrep must remain undisturbed. - * Copy into the new one and bump refcounts + * The original intrep must remain undisturbed. Copy into the new + * one and bump refcounts */ while (numElems--) { *dst = *src++; @@ -664,9 +672,11 @@ Tcl_ListObjAppendElement( } listRepPtr->refCount--; } else { - /* Old intrep to be freed, re-use refCounts */ - memcpy(dst, src, (size_t) numElems * sizeof(Tcl_Obj *)); + /* + * Old intrep to be freed, re-use refCounts. + */ + memcpy(dst, src, (size_t) numElems * sizeof(Tcl_Obj *)); ckfree(listRepPtr); } listRepPtr = newPtr; @@ -854,11 +864,10 @@ Tcl_ListObjReplace( } if (listPtr->typePtr != &tclListType) { if (listPtr->bytes == tclEmptyStringRep) { - if (objc) { - Tcl_SetListObj(listPtr, objc, NULL); - } else { + if (!objc) { return TCL_OK; } + Tcl_SetListObj(listPtr, objc, NULL); } else { int result = SetListFromAny(interp, listPtr); @@ -891,8 +900,9 @@ Tcl_ListObjReplace( } else if (numElems < first+count || first+count < 0) { /* * The 'first+count < 0' condition here guards agains integer - * overflow in determining 'first+count' + * overflow in determining 'first+count'. */ + count = numElems - first; } @@ -1075,8 +1085,6 @@ TclLindexList( { int index; /* Index into the list. */ - Tcl_Obj **indices; /* Array of list indices. */ - int indexCount; /* Size of the array of list indices. */ Tcl_Obj *indexListCopy; /* @@ -1116,8 +1124,19 @@ TclLindexList( return TclLindexFlat(interp, listPtr, 1, &argPtr); } - TclListObjGetElements(NULL, indexListCopy, &indexCount, &indices); - listPtr = TclLindexFlat(interp, listPtr, indexCount, indices); + if (indexListCopy->typePtr == &tclListType) { + List *listRepPtr = ListRepPtr(indexListCopy); + + listPtr = TclLindexFlat(interp, listPtr, listRepPtr->elemCount, + &listRepPtr->elements); + } else { + int indexCount = -1; /* Size of the array of list indices. */ + Tcl_Obj **indices = NULL; + /* Array of list indices. */ + + Tcl_ListObjGetElements(NULL, indexListCopy, &indexCount, &indices); + listPtr = TclLindexFlat(interp, listPtr, indexCount, indices); + } Tcl_DecrRefCount(indexListCopy); return listPtr; } @@ -1375,6 +1394,7 @@ TclLsetFlat( retValuePtr = subListPtr; chainPtr = NULL; + result = TCL_OK; /* * Loop through all the index arguments, and for each one dive into the @@ -1385,11 +1405,14 @@ TclLsetFlat( int elemCount; Tcl_Obj *parentList, **elemPtrs; - /* Check for the possible error conditions... */ - result = TCL_ERROR; + /* + * Check for the possible error conditions... + */ + if (TclListObjGetElements(interp, subListPtr, &elemCount, &elemPtrs) != TCL_OK) { /* ...the sublist we're indexing into isn't a list at all. */ + result = TCL_ERROR; break; } @@ -1401,6 +1424,7 @@ TclLsetFlat( if (TclGetIntForIndexM(interp, *indexArray, elemCount - 1, &index) != TCL_OK) { /* ...the index we're trying to use isn't an index at all. */ + result = TCL_ERROR; indexArray++; break; } @@ -1411,9 +1435,10 @@ TclLsetFlat( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", + "BADINDEX", NULL); } - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX", - NULL); + result = TCL_ERROR; break; } @@ -1424,7 +1449,6 @@ TclLsetFlat( * modify it. */ - result = TCL_OK; if (--indexCount) { parentList = subListPtr; if (index == elemCount) { @@ -1514,10 +1538,13 @@ TclLsetFlat( } /* - * Store valuePtr in proper sublist and return. + * Store valuePtr in proper sublist and return. The -1 is to avoid a + * compiler warning (not a problem because we checked that we have a + * proper list - or something convertible to one - above). */ - Tcl_ListObjLength(NULL, subListPtr, &len); + len = -1; + TclListObjLength(NULL, subListPtr, &len); if (index == len) { Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr); } else { @@ -1586,9 +1613,9 @@ TclListObjSetElement( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", + "BADINDEX", NULL); } - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX", - NULL); return TCL_ERROR; } result = SetListFromAny(interp, listPtr); @@ -1811,19 +1838,23 @@ SetListFromAny( */ estCount = TclMaxListLength(nextElem, length, &limit); - estCount += (estCount == 0); /* Smallest List struct holds 1 element. */ + estCount += (estCount == 0); /* Smallest list struct holds 1 + * element. */ listRepPtr = AttemptNewList(interp, estCount, NULL); if (listRepPtr == NULL) { return TCL_ERROR; } elemPtrs = &listRepPtr->elements; - /* Each iteration, parse and store a list element */ + /* + * Each iteration, parse and store a list element. + */ + while (nextElem < limit) { const char *elemStart; int elemSize, literal; - if (TCL_OK != TclFindElement(interp, nextElem, (limit - nextElem), + if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem, &elemStart, &nextElem, &elemSize, &literal)) { while (--elemPtrs >= &listRepPtr->elements) { Tcl_DecrRefCount(*elemPtrs); @@ -1904,7 +1935,9 @@ UpdateStringOfList( listRepPtr->canonicalFlag = 1; - /* Handle empty list case first, so rest of the routine is simpler */ + /* + * Handle empty list case first, so rest of the routine is simpler. + */ if (numElems == 0) { listPtr->bytes = tclEmptyStringRep; @@ -1919,12 +1952,15 @@ UpdateStringOfList( if (numElems <= LOCAL_SIZE) { flagPtr = localFlags; } else { - /* We know numElems <= LIST_MAX, so this is safe. */ + /* + * We know numElems <= LIST_MAX, so this is safe. + */ + flagPtr = ckalloc(numElems * sizeof(int)); } elemPtrs = &listRepPtr->elements; for (i = 0; i < numElems; i++) { - flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 ); + flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0); elem = TclGetStringFromObj(elemPtrs[i], &length); bytesNeeded += TclScanElement(elem, length, flagPtr+i); if (bytesNeeded < 0) { @@ -1944,7 +1980,7 @@ UpdateStringOfList( listPtr->bytes = ckalloc(bytesNeeded); dst = listPtr->bytes; for (i = 0; i < numElems; i++) { - flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 ); + flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0); elem = TclGetStringFromObj(elemPtrs[i], &length); dst += TclConvertElement(elem, length, dst, flagPtr[i]); *dst++ = ' '; diff --git a/generic/tclVar.c b/generic/tclVar.c index 62bf1c4..4df5d43 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -3077,21 +3077,18 @@ ArrayStartSearchCmd( hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew); if (isNew) { searchPtr->id = 1; - Tcl_AppendResult(interp, "s-1-", varName, NULL); varPtr->flags |= VAR_SEARCH_ACTIVE; searchPtr->nextPtr = NULL; } else { - char string[TCL_INTEGER_SPACE]; - searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1; - TclFormatInt(string, searchPtr->id); - Tcl_AppendResult(interp, "s-", string, "-", varName, NULL); searchPtr->nextPtr = Tcl_GetHashValue(hPtr); } searchPtr->varPtr = varPtr; searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr, &searchPtr->search); Tcl_SetHashValue(hPtr, searchPtr); + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("s-%d-%s", searchPtr->id, varName)); return TCL_OK; } -- cgit v0.12 From 3323723916d6dd4a6fa97bec7fb95f9299cadf22 Mon Sep 17 00:00:00 2001 From: andreask Date: Tue, 16 Aug 2011 16:04:28 +0000 Subject: Fixed the C99/C++ comments introduced by [8d3f0fb215] which break strict C89 compilers (AIX, cough, cough) --- generic/tclMain.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclMain.c b/generic/tclMain.c index 652074e..114d2c3 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -392,7 +392,7 @@ Tcl_MainEx( /* * Arrange for final deletion of the main interp */ - // ARGH Munchhausen effect + /* ARGH Munchhausen effect */ Tcl_CreateExitHandler(FreeMainInterp, (ClientData)interp); } @@ -928,7 +928,7 @@ FreeMainInterp( { Tcl_Interp *interp = (Tcl_Interp *) clientData; - //if (TclInExit()) return; + /*if (TclInExit()) return;*/ if (!Tcl_InterpDeleted(interp)) { Tcl_DeleteInterp(interp); -- cgit v0.12 From 07e716801399c0843c58d8c3c6b43f183f1fd378 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 16 Aug 2011 19:49:57 +0000 Subject: 3392070 More complete prevention of Tcl_Obj reference cycles when producing an intrep of ByteCode. --- ChangeLog | 5 +++++ generic/tclCompile.c | 10 +++++++++- 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index b8832e6..567bfd2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2011-08-16 Don Porter + + * generic/tclCompile.c: [Bug 3392070] More complete prevention of + Tcl_Obj reference cycles when producing an intrep of ByteCode. + 2011-08-16 Donal K. Fellows * generic/tclListObj.c (TclLindexList, TclLsetFlat): Silence warnings diff --git a/generic/tclCompile.c b/generic/tclCompile.c index ae633ea..026503b 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -2449,8 +2449,16 @@ TclInitByteCodeObj( * a value contains a literal which is that same value. * If this is allowed to happen, refcount decrements may not * reach zero, and memory may leak. Bugs 467523, 3357771 + * + * NOTE: [Bugs 3392070, 3389764] We make a copy based completely + * on the string value, and do not call Tcl_DuplicateObj() so we + * can be sure we do not have any lingering cycles hiding in + * the intrep. */ - codePtr->objArrayPtr[i] = Tcl_DuplicateObj(objPtr); + int numBytes; + const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); + + codePtr->objArrayPtr[i] = Tcl_NewStringObj(bytes, numBytes); Tcl_IncrRefCount(codePtr->objArrayPtr[i]); Tcl_DecrRefCount(objPtr); } else { -- cgit v0.12 From 5f6458590d2630066c197d4c91986c175c8820e3 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 17 Aug 2011 06:37:02 +0000 Subject: separate test for overflowed and negative Tcl_UniChar --- tests/utf.test | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/tests/utf.test b/tests/utf.test index d319f6e..92b3a48 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -27,9 +27,12 @@ test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} { test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} { set x "\u4e4e" } [bytestring "\xe4\xb9\x8e"] -test utf-1.5 {Tcl_UniCharToUtf: negative Tcl_UniChar} { - string length [format %c -1] -} 1 +test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} { + format %c 0x110000 +} [bytestring "\xef\xbf\xbd"] +test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} { + format %c -1 +} [bytestring "\xef\xbf\xbd"] test utf-2.1 {Tcl_UtfToUniChar: low ascii} { string length "abc" -- cgit v0.12