From b915b5fe069f09a9bd7dec58b31623b29133be2f Mon Sep 17 00:00:00 2001 From: Kevin B Kenny Date: Wed, 22 Sep 2010 01:08:49 +0000 Subject: merge changes from HEAD --- ChangeLog | 18 ++++++++++++++++++ generic/tclExecute.c | 9 ++++----- generic/tclIOUtil.c | 4 ++-- generic/tclOOMethod.c | 14 +++++++++----- generic/tclPathObj.c | 22 +++++++++++++--------- generic/tclResult.c | 4 ++-- generic/tclVar.c | 30 ++++++++++-------------------- win/configure | 2 +- win/tcl.m4 | 2 +- win/tclWinFCmd.c | 20 ++++++-------------- win/tclWinFile.c | 5 +++-- win/tclWinPipe.c | 6 +++--- 12 files changed, 72 insertions(+), 64 deletions(-) diff --git a/ChangeLog b/ChangeLog index 1d734fe..3babd85 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2010-09-21 Jeff Hobbs + + * generic/tclExecute.c (TclExecuteByteCode): + * generic/tclOOMethod.c (ProcedureMethodCompiledVarConnect): + * generic/tclVar.c (TclLookupSimpleVar, CompareVarKeys): + * generic/tclPathObj.c (Tcl_FSGetNormalizedPath, Tcl_FSEqualPaths): + * generic/tclIOUtil.c (TclFSCwdPointerEquals): peephole opt + * generic/tclResult.c (TclMergeReturnOptions): use memcmp where + applicable as possible speedup on some libc variants. + 2010-09-21 Kevin B. Kenny [BRANCH: dogeen-assembler-branch] @@ -14,6 +24,14 @@ Initial commit of Ozgur Dogan Ugurlu's (SF user: dogeen) assembler for the Tcl bytecode language. +2010-09-21 Jan Nijtmans + + * win/tclWinFile.c: Fix declaration after statement. + * win/tcl.m4: Add -Wdeclaration-after-statement, so + * win/configure: this mistake cannot happen again. + * win/tclWinFCmd.c: [Bug 3069278]: Breakage on head Windows triggered + * win/tclWinPipe.c: by install-tzdata, final fix + 2010-09-20 Jan Nijtmans * win/tclWinFCmd.c: Eliminate tclWinProcs->useWide everywhere, since diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 6a4b495..58434c0 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.494 2010/09/01 20:35:33 andreas_kupries Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.494.2.1 2010/09/22 01:08:49 kennykb Exp $ */ #include "tclInt.h" @@ -4454,7 +4454,6 @@ TclExecuteByteCode( value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; - /* TODO: Consider more efficient tests than strcmp() */ s1 = TclGetStringFromObj(valuePtr, &s1len); if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) { TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ERROR: ", O2S(valuePtr), @@ -4479,7 +4478,7 @@ TclExecuteByteCode( s2len = 0; } if (s1len == s2len) { - match = (strcmp(s1, s2) == 0); + match = (memcmp(s1, s2, s1len) == 0); } i++; } while (i < length && match == 0); @@ -4545,10 +4544,10 @@ TclExecuteByteCode( */ if (*pc == INST_STR_NEQ) { - match = (strcmp(s1, s2) != 0); + match = (memcmp(s1, s2, s1len) != 0); } else { /* INST_STR_EQ */ - match = (strcmp(s1, s2) == 0); + match = (memcmp(s1, s2, s1len) == 0); } } else { match = (*pc == INST_STR_NEQ); diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 234e973..42ab1f3 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -17,7 +17,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOUtil.c,v 1.177 2010/08/14 17:13:02 nijtmans Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.177.2.1 2010/09/22 01:08:49 kennykb Exp $ */ #include "tclInt.h" @@ -506,7 +506,7 @@ TclFSCwdPointerEquals( str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1); str2 = Tcl_GetStringFromObj(*pathPtrPtr, &len2); - if (len1 == len2 && !strcmp(str1,str2)) { + if ((len1 == len2) && !memcmp(str1, str2, len1)) { /* * They are equal, but different objects. Update so they will be * the same object in the future. diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 9f5be6b..fcc0638 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOOMethod.c,v 1.26 2010/03/24 13:21:11 dkf Exp $ + * RCS: @(#) $Id: tclOOMethod.c,v 1.26.2.1 2010/09/22 01:08:49 kennykb Exp $ */ #ifdef HAVE_CONFIG_H @@ -994,8 +994,10 @@ ProcedureMethodCompiledVarConnect( CallContext *contextPtr; Tcl_Obj *variableObj; Tcl_HashEntry *hPtr; - int i, isNew, cacheIt; - const char *varName = Tcl_GetString(infoPtr->variableObj); + int i, isNew, cacheIt, varLen, len; + const char *match, *varName; + + varName = TclGetStringFromObj(infoPtr->variableObj, &varLen); /* * Check that the variable is being requested in a context that is also a @@ -1027,14 +1029,16 @@ ProcedureMethodCompiledVarConnect( .mPtr->declaringClassPtr != NULL) { FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index] .mPtr->declaringClassPtr->variables) { - if (!strcmp(Tcl_GetString(variableObj), varName)) { + match = TclGetStringFromObj(variableObj, &len); + if ((len == varLen) && !memcmp(match, varName, len)) { cacheIt = 0; goto gotMatch; } } } else { FOREACH(variableObj, contextPtr->oPtr->variables) { - if (!strcmp(Tcl_GetString(variableObj), varName)) { + match = TclGetStringFromObj(variableObj, &len); + if ((len == varLen) && !memcmp(match, varName, len)) { cacheIt = 1; goto gotMatch; } diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 152ffde..3bd4c53 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclPathObj.c,v 1.88 2010/03/05 14:34:04 dkf Exp $ + * RCS: @(#) $Id: tclPathObj.c,v 1.88.4.1 2010/09/22 01:08:49 kennykb Exp $ */ #include "tclInt.h" @@ -2028,8 +2028,12 @@ Tcl_FSGetNormalizedPath( */ if (pureNormalized) { - if (!strcmp(TclGetString(fsPathPtr->normPathPtr), - TclGetString(pathPtr))) { + int normPathLen, pathLen; + const char *normPath; + + path = TclGetStringFromObj(pathPtr, &pathLen); + normPath = TclGetStringFromObj(fsPathPtr->normPathPtr, &normPathLen); + if ((pathLen == normPathLen) && !memcmp(path, normPath, pathLen)) { /* * The path was already normalized. Get rid of the duplicate. */ @@ -2301,9 +2305,9 @@ Tcl_FSEqualPaths( if (firstPtr == NULL || secondPtr == NULL) { return 0; } - firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); - secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); - if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) { + firstStr = TclGetStringFromObj(firstPtr, &firstLen); + secondStr = TclGetStringFromObj(secondPtr, &secondLen); + if ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)) { return 1; } @@ -2321,9 +2325,9 @@ Tcl_FSEqualPaths( return 0; } - firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen); - secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen); - return (firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0); + firstStr = TclGetStringFromObj(firstPtr, &firstLen); + secondStr = TclGetStringFromObj(secondPtr, &secondLen); + return ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)); } /* diff --git a/generic/tclResult.c b/generic/tclResult.c index 07b50db..919a901 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclResult.c,v 1.61 2010/04/05 19:44:45 ferrieux Exp $ + * RCS: @(#) $Id: tclResult.c,v 1.61.2.1 2010/09/22 01:08:49 kennykb Exp $ */ #include "tclInt.h" @@ -1378,7 +1378,7 @@ TclMergeReturnOptions( const char *compare = TclGetStringFromObj(keys[KEY_OPTIONS], &compareLen); - if ((optLen == compareLen) && (strcmp(opt, compare) == 0)) { + if ((optLen == compareLen) && (memcmp(opt, compare, optLen) == 0)) { Tcl_DictSearch search; int done = 0; Tcl_Obj *keyPtr; diff --git a/generic/tclVar.c b/generic/tclVar.c index ee4e84f..c36dedf 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.203 2010/09/01 20:35:33 andreas_kupries Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.203.2.1 2010/09/22 01:08:49 kennykb Exp $ */ #include "tclInt.h" @@ -880,8 +880,8 @@ TclLookupSimpleVar( * the variable. */ Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr; ResolverScheme *resPtr; - int isNew, i, result; - const char *varName = TclGetString(varNamePtr); + int isNew, i, result, varLen; + const char *varName = TclGetStringFromObj(varNamePtr, &varLen); varPtr = NULL; varNsPtr = NULL; /* Set non-NULL if a nonlocal variable. */ @@ -1006,17 +1006,18 @@ TclLookupSimpleVar( } } } else { /* Local var: look in frame varFramePtr. */ - int localCt = varFramePtr->numCompiledLocals; + int localLen, localCt = varFramePtr->numCompiledLocals; Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0; + const char *localNameStr; for (i=0 ; icompiledLocals[i]; } @@ -6428,21 +6429,10 @@ CompareVarKeys( l2 = objPtr2->length; /* - * Only compare if the string representations are of the same length. + * Only compare string representations of the same length. */ - if (l1 == l2) { - for (;; p1++, p2++, l1--) { - if (*p1 != *p2) { - break; - } - if (l1 == 0) { - return 1; - } - } - } - - return 0; + return ((l1 == l2) && !memcmp(p1, p2, l1)); } /* diff --git a/win/configure b/win/configure index 6715c57..fefa99b 100755 --- a/win/configure +++ b/win/configure @@ -3985,7 +3985,7 @@ echo "$as_me: error: ${CC} does not support the -shared option. CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall" + CFLAGS_WARNING="-Wall -Wdeclaration-after-statement" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= diff --git a/win/tcl.m4 b/win/tcl.m4 index ecaad78..1ad10ae 100644 --- a/win/tcl.m4 +++ b/win/tcl.m4 @@ -535,7 +535,7 @@ file for information about building with Mingw.]) CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall" + CFLAGS_WARNING="-Wall -Wdeclaration-after-statement" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index fe89976..310a37f 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -9,17 +9,9 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinFCmd.c,v 1.67 2010/09/20 14:28:15 nijtmans Exp $ + * RCS: @(#) $Id: tclWinFCmd.c,v 1.67.2.1 2010/09/22 01:08:49 kennykb Exp $ */ -/* TODO: This file does not compile in UNICODE mode. - * See [Freq 2965056]: Windows build with -DUNICODE - * and - * [Bug 3069278]: breakage on head Windows triggered by install-tzdata - */ -#undef UNICODE -#undef _UNICODE - #include "tclWinInt.h" /* @@ -339,8 +331,8 @@ DoRenameFile( TCHAR *nativeSrcRest, *nativeDstRest; const char **srcArgv, **dstArgv; int size, srcArgc, dstArgc; - TCHAR nativeSrcPath[MAX_PATH * 2]; - TCHAR nativeDstPath[MAX_PATH * 2]; + TCHAR nativeSrcPath[MAX_PATH]; + TCHAR nativeDstPath[MAX_PATH]; Tcl_DString srcString, dstString; const char *src, *dst; @@ -476,7 +468,7 @@ DoRenameFile( TCHAR *nativeRest, *nativeTmp, *nativePrefix; int result, size; - TCHAR tempBuf[MAX_PATH * 2]; + TCHAR tempBuf[MAX_PATH]; size = tclWinProcs->getFullPathNameProc(nativeDst, MAX_PATH, tempBuf, &nativeRest); @@ -484,7 +476,7 @@ DoRenameFile( return TCL_ERROR; } nativeTmp = (TCHAR *) tempBuf; - nativeRest[0] = '\0'; + nativeRest[0] = L'\0'; result = TCL_ERROR; nativePrefix = (TCHAR *) L"tclr"; @@ -1304,7 +1296,7 @@ TraverseWinTree( goto end; } - nativeSource[oldSourceLen + 1] = '\0'; + Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1); Tcl_DStringSetLength(sourcePtr, oldSourceLen); result = traverseProc(nativeSource, nativeTarget, DOTREE_PRED, errorPtr); diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 98c9fc2..bd98a1a 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinFile.c,v 1.112 2010/09/20 14:28:13 nijtmans Exp $ + * RCS: @(#) $Id: tclWinFile.c,v 1.112.2.1 2010/09/22 01:08:49 kennykb Exp $ */ #include "tclWinInt.h" @@ -1885,6 +1885,7 @@ TclpGetCwd( { TCHAR buffer[MAX_PATH]; char *p; + WCHAR *native; if (tclWinProcs->getCurrentDirectoryProc(MAX_PATH, buffer) == 0) { TclWinConvertError(GetLastError()); @@ -1899,7 +1900,7 @@ TclpGetCwd( * Watch for the weird Windows c:\\UNC syntax. */ - WCHAR *native = (WCHAR *) buffer; + native = (WCHAR *) buffer; if ((native[0] != '\0') && (native[1] == ':') && (native[2] == '\\') && (native[3] == '\\')) { native += 2; diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index a41898d..84b18b6 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinPipe.c,v 1.83 2010/09/20 14:28:15 nijtmans Exp $ + * RCS: @(#) $Id: tclWinPipe.c,v 1.83.2.1 2010/09/22 01:08:49 kennykb Exp $ */ #include "tclWinInt.h" @@ -3133,8 +3133,8 @@ TclpOpenTemporaryFile( sprintf(number, "%d.TMP", counter); counter = (unsigned short) (counter + 1); tclWinProcs->utf2tchar(number, strlen(number), &buf); - memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf)); - *(WCHAR *)(namePtr + Tcl_DStringLength(&buf) + 1) = '\0'; + Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf) + 1); + memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf) + 1); Tcl_DStringFree(&buf); handle = tclWinProcs->createFileProc((TCHAR *) name, -- cgit v0.12