From dfa2b92acec26c1eff9f3e9476d6b0c4042064b9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 13 Sep 2024 12:16:56 +0000 Subject: (Backport): Fix bug [fccb9f322f] - system encoding detection --- generic/tclInterp.c | 72 ++++++++++++++++++++++++++++------------------------- generic/tclZipfs.c | 35 ++++++++++++++------------ tests/unixInit.test | 17 ++++++++++++- 3 files changed, 73 insertions(+), 51 deletions(-) diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 2935b34..24fcb3b 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -207,7 +207,11 @@ struct LimitHandler { #define LIMIT_HANDLER_ACTIVE 0x01 #define LIMIT_HANDLER_DELETED 0x02 - +/* + * Macro to make looking up child and parent info more convenient. + */ +#define INTERP_INFO(interp) \ + ((InterpInfo *)((Interp *)(interp))->interpInfo) /* * Prototypes for local static functions: @@ -222,12 +226,12 @@ static int AliasDelete(Tcl_Interp *interp, static int AliasDescribe(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Obj *objPtr); static int AliasList(Tcl_Interp *interp, Tcl_Interp *childInterp); -static Tcl_ObjCmdProc AliasNRCmd; -static Tcl_CmdDeleteProc AliasObjCmdDeleteProc; +static Tcl_ObjCmdProc AliasNRCmd; +static Tcl_CmdDeleteProc AliasObjCmdDeleteProc; static Tcl_Interp * GetInterp(Tcl_Interp *interp, Tcl_Obj *pathPtr); static Tcl_Interp * GetInterp2(Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]); -static Tcl_InterpDeleteProc InterpInfoDeleteProc; +static Tcl_InterpDeleteProc InterpInfoDeleteProc; static int ChildBgerror(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Size objc, Tcl_Obj *const objv[]); @@ -276,7 +280,6 @@ static void TimeLimitCallback(void *clientData); static Tcl_NRPostProc NRPostInvokeHidden; static Tcl_ObjCmdProc NRInterpCmd; static Tcl_ObjCmdProc NRChildCmd; - /* *---------------------------------------------------------------------- @@ -339,7 +342,8 @@ Tcl_Init( pkgName.nextPtr = *names; *names = &pkgName; if (tclPreInitScript != NULL) { - if (Tcl_EvalEx(interp, tclPreInitScript, TCL_INDEX_NONE, 0) == TCL_ERROR) { + if (Tcl_EvalEx(interp, tclPreInitScript, TCL_INDEX_NONE, + 0 /*flags*/) == TCL_ERROR) { goto end; } } @@ -450,7 +454,7 @@ Tcl_Init( " }\n" "}\n" "tclInit", TCL_INDEX_NONE, 0); - + TclpSetInitialEncodings(); end: *names = (*names)->nextPtr; return result; @@ -526,13 +530,11 @@ InterpInfoDeleteProc( Tcl_Interp *interp) /* Interp being deleted. All commands for * child interps should already be deleted. */ { - InterpInfo *interpInfoPtr; + InterpInfo *interpInfoPtr = INTERP_INFO(interp); Child *childPtr; Parent *parentPtr; Target *targetPtr; - interpInfoPtr = (InterpInfo *) ((Interp *) interp)->interpInfo; - /* * There shouldn't be any commands left. */ @@ -551,6 +553,7 @@ InterpInfoDeleteProc( for (targetPtr = parentPtr->targetsPtr; targetPtr != NULL; ) { Target *tmpPtr = targetPtr->nextPtr; + Tcl_DeleteCommandFromToken(targetPtr->childInterp, targetPtr->childCmd); targetPtr = tmpPtr; @@ -873,7 +876,7 @@ NRInterpCmd( "DELETESELF", (char *)NULL); return TCL_ERROR; } - iiPtr = (InterpInfo *) ((Interp *) childInterp)->interpInfo; + iiPtr = INTERP_INFO(childInterp); Tcl_DeleteCommandFromToken(iiPtr->child.parentInterp, iiPtr->child.interpCmd); } @@ -1042,7 +1045,7 @@ NRInterpCmd( if (childInterp == NULL) { return TCL_ERROR; } - iiPtr = (InterpInfo *) ((Interp *) childInterp)->interpInfo; + iiPtr = INTERP_INFO(childInterp); TclNewObj(resultPtr); hPtr = Tcl_FirstHashEntry(&iiPtr->parent.childTable, &hashSearch); for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) { @@ -1107,7 +1110,7 @@ NRInterpCmd( aliasName = TclGetString(objv[3]); - iiPtr = (InterpInfo *) ((Interp *) childInterp)->interpInfo; + iiPtr = INTERP_INFO(childInterp); hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -1356,7 +1359,7 @@ Tcl_GetAliasObj( Tcl_Size *objcPtr, /* (Return) count of addnl args. */ Tcl_Obj ***objvPtr) /* (Return) additional args. */ { - InterpInfo *iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo; + InterpInfo *iiPtr = INTERP_INFO(interp); Tcl_HashEntry *hPtr; Alias *aliasPtr; Tcl_Size objc; @@ -1366,7 +1369,8 @@ Tcl_GetAliasObj( if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "alias \"%s\" not found", aliasName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, (char *)NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, + (char *)NULL); return TCL_ERROR; } aliasPtr = (Alias *)Tcl_GetHashValue(hPtr); @@ -1595,7 +1599,7 @@ AliasCreate( * Make an entry in the alias table. If it already exists, retry. */ - childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child; + childPtr = &INTERP_INFO(childInterp)->child; while (1) { Tcl_Obj *newToken; const char *string; @@ -1641,7 +1645,7 @@ AliasCreate( targetPtr->childCmd = aliasPtr->childCmd; targetPtr->childInterp = childInterp; - parentPtr = &((InterpInfo*) ((Interp*) parentInterp)->interpInfo)->parent; + parentPtr = &INTERP_INFO(parentInterp)->parent; targetPtr->nextPtr = parentPtr->targetsPtr; targetPtr->prevPtr = NULL; if (parentPtr->targetsPtr != NULL) { @@ -1689,7 +1693,7 @@ AliasDelete( * delete it. */ - childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child; + childPtr = &INTERP_INFO(childInterp)->child; hPtr = Tcl_FindHashEntry(&childPtr->aliasTable, TclGetString(namePtr)); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -1738,7 +1742,7 @@ AliasDescribe( * describe it. */ - childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child; + childPtr = &INTERP_INFO(childInterp)->child; hPtr = Tcl_FindHashEntry(&childPtr->aliasTable, TclGetString(namePtr)); if (hPtr == NULL) { return TCL_OK; @@ -1777,7 +1781,7 @@ AliasList( Child *childPtr; TclNewObj(resultPtr); - childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child; + childPtr = &INTERP_INFO(childInterp)->child; entryPtr = Tcl_FirstHashEntry(&childPtr->aliasTable, &hashSearch); for ( ; entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&hashSearch)) { @@ -2070,8 +2074,7 @@ AliasObjCmdDeleteProc( if (targetPtr->prevPtr != NULL) { targetPtr->prevPtr->nextPtr = targetPtr->nextPtr; } else { - Parent *parentPtr = &((InterpInfo *) ((Interp *) - aliasPtr->targetInterp)->interpInfo)->parent; + Parent *parentPtr = &INTERP_INFO(aliasPtr->targetInterp)->parent; parentPtr->targetsPtr = targetPtr->nextPtr; } @@ -2178,7 +2181,7 @@ Tcl_GetParent( if (interp == NULL) { return NULL; } - childPtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->child; + childPtr = &INTERP_INFO(interp)->child; return childPtr->parentInterp; } @@ -2222,7 +2225,7 @@ TclSetChildCancelFlags( flags &= (CANCELED | TCL_CANCEL_UNWIND); - parentPtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->parent; + parentPtr = &INTERP_INFO(interp)->parent; hPtr = Tcl_FirstHashEntry(&parentPtr->childTable, &hashSearch); for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) { @@ -2286,13 +2289,14 @@ Tcl_GetInterpPath( if (targetInterp == NULL) { return TCL_ERROR; } - iiPtr = (InterpInfo *) ((Interp *) targetInterp)->interpInfo; - if (Tcl_GetInterpPath(interp, iiPtr->child.parentInterp) != TCL_OK){ + iiPtr = INTERP_INFO(targetInterp); + if (Tcl_GetInterpPath(interp, iiPtr->child.parentInterp) != TCL_OK) { return TCL_ERROR; } Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), - Tcl_NewStringObj((const char *)Tcl_GetHashKey(&iiPtr->parent.childTable, - iiPtr->child.childEntryPtr), -1)); + Tcl_NewStringObj((const char *) + Tcl_GetHashKey(&iiPtr->parent.childTable, + iiPtr->child.childEntryPtr), -1)); return TCL_OK; } @@ -2332,7 +2336,7 @@ GetInterp( searchInterp = interp; for (i = 0; i < objc; i++) { - parentInfoPtr = (InterpInfo *) ((Interp *) searchInterp)->interpInfo; + parentInfoPtr = INTERP_INFO(searchInterp); hPtr = Tcl_FindHashEntry(&parentInfoPtr->parent.childTable, TclGetString(objv[i])); if (hPtr == NULL) { @@ -2451,7 +2455,7 @@ ChildCreate( safe = Tcl_IsSafe(parentInterp); } - parentInfoPtr = (InterpInfo *) ((Interp *) parentInterp)->interpInfo; + parentInfoPtr = INTERP_INFO(parentInterp); hPtr = Tcl_CreateHashEntry(&parentInfoPtr->parent.childTable, path, &isNew); if (isNew == 0) { @@ -2462,7 +2466,7 @@ ChildCreate( } childInterp = Tcl_CreateInterp(); - childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child; + childPtr = &INTERP_INFO(childInterp)->child; childPtr->parentInterp = parentInterp; childPtr->childEntryPtr = hPtr; childPtr->childInterp = childInterp; @@ -2767,13 +2771,13 @@ NRChildCmd( static void ChildObjCmdDeleteProc( - void *clientData) /* The ChildRecord for the command. */ + void *clientData) /* The ChildRecord for the command. */ { Child *childPtr; /* Interim storage for Child record. */ Tcl_Interp *childInterp = (Tcl_Interp *)clientData; /* And for a child interp. */ - childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child; + childPtr = &INTERP_INFO(childInterp)->child; /* * Unlink the child from its parent interpreter. @@ -3287,7 +3291,7 @@ TclMakeSafe( { Tcl_Channel chan; /* Channel to remove from safe interpreter. */ Interp *iPtr = (Interp *) interp; - Tcl_Interp *parent = ((InterpInfo*) iPtr->interpInfo)->child.parentInterp; + Tcl_Interp *parent = INTERP_INFO(iPtr)->child.parentInterp; TclHideUnsafeCommands(interp); diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 66efb68..ee280ee 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -1300,7 +1300,7 @@ AllocateZipFile( size_t mountPointNameLength) { size_t size = sizeof(ZipFile) + mountPointNameLength + 1; - ZipFile *zf = (ZipFile *) attemptckalloc(size); + ZipFile *zf = (ZipFile *)attemptckalloc(size); if (!zf) { ZIPFS_MEM_ERROR(interp); @@ -1313,7 +1313,7 @@ AllocateZipFile( static inline ZipEntry * AllocateZipEntry(void) { - ZipEntry *z = (ZipEntry *) ckalloc(sizeof(ZipEntry)); + ZipEntry *z = (ZipEntry *)ckalloc(sizeof(ZipEntry)); memset(z, 0, sizeof(ZipEntry)); return z; } @@ -1322,7 +1322,7 @@ static inline ZipChannel * AllocateZipChannel( Tcl_Interp *interp) { - ZipChannel *zc = (ZipChannel *) attemptckalloc(sizeof(ZipChannel)); + ZipChannel *zc = (ZipChannel *)attemptckalloc(sizeof(ZipChannel)); if (!zc) { ZIPFS_MEM_ERROR(interp); @@ -1689,7 +1689,7 @@ ZipFSOpenArchive( ZIPFS_POSIX_ERROR(interp, "seek error"); goto error; } - zf->ptrToFree = zf->data = (unsigned char *) attemptckalloc(zf->length); + zf->ptrToFree = zf->data = (unsigned char *)attemptckalloc(zf->length); if (!zf->ptrToFree) { ZIPFS_MEM_ERROR(interp); goto error; @@ -1928,7 +1928,7 @@ ZipFSCatalogFilesystem( zf->mountPointLen = strlen(zf->mountPoint); zf->nameLength = strlen(zipname); - zf->name = (char *) ckalloc(zf->nameLength + 1); + zf->name = (char *)ckalloc(zf->nameLength + 1); memcpy(zf->name, zipname, zf->nameLength + 1); Tcl_SetHashValue(hPtr, zf); @@ -2993,7 +2993,7 @@ ZipAddFile( memset(buf, '\0', ZIP_LOCAL_HEADER_LEN); memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpathExt, zpathlen); len = zpathlen + ZIP_LOCAL_HEADER_LEN; - if ((size_t) Tcl_Write(out, buf, len) != len) { + if ((size_t)Tcl_Write(out, buf, len) != len) { writeErrorWithChannelOpen: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error on \"%s\": %s", @@ -3017,7 +3017,7 @@ ZipAddFile( ZipWriteShort(astart, aend, abuf, 0xffff); ZipWriteShort(astart, aend, abuf + 2, align - 4); ZipWriteInt(astart, aend, abuf + 4, 0x03020100); - if ((size_t) Tcl_Write(out, (const char *) abuf, align) != align) { + if ((size_t)Tcl_Write(out, (const char *) abuf, align) != align) { goto writeErrorWithChannelOpen; } } @@ -3093,7 +3093,7 @@ ZipAddFile( stream.avail_out = sizeof(obuf); stream.next_out = (unsigned char *) obuf; len = deflate(&stream, flush); - if (len == (size_t) Z_STREAM_ERROR) { + if (len == (size_t)Z_STREAM_ERROR) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "deflate error on \"%s\"", TclGetString(pathObj))); ZIPFS_ERROR_CODE(interp, "DEFLATE"); @@ -3159,7 +3159,7 @@ ZipAddFile( buf[i] = (char) zencode(keys0, crc32tab, buf[i], tmp); } } - if ((size_t) Tcl_Write(out, buf, len) != len) { + if ((size_t)Tcl_Write(out, buf, len) != len) { goto writeErrorWithChannelOpen; } nbytecompr += len; @@ -3553,7 +3553,7 @@ ZipFSMkZipOrImg( strip = NULL; } } - for (i = 0; i < (size_t) lobjc; i += (mappingList ? 2 : 1)) { + for (i = 0; i < (size_t)lobjc; i += (mappingList ? 2 : 1)) { Tcl_Obj *pathObj = lobjv[i]; const char *name = ComputeNameInArchive(pathObj, (mappingList ? lobjv[i + 1] : NULL), strip, slen); @@ -3573,7 +3573,7 @@ ZipFSMkZipOrImg( directoryStartOffset = Tcl_Tell(out); count = 0; - for (i = 0; i < (size_t) lobjc; i += (mappingList ? 2 : 1)) { + for (i = 0; i < (size_t)lobjc; i += (mappingList ? 2 : 1)) { const char *name = ComputeNameInArchive(lobjv[i], (mappingList ? lobjv[i + 1] : NULL), strip, slen); Tcl_DString ds; @@ -4250,6 +4250,8 @@ ScriptLibrarySetup( Tcl_IncrRefCount(searchPathObj); Tcl_SetEncodingSearchPath(searchPathObj); Tcl_DecrRefCount(searchPathObj); + /* Bug [fccb9f322f]. Reinit system encoding after setting search path */ + TclpSetInitialEncodings(); return libDirObj; } @@ -5023,7 +5025,7 @@ InitWritableChannel( assert(stream.avail_in >= ZIP_CRYPT_HDR_LEN); stream.avail_in -= ZIP_CRYPT_HDR_LEN; - cbuf = (unsigned char *) attemptckalloc(stream.avail_in ? stream.avail_in : 1); + cbuf = (unsigned char *)attemptckalloc(stream.avail_in ? stream.avail_in : 1); if (!cbuf) { goto memoryError; } @@ -5176,7 +5178,7 @@ InitReadableChannel( if (info->isEncrypted) { assert(stream.avail_in >= ZIP_CRYPT_HDR_LEN); stream.avail_in -= ZIP_CRYPT_HDR_LEN; - ubuf = (unsigned char *) attemptckalloc(stream.avail_in ? stream.avail_in : 1); + ubuf = (unsigned char *)attemptckalloc(stream.avail_in ? stream.avail_in : 1); if (!ubuf) { goto memoryError; } @@ -5214,8 +5216,9 @@ InitReadableChannel( goto corruptionError; } /* Even if decompression succeeded, counts should be as expected */ - if ((int) stream.total_out != z->numBytes) + if ((int) stream.total_out != z->numBytes) { goto corruptionError; + } if (ubuf) { info->isEncrypted = 0; @@ -5234,7 +5237,7 @@ InitReadableChannel( goto corruptionError; } len = z->numCompressedBytes - ZIP_CRYPT_HDR_LEN; - ubuf = (unsigned char *) attemptckalloc(len); + ubuf = (unsigned char *)attemptckalloc(len); if (ubuf == NULL) { goto memoryError; } @@ -5662,7 +5665,7 @@ ZipFSMatchInDirectoryProc( */ l = strlen(pattern); - pat = (char *) ckalloc(len + l + 2); + pat = (char *)ckalloc(len + l + 2); memcpy(pat, path, len); while ((len > 1) && (pat[len - 1] == '/')) { --len; diff --git a/tests/unixInit.test b/tests/unixInit.test index 3bbe1e9..899779c 100644 --- a/tests/unixInit.test +++ b/tests/unixInit.test @@ -96,11 +96,26 @@ test unixInit-3.1 {TclpSetInitialEncodings} -constraints { } -cleanup { unset -nocomplain env(LANG) } -match regexp -result {^(iso8859-15?|utf-8)$} + +# unixInit-3.2 depends on the *spawned* [interpreter] being able to locate +# tcl_library without setting of TCL_LIBRARY env. This in turn depends on +# Tcl's "library" directory being under the parent or grandparent of the +# executable directory (the initScript search path in tclInterp.c). +# Thus this constraint. On GiuHub CI, the only time this is not true +# is for the XCode builds. +if {[string match [zipfs root]* [info library]] || + [file isfile [file normalize [file join [info nameofexecutable] .. .. library init.tcl]]] || + [file isfile [file normalize [file join [info nameofexecutable] .. .. .. library init.tcl]]] +} { + tcltest::testConstraint enableUnixInit32 1 +} else { + tcltest::testConstraint enableUnixInit32 0 +} test unixInit-3.2 {TclpSetInitialEncodings} -setup { catch {set oldlc_all $env(LC_ALL)} catch {set oldtcl_library $env(TCL_LIBRARY)} unset -nocomplain env(TCL_LIBRARY) -} -constraints {unix stdio knownBug} -body { +} -constraints {unix stdio enableUnixInit32} -body { set env(LANG) japanese set env(LC_ALL) japanese set f [open "|[list [interpreter]]" w+] -- cgit v0.12