From dbd66934211a010f92ae020abcc843e724117b6e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 24 May 2024 07:03:46 +0000 Subject: Code optimization: no need for encoding = Tcl_GetEncoding(NULL, NULL). Use TclDStringToObj where possible --- generic/tclUtil.c | 3 +-- unix/tclUnixFile.c | 50 ++++++++++++++++++++++++-------------------------- 2 files changed, 25 insertions(+), 28 deletions(-) diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 0c2f305..dab5c3a 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -4340,8 +4340,7 @@ TclGetProcessGlobalValue( */ Tcl_ExternalToUtfDString(NULL, pgvPtr->value, pgvPtr->numBytes, &newValue); - value = Tcl_NewStringObj(Tcl_DStringValue(&newValue), Tcl_DStringLength(&newValue)); - Tcl_DStringFree(&newValue); + value = TclDStringToObj(&newValue); hPtr = Tcl_CreateHashEntry(cacheMap, INT2PTR(pgvPtr->epoch), &dummy); Tcl_MutexUnlock(&pgvPtr->mutex); diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 1d1d729..5f9f9b3 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -54,10 +54,10 @@ TclpFindExecutable( TclSetObjNameOfExecutable( Tcl_NewStringObj(name, length), NULL); #else - Tcl_Encoding encoding; const char *name, *p; Tcl_StatBuf statBuf; Tcl_DString buffer, nameString, cwd, utfName; + Tcl_Obj *obj; if (argv0 == NULL) { return; @@ -125,15 +125,16 @@ TclpFindExecutable( && S_ISREG(statBuf.st_mode)) { goto gotName; } - if (*p == '\0') { + if (p[0] == '\0') { break; - } else if (*(p+1) == 0) { + } else if (p[1] == 0) { p = "./"; } else { p++; } } - TclSetObjNameOfExecutable(Tcl_NewObj(), NULL); + TclNewObj(obj); + TclSetObjNameOfExecutable(obj, NULL); goto done; /* @@ -147,16 +148,16 @@ TclpFindExecutable( if (name[0] == '/') #endif { - encoding = Tcl_GetEncoding(NULL, NULL); - Tcl_ExternalToUtfDString(encoding, name, -1, &utfName); + Tcl_ExternalToUtfDString(NULL, name, -1, &utfName); TclSetObjNameOfExecutable( - Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding); + Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), NULL); Tcl_DStringFree(&utfName); goto done; } if (TclpGetCwd(NULL, &cwd) == NULL) { - TclSetObjNameOfExecutable(Tcl_NewObj(), NULL); + TclNewObj(obj); + TclSetObjNameOfExecutable(obj, NULL); goto done; } @@ -183,11 +184,9 @@ TclpFindExecutable( TclDStringAppendDString(&buffer, &nameString); Tcl_DStringFree(&nameString); - encoding = Tcl_GetEncoding(NULL, NULL); - Tcl_ExternalToUtfDString(encoding, Tcl_DStringValue(&buffer), -1, - &utfName); + Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&buffer), -1, &utfName); TclSetObjNameOfExecutable( - Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding); + Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), NULL); Tcl_DStringFree(&utfName); done: @@ -269,7 +268,7 @@ TclpMatchInDirectory( Tcl_DString dsOrig; /* utf-8 encoding of dir */ Tcl_DStringInit(&dsOrig); - dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength); + dirName = TclGetStringFromObj(fileNamePtr, &dirLength); Tcl_DStringAppend(&dsOrig, dirName, dirLength); /* @@ -363,8 +362,7 @@ TclpMatchInDirectory( * and pattern. If so, add the file to the result. */ - utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, - &utfDs); + utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, &utfDs); if (Tcl_StringCaseMatch(utfname, pattern, 0)) { int typeOk = 1; @@ -621,7 +619,7 @@ TclpObjAccess( Tcl_Obj *pathPtr, /* Path of file to access */ int mode) /* Permission setting. */ { - const char *path = Tcl_FSGetNativePath(pathPtr); + const char *path = (const char *)Tcl_FSGetNativePath(pathPtr); if (path == NULL) { return -1; @@ -702,9 +700,9 @@ TclpObjLstat( *---------------------------------------------------------------------- */ -ClientData +void * TclpGetNativeCwd( - ClientData clientData) + void *clientData) { char buffer[MAXPATHLEN+1]; @@ -719,7 +717,7 @@ TclpGetNativeCwd( #endif /* USEGETWD */ if ((clientData == NULL) || strcmp(buffer, (const char *) clientData)) { - char *newCd = (char*)ckalloc(strlen(buffer) + 1); + char *newCd = (char *)ckalloc(strlen(buffer) + 1); strcpy(newCd, buffer); return newCd; @@ -937,9 +935,9 @@ TclpObjLink( */ if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { - int targetLen; Tcl_DString ds; Tcl_Obj *transPtr; + int length; /* * Now we don't want to link to the absolute, normalized path. @@ -951,8 +949,8 @@ TclpObjLink( if (transPtr == NULL) { return NULL; } - target = Tcl_GetStringFromObj(transPtr, &targetLen); - target = Tcl_UtfToExternalDString(NULL, target, targetLen, &ds); + target = Tcl_GetStringFromObj(transPtr, &length); + target = Tcl_UtfToExternalDString(NULL, target, length, &ds); Tcl_DecrRefCount(transPtr); if (symlink(target, src) != 0) { @@ -1048,7 +1046,7 @@ TclpFilesystemPathType( Tcl_Obj * TclpNativeToNormalized( - ClientData clientData) + void *clientData) { Tcl_DString ds; @@ -1072,7 +1070,7 @@ TclpNativeToNormalized( *--------------------------------------------------------------------------- */ -ClientData +void * TclNativeCreateNativeRep( Tcl_Obj *pathPtr) { @@ -1139,9 +1137,9 @@ TclNativeCreateNativeRep( *--------------------------------------------------------------------------- */ -ClientData +void * TclNativeDupInternalRep( - ClientData clientData) + void *clientData) { char *copy; size_t len; -- cgit v0.12 From 44c29862ccca2d251d85047622dca7efe4268721 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Fri, 24 May 2024 15:13:10 +0000 Subject: Fix [e589d9bdab] --- win/tclWinSock.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 761023b..c05f550 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -1378,7 +1378,7 @@ TcpGetOptionProc( reverseDNS = NI_NUMERICHOST; } - if (HAVE_OPTION("-peername")) { + if ((len == 0) || HAVE_OPTION("-peername")) { address peername; socklen_t size = sizeof(peername); -- cgit v0.12 From e1036ec626a90838228776217c00ccd308939a9d Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Fri, 24 May 2024 15:19:13 +0000 Subject: Add test for [e589d9bdab] --- tests/socket.test | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/tests/socket.test b/tests/socket.test index b628404..2f71d7b 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -1110,6 +1110,25 @@ test socket_$af-7.5 {testing socket specific options} -setup { close $s close $s1 } -result [list $localhost 1 3] +test socket_$af-7.6 {testing socket specific options - bug e589d9bdab} -setup { + set timer [after 10000 "set x timed_out"] + set l "" +} -constraints [list socket supported_$af unixOrWin] -body { + set s [socket -server accept 0] + proc accept {s a p} { + global x + set x [fconfigure $s -sockname] + close $s + } + set listen [lindex [fconfigure $s -sockname] 2] + set s1 [socket $localhost $listen] + vwait x + lsort [dict keys [fconfigure $s1]] +} -cleanup { + after cancel $timer + close $s + close $s1 +} -result {-blocking -buffering -buffersize -encoding -eofchar -keepalive -nodelay -peername -profile -sockname -translation} test socket_$af-8.1 {testing -async flag on sockets} -constraints [list socket supported_$af] -body { # NOTE: This test may fail on some Solaris 2.4 systems. If it does, check -- cgit v0.12 From 26d88985bd21932bc679f523a245cebfcc8516aa Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Fri, 24 May 2024 15:31:28 +0000 Subject: Backport test for bug [e589d9bdab] --- tests/socket.test | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/tests/socket.test b/tests/socket.test index 7251bfa..31d41ba 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -1079,6 +1079,25 @@ test socket_$af-7.5 {testing socket specific options} -setup { close $s close $s1 } -result [list $localhost 1 3] +test socket_$af-7.6 {testing socket specific options - bug e589d9bdab} -setup { + set timer [after 10000 "set x timed_out"] + set l "" +} -constraints [list socket supported_$af unixOrWin] -body { + set s [socket -server accept 0] + proc accept {s a p} { + global x + set x [fconfigure $s -sockname] + close $s + } + set listen [lindex [fconfigure $s -sockname] 2] + set s1 [socket $localhost $listen] + vwait x + lsort [dict keys [fconfigure $s1]] +} -cleanup { + after cancel $timer + close $s + close $s1 +} -result {-blocking -buffering -buffersize -encoding -eofchar -peername -sockname -translation} test socket_$af-8.1 {testing -async flag on sockets} -constraints [list socket supported_$af] -body { # NOTE: This test may fail on some Solaris 2.4 systems. If it does, check -- cgit v0.12