From 0e0db3eebbdd61ad8fa4395b3d7b4fbc098e6f10 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 12 Aug 2025 08:46:15 +0000 Subject: Backport some code formatting from 9.0. Fix sentinels --- generic/tclOODefineCmds.c | 70 +++++++++++++++++++++++------------------------ macosx/tclMacOSXFCmd.c | 63 +++++++++++++++++++++--------------------- 2 files changed, 67 insertions(+), 66 deletions(-) diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index 4b97740..efb2c8b 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -451,7 +451,7 @@ RenameDeleteMethod( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "method %s does not exist", TclGetString(fromPtr))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", - TclGetString(fromPtr), NULL); + TclGetString(fromPtr), (char *)NULL); return TCL_ERROR; } hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) fromPtr); @@ -465,14 +465,14 @@ RenameDeleteMethod( renameToSelf: Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot rename method to itself", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_TO_SELF", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_TO_SELF", (char *)NULL); return TCL_ERROR; } else if (!isNew) { renameToExisting: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "method called %s already exists", TclGetString(toPtr))); - Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_OVER", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_OVER", (char *)NULL); return TCL_ERROR; } } @@ -541,7 +541,7 @@ TclOOUnknownDefinition( if (objc < 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad call of unknown handler", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", (char *)NULL); return TCL_ERROR; } if (TclOOGetDefineCmdContext(interp) == NULL) { @@ -588,7 +588,7 @@ TclOOUnknownDefinition( noMatch: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid command name \"%s\"", soughtStr)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", soughtStr, NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", soughtStr, (char *)NULL); return TCL_ERROR; } @@ -677,7 +677,7 @@ InitDefineContext( Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot process definitions; support namespace deleted", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } @@ -716,7 +716,7 @@ TclOOGetDefineCmdContext( Tcl_SetObjResult(interp, Tcl_NewStringObj( "this command may only be called from within the context of" " an ::oo::define or ::oo::objdefine command", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return NULL; } object = iPtr->varFramePtr->clientData; @@ -724,7 +724,7 @@ TclOOGetDefineCmdContext( Tcl_SetObjResult(interp, Tcl_NewStringObj( "this command cannot be called when the object has been" " deleted", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return NULL; } return object; @@ -766,7 +766,7 @@ GetClassInOuterContext( if (oPtr->classPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", - TclGetString(className), NULL); + TclGetString(className), (char *)NULL); return NULL; } return oPtr->classPtr; @@ -913,7 +913,7 @@ TclOODefineObjCmd( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s does not refer to a class",TclGetString(objv[1]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", - TclGetString(objv[1]), NULL); + TclGetString(objv[1]), (char *)NULL); return TCL_ERROR; } @@ -1117,13 +1117,13 @@ TclOODefineClassObjCmd( if (oPtr->flags & ROOT_OBJECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may not modify the class of the root object class", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } if (oPtr->flags & ROOT_CLASS) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may not modify the class of the class of classes", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } @@ -1143,7 +1143,7 @@ TclOODefineClassObjCmd( if (oPtr == clsPtr->thisPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may not change classes into an instance of themselves", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } @@ -1293,7 +1293,7 @@ TclOODefineDeleteMethodObjCmd( if (!isInstanceDeleteMethod && !oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } @@ -1417,7 +1417,7 @@ TclOODefineExportObjCmd( if (!isInstanceExport && !clsPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } @@ -1509,7 +1509,7 @@ TclOODefineForwardObjCmd( if (!isInstanceForward && !oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } isPublic = Tcl_StringMatch(TclGetString(objv[1]), PUBLIC_PATTERN) @@ -1567,7 +1567,7 @@ TclOODefineMethodObjCmd( if (!isInstanceMethod && !oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } isPublic = Tcl_StringMatch(TclGetString(objv[1]), PUBLIC_PATTERN) @@ -1623,7 +1623,7 @@ TclOODefineRenameMethodObjCmd( if (!isInstanceRenameMethod && !oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } @@ -1684,7 +1684,7 @@ TclOODefineUnexportObjCmd( if (!isInstanceUnexport && !clsPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } @@ -1870,7 +1870,7 @@ ClassFilterGet( } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } @@ -1906,7 +1906,7 @@ ClassFilterSet( } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } else if (TclListObjGetElements(interp, objv[0], &filterc, &filterv) != TCL_OK) { @@ -1950,7 +1950,7 @@ ClassMixinGet( } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } @@ -1989,7 +1989,7 @@ ClassMixinSet( } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } else if (TclListObjGetElements(interp, objv[0], &mixinc, &mixinv) != TCL_OK) { @@ -2008,7 +2008,7 @@ ClassMixinSet( if (TclOOIsReachable(oPtr->classPtr, mixins[i])) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may not mix a class into itself", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", (char *)NULL); goto freeAndError; } } @@ -2055,7 +2055,7 @@ ClassSuperGet( } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } @@ -2093,12 +2093,12 @@ ClassSuperSet( } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } else if (oPtr == oPtr->fPtr->objectCls->thisPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may not modify the superclass of the root object", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } else if (TclListObjGetElements(interp, objv[0], &superc, &superv) != TCL_OK) { @@ -2139,14 +2139,14 @@ ClassSuperSet( Tcl_SetObjResult(interp, Tcl_NewStringObj( "class should only be a direct superclass once", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS", (char *)NULL); goto failedAfterAlloc; } } if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to form circular dependency graph", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", (char *)NULL); failedAfterAlloc: for (; i-- > 0 ;) { TclOODecrRefCount(superclasses[i]->thisPtr); @@ -2220,7 +2220,7 @@ ClassVarsGet( } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } @@ -2257,7 +2257,7 @@ ClassVarsSet( } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to misuse API", -1)); - Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } else if (TclListObjGetElements(interp, objv[0], &varc, &varv) != TCL_OK) { @@ -2271,14 +2271,14 @@ ClassVarsSet( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid declared variable name \"%s\": must not %s", varName, "contain namespace separators")); - Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", (char *)NULL); return TCL_ERROR; } if (Tcl_StringMatch(varName, "*(*)")) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid declared variable name \"%s\": must not %s", varName, "refer to an array element")); - Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", (char *)NULL); return TCL_ERROR; } } @@ -2552,14 +2552,14 @@ ObjVarsSet( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid declared variable name \"%s\": must not %s", varName, "contain namespace separators")); - Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", (char *)NULL); return TCL_ERROR; } if (Tcl_StringMatch(varName, "*(*)")) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid declared variable name \"%s\": must not %s", varName, "refer to an array element")); - Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL); + Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", (char *)NULL); return TCL_ERROR; } } diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index 064f9e3..e27fdff 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -84,11 +84,11 @@ static int SetOSTypeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfOSType(Tcl_Obj *objPtr); static const Tcl_ObjType tclOSTypeType = { - "osType", /* name */ - NULL, /* freeIntRepProc */ - NULL, /* dupIntRepProc */ - UpdateStringOfOSType, /* updateStringProc */ - SetOSTypeFromAny /* setFromAnyProc */ + "osType", /* name */ + NULL, /* freeIntRepProc */ + NULL, /* dupIntRepProc */ + UpdateStringOfOSType, /* updateStringProc */ + SetOSTypeFromAny /* setFromAnyProc */ }; enum { @@ -131,10 +131,10 @@ typedef struct { int TclMacOSXGetFileAttribute( - Tcl_Interp *interp, /* The interp we are using for errors. */ - int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The name of the file (UTF-8). */ - Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ + Tcl_Interp *interp, /* The interp we are using for errors. */ + int objIndex, /* The index of the attribute. */ + Tcl_Obj *fileName, /* The name of the file (UTF-8). */ + Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */ { #ifdef HAVE_GETATTRLIST int result; @@ -192,18 +192,18 @@ TclMacOSXGetFileAttribute( OSSwapBigToHostInt32(finder->type)); break; case MACOSX_HIDDEN_ATTRIBUTE: - *attributePtrPtr = Tcl_NewBooleanObj( + TclNewIntObj(*attributePtrPtr, (finder->fdFlags & kFinfoIsInvisible) != 0); break; case MACOSX_RSRCLENGTH_ATTRIBUTE: - *attributePtrPtr = Tcl_NewWideIntObj(*rsrcForkSize); + TclNewIntObj(*attributePtrPtr, *rsrcForkSize); break; } return TCL_OK; #else Tcl_SetObjResult(interp, Tcl_NewStringObj( "Mac OS X file attributes not supported", -1)); - Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL); + Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (char *)NULL); return TCL_ERROR; #endif /* HAVE_GETATTRLIST */ } @@ -335,7 +335,7 @@ TclMacOSXSetFileAttribute( if (newRsrcForkSize != 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "setting nonzero rsrclength not supported", -1)); - Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL); + Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (char *)NULL); return TCL_ERROR; } @@ -376,7 +376,7 @@ TclMacOSXSetFileAttribute( #else Tcl_SetObjResult(interp, Tcl_NewStringObj( "Mac OS X file attributes not supported", -1)); - Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL); + Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (char *)NULL); return TCL_ERROR; #endif } @@ -517,7 +517,7 @@ TclMacOSXMatchType( bzero(&alist, sizeof(struct attrlist)); alist.bitmapcount = ATTR_BIT_MAP_COUNT; alist.commonattr = ATTR_CMN_FNDRINFO; - if (getattrlist(pathName, &alist, &finfo, sizeof(fileinfobuf), 0) != 0) { + if (getattrlist(pathName, &alist, &finfo, sizeof(fileinfobuf), 0)) { return 0; } if ((types->perm & TCL_GLOB_PERM_HIDDEN) && @@ -636,18 +636,19 @@ SetOSTypeFromAny( Tcl_Obj *objPtr) /* Pointer to the object to convert */ { const char *string; - int length, result = TCL_OK; + int result = TCL_OK; Tcl_DString ds; Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman"); + int length; - string = Tcl_GetStringFromObj(objPtr, &length); + string = TclGetStringFromObj(objPtr, &length); Tcl_UtfToExternalDString(encoding, string, length, &ds); if (Tcl_DStringLength(&ds) > 4) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected Macintosh OS type but got \"%s\": ", string)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "MAC_OSTYPE", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "MAC_OSTYPE", (char *)NULL); } result = TCL_ERROR; } else { @@ -656,9 +657,9 @@ SetOSTypeFromAny( memcpy(bytes, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); osType = (OSType) bytes[0] << 24 | - (OSType) bytes[1] << 16 | - (OSType) bytes[2] << 8 | - (OSType) bytes[3]; + (OSType) bytes[1] << 16 | + (OSType) bytes[2] << 8 | + (OSType) bytes[3]; TclFreeIntRep(objPtr); objPtr->internalRep.longValue = (long) osType; objPtr->typePtr = &tclOSTypeType; @@ -689,22 +690,22 @@ SetOSTypeFromAny( static void UpdateStringOfOSType( - Tcl_Obj *objPtr) /* OSType object whose string rep to + Tcl_Obj *objPtr) /* OSType object whose string rep to * update. */ { - char string[5]; OSType osType = (OSType) objPtr->internalRep.longValue; Tcl_DString ds; Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman"); unsigned len; - - string[0] = (char) (osType >> 24); - string[1] = (char) (osType >> 16); - string[2] = (char) (osType >> 8); - string[3] = (char) (osType); - string[4] = '\0'; - Tcl_ExternalToUtfDString(encoding, string, -1, &ds); - len = (unsigned) Tcl_DStringLength(&ds) + 1; + char src[5]; + + src[0] = (char) (osType >> 24); + src[1] = (char) (osType >> 16); + src[2] = (char) (osType >> 8); + src[3] = (char) (osType); + src[4] = '\0'; + Tcl_ExternalToUtfDString(encoding, src, -1, &ds); + len = (unsigned)Tcl_DStringLength(&ds) + 1; objPtr->bytes = ckalloc(len); memcpy(objPtr->bytes, Tcl_DStringValue(&ds), len); objPtr->length = Tcl_DStringLength(&ds); -- cgit v0.12 From 4f6b05865f90108d30f813b45771ad81ab4a771d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 12 Aug 2025 08:49:41 +0000 Subject: Update actions/checkout@v4 to actions/checkout@v5 --- .github/workflows/linux-build.yml | 2 +- .github/workflows/mac-build.yml | 4 ++-- .github/workflows/win-build.yml | 4 ++-- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/.github/workflows/linux-build.yml b/.github/workflows/linux-build.yml index aeee20f..5d7efd7 100644 --- a/.github/workflows/linux-build.yml +++ b/.github/workflows/linux-build.yml @@ -30,7 +30,7 @@ jobs: working-directory: unix steps: - name: Checkout - uses: actions/checkout@v4 + uses: actions/checkout@v5 timeout-minutes: 5 - name: Install 32-bit dependencies if needed # Duplicated from above diff --git a/.github/workflows/mac-build.yml b/.github/workflows/mac-build.yml index afe6afa..746ee19 100644 --- a/.github/workflows/mac-build.yml +++ b/.github/workflows/mac-build.yml @@ -17,7 +17,7 @@ jobs: working-directory: macosx steps: - name: Checkout - uses: actions/checkout@v4 + uses: actions/checkout@v5 timeout-minutes: 5 - name: Prepare run: | @@ -48,7 +48,7 @@ jobs: working-directory: unix steps: - name: Checkout - uses: actions/checkout@v4 + uses: actions/checkout@v5 timeout-minutes: 5 - name: Prepare run: | diff --git a/.github/workflows/win-build.yml b/.github/workflows/win-build.yml index 287016a..09468d7 100644 --- a/.github/workflows/win-build.yml +++ b/.github/workflows/win-build.yml @@ -28,7 +28,7 @@ jobs: # Using powershell means we need to explicitly stop on failure steps: - name: Checkout - uses: actions/checkout@v4 + uses: actions/checkout@v5 timeout-minutes: 5 - name: Init MSVC uses: ilammy/msvc-dev-cmd@v1 @@ -77,7 +77,7 @@ jobs: install: git mingw-w64-x86_64-toolchain make timeout-minutes: 10 - name: Checkout - uses: actions/checkout@v4 + uses: actions/checkout@v5 timeout-minutes: 5 - name: Prepare run: | -- cgit v0.12 From c31f8caa4db33c3536119f7b6231eaa3033fe4ae Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 12 Aug 2025 10:03:34 +0000 Subject: Alternative proposed fix for [992f94d847]: avoid misaligned pointers in macOS file attribute functions --- macosx/tclMacOSXFCmd.c | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index e27fdff..a192c23 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -107,6 +107,8 @@ typedef struct finderinfo { } __attribute__ ((__packed__)) finderinfo; typedef struct { + u_int64_t reserved1; /* Make sure data is 8-byte aligned */ + u_int32_t reserved2; /* See [992f94d847] */ u_int32_t info_length; u_int32_t data[8]; } fileinfobuf; @@ -173,7 +175,7 @@ TclMacOSXGetFileAttribute( alist.commonattr = ATTR_CMN_FNDRINFO; } native = (const char *)Tcl_FSGetNativePath(fileName); - result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0); + result = getattrlist(native, &alist, &finfo.info_length, sizeof(fileinfobuf)-offsetof(fileinfobuf,info_length), 0); if (result != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -269,7 +271,7 @@ TclMacOSXSetFileAttribute( alist.commonattr = ATTR_CMN_FNDRINFO; } native = (const char *)Tcl_FSGetNativePath(fileName); - result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0); + result = getattrlist(native, &alist, &finfo.info_length, sizeof(fileinfobuf)-offsetof(fileinfobuf,info_length), 0); if (result != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -426,7 +428,7 @@ TclMacOSXCopyFileAttributes( alist.bitmapcount = ATTR_BIT_MAP_COUNT; alist.commonattr = ATTR_CMN_FNDRINFO; - if (getattrlist(src, &alist, &finfo, sizeof(fileinfobuf), 0)) { + if (getattrlist(src, &alist, &finfo.info_length, sizeof(fileinfobuf)-offsetof(fileinfobuf,info_length), 0)) { return TCL_ERROR; } if (setattrlist(dst, &alist, &finfo.data, sizeof(finfo.data), 0)) { @@ -448,7 +450,7 @@ TclMacOSXCopyFileAttributes( alist.commonattr = 0; alist.fileattr = ATTR_FILE_RSRCLENGTH; - if (getattrlist(src, &alist, &finfo, sizeof(fileinfobuf), 0)) { + if (getattrlist(src, &alist, &finfo.info_length, sizeof(fileinfobuf)-offsetof(fileinfobuf,info_length), 0)) { return TCL_ERROR; } else if (*rsrcForkSize == 0) { return TCL_OK; @@ -517,7 +519,7 @@ TclMacOSXMatchType( bzero(&alist, sizeof(struct attrlist)); alist.bitmapcount = ATTR_BIT_MAP_COUNT; alist.commonattr = ATTR_CMN_FNDRINFO; - if (getattrlist(pathName, &alist, &finfo, sizeof(fileinfobuf), 0)) { + if (getattrlist(pathName, &alist, &finfo.info_length, sizeof(fileinfobuf)-offsetof(fileinfobuf,info_length), 0)) { return 0; } if ((types->perm & TCL_GLOB_PERM_HIDDEN) && -- cgit v0.12 From bb662c4f7abec1e0edf052104705a0ecf4dc2c21 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 12 Aug 2025 14:25:16 +0000 Subject: Update dde => 1.4.5. Don't worry about Tcl 8.7 any more --- changes | 18 ++++- generic/tclStubLib.c | 2 +- generic/tclUniData.c | 8 +-- library/dde/pkgIndex.tcl | 9 ++- library/reg/pkgIndex.tcl | 1 - tests/winDde.test | 4 +- tools/uniParse.tcl | 8 +-- unix/tclAppInit.c | 4 +- win/Makefile.in | 2 +- win/makefile.vc | 2 +- win/rules.vc | 14 ++-- win/tclAppInit.c | 4 +- win/tclWinDde.c | 175 ++++++++++++++++++++++++----------------------- 13 files changed, 133 insertions(+), 118 deletions(-) diff --git a/changes b/changes index 5ebf66a..b11fc1b 100644 --- a/changes +++ b/changes @@ -9385,13 +9385,19 @@ Many code fixes to avoid overflow or undefined behavior. Thanks chrstphrchvz. 2024-12-16 (bug) [63449c] [namespace children] doesn't match non-glob patterns below the global namespace (stu) -2025-01-06 (bug) [63449c] Better error-message than "interpreter uses an incompatible stubs mechanism" (nijtmans) +2025-01-06 (bug) [fc3509] Better error-message than "interpreter uses an incompatible stubs mechanism" (nijtmans) 2025-01-19 tzdata updated to Olson's tzdata2025a (nijtmans) +2025-01-28 (bug) [4f0b57] Win: [exec] now works on App Execution Aliases. (noble,nadkarni) + +2025-01-28 (bug) [4e2c8b] Win: [auto_execok] handles larger set of shell commands. (nadkarni) + +2025-03-06 (bug) [ba68d1] errorline from [interp eval], interp-26.9 (sebres) + 2025-03-23 tzdata updated to Olson's tzdata2025b (nijtmans) -2025-04-01 (bug) [fd8341] Tcl_InitStubs compatibility for 9.1, better error-handling (nijtmans) +2025-04-11 (bug) [fd8341] Tcl_InitStubs compatibility for 9.1, better error-handling (nijtmans) 2025-05-05 (bug) [42d14c] Fix scan with long mantissa. Ex.: scan "1.[string repeat 1 191]e-321" %g @@ -9402,3 +9408,11 @@ Many code fixes to avoid overflow or undefined behavior. Thanks chrstphrchvz. 2025-06-25 (bug) [ecafd8] Euro/Tail-sign missing from cp864 encoding (nijtmans) 2025-07-03 (bug) [6b0f77] gcc 14 breaks configure test for bigendian leading to broken floating point (nijtmans) + +2025-07-16 (bug) [c9f052] prevent overflow crash in Tcl_SplitList(). (boyang,nadkarni) + +2025-07-21 (bug) [61c01e] Flawed ref counts in filesystem implementation for Windows led to use-after-free (sebres) + +2025-08-12 (new) dde => 1.4.5 + +- (to be) Released 8.6.17, Aug ??, 2025 - https://core.tcl-lang.org/tcl/ for details diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index ec3c883..cdef4e9 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -71,7 +71,7 @@ Tcl_InitStubs( } if (stubsPtr && (stubsPtr->magic == ((int)0xFCA3BACB + (int)sizeof(void *))) && ((exact|0x010000) == 0x070800)) { - /* We are running in Tcl 9.x, but extension is compiled with 8.6 or 8.7 */ + /* We are running in Tcl 9.x, but extension is compiled with 8.6 */ stubsPtr->tcl_SetObjResult(interp, stubsPtr->tcl_ObjPrintf( "this extension is compiled for Tcl %d.%d", (exact & 0x0FF00)>>8, (exact & 0x0FF0000)>>16)); diff --git a/generic/tclUniData.c b/generic/tclUniData.c index c1ad45e..ae47067 100644 --- a/generic/tclUniData.c +++ b/generic/tclUniData.c @@ -195,7 +195,7 @@ static const unsigned short pageMap[] = { 1344, 1344, 1344, 10112, 10144, 1344, 10176, 1344, 10208, 10240, 10272, 10304, 10336, 10368, 1344, 1344, 1344, 10400, 10432, 64, 10464, 10496, 10528, 4736, 10560, 10592 -#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6 +#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 ,10624, 10656, 10688, 3296, 1344, 1344, 1344, 10720, 10752, 10784, 10816, 10848, 10880, 10912, 8032, 10944, 3296, 3296, 3296, 3296, 9216, 1344, 10976, 11008, 1344, 11040, 11072, 11104, 11136, 1344, 11168, @@ -1180,7 +1180,7 @@ static const unsigned char groupMap[] = { 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 0, 0, 0, 4, 4, 7, 11, 14, 4, 4, 0, 14, 7, 7, 7, 7, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 14, 14, 0, 0 -#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6 +#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 ,15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, @@ -1733,7 +1733,7 @@ static const int groups[] = { 10370, 10049, 10114, 8769, 8834 }; -#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6 +#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 # define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= 0x323C0) #else # define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1F0000) != 0) @@ -1792,7 +1792,7 @@ enum { * Unicode character tables. */ -#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6 +#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 # define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0x1FFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]]) #else # define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0xFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]]) diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl index 18ac517..542f5e5 100644 --- a/library/dde/pkgIndex.tcl +++ b/library/dde/pkgIndex.tcl @@ -1,12 +1,11 @@ if {[info sharedlibextension] != ".dll"} return if {[package vsatisfies [package provide Tcl] 9.0-]} { - package ifneeded dde 1.4.4 \ + package ifneeded dde 1.4.5 \ [list load [file join $dir tcl9dde14.dll] Dde] -} elseif {![package vsatisfies [package provide Tcl] 8.7] - && [::tcl::pkgconfig get debug]} { - package ifneeded dde 1.4.4 \ +} elseif {[::tcl::pkgconfig get debug]} { + package ifneeded dde 1.4.5 \ [list load [file join $dir tcldde14g.dll] Dde] } else { - package ifneeded dde 1.4.4 \ + package ifneeded dde 1.4.5 \ [list load [file join $dir tcldde14.dll] Dde] } diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl index 3b430b1..3c582aa 100644 --- a/library/reg/pkgIndex.tcl +++ b/library/reg/pkgIndex.tcl @@ -1,4 +1,3 @@ -if {![package vsatisfies [package provide Tcl] 8.5]} return if {[info sharedlibextension] != ".dll"} return if {[::tcl::pkgconfig get debug]} { package ifneeded registry 1.3.5 \ diff --git a/tests/winDde.test b/tests/winDde.test index a526d0d..3748046 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -20,7 +20,7 @@ testConstraint dde 0 if {[testConstraint win]} { if {![catch { ::tcltest::loadTestedCommands - set ::ddever [package require dde 1.4.4] + set ::ddever [package require dde 1.4.5] set ::ddelib [info loaded "" Dde]}]} { testConstraint dde 1 } @@ -104,7 +104,7 @@ proc createChildProcess {ddeServerName args} { # ------------------------------------------------------------------------- test winDde-1.0 {check if we are testing the right dll} {win dde} { set ::ddever -} {1.4.4} +} {1.4.5} test winDde-1.1 {Settings the server's topic name} -constraints dde -body { list [dde servername foobar] [dde servername] [dde servername self] diff --git a/tools/uniParse.tcl b/tools/uniParse.tcl index aec5864..8cdb380 100644 --- a/tools/uniParse.tcl +++ b/tools/uniParse.tcl @@ -212,7 +212,7 @@ static const unsigned short pageMap\[\] = {" puts $f $line set lastpage [expr {[lindex $line end] >> $shift}] puts stdout "lastpage: $lastpage" - puts $f "#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6" + puts $f "#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8" set line " ," } append line [lindex $pMap $i] @@ -242,7 +242,7 @@ static const unsigned char groupMap\[\] = {" set lastj [expr {[llength $page] - 1}] if {$i == ($lastpage + 1)} { puts $f [string trimright $line " \t,"] - puts $f "#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6" + puts $f "#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8" set line " ," } for {set j 0} {$j <= $lastj} {incr j} { @@ -342,7 +342,7 @@ static const int groups\[\] = {" puts $f $line puts -nonewline $f "}; -#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6 +#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 # define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= [format 0x%X $next]) #else # define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1F0000) != 0) @@ -401,7 +401,7 @@ enum { * Unicode character tables. */ -#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6 +#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 # define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0x1FFFFF) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\]) #else # define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0xFFFF) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\]) diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 552f9e4..5e9ab10 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -83,8 +83,8 @@ main( #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); -#elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE)) - /* New in Tcl 8.7. This doesn't work on Windows without UNICODE */ +#elif TCL_MAJOR_VERSION > 8 && (!defined(_WIN32) || defined(UNICODE)) + /* New in Tcl 9.0. This doesn't work on Windows without UNICODE */ TclZipfs_AppHook(&argc, &argv); #endif diff --git a/win/Makefile.in b/win/Makefile.in index 63bd318..2877183 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -155,7 +155,7 @@ TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX} TEST_EXE_FILE = tcltest${EXESUFFIX} TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX} TEST_LOAD_PRMS = lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\ - package ifneeded dde 1.4.4 [list load ${DDE_DLL_FILE} Dde];\ + package ifneeded dde 1.4.5 [list load ${DDE_DLL_FILE} Dde];\ package ifneeded registry 1.3.5 [list load ${REG_DLL_FILE} Registry] TEST_LOAD_FACILITIES = package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load ${TEST_DLL_FILE}];\ $(TEST_LOAD_PRMS) diff --git a/win/makefile.vc b/win/makefile.vc index c88c0ec..1d4033a 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -482,7 +482,7 @@ test: test-core test-pkgs test-core: setup $(TCLTEST) dlls $(CAT32) set TCL_LIBRARY=$(ROOT:\=/)/library $(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << - package ifneeded dde 1.4.4 [list load "$(TCLDDELIB:\=/)" Dde] + package ifneeded dde 1.4.5 [list load "$(TCLDDELIB:\=/)" Dde] package ifneeded registry 1.3.5 [list load "$(TCLREGLIB:\=/)" Registry] << diff --git a/win/rules.vc b/win/rules.vc index c6c3b5f..b9ea031 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -804,10 +804,10 @@ DOTSEPARATED=$(DOTSEPARATED:b=.) # MSVCRT - 1 -> link to dynamic C runtime even when building static Tcl build # 0 -> link to static C runtime for static Tcl build. # Does not impact shared Tcl builds (STATIC_BUILD == 0) -# Default: 1 for Tcl 8.7 and up, 0 otherwise. +# Default: 1 for Tcl 9.0 and up, 0 otherwise. # TCL_USE_STATIC_PACKAGES - 1 -> statically link the registry and dde extensions # in the Tcl and Wish shell. 0 -> keep them as shared libraries. Does -# not impact shared Tcl builds. Implied by STATIC_BUILD since Tcl 8.7. +# not impact shared Tcl builds. Implied by STATIC_BUILD since Tcl 9.0. # USE_THREAD_ALLOC - 1 -> Use a shared global free pool for allocation. # 0 -> Use the non-thread allocator. # UNCHECKED - 1 -> when doing a debug build with symbols, use the release @@ -1037,7 +1037,7 @@ WARNINGS = $(WARNINGS) -Wp64 # different compilers, build configurations etc., # # Naming convention (suffixes): -# t = full thread support. (Not used for Tcl >= 8.7) +# t = full thread support. (Not used for Tcl >= 9.0) # s = static library (as opposed to an import library) # g = linked to the debug enabled C run-time. # x = special static build when it links to the dynamic C run-time. @@ -1160,7 +1160,7 @@ TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX:t=).exe TCLSTUBLIB = $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:t=).lib # When building extensions, may be linking against Tcl that does not add -# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. +# "t" suffix (e.g. 8.6). If lib not found check for that possibility. !if !exist("$(TCLIMPLIB)") TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)t$(SUFX:t=).lib !endif @@ -1180,7 +1180,7 @@ TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX:t=).exe TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib # When building extensions, may be linking against Tcl that does not add -# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. +# "t" suffix (e.g. 8.6). If lib not found check for that possibility. !if !exist("$(TCLIMPLIB)") TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)t$(SUFX:t=).lib !endif @@ -1237,7 +1237,7 @@ WISH = $(_TKDIR)\bin\$(WISHNAME) TKSTUBLIB = $(_TKDIR)\lib\$(TKSTUBLIBNAME) TKIMPLIB = $(_TKDIR)\lib\$(TKIMPLIBNAME) # When building extensions, may be linking against Tk that does not add -# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. +# "t" suffix (e.g. 8.6). If lib not found check for that possibility. !if !exist("$(TKIMPLIB)") TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX:t=).lib TKIMPLIB = $(_TKDIR)\lib\$(TKIMPLIBNAME) @@ -1251,7 +1251,7 @@ WISH = $(_TKDIR)\win\$(BUILDDIRTOP)\$(WISHNAME) TKSTUBLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKSTUBLIBNAME) TKIMPLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME) # When building extensions, may be linking against Tk that does not add -# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility. +# "t" suffix (e.g. 8.6). If lib not found check for that possibility. !if !exist("$(TKIMPLIB)") TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX:t=).lib TKIMPLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME) diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 058b92a..ba5d6bc 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -131,8 +131,8 @@ _tmain( #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); -#elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE)) - /* New in Tcl 8.7. This doesn't work on Windows without UNICODE */ +#elif TCL_MAJOR_VERSION > 8 && (!defined(_WIN32) || defined(UNICODE)) + /* New in Tcl 9.0. This doesn't work on Windows without UNICODE */ TclZipfs_AppHook(&argc, &argv); #endif diff --git a/win/tclWinDde.c b/win/tclWinDde.c index ee3aa75..ebcd736 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -79,7 +79,7 @@ static DWORD ddeInstance; /* The application instance handle given to us * by DdeInitialize. */ static int ddeIsServer = 0; -#define TCL_DDE_VERSION "1.4.4" +#define TCL_DDE_VERSION "1.4.5" #define TCL_DDE_PACKAGE_NAME "dde" #define TCL_DDE_SERVICE_NAME L"TclEval" #define TCL_DDE_EXECUTE_RESULT L"$TCLEVAL$EXECUTE$RESULT" @@ -90,8 +90,24 @@ static int ddeIsServer = 0; TCL_DECLARE_MUTEX(ddeMutex) +#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) +# if TCL_UTF_MAX > 3 +# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) +# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) +# else +# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString +# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString +# endif +#ifndef Tcl_Size +# define Tcl_Size int +#endif +#ifndef Tcl_CreateObjCommand2 +# define Tcl_CreateObjCommand2 Tcl_CreateObjCommand +#endif +#endif + /* - * Forward declarations for functions defined later in this file. + * Declarations for functions defined in this file. */ static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg, @@ -114,43 +130,19 @@ static int MakeDdeConnection(Tcl_Interp *interp, const WCHAR *name, HCONV *ddeConvPtr); static void SetDdeError(Tcl_Interp *interp); static int DdeObjCmd(void *clientData, - Tcl_Interp *interp, int objc, + Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]); -#if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7) -# if TCL_UTF_MAX > 3 -# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) -# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) -# else -# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString -# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString -# endif -#endif - -static unsigned char * -getByteArrayFromObj( - Tcl_Obj *objPtr, - size_t *lengthPtr -) { - int length; - - unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length); -#if TCL_MAJOR_VERSION > 8 - if (sizeof(TCL_HASH_TYPE) > sizeof(int)) { - /* 64-bit and TIP #494 situation: */ - *lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1; - } else -#endif - /* 32-bit or without TIP #494 */ - *lengthPtr = (size_t) (unsigned) length; - return result; -} - #ifdef __cplusplus extern "C" { #endif DLLEXPORT int Dde_Init(Tcl_Interp *interp); DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp); +#if TCL_MAJOR_VERSION < 9 +/* With those additional entries, "load tcldde14.dll" works without 3th argument */ +DLLEXPORT int Tcldde_Init(Tcl_Interp *interp); +DLLEXPORT int Tcldde_SafeInit(Tcl_Interp *interp); +#endif #ifdef __cplusplus } #endif @@ -179,10 +171,18 @@ Dde_Init( return TCL_ERROR; } - Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL); + Tcl_CreateObjCommand2(interp, "dde", DdeObjCmd, NULL, NULL); Tcl_CreateExitHandler(DdeExitProc, NULL); return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL); } +#if TCL_MAJOR_VERSION < 9 +int +Tcldde_Init( + Tcl_Interp *interp) +{ + return Dde_Init(interp); +} +#endif /* *---------------------------------------------------------------------- @@ -210,6 +210,14 @@ Dde_SafeInit( } return result; } +#if TCL_MAJOR_VERSION < 9 +int +Tcldde_SafeInit( + Tcl_Interp *interp) +{ + return Dde_SafeInit(interp); +} +#endif /* *---------------------------------------------------------------------- @@ -302,19 +310,20 @@ Initialize(void) static const WCHAR * DdeSetServerName( Tcl_Interp *interp, - const WCHAR *name, /* The name that will be used to refer to the + const WCHAR *name, /* The name that will be used to refer to the * interpreter in later "send" commands. Must * be globally unique. */ - int flags, /* DDE_FLAG_FORCE or 0 */ + int flags, /* DDE_FLAG_FORCE or 0 */ Tcl_Obj *handlerPtr) /* Name of the optional proc/command to handle * incoming Dde eval's */ { - int suffix, offset; + int suffix; RegisteredInterp *riPtr, *prevPtr; Tcl_DString dString; const WCHAR *actualName; Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL; - int n, srvCount = 0, lastSuffix, r = TCL_OK; + Tcl_Size n, srvCount = 0, offset; + int lastSuffix, r = TCL_OK; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* @@ -440,7 +449,7 @@ DdeSetServerName( Tcl_ExposeCommand(interp, "dde", "dde"); } - Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, + Tcl_CreateObjCommand2(interp, "dde", DdeObjCmd, riPtr, DeleteProc); if (Tcl_IsSafe(interp)) { Tcl_HideCommand(interp, "dde", "dde"); @@ -506,7 +515,7 @@ DdeGetRegistrationPtr( static void DeleteProc( - void *clientData) /* The interp we are deleting. */ + void *clientData) /* The interp we are deleting. */ { RegisteredInterp *riPtr = (RegisteredInterp *) clientData; RegisteredInterp *searchPtr, *prevPtr; @@ -559,8 +568,8 @@ DeleteProc( static Tcl_Obj * ExecuteRemoteObject( - RegisteredInterp *riPtr, /* Info about this server. */ - Tcl_Obj *ddeObjectPtr) /* The object to execute. */ + RegisteredInterp *riPtr, /* Info about this server. */ + Tcl_Obj *ddeObjectPtr) /* The object to execute. */ { Tcl_Obj *returnPackagePtr; int result = TCL_OK; @@ -569,7 +578,7 @@ ExecuteRemoteObject( Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: " "a handler procedure must be defined for use in a safe " "interp", -1)); - Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", NULL); + Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", (char *)NULL); result = TCL_ERROR; } @@ -647,7 +656,7 @@ DdeServerProc( /* Transaction-dependent data. */ { Tcl_DString dString; - size_t len; + Tcl_Size len; DWORD dlen; WCHAR *utilString; Tcl_Obj *ddeObjectPtr; @@ -767,8 +776,7 @@ DdeServerProc( CP_WINUNICODE); if (_wcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { returnString = - Tcl_GetString(convPtr->returnPackagePtr); - len = convPtr->returnPackagePtr->length; + Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); if (uFmt != CF_TEXT) { Tcl_DStringInit(&dsBuf); Tcl_UtfToWCharDString(returnString, len, &dsBuf); @@ -790,8 +798,7 @@ DdeServerProc( convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, TCL_GLOBAL_ONLY); if (variableObjPtr != NULL) { - returnString = Tcl_GetString(variableObjPtr); - len = variableObjPtr->length; + returnString = Tcl_GetStringFromObj(variableObjPtr, &len); if (uFmt != CF_TEXT) { Tcl_DStringInit(&dsBuf); Tcl_UtfToWCharDString(returnString, len, &dsBuf); @@ -939,8 +946,8 @@ DdeServerProc( */ HSZPAIR *returnPtr; - int i; - int numItems; + Tcl_Size i; + DWORD numItems; for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL; i++, riPtr = riPtr->nextPtr) { @@ -949,12 +956,15 @@ DdeServerProc( */ } - numItems = i; + if ((size_t)i >= UINT_MAX/sizeof(HSZPAIR)) { + return NULL; + } + numItems = (DWORD)i; ddeReturn = DdeCreateDataHandle(ddeInstance, NULL, - (numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0); + (numItems + 1) * (DWORD)sizeof(HSZPAIR), 0, 0, 0, 0); returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &dlen); len = dlen; - for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems; + for (i = 0, riPtr = tsdPtr->interpListPtr; i < (Tcl_Size)numItems; i++, riPtr = riPtr->nextPtr) { returnPtr[i].hszSvc = DdeCreateStringHandleW(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE); @@ -1040,7 +1050,7 @@ MakeDdeConnection( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "no registered server named \"%s\"", Tcl_DStringValue(&dString))); Tcl_DStringFree(&dString); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", (char *)NULL); } return TCL_ERROR; } @@ -1246,7 +1256,7 @@ DdeGetServicesList( static void SetDdeError( - Tcl_Interp *interp) /* The interp to put the message in. */ + Tcl_Interp *interp) /* The interp to put the message in. */ { const char *errorMessage, *errorCode; @@ -1271,7 +1281,7 @@ SetDdeError( } Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1)); - Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, (char *)NULL); } /* @@ -1293,9 +1303,9 @@ SetDdeError( static int DdeObjCmd( - void *dummy, /* Not used. */ + void *dummy, /* Not used. */ Tcl_Interp *interp, /* The interp we are sending from */ - int objc, /* Number of arguments */ + Tcl_Size objc, /* Number of arguments */ Tcl_Obj *const *objv) /* The arguments */ { static const char *const ddeCommands[] = { @@ -1314,7 +1324,7 @@ DdeObjCmd( "-async", "-binary", NULL }; enum DdeExecOptions { - DDE_EXEC_ASYNC, DDE_EXEC_BINARY + DDE_EXEC_ASYNC, DDE_EXEC_BINARY }; static const char *const ddeEvalOptions[] = { "-async", NULL @@ -1323,9 +1333,9 @@ DdeObjCmd( "-binary", NULL }; - int index, i, argIndex; - size_t length; - int flags = 0, result = TCL_OK, firstArg = 0; + int index, argIndex; + Tcl_Size length, i, firstArg = 0; + int flags = 0, result = TCL_OK; HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn; HCONV hConv = NULL; @@ -1487,9 +1497,8 @@ DdeObjCmd( Initialize(); if (firstArg != 1) { - const char *src = Tcl_GetString(objv[firstArg]); + const char *src = Tcl_GetStringFromObj(objv[firstArg], &length); - length = objv[firstArg]->length; Tcl_DStringInit(&serviceBuf); Tcl_UtfToWCharDString(src, length, &serviceBuf); serviceName = (WCHAR *) Tcl_DStringValue(&serviceBuf); @@ -1506,9 +1515,8 @@ DdeObjCmd( } if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { - const char *src = Tcl_GetString(objv[firstArg + 1]); + const char *src = Tcl_GetStringFromObj(objv[firstArg + 1], &length); - length = objv[firstArg + 1]->length; Tcl_DStringInit(&topicBuf); topicName = Tcl_UtfToWCharDString(src, length, &topicBuf); length = Tcl_DStringLength(&topicBuf) / sizeof(WCHAR); @@ -1538,19 +1546,18 @@ DdeObjCmd( break; case DDE_EXECUTE: { - size_t dataLength; + Tcl_Size dataLength; const void *dataString; Tcl_DString dsBuf; Tcl_DStringInit(&dsBuf); if (flags & DDE_FLAG_BINARY) { dataString = - getByteArrayFromObj(objv[firstArg + 2], &dataLength); + Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength); } else { const char *src; - src = Tcl_GetString(objv[firstArg + 2]); - dataLength = objv[firstArg + 2]->length; + src = Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength); Tcl_DStringInit(&dsBuf); dataString = Tcl_UtfToWCharDString(src, dataLength, &dsBuf); @@ -1561,7 +1568,7 @@ DdeObjCmd( Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot execute null data", -1)); Tcl_DStringFree(&dsBuf); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", (char *)NULL); result = TCL_ERROR; break; } @@ -1603,8 +1610,7 @@ DdeObjCmd( const WCHAR *itemString; const char *src; - src = Tcl_GetString(objv[firstArg + 2]); - length = objv[firstArg + 2]->length; + src = Tcl_GetStringFromObj(objv[firstArg + 2], &length); Tcl_DStringInit(&itemBuf); itemString = Tcl_UtfToWCharDString(src, length, &itemBuf); length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR); @@ -1612,7 +1618,7 @@ DdeObjCmd( if (length == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot request value of null data", -1)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", (char *)NULL); result = TCL_ERROR; goto cleanup; } @@ -1645,7 +1651,7 @@ DdeObjCmd( if ((tmp >= sizeof(WCHAR)) && !dataString[tmp / sizeof(WCHAR) - 1]) { - tmp -= sizeof(WCHAR); + tmp -= (DWORD)sizeof(WCHAR); } Tcl_DStringInit(&dsBuf); Tcl_WCharToUtfDString(dataString, tmp>>1, &dsBuf); @@ -1671,26 +1677,24 @@ DdeObjCmd( BYTE *dataString; const char *src; - src = Tcl_GetString(objv[firstArg + 2]); - length = objv[firstArg + 2]->length; + src = Tcl_GetStringFromObj(objv[firstArg + 2], &length); Tcl_DStringInit(&itemBuf); itemString = Tcl_UtfToWCharDString(src, length, &itemBuf); length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR); if (length == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot have a null item", -1)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", (char *)NULL); result = TCL_ERROR; goto cleanup; } Tcl_DStringInit(&dsBuf); if (flags & DDE_FLAG_BINARY) { dataString = (BYTE *) - getByteArrayFromObj(objv[firstArg + 3], &length); + Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length); } else { const char *data = - Tcl_GetString(objv[firstArg + 3]); - length = objv[firstArg + 3]->length; + Tcl_GetStringFromObj(objv[firstArg + 3], &length); Tcl_DStringInit(&dsBuf); dataString = (BYTE *) Tcl_UtfToWCharDString(data, length, &dsBuf); @@ -1734,7 +1738,7 @@ DdeObjCmd( if (serviceName == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid service name \"\"", -1)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", (char *)NULL); result = TCL_ERROR; goto cleanup; } @@ -1783,7 +1787,7 @@ DdeObjCmd( "permission denied: a handler procedure must be" " defined for use in a safe interp", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK", - NULL); + (char *)NULL); result = TCL_ERROR; } @@ -1848,14 +1852,13 @@ DdeObjCmd( invalidServerResponse: Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid data returned from server", -1)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", (char *)NULL); result = TCL_ERROR; goto cleanup; } objPtr = Tcl_ConcatObj(objc, objv); - string = Tcl_GetString(objPtr); - length = objPtr->length; + string = Tcl_GetStringFromObj(objPtr, &length); Tcl_DStringInit(&dsBuf); Tcl_UtfToWCharDString(string, length, &dsBuf); string = Tcl_DStringValue(&dsBuf); @@ -1905,7 +1908,7 @@ DdeObjCmd( length = DdeGetData(ddeData, NULL, 0, 0); ddeDataString = (WCHAR *) Tcl_Alloc(length); DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0); - if (length > sizeof(WCHAR)) { + if (length > (Tcl_Size)sizeof(WCHAR)) { length -= sizeof(WCHAR); } Tcl_DStringInit(&dsBuf); -- cgit v0.12