From afb6b82ad412a7fb6f45ea72347804b401e5ddd4 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 19 Mar 2024 08:09:13 +0000 Subject: (cherry-pick) docs - note that Tcl_AsyncMark() and Tcl_AsyncDelete() are actually void funcs --- doc/Async.3 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/doc/Async.3 b/doc/Async.3 index 347ba3d..a8896af 100644 --- a/doc/Async.3 +++ b/doc/Async.3 @@ -17,11 +17,13 @@ Tcl_AsyncCreate, Tcl_AsyncMark, Tcl_AsyncInvoke, Tcl_AsyncDelete, Tcl_AsyncReady Tcl_AsyncHandler \fBTcl_AsyncCreate\fR(\fIproc, clientData\fR) .sp +void \fBTcl_AsyncMark\fR(\fIasync\fR) .sp int \fBTcl_AsyncInvoke\fR(\fIinterp, code\fR) .sp +void \fBTcl_AsyncDelete\fR(\fIasync\fR) .sp int -- cgit v0.12 From a9b046b5bd7c666a406a17cbb0d86a2842091bac Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 20 Mar 2024 13:14:26 +0000 Subject: (backport) more spacing/formatting tweaks. For now, macosx/unix/win only. --- macosx/tclMacOSXNotify.c | 22 +++++++-------- unix/tclEpollNotfy.c | 10 +++---- unix/tclKqueueNotfy.c | 10 +++---- unix/tclSelectNotfy.c | 10 +++---- unix/tclUnixChan.c | 2 +- unix/tclUnixCompat.c | 8 +++--- unix/tclUnixFCmd.c | 23 ++++++++-------- unix/tclUnixFile.c | 16 +++++------ unix/tclUnixInit.c | 42 ++++++++++++++--------------- unix/tclUnixNotfy.c | 8 +++--- unix/tclUnixPipe.c | 11 ++++---- unix/tclUnixTest.c | 20 +++++++------- unix/tclUnixThrd.c | 2 +- unix/tclUnixTime.c | 16 +++++------ unix/tclXtNotify.c | 10 +++---- unix/tclXtTest.c | 2 +- win/tclWinChan.c | 70 ++++++++++++++++++++++++------------------------ win/tclWinFile.c | 36 ++++++++++++------------- win/tclWinInit.c | 4 +-- win/tclWinLoad.c | 2 +- win/tclWinNotify.c | 10 +++---- win/tclWinSerial.c | 58 +++++++++++++++++++-------------------- win/tclWinSock.c | 4 +-- win/tclWinTest.c | 34 ++++++++++------------- win/tclWinThrd.c | 11 ++++---- win/tclWinTime.c | 18 ++++++------- 26 files changed, 224 insertions(+), 235 deletions(-) diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c index 169c7b9..de633a5 100644 --- a/macosx/tclMacOSXNotify.c +++ b/macosx/tclMacOSXNotify.c @@ -311,7 +311,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - ClientData clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; @@ -505,7 +505,7 @@ static CFStringRef tclEventsOnlyRunLoopMode = NULL; */ static void StartNotifierThread(void); -static TCL_NORETURN void NotifierThreadProc(ClientData clientData); +static TCL_NORETURN void NotifierThreadProc(void *clientData); static int FileHandlerEventProc(Tcl_Event *evPtr, int flags); static void TimerWakeUp(CFRunLoopTimerRef timer, void *info); static void QueueFileEvents(void *info); @@ -612,7 +612,7 @@ LookUpFileHandler( *---------------------------------------------------------------------- */ -ClientData +void * TclpInitNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -868,7 +868,7 @@ StartNotifierThread(void) void TclpFinalizeNotifier( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -970,7 +970,7 @@ TclpFinalizeNotifier( void TclpAlertNotifier( - ClientData clientData) + void *clientData) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; @@ -1047,7 +1047,7 @@ TclpSetTimer( static void TimerWakeUp( TCL_UNUSED(CFRunLoopTimerRef), - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { } @@ -1114,7 +1114,7 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - ClientData clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); @@ -1322,7 +1322,7 @@ FileHandlerEventProc( * * TclpNotifierData -- * - * This function returns a ClientData pointer to be associated + * This function returns a void pointer to be associated * with a Tcl_AsyncHandler. * * Results: @@ -1334,7 +1334,7 @@ FileHandlerEventProc( *---------------------------------------------------------------------- */ -ClientData +void * TclpNotifierData(void) { return NULL; @@ -1908,7 +1908,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ TCL_UNUSED(Tcl_ThreadId), /* Target thread. */ - TCL_UNUSED(ClientData), /* Notifier data. */ + TCL_UNUSED(void *), /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { @@ -1967,7 +1967,7 @@ TclAsyncNotifier( static TCL_NORETURN void NotifierThreadProc( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr; fd_set readableMask, writableMask, exceptionalMask; diff --git a/unix/tclEpollNotfy.c b/unix/tclEpollNotfy.c index 649c21b..563a30b 100644 --- a/unix/tclEpollNotfy.c +++ b/unix/tclEpollNotfy.c @@ -42,7 +42,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - ClientData clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ LIST_ENTRY(FileHandler) readyNode; /* Next/previous in list of FileHandlers asso- @@ -150,7 +150,7 @@ static int PlatformEventsWait(struct epoll_event *events, *---------------------------------------------------------------------- */ -ClientData +void * TclpInitNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -275,7 +275,7 @@ PlatformEventsControl( void TclpFinalizeNotifier( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -513,7 +513,7 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - ClientData clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); @@ -791,7 +791,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ Tcl_ThreadId threadId, /* Target thread. */ - ClientData clientData, /* Notifier data. */ + void *clientData, /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { diff --git a/unix/tclKqueueNotfy.c b/unix/tclKqueueNotfy.c index 2f495bd..627fa6e 100644 --- a/unix/tclKqueueNotfy.c +++ b/unix/tclKqueueNotfy.c @@ -40,7 +40,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - ClientData clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ LIST_ENTRY(FileHandler) readyNode; /* Next/previous in list of FileHandlers asso- @@ -274,7 +274,7 @@ PlatformEventsControl( void TclpFinalizeNotifier( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -330,7 +330,7 @@ TclpFinalizeNotifier( *---------------------------------------------------------------------- */ -ClientData +void * TclpInitNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -518,7 +518,7 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - ClientData clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); @@ -787,7 +787,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ Tcl_ThreadId threadId, /* Target thread. */ - ClientData clientData, /* Notifier data. */ + void *clientData, /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { diff --git a/unix/tclSelectNotfy.c b/unix/tclSelectNotfy.c index fc77e77..e41cefa 100644 --- a/unix/tclSelectNotfy.c +++ b/unix/tclSelectNotfy.c @@ -32,7 +32,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - ClientData clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; @@ -214,7 +214,7 @@ static sigset_t allSigMask; */ #if TCL_THREADS -static TCL_NORETURN void NotifierThreadProc(ClientData clientData); +static TCL_NORETURN void NotifierThreadProc(void *clientData); #if defined(HAVE_PTHREAD_ATFORK) static int atForkInit = 0; static void AtForkChild(void); @@ -480,7 +480,7 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - ClientData clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); @@ -1115,12 +1115,12 @@ NotifierThreadProc( tspecPtr->tv_nsec = timePtr->tv_usec * 1000; } ret = pselect(numFdBits, &readableMask, &writableMask, - &exceptionMask, tspecPtr, ¬ifierSigMask); + &exceptionMask, tspecPtr, ¬ifierSigMask); } #else pthread_sigmask(SIG_SETMASK, ¬ifierSigMask, NULL); ret = select(numFdBits, &readableMask, &writableMask, &exceptionMask, - timePtr); + timePtr); pthread_sigmask(SIG_BLOCK, &allSigMask, NULL); #endif diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index fc2280a..d0e47a8 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -775,7 +775,7 @@ FileGetOptionProc( * general probe. */ - dictContents = Tcl_GetStringFromObj(dictObj, &dictLength); + dictContents = TclGetStringFromObj(dictObj, &dictLength); Tcl_DStringAppend(dsPtr, dictContents, dictLength); Tcl_DecrRefCount(dictObj); return TCL_OK; diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index 3a7778e..2a92031 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -118,10 +118,10 @@ static int CopyString(const char *src, char *buf, int buflen); #endif #ifdef NEED_PW_CLEANER -static void FreePwBuf(ClientData dummy); +static void FreePwBuf(void *dummy); #endif #ifdef NEED_GR_CLEANER -static void FreeGrBuf(ClientData dummy); +static void FreeGrBuf(void *dummy); #endif #endif /* TCL_THREADS */ @@ -336,7 +336,7 @@ TclpGetPwUid( #ifdef NEED_PW_CLEANER static void FreePwBuf( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -519,7 +519,7 @@ TclpGetGrGid( #ifdef NEED_GR_CLEANER static void FreeGrBuf( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index b009d97..cc8af05 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -484,8 +484,7 @@ DoCopyFile( char linkBuf[MAXPATHLEN+1]; int length; - length = readlink(src, linkBuf, MAXPATHLEN); - /* INTL: Native. */ + length = readlink(src, linkBuf, MAXPATHLEN); /* INTL: Native. */ if (length == -1) { return TCL_ERROR; } @@ -1515,7 +1514,7 @@ SetGroupAttribute( " group \"%s\" does not exist", TclGetString(fileName), string)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SETGRP", - "NO_GROUP", (void *)NULL); + "NO_GROUP", (char *)NULL); } return TCL_ERROR; } @@ -1581,7 +1580,7 @@ SetOwnerAttribute( " user \"%s\" does not exist", TclGetString(fileName), string)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SETOWN", - "NO_USER", (void *)NULL); + "NO_USER", (char *)NULL); } return TCL_ERROR; } @@ -1676,7 +1675,7 @@ SetPermissionsAttribute( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown permission string format \"%s\"", modeStringPtr)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PERMISSION", (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "PERMISSION", (char *)NULL); } return TCL_ERROR; } @@ -1763,7 +1762,7 @@ GetModeFromPermString( newMode = 0; for (i = 0; i < 9; i++) { - switch (*(modeStringPtr+i)) { + switch (modeStringPtr[i]) { case 'r': if ((i%3) != 0) { goto chmodStyleCheck; @@ -1825,13 +1824,13 @@ GetModeFromPermString( * We now check for an "ugoa+-=rwxst" style permissions string */ - for (n = 0 ; *(modeStringPtr+n) != '\0' ; n = n + i) { + for (n = 0 ; modeStringPtr[n] != '\0' ; n += i) { oldMode = *modePtr; who = op = what = op_found = who_found = 0; - for (i = 0 ; *(modeStringPtr+n+i) != '\0' ; i++ ) { + for (i = 0 ; modeStringPtr[n + i] != '\0' ; i++ ) { if (!who_found) { /* who */ - switch (*(modeStringPtr+n+i)) { + switch (modeStringPtr[n + i]) { case 'u': who |= 0x9C0; continue; @@ -1852,7 +1851,7 @@ GetModeFromPermString( } if (!op_found) { /* op */ - switch (*(modeStringPtr+n+i)) { + switch (modeStringPtr[n + i]) { case '+': op = 1; op_found = 1; @@ -1870,7 +1869,7 @@ GetModeFromPermString( } } /* what */ - switch (*(modeStringPtr+n+i)) { + switch (modeStringPtr[n + i]) { case 'r': what |= 0x124; continue; @@ -1891,7 +1890,7 @@ GetModeFromPermString( default: return TCL_ERROR; } - if (*(modeStringPtr+n+i) == ',') { + if (modeStringPtr[n + i] == ',') { i++; break; } diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index fc3adab..80ef634 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -131,9 +131,9 @@ 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++; @@ -712,9 +712,9 @@ TclpObjLstat( *---------------------------------------------------------------------- */ -ClientData +void * TclpGetNativeCwd( - ClientData clientData) + void *clientData) { char buffer[MAXPATHLEN+1]; @@ -1058,7 +1058,7 @@ TclpFilesystemPathType( Tcl_Obj * TclpNativeToNormalized( - ClientData clientData) + void *clientData) { Tcl_DString ds; @@ -1082,7 +1082,7 @@ TclpNativeToNormalized( *--------------------------------------------------------------------------- */ -ClientData +void * TclNativeCreateNativeRep( Tcl_Obj *pathPtr) { @@ -1149,9 +1149,9 @@ TclNativeCreateNativeRep( *--------------------------------------------------------------------------- */ -ClientData +void * TclNativeDupInternalRep( - ClientData clientData) + void *clientData) { char *copy; size_t len; diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 8e2dd1e..b15f80a 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -53,31 +53,31 @@ static const char *const processors[NUMPROCESSORS] = { }; typedef struct { - union { - unsigned int dwOemId; - struct { - int wProcessorArchitecture; - int wReserved; + union { + unsigned int dwOemId; + struct { + int wProcessorArchitecture; + int wReserved; + }; }; - }; - unsigned int dwPageSize; - void *lpMinimumApplicationAddress; - void *lpMaximumApplicationAddress; - void *dwActiveProcessorMask; - unsigned int dwNumberOfProcessors; - unsigned int dwProcessorType; - unsigned int dwAllocationGranularity; - int wProcessorLevel; - int wProcessorRevision; + unsigned int dwPageSize; + void *lpMinimumApplicationAddress; + void *lpMaximumApplicationAddress; + void *dwActiveProcessorMask; + unsigned int dwNumberOfProcessors; + unsigned int dwProcessorType; + unsigned int dwAllocationGranularity; + int wProcessorLevel; + int wProcessorRevision; } SYSTEM_INFO; typedef struct { - unsigned int dwOSVersionInfoSize; - unsigned int dwMajorVersion; - unsigned int dwMinorVersion; - unsigned int dwBuildNumber; - unsigned int dwPlatformId; - wchar_t szCSDVersion[128]; + unsigned int dwOSVersionInfoSize; + unsigned int dwMajorVersion; + unsigned int dwMinorVersion; + unsigned int dwBuildNumber; + unsigned int dwPlatformId; + wchar_t szCSDVersion[128]; } OSVERSIONINFOW; #endif diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c index 0a2b695..1023db4 100644 --- a/unix/tclUnixNotfy.c +++ b/unix/tclUnixNotfy.c @@ -27,7 +27,7 @@ static int FileHandlerEventProc(Tcl_Event *evPtr, int flags); # define NOTIFIER_SELECT #elif !defined(NOTIFIER_EPOLL) && !defined(NOTIFIER_KQUEUE) # define NOTIFIER_SELECT -static TCL_NORETURN void NotifierThreadProc(ClientData clientData); +static TCL_NORETURN void NotifierThreadProc(void *clientData); # if defined(HAVE_PTHREAD_ATFORK) static void AtForkChild(void); # endif /* HAVE_PTHREAD_ATFORK */ @@ -484,7 +484,7 @@ AtForkChild(void) * * TclpNotifierData -- * - * This function returns a ClientData pointer to be associated + * This function returns a void pointer to be associated * with a Tcl_AsyncHandler. * * Results: @@ -497,13 +497,13 @@ AtForkChild(void) *---------------------------------------------------------------------- */ -ClientData +void * TclpNotifierData(void) { #if defined(NOTIFIER_EPOLL) || defined(NOTIFIER_KQUEUE) ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - return (ClientData) tsdPtr; + return tsdPtr; #else return NULL; #endif diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index 63e576b..70a5d5d 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -507,12 +507,11 @@ TclpCreateProcess( sigdelset(&sigs, SIGKILL); sigdelset(&sigs, SIGSTOP); - posix_spawnattr_setflags(&attr, - POSIX_SPAWN_SETSIGDEF + posix_spawnattr_setflags(&attr, POSIX_SPAWN_SETSIGDEF #ifdef POSIX_SPAWN_USEVFORK - | POSIX_SPAWN_USEVFORK + | POSIX_SPAWN_USEVFORK #endif - ); + ); posix_spawnattr_setsigdefault(&attr, &sigs); posix_spawn_file_actions_adddup2(&actions, GetFd(inputFile), 0); @@ -520,7 +519,7 @@ TclpCreateProcess( posix_spawn_file_actions_adddup2(&actions, GetFd(errorFile), 2); status = posix_spawnp(&pid, newArgv[0], &actions, &attr, - newArgv, environ); + newArgv, environ); childErrno = errno; posix_spawn_file_actions_destroy(&actions); posix_spawnattr_destroy(&attr); @@ -1349,7 +1348,7 @@ Tcl_WaitPid( int Tcl_PidObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index 008a2f0..515f234 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -129,7 +129,7 @@ TclplatformtestInit( static int TestfilehandlerCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -310,7 +310,7 @@ TestfilehandlerCmd( static void TestFileHandlerProc( - ClientData clientData, /* Points to a Pipe structure. */ + void *clientData, /* Points to a Pipe structure. */ int mask) /* Indicates which events happened: * TCL_READABLE or TCL_WRITABLE. */ { @@ -343,7 +343,7 @@ TestFileHandlerProc( static int TestfilewaitCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -351,7 +351,7 @@ TestfilewaitCmd( int mask, result, timeout; Tcl_Channel channel; int fd; - ClientData data; + void *data; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "file readable|writable|both timeout"); @@ -374,7 +374,7 @@ TestfilewaitCmd( } if (Tcl_GetChannelHandle(channel, (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE, - (ClientData*) &data) != TCL_OK) { + (void **) &data) != TCL_OK) { Tcl_AppendResult(interp, "couldn't get channel file", (void *)NULL); return TCL_ERROR; } @@ -411,7 +411,7 @@ TestfilewaitCmd( static int TestfindexecutableCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -453,7 +453,7 @@ TestfindexecutableCmd( static int TestforkCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -499,7 +499,7 @@ TestforkCmd( static int TestalarmCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -577,7 +577,7 @@ AlarmHandler( static int TestgotsigCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ TCL_UNUSED(int) /*objc*/, TCL_UNUSED(Tcl_Obj *const *)) @@ -608,7 +608,7 @@ TestgotsigCmd( static int TestchmodCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index c67495e..9587590 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -221,7 +221,7 @@ int TclpThreadCreate( Tcl_ThreadId *idPtr, /* Return, the ID of the thread */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread */ - ClientData clientData, /* The one argument to Main() */ + void *clientData, /* The one argument to Main() */ TCL_HASH_TYPE stackSize, /* Size of stack for the new thread */ int flags) /* Flags controlling behaviour of the new * thread. */ diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index f242cf4..c4f6737 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -44,13 +44,13 @@ static char *lastTZ = NULL; /* Holds the last setting of the TZ */ static void SetTZIfNecessary(void); -static void CleanupMemory(ClientData clientData); +static void CleanupMemory(void *clientData); #endif /* TCL_NO_DEPRECATED */ static void NativeScaleTime(Tcl_Time *timebuf, - ClientData clientData); + void *clientData); static void NativeGetTime(Tcl_Time *timebuf, - ClientData clientData); + void *clientData); /* * TIP #233 (Virtualized Time): Data for the time hooks, if any. @@ -466,7 +466,7 @@ void Tcl_SetTimeProc( Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, - ClientData clientData) + void *clientData) { tclGetTimeProcPtr = getProc; tclScaleTimeProcPtr = scaleProc; @@ -493,7 +493,7 @@ void Tcl_QueryTimeProc( Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, - ClientData *clientData) + void **clientData) { if (getProc) { *getProc = tclGetTimeProcPtr; @@ -526,7 +526,7 @@ Tcl_QueryTimeProc( static void NativeScaleTime( TCL_UNUSED(Tcl_Time *), - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { /* Native scale is 1:1. Nothing is done */ } @@ -551,7 +551,7 @@ NativeScaleTime( static void NativeGetTime( Tcl_Time *timePtr, - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { struct timeval tv; @@ -620,7 +620,7 @@ SetTZIfNecessary(void) static void CleanupMemory( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ckfree(lastTZ); } diff --git a/unix/tclXtNotify.c b/unix/tclXtNotify.c index 5f99239..87f7e86 100644 --- a/unix/tclXtNotify.c +++ b/unix/tclXtNotify.c @@ -33,7 +33,7 @@ typedef struct FileHandler { XtInputId except; /* Xt exception callback handle. */ Tcl_FileProc *proc; /* Procedure to call, in the style of * Tcl_CreateFileHandler. */ - ClientData clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; @@ -79,10 +79,10 @@ static int initialized = 0; static int FileHandlerEventProc(Tcl_Event *evPtr, int flags); static void FileProc(XtPointer clientData, int *source, XtInputId *id); -static void NotifierExitHandler(ClientData clientData); +static void NotifierExitHandler(void *clientData); static void TimerProc(XtPointer clientData, XtIntervalId *id); static void CreateFileHandler(int fd, int mask, - Tcl_FileProc *proc, ClientData clientData); + Tcl_FileProc *proc, void *clientData); static void DeleteFileHandler(int fd); static void SetTimer(const Tcl_Time * timePtr); static int WaitForEvent(const Tcl_Time * timePtr); @@ -229,7 +229,7 @@ InitNotifier(void) static void NotifierExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { if (notifier.currentTimeout != 0) { XtRemoveTimeOut(notifier.currentTimeout); @@ -339,7 +339,7 @@ CreateFileHandler( * called. */ Tcl_FileProc *proc, /* Procedure to call for each selected * event. */ - ClientData clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { FileHandler *filePtr; diff --git a/unix/tclXtTest.c b/unix/tclXtTest.c index d4b4251..c6bcc18 100644 --- a/unix/tclXtTest.c +++ b/unix/tclXtTest.c @@ -77,7 +77,7 @@ Tclxttest_Init( static int TesteventloopCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ diff --git a/win/tclWinChan.c b/win/tclWinChan.c index a69ca5d..9b018e4 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -72,33 +72,33 @@ typedef struct { * Static routines for this file: */ -static int FileBlockProc(ClientData instanceData, int mode); -static void FileChannelExitHandler(ClientData clientData); -static void FileCheckProc(ClientData clientData, int flags); -static int FileCloseProc(ClientData instanceData, +static int FileBlockProc(void *instanceData, int mode); +static void FileChannelExitHandler(void *clientData); +static void FileCheckProc(void *clientData, int flags); +static int FileCloseProc(void *instanceData, Tcl_Interp *interp, int flags); static int FileEventProc(Tcl_Event *evPtr, int flags); -static int FileGetHandleProc(ClientData instanceData, - int direction, ClientData *handlePtr); -static int FileGetOptionProc(ClientData instanceData, +static int FileGetHandleProc(void *instanceData, + int direction, void **handlePtr); +static int FileGetOptionProc(void *instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); static ThreadSpecificData *FileInit(void); -static int FileInputProc(ClientData instanceData, char *buf, +static int FileInputProc(void *instanceData, char *buf, int toRead, int *errorCode); -static int FileOutputProc(ClientData instanceData, +static int FileOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCode); #ifndef TCL_NO_DEPRECATED -static int FileSeekProc(ClientData instanceData, long offset, +static int FileSeekProc(void *instanceData, long offset, int mode, int *errorCode); #endif -static long long FileWideSeekProc(ClientData instanceData, +static long long FileWideSeekProc(void *instanceData, long long offset, int mode, int *errorCode); -static void FileSetupProc(ClientData clientData, int flags); -static void FileWatchProc(ClientData instanceData, int mask); -static void FileThreadActionProc(ClientData instanceData, +static void FileSetupProc(void *clientData, int flags); +static void FileWatchProc(void *instanceData, int mask); +static void FileThreadActionProc(void *instanceData, int action); -static int FileTruncateProc(ClientData instanceData, +static int FileTruncateProc(void *instanceData, long long length); static DWORD FileGetType(HANDLE handle); static int NativeIsComPort(const WCHAR *nativeName); @@ -227,7 +227,7 @@ FileInit(void) static void FileChannelExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL); } @@ -251,7 +251,7 @@ FileChannelExitHandler( void FileSetupProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { FileInfo *infoPtr; @@ -294,7 +294,7 @@ FileSetupProc( static void FileCheckProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { FileEvent *evPtr; @@ -393,7 +393,7 @@ FileEventProc( static int FileBlockProc( - ClientData instanceData, /* Instance data for channel. */ + void *instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { @@ -432,7 +432,7 @@ FileBlockProc( static int FileCloseProc( - ClientData instanceData, /* Pointer to FileInfo structure. */ + void *instanceData, /* Pointer to FileInfo structure. */ TCL_UNUSED(Tcl_Interp *), int flags) { @@ -510,7 +510,7 @@ FileCloseProc( #ifndef TCL_NO_DEPRECATED static int FileSeekProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ long offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ @@ -589,7 +589,7 @@ FileSeekProc( static long long FileWideSeekProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ long long offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ @@ -641,7 +641,7 @@ FileWideSeekProc( static int FileTruncateProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ long long length) /* Length to truncate at. */ { FileInfo *infoPtr = (FileInfo *)instanceData; @@ -717,7 +717,7 @@ FileTruncateProc( static int FileInputProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ char *buf, /* Where to store data read. */ int bufSize, /* Num bytes available in buffer. */ int *errorCode) /* Where to store error code. */ @@ -772,7 +772,7 @@ FileInputProc( static int FileOutputProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ @@ -819,7 +819,7 @@ FileOutputProc( static void FileWatchProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ int mask) /* What events to watch for; OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -858,9 +858,9 @@ FileWatchProc( static int FileGetHandleProc( - ClientData instanceData, /* The file state. */ + void *instanceData, /* The file state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - ClientData *handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { FileInfo *infoPtr = (FileInfo *)instanceData; @@ -868,7 +868,7 @@ FileGetHandleProc( return TCL_ERROR; } - *handlePtr = (ClientData) infoPtr->handle; + *handlePtr = (void *)infoPtr->handle; return TCL_OK; } @@ -913,7 +913,7 @@ StoreElementInDict( * duplicate keys. */ - Tcl_Obj *nameObj = Tcl_NewStringObj(name, -1); + Tcl_Obj *nameObj = Tcl_NewStringObj(name, TCL_INDEX_NONE); Tcl_DictObjPut(NULL, dictObj, nameObj, valueObj); } @@ -997,9 +997,9 @@ StatOpenFile( * Anything else and we definitely couldn't have got here anyway. */ if (attr & FILE_ATTRIBUTE_DIRECTORY) { - STORE_ELEM("type", Tcl_NewStringObj("directory", -1)); + STORE_ELEM("type", Tcl_NewStringObj("directory", TCL_INDEX_NONE)); } else { - STORE_ELEM("type", Tcl_NewStringObj("file", -1)); + STORE_ELEM("type", Tcl_NewStringObj("file", TCL_INDEX_NONE)); } #undef STORE_ELEM @@ -1008,7 +1008,7 @@ StatOpenFile( static int FileGetOptionProc( - ClientData instanceData, /* The file state. */ + void *instanceData, /* The file state. */ Tcl_Interp *interp, /* For error reporting. */ const char *optionName, /* What option to read, or NULL for all. */ Tcl_DString *dsPtr) /* Where to write the value read. */ @@ -1306,7 +1306,7 @@ TclpOpenFileChannel( Tcl_Channel Tcl_MakeFileChannel( - ClientData rawHandle, /* OS level handle */ + void *rawHandle, /* OS level handle */ int mode) /* OR'ed combination of TCL_READABLE and * TCL_WRITABLE to indicate file mode. */ { @@ -1694,7 +1694,7 @@ TclWinFlushDirtyChannels(void) static void FileThreadActionProc( - ClientData instanceData, + void *instanceData, int action) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 62cc94e..b27487f 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -2769,27 +2769,25 @@ TclpObjNormalizePath( * Convert the entire known path to long form. */ - if (1) { - WCHAR wpath[MAX_PATH]; - const WCHAR *nativePath; - DWORD wpathlen; + WCHAR wpath[MAX_PATH]; + const WCHAR *nativePath; + DWORD wpathlen; - Tcl_DStringInit(&ds); - nativePath = - Tcl_UtfToWCharDString(path, lastValidPathEnd - path, &ds); - wpathlen = GetLongPathNameProc(nativePath, - (WCHAR *) wpath, MAX_PATH); - /* - * We have to make the drive letter uppercase. - */ + Tcl_DStringInit(&ds); + nativePath = + Tcl_UtfToWCharDString(path, lastValidPathEnd - path, &ds); + wpathlen = GetLongPathNameProc(nativePath, + (WCHAR *) wpath, MAX_PATH); + /* + * We have to make the drive letter uppercase. + */ - if (wpath[0] >= 'a') { - wpath[0] -= ('a' - 'A'); - } - Tcl_DStringAppend(&dsNorm, (const char *) wpath, - wpathlen * sizeof(WCHAR)); - Tcl_DStringFree(&ds); + if (wpath[0] >= 'a') { + wpath[0] -= ('a' - 'A'); } + Tcl_DStringAppend(&dsNorm, (const char *) wpath, + wpathlen * sizeof(WCHAR)); + Tcl_DStringFree(&ds); #endif /* TclNORM_LONG_PATH */ } @@ -3111,7 +3109,7 @@ TclNativeCreateNativeRep( wp = nativePathPtr = (WCHAR *)ckalloc((len + 6) * sizeof(WCHAR)); if (nativePathPtr==0) { - goto done; + goto done; } MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr, len + 2); diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 59404d6..3764a79 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -588,7 +588,7 @@ TclpFindVariable( * entries in environ (for unsuccessful * searches). */ { - Tcl_Size i, length, result = -1; + Tcl_Size i, length, result = TCL_INDEX_NONE; const WCHAR *env; const char *p1, *p2; char *envUpper, *nameUpper; @@ -612,7 +612,7 @@ TclpFindVariable( */ Tcl_DStringInit(&envString); - envUpper = Tcl_WCharToUtfDString(env, -1, &envString); + envUpper = Tcl_WCharToUtfDString(env, TCL_INDEX_NONE, &envString); p1 = strchr(envUpper, '='); if (p1 == NULL) { continue; diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index 4d9b578..a03132f 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -175,7 +175,7 @@ TclpDlopen( */ handlePtr = (Tcl_LoadHandle)ckalloc(sizeof(struct Tcl_LoadHandle_)); - handlePtr->clientData = (ClientData) hInstance; + handlePtr->clientData = (void *) hInstance; handlePtr->findSymbolProcPtr = &FindSymbol; handlePtr->unloadFileProcPtr = &UnloadFile; *loadHandle = handlePtr; diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index 64d739a..795db74 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -76,7 +76,7 @@ static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message, *---------------------------------------------------------------------- */ -ClientData +void * TclpInitNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -148,7 +148,7 @@ TclpInitNotifier(void) void TclpFinalizeNotifier( - ClientData clientData) /* Pointer to notifier data. */ + void *clientData) /* Pointer to notifier data. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; @@ -218,7 +218,7 @@ TclpFinalizeNotifier( void TclpAlertNotifier( - ClientData clientData) /* Pointer to thread data. */ + void *clientData) /* Pointer to thread data. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; @@ -424,7 +424,7 @@ NotifierProc( * * TclpNotifierData -- * - * This function returns a ClientData pointer to be associated + * This function returns a void pointer to be associated * with a Tcl_AsyncHandler. * * Results: @@ -436,7 +436,7 @@ NotifierProc( *---------------------------------------------------------------------- */ -ClientData +void * TclpNotifierData(void) { return NULL; diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 7e6b76a..d343d87 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -165,30 +165,30 @@ static COMMTIMEOUTS no_timeout = { * Declarations for functions used only in this file. */ -static int SerialBlockProc(ClientData instanceData, int mode); -static void SerialCheckProc(ClientData clientData, int flags); -static int SerialCloseProc(ClientData instanceData, +static int SerialBlockProc(void *instanceData, int mode); +static void SerialCheckProc(void *clientData, int flags); +static int SerialCloseProc(void *instanceData, Tcl_Interp *interp, int flags); static int SerialEventProc(Tcl_Event *evPtr, int flags); -static void SerialExitHandler(ClientData clientData); -static int SerialGetHandleProc(ClientData instanceData, - int direction, ClientData *handlePtr); +static void SerialExitHandler(void *clientData); +static int SerialGetHandleProc(void *instanceData, + int direction, void **handlePtr); static ThreadSpecificData *SerialInit(void); -static int SerialInputProc(ClientData instanceData, char *buf, +static int SerialInputProc(void *instanceData, char *buf, int toRead, int *errorCode); -static int SerialOutputProc(ClientData instanceData, +static int SerialOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCode); -static void SerialSetupProc(ClientData clientData, int flags); -static void SerialWatchProc(ClientData instanceData, int mask); -static void ProcExitHandler(ClientData clientData); -static int SerialGetOptionProc(ClientData instanceData, +static void SerialSetupProc(void *clientData, int flags); +static void SerialWatchProc(void *instanceData, int mask); +static void ProcExitHandler(void *clientData); +static int SerialGetOptionProc(void *instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); -static int SerialSetOptionProc(ClientData instanceData, +static int SerialSetOptionProc(void *instanceData, Tcl_Interp *interp, const char *optionName, const char *value); static DWORD WINAPI SerialWriterThread(LPVOID arg); -static void SerialThreadActionProc(ClientData instanceData, +static void SerialThreadActionProc(void *instanceData, int action); static int SerialBlockingRead(SerialInfo *infoPtr, LPVOID buf, DWORD bufSize, LPDWORD lpRead, LPOVERLAPPED osPtr); @@ -285,7 +285,7 @@ SerialInit(void) static void SerialExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); SerialInfo *infoPtr; @@ -323,7 +323,7 @@ SerialExitHandler( static void ProcExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { Tcl_MutexLock(&serialMutex); initialized = 0; @@ -406,7 +406,7 @@ SerialGetMilliseconds(void) void SerialSetupProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { SerialInfo *infoPtr; @@ -461,7 +461,7 @@ SerialSetupProc( static void SerialCheckProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { SerialInfo *infoPtr; @@ -561,7 +561,7 @@ SerialCheckProc( static int SerialBlockProc( - ClientData instanceData, /* Instance data for channel. */ + void *instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { @@ -600,7 +600,7 @@ SerialBlockProc( static int SerialCloseProc( - ClientData instanceData, /* Pointer to SerialInfo structure. */ + void *instanceData, /* Pointer to SerialInfo structure. */ TCL_UNUSED(Tcl_Interp *), int flags) { @@ -855,7 +855,7 @@ SerialBlockingWrite( static int SerialInputProc( - ClientData instanceData, /* Serial state. */ + void *instanceData, /* Serial state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ @@ -962,7 +962,7 @@ SerialInputProc( static int SerialOutputProc( - ClientData instanceData, /* Serial state. */ + void *instanceData, /* Serial state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ @@ -1192,7 +1192,7 @@ SerialEventProc( static void SerialWatchProc( - ClientData instanceData, /* Serial state. */ + void *instanceData, /* Serial state. */ int mask) /* What events to watch for, OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -1249,13 +1249,13 @@ SerialWatchProc( static int SerialGetHandleProc( - ClientData instanceData, /* The serial state. */ + void *instanceData, /* The serial state. */ TCL_UNUSED(int) /*direction*/, - ClientData *handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { SerialInfo *infoPtr = (SerialInfo *) instanceData; - *handlePtr = (ClientData) infoPtr->handle; + *handlePtr = (void *)infoPtr->handle; return TCL_OK; } @@ -1618,7 +1618,7 @@ SerialModemStatusStr( static int SerialSetOptionProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ @@ -2042,7 +2042,7 @@ SerialSetOptionProc( static int SerialGetOptionProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ @@ -2279,7 +2279,7 @@ SerialGetOptionProc( static void SerialThreadActionProc( - ClientData instanceData, + void *instanceData, int action) { SerialInfo *infoPtr = (SerialInfo *) instanceData; diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 4f1a9c2..0dd7871 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -2360,9 +2360,9 @@ TcpAccept( if (statePtr->acceptProc != NULL) { getnameinfo(&(addr.sa), len, host, sizeof(host), port, sizeof(port), - NI_NUMERICHOST|NI_NUMERICSERV); + NI_NUMERICHOST|NI_NUMERICSERV); statePtr->acceptProc(statePtr->acceptProcData, newInfoPtr->channel, - host, atoi(port)); + host, atoi(port)); } } diff --git a/win/tclWinTest.c b/win/tclWinTest.c index f2c9a86d..ec12f67 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -101,7 +101,7 @@ TclplatformtestInit( static int TesteventloopCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -152,7 +152,7 @@ TesteventloopCmd( framePtr = oldFramePtr; } else { Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), - "\": must be done or wait", (void *)NULL); + "\": must be done or wait", (char *)NULL); return TCL_ERROR; } return TCL_OK; @@ -177,7 +177,7 @@ TesteventloopCmd( static int TestvolumetypeCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -206,11 +206,11 @@ TestvolumetypeCmd( if (found == 0) { Tcl_AppendResult(interp, "could not get volume type for \"", - (path?path:""), "\"", (void *)NULL); + (path?path:""), "\"", (char *)NULL); Tcl_WinConvertError(GetLastError()); return TCL_ERROR; } - Tcl_AppendResult(interp, volType, (void *)NULL); + Tcl_AppendResult(interp, volType, (char *)NULL); return TCL_OK; #undef VOL_BUF_SIZE } @@ -243,7 +243,7 @@ TestvolumetypeCmd( static int TestwinclockCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ @@ -292,7 +292,7 @@ TestwinclockCmd( static int TestwinsleepCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ @@ -312,7 +312,7 @@ TestwinsleepCmd( static int TestSizeCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ @@ -357,7 +357,7 @@ syntax: static int TestExceptionCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ @@ -604,14 +604,9 @@ TestplatformChmod( * to remove inherited ACL (we need to overwrite the default ACL's in this case) */ - if (SetNamedSecurityInfoA((LPSTR)nativePath, - SE_FILE_OBJECT, - DACL_SECURITY_INFORMATION | - PROTECTED_DACL_SECURITY_INFORMATION, - NULL, - NULL, - newAcl, - NULL) == ERROR_SUCCESS) { + if (SetNamedSecurityInfoA((LPSTR)nativePath, SE_FILE_OBJECT, + DACL_SECURITY_INFORMATION | PROTECTED_DACL_SECURITY_INFORMATION, + NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) { res = 0; } @@ -635,7 +630,6 @@ TestplatformChmod( /* Run normal chmod command */ return chmod(nativePath, pmode); - } /* @@ -659,7 +653,7 @@ TestplatformChmod( static int TestchmodCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ @@ -685,7 +679,7 @@ TestchmodCmd( } if (TestplatformChmod(translated, mode) != 0) { Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp), - (void *)NULL); + (char *)NULL); return TCL_ERROR; } Tcl_DStringFree(&buffer); diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index e468d7a..e8d4d4d 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -203,12 +203,12 @@ int TclpThreadCreate( Tcl_ThreadId *idPtr, /* Return, the ID of the thread. */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread. */ - ClientData clientData, /* The one argument to Main(). */ + void *clientData, /* The one argument to Main(). */ TCL_HASH_TYPE stackSize, /* Size of stack for the new thread. */ int flags) /* Flags controlling behaviour of the new * thread. */ { - WinThread *winThreadPtr; /* Per-thread startup info */ + WinThread *winThreadPtr; /* Per-thread startup info */ HANDLE tHandle; winThreadPtr = (WinThread *)ckalloc(sizeof(WinThread)); @@ -219,8 +219,7 @@ TclpThreadCreate( EnterCriticalSection(&joinLock); *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and - * on WIN64 sizeof void* != sizeof unsigned - */ + * on WIN64 sizeof void* != sizeof unsigned */ #if defined(_MSC_VER) || defined(__MSVCRT__) tHandle = (HANDLE) _beginthreadex(NULL, (unsigned)stackSize, @@ -535,7 +534,7 @@ TclFinalizeLock(void) #if TCL_THREADS /* locally used prototype */ -static void FinalizeConditionEvent(ClientData data); +static void FinalizeConditionEvent(void *data); /* *---------------------------------------------------------------------- @@ -880,7 +879,7 @@ Tcl_ConditionNotify( static void FinalizeConditionEvent( - ClientData data) + void *data) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) data; diff --git a/win/tclWinTime.c b/win/tclWinTime.c index 6fecbd2..438a8ec 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -136,7 +136,7 @@ static struct { #ifndef TCL_NO_DEPRECATED static struct tm * ComputeGMT(const time_t *tp); #endif /* TCL_NO_DEPRECATED */ -static void StopCalibration(ClientData clientData); +static void StopCalibration(void *clientData); static DWORD WINAPI CalibrationThread(LPVOID arg); static void UpdateTimeEachSecond(void); static void ResetCounterSamples(unsigned long long fileTime, @@ -144,10 +144,10 @@ static void ResetCounterSamples(unsigned long long fileTime, static long long AccumulateSample(long long perfCounter, unsigned long long fileTime); static void NativeScaleTime(Tcl_Time* timebuf, - ClientData clientData); + void *clientData); static long long NativeGetMicroseconds(void); static void NativeGetTime(Tcl_Time* timebuf, - ClientData clientData); + void *clientData); /* * TIP #233 (Virtualized Time): Data for the time hooks, if any. @@ -155,7 +155,7 @@ static void NativeGetTime(Tcl_Time* timebuf, Tcl_GetTimeProc *tclGetTimeProcPtr = NativeGetTime; Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime; -ClientData tclTimeClientData = NULL; +void *tclTimeClientData = NULL; /* * Inlined version of Tcl_GetTime. @@ -438,7 +438,7 @@ Tcl_GetTime( static void NativeScaleTime( TCL_UNUSED(Tcl_Time *), - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { /* * Native scale is 1:1. Nothing is done. @@ -704,7 +704,7 @@ NativeGetMicroseconds(void) static void NativeGetTime( Tcl_Time *timePtr, - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { long long usecSincePosixEpoch; @@ -751,7 +751,7 @@ void TclWinResetTimerResolution(void); static void StopCalibration( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { SetEvent(timeInfo.exitEvent); @@ -1515,7 +1515,7 @@ void Tcl_SetTimeProc( Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, - ClientData clientData) + void *clientData) { tclGetTimeProcPtr = getProc; tclScaleTimeProcPtr = scaleProc; @@ -1542,7 +1542,7 @@ void Tcl_QueryTimeProc( Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, - ClientData *clientData) + void **clientData) { if (getProc) { *getProc = tclGetTimeProcPtr; -- cgit v0.12 From db2c4a21b2cc03076d2c22b74dea2662f5f35143 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 20 Mar 2024 14:42:16 +0000 Subject: dup test name --- tests/zipfs.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/zipfs.test b/tests/zipfs.test index 69c682e..b696308 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -1450,7 +1450,7 @@ namespace eval test_ns_zipfs { testzipfsglob basic-type-d-f $basicMounts [list -type {d f} $defMountPt/*] [zipfspathsmt $defMountPt test testdir] testzipfsglob basic-type-l $basicMounts [list -type l $defMountPt/*] "no files matched glob pattern \"$defMountPt/*\"" -returnCodes error foreach type {b c l p s} { - testzipfsglob basic-type-$type $basicMounts [list -type $type $defMountPt/*] "no files matched glob pattern \"$defMountPt/*\"" -returnCodes error + testzipfsglob basic-type-1-$type $basicMounts [list -type $type $defMountPt/*] "no files matched glob pattern \"$defMountPt/*\"" -returnCodes error testzipfsglob basic-type-f-$type $basicMounts [list -type [list f $type] $defMountPt/*] [zipfspathsmt $defMountPt test] testzipfsglob basic-type-d-$type $basicMounts [list -type [list d $type] $defMountPt/*] [zipfspathsmt $defMountPt testdir] } -- cgit v0.12 From 51726860a52a5b883da201bbe583ed41e4f01e52 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 20 Mar 2024 16:37:22 +0000 Subject: added performance regression tests for list facilities (initially only few lsearch cases, illustrating [6811a0081940b76c]) --- tests-perf/list.perf.tcl | 100 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 100 insertions(+) create mode 100644 tests-perf/list.perf.tcl diff --git a/tests-perf/list.perf.tcl b/tests-perf/list.perf.tcl new file mode 100644 index 0000000..9c66259 --- /dev/null +++ b/tests-perf/list.perf.tcl @@ -0,0 +1,100 @@ +#!/usr/bin/tclsh + +# ------------------------------------------------------------------------ +# +# list.perf.tcl -- +# +# This file provides performance tests for comparison of tcl-speed +# of list facilities. +# +# ------------------------------------------------------------------------ +# +# Copyright (c) 2024 Serg G. Brester (aka sebres) +# +# See the file "license.terms" for information on usage and redistribution +# of this file. +# + + +if {![namespace exists ::tclTestPerf]} { + source [file join [file dirname [info script]] test-performance.tcl] +} + + +namespace eval ::tclTestPerf-List { + +namespace path {::tclTestPerf} + +# regression tests for [bug-da16d15574] (fix for [db4f2843cd]): +proc test-lsearch-regress {{reptime 1000}} { + _test_run -no-result $reptime { + # list with 5000 strings with ca. 50 chars elements: + setup { set str [join [lrepeat 13 "XXX"] /]; set l [lrepeat 5000 $str]; llength $l } + # lsearch with no option, found immediatelly : + { lsearch $l $str } + # lsearch with -glob, found immediatelly : + { lsearch -glob $l $str } + # lsearch with -exact, found immediatelly : + { lsearch -exact $l $str } + # lsearch with -dictionary, found immediatelly : + { lsearch -dictionary $l $str } + + # lsearch with -nocase only, found immediatelly : + { lsearch -nocase $l $str } + # lsearch with -nocase -glob, found immediatelly : + { lsearch -nocase -glob $l $str } + # lsearch with -nocase -exact, found immediatelly : + { lsearch -nocase -exact $l $str } + # lsearch with -nocase -dictionary, found immediatelly : + { lsearch -nocase -dictionary $l $str } + } +} + +proc test-lsearch-nf-regress {{reptime 1000}} { + _test_run -no-result $reptime { + # list with 5000 strings with ca. 50 chars elements: + setup { set str [join [lrepeat 13 "XXX"] /]; set sNF $str/NF; set l [lrepeat 5000 $str]; llength $l } + # lsearch with no option, not found: + { lsearch $l $sNF } + # lsearch with -glob, not found: + { lsearch -glob $l $sNF } + # lsearch with -exact, not found: + { lsearch -exact $l $sNF } + # lsearch with -dictionary, not found: + { lsearch -dictionary $l $sNF } + } +} + +proc test-lsearch-nc-nf-regress {{reptime 1000}} { + _test_run -no-result $reptime { + # list with 5000 strings with ca. 50 chars elements: + setup { set str [join [lrepeat 13 "XXX"] /]; set sNF $str/NF; set l [lrepeat 5000 $str]; llength $l } + # lsearch with -nocase only, not found: + { lsearch -nocase $l $sNF } + # lsearch with -nocase -glob, not found: + { lsearch -nocase -glob $l $sNF } + # lsearch with -nocase -exact, not found: + { lsearch -nocase -exact $l $sNF } + # lsearch with -nocase -dictionary, not found: + { lsearch -nocase -dictionary $l $sNF } + } +} + +proc test {{reptime 1000}} { + test-lsearch-regress $reptime + test-lsearch-nf-regress $reptime + test-lsearch-nc-nf-regress $reptime + + puts \n**OK** +} + +}; # end of ::tclTestPerf-List + +# ------------------------------------------------------------------------ + +# if calling direct: +if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} { + array set in {-time 500} + array set in $argv + ::tclTestPerf-List::test $in(-time) +} -- cgit v0.12 From 4d5b75e119924242a8d98267802d7b57d396de43 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 20 Mar 2024 16:39:12 +0000 Subject: small amend (incorrect copy&paste removed) --- tests-perf/list.perf.tcl | 1 - 1 file changed, 1 deletion(-) diff --git a/tests-perf/list.perf.tcl b/tests-perf/list.perf.tcl index 9c66259..9fde335 100644 --- a/tests-perf/list.perf.tcl +++ b/tests-perf/list.perf.tcl @@ -25,7 +25,6 @@ namespace eval ::tclTestPerf-List { namespace path {::tclTestPerf} -# regression tests for [bug-da16d15574] (fix for [db4f2843cd]): proc test-lsearch-regress {{reptime 1000}} { _test_run -no-result $reptime { # list with 5000 strings with ca. 50 chars elements: -- cgit v0.12 From 30f26cff8be85483cb7c90b15ce9acc2f4607583 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 20 Mar 2024 17:56:25 +0000 Subject: optimize TclUtfToUCS4 for single code units (non high surrogates), especially for ascii; fixes performance regression [6811a0081940b76c] --- generic/tclInt.h | 8 +++++++- generic/tclUtf.c | 6 +++--- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index de92a7d..7efaf80 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3180,7 +3180,7 @@ MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes, MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes, const char *trim, int numTrim); MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct); -MODULE_SCOPE int TclUtfToUCS4(const char *, int *); +MODULE_SCOPE int TclpUtfToUCS4(const char *, int *); MODULE_SCOPE int TclUCS4ToUtf(int, char *); MODULE_SCOPE int TclUCS4ToLower(int ch); #if TCL_UTF_MAX == 4 @@ -3995,6 +3995,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, * the result of Tcl_UtfToUniChar. The ANSI C "prototype" for this macro is: * * MODULE_SCOPE int TclUtfToUniChar(const char *string, Tcl_UniChar *ch); + * MODULE_SCOPE int TclpUtfToUCS4(const char *src, int *ucs4Ptr); *---------------------------------------------------------------- */ @@ -4003,6 +4004,11 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, ((*(chPtr) = UCHAR(*(str))), 1) \ : Tcl_UtfToUniChar(str, chPtr)) +#define TclUtfToUCS4(src, ucs4Ptr) \ + (((UCHAR(*(src))) < 0x80) ? \ + ((*(ucs4Ptr) = UCHAR(*(src))), 1) \ + : TclpUtfToUCS4(src, ucs4Ptr)) + /* *---------------------------------------------------------------- * Macro counterpart of the Tcl_NumUtfChars() function. To be used in speed- diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 6fbeb36..04f7208 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -2462,18 +2462,18 @@ TclUniCharMatch( */ int -TclUtfToUCS4( +TclpUtfToUCS4( const char *src, /* The UTF-8 string. */ int *ucs4Ptr) /* Filled with the UCS4 codepoint represented * by the UTF-8 string. */ { Tcl_UniChar ch = 0; - int len = Tcl_UtfToUniChar(src, &ch); + int len = TclUtfToUniChar(src, &ch); #if TCL_UTF_MAX <= 4 if ((ch & ~0x3FF) == 0xD800) { Tcl_UniChar low = ch; - int len2 = Tcl_UtfToUniChar(src+len, &low); + int len2 = TclUtfToUniChar(src+len, &low); if ((low & ~0x3FF) == 0xDC00) { *ucs4Ptr = (((ch & 0x3FF) << 10) | (low & 0x3FF)) + 0x10000; return len + len2; -- cgit v0.12 From 7148cbe60d4d36e24731859efa0bf7af19a9b37a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 20 Mar 2024 20:40:56 +0000 Subject: put back line accidently removed --- generic/tclStringObj.c | 1 + 1 file changed, 1 insertion(+) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index dba36a6..10faa02 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -618,6 +618,7 @@ TclGetUniChar( return -1; } const char *begin = TclUtfAtIndex(objPtr->bytes, index); + TclUtfToUniChar(begin, &ch); return ch; } -- cgit v0.12 From 8197ed757c03ffb91505685667a4d963923b3d22 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 21 Mar 2024 00:27:29 +0000 Subject: more lsearch performance tests --- tests-perf/list.perf.tcl | 65 ++++++++++++++++++++++++++++++------------------ 1 file changed, 41 insertions(+), 24 deletions(-) diff --git a/tests-perf/list.perf.tcl b/tests-perf/list.perf.tcl index 9fde335..121a922 100644 --- a/tests-perf/list.perf.tcl +++ b/tests-perf/list.perf.tcl @@ -27,62 +27,79 @@ namespace path {::tclTestPerf} proc test-lsearch-regress {{reptime 1000}} { _test_run -no-result $reptime { - # list with 5000 strings with ca. 50 chars elements: + # found-first immediately, list with 5000 strings with ca. 50 chars elements: setup { set str [join [lrepeat 13 "XXX"] /]; set l [lrepeat 5000 $str]; llength $l } - # lsearch with no option, found immediatelly : + { lsearch $l $str } - # lsearch with -glob, found immediatelly : { lsearch -glob $l $str } - # lsearch with -exact, found immediatelly : { lsearch -exact $l $str } - # lsearch with -dictionary, found immediatelly : { lsearch -dictionary $l $str } + { lsearch -exact -dictionary $l $str } - # lsearch with -nocase only, found immediatelly : { lsearch -nocase $l $str } - # lsearch with -nocase -glob, found immediatelly : { lsearch -nocase -glob $l $str } - # lsearch with -nocase -exact, found immediatelly : { lsearch -nocase -exact $l $str } - # lsearch with -nocase -dictionary, found immediatelly : { lsearch -nocase -dictionary $l $str } + { lsearch -nocase -exact -dictionary $l $str } } } proc test-lsearch-nf-regress {{reptime 1000}} { _test_run -no-result $reptime { - # list with 5000 strings with ca. 50 chars elements: + # not-found, list with 5000 strings with ca. 50 chars elements: setup { set str [join [lrepeat 13 "XXX"] /]; set sNF $str/NF; set l [lrepeat 5000 $str]; llength $l } - # lsearch with no option, not found: + { lsearch $l $sNF } - # lsearch with -glob, not found: { lsearch -glob $l $sNF } - # lsearch with -exact, not found: { lsearch -exact $l $sNF } - # lsearch with -dictionary, not found: { lsearch -dictionary $l $sNF } + { lsearch -exact -dictionary $l $sNF } + { lsearch -sorted $l $sNF } + { lsearch -bisect $l $sNF } + + { lsearch -nocase $l $sNF } + { lsearch -nocase -glob $l $sNF } + { lsearch -nocase -exact $l $sNF } + { lsearch -nocase -dictionary $l $sNF } + { lsearch -nocase -exact -dictionary $l $sNF } + { lsearch -nocase -sorted $l $sNF } + { lsearch -nocase -bisect $l $sNF } } } -proc test-lsearch-nc-nf-regress {{reptime 1000}} { +proc test-lsearch-nf-non-opti-fast {{reptime 1000}} { _test_run -no-result $reptime { - # list with 5000 strings with ca. 50 chars elements: - setup { set str [join [lrepeat 13 "XXX"] /]; set sNF $str/NF; set l [lrepeat 5000 $str]; llength $l } - # lsearch with -nocase only, not found: + # not-found, list with 5000 strings with ca. 50 chars elements: + setup { set str [join [lrepeat 13 "XXX"] /]; set sNF "$str/*"; set l [lrepeat 5000 $str]; llength $l } + + { lsearch -sorted -dictionary $l $sNF } + { lsearch -bisect -dictionary $l $sNF } + + { lsearch -sorted -nocase -dictionary $l $sNF } + { lsearch -bisect -nocase -dictionary $l $sNF } + + } +} + +proc test-lsearch-nf-non-opti-slow {{reptime 1000}} { + _test_run -no-result $reptime { + # not-found, list with 5000 strings with ca. 50 chars elements: + setup { set str [join [lrepeat 13 "XXX"] /]; set sNF "$str/*"; set l [lrepeat 5000 $str]; llength $l } + + { lsearch $l $sNF } + { lsearch -glob $l $sNF } + { lsearch -nocase $l $sNF } - # lsearch with -nocase -glob, not found: { lsearch -nocase -glob $l $sNF } - # lsearch with -nocase -exact, not found: - { lsearch -nocase -exact $l $sNF } - # lsearch with -nocase -dictionary, not found: - { lsearch -nocase -dictionary $l $sNF } + } } proc test {{reptime 1000}} { test-lsearch-regress $reptime test-lsearch-nf-regress $reptime - test-lsearch-nc-nf-regress $reptime + test-lsearch-nf-non-opti-fast $reptime + test-lsearch-nf-non-opti-slow $reptime puts \n**OK** } -- cgit v0.12 From 3fd7f1aa143d5095721daf36be1497966e1fae79 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 21 Mar 2024 12:57:21 +0000 Subject: Formatting/indenting --- generic/tclArithSeries.c | 58 ++--- generic/tclIO.c | 101 ++++---- generic/tclObj.c | 6 +- generic/tclTest.c | 561 +++++++++++++++++++++---------------------- generic/tclTestObj.c | 25 +- generic/tclTestProcBodyObj.c | 2 +- macosx/tclMacOSXFCmd.c | 19 +- unix/tclUnixTest.c | 50 ++-- 8 files changed, 412 insertions(+), 410 deletions(-) diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index a29b589..48e9f80 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -106,9 +106,9 @@ ArithSeriesIndexDbl( { ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl*)arithSeriesRepPtr; if (arithSeriesRepPtr->isDouble) { - double d = dblRepPtr->start + (index * dblRepPtr->step); + double d = dblRepPtr->start + (index * dblRepPtr->step); unsigned n = (dblRepPtr->precision > 0 ? dblRepPtr->precision : 0); - return ArithRound(d, n); + return ArithRound(d, n); } else { return (double)(arithSeriesRepPtr->start + (index * arithSeriesRepPtr->step)); } @@ -277,8 +277,7 @@ DupArithSeriesInternalRep( static void FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesObjPtr) /* Free any allocated memory */ { - ArithSeries *arithSeriesRepPtr = - (ArithSeries *)arithSeriesObjPtr->internalRep.twoPtrValue.ptr1; + ArithSeries *arithSeriesRepPtr = (ArithSeries *)arithSeriesObjPtr->internalRep.twoPtrValue.ptr1; if (arithSeriesRepPtr->elements) { Tcl_Size i; @@ -319,7 +318,9 @@ NewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_Wide ArithSeries *arithSeriesRepPtr; length = len>=0 ? len : -1; - if (length < 0) length = -1; + if (length < 0) { + length = -1; + } TclNewObj(arithSeriesObj); @@ -337,8 +338,9 @@ NewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_Wide arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr; arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL; arithSeriesObj->typePtr = &tclArithSeriesType; - if (length > 0) + if (length > 0) { Tcl_InvalidateStringRep(arithSeriesObj); + } return arithSeriesObj; } @@ -621,7 +623,9 @@ TclArithSeriesObjIndex( * *---------------------------------------------------------------------- */ -Tcl_Size TclArithSeriesObjLength(Tcl_Obj *arithSeriesObj) +Tcl_Size +TclArithSeriesObjLength( + Tcl_Obj *arithSeriesObj) { ArithSeries *arithSeriesRepPtr = (ArithSeries*) arithSeriesObj->internalRep.twoPtrValue.ptr1; @@ -655,7 +659,7 @@ ArithSeriesObjStep( Tcl_Obj *stepObj; if (arithSeriesObj->typePtr != &tclArithSeriesType) { - Tcl_Panic("ArithSeriesObjStep called with a not ArithSeries Obj."); + Tcl_Panic("ArithSeriesObjStep called with a not ArithSeries Obj."); } arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj); if (arithSeriesRepPtr->isDouble) { @@ -767,7 +771,7 @@ TclArithSeriesObjRange( ((arithSeriesObj->refCount > 1))) { Tcl_Obj *newSlicePtr; if (TclNewArithSeriesObj(interp, &newSlicePtr, - arithSeriesRepPtr->isDouble, startObj, endObj, + arithSeriesRepPtr->isDouble, startObj, endObj, stepObj, NULL) != TCL_OK) { newSlicePtr = NULL; } @@ -901,9 +905,7 @@ TclArithSeriesGetElements( *objcPtr = objc; } else { if (interp != NULL) { - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf("value is not an arithseries")); + Tcl_SetObjResult(interp, Tcl_NewStringObj("value is not an arithseries", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", (void *)NULL); } return TCL_ERROR; @@ -1046,12 +1048,10 @@ TclArithSeriesObjReverse( static void UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr) { - ArithSeries *arithSeriesRepPtr = - (ArithSeries*)arithSeriesObjPtr->internalRep.twoPtrValue.ptr1; + ArithSeries *arithSeriesRepPtr = (ArithSeries*)arithSeriesObjPtr->internalRep.twoPtrValue.ptr1; char *p; - Tcl_Obj *elemObj; - Tcl_Size i; - Tcl_Size length = 0; + Tcl_Obj *eleObj; + Tcl_Size i, bytlen = 0; Tcl_Size slen; /* @@ -1061,7 +1061,7 @@ UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr) for (i = 0; i < arithSeriesRepPtr->len; i++) { double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i); slen = d>0 ? log10(d)+1 : d<0 ? log10((0-d))+2 : 1; - length += slen; + bytlen += slen; } } else { for (i = 0; i < arithSeriesRepPtr->len; i++) { @@ -1069,35 +1069,35 @@ UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr) char tmp[TCL_DOUBLE_SPACE+2]; tmp[0] = 0; Tcl_PrintDouble(NULL,d,tmp); - if ((length + strlen(tmp)) > TCL_SIZE_MAX) { + if ((bytlen + strlen(tmp)) > TCL_SIZE_MAX) { break; // overflow } - length += strlen(tmp); + bytlen += strlen(tmp); } } - length += arithSeriesRepPtr->len; // Space for each separator + bytlen += arithSeriesRepPtr->len; // Space for each separator /* * Pass 2: generate the string repr. */ - p = Tcl_InitStringRep(arithSeriesObjPtr, NULL, length); + p = Tcl_InitStringRep(arithSeriesObjPtr, NULL, bytlen); if (p == NULL) { - Tcl_Panic("Unable to allocate string size %d", length); + Tcl_Panic("Unable to allocate string size %d", bytlen); } for (i = 0; i < arithSeriesRepPtr->len; i++) { - elemObj = TclArithSeriesObjIndex(NULL, arithSeriesObjPtr, i); - char *str = Tcl_GetStringFromObj(elemObj, &slen); - if (((p - arithSeriesObjPtr->bytes)+slen) > length) { + eleObj = TclArithSeriesObjIndex(NULL, arithSeriesObjPtr, i); + char *str = TclGetStringFromObj(eleObj, &slen); + if (((p - arithSeriesObjPtr->bytes)+slen) > bytlen) { break; } strncpy(p, str, slen); p[slen] = ' '; p += slen+1; - Tcl_DecrRefCount(elemObj); + Tcl_DecrRefCount(eleObj); } - if (length > 0) arithSeriesObjPtr->bytes[length-1] = '\0'; - arithSeriesObjPtr->length = length-1; + if (bytlen > 0) arithSeriesObjPtr->bytes[bytlen-1] = '\0'; + arithSeriesObjPtr->length = bytlen-1; } /* diff --git a/generic/tclIO.c b/generic/tclIO.c index 15e0785..8f53bb9 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -28,7 +28,7 @@ typedef struct ChannelHandler { int mask; /* Mask of desired events. */ Tcl_ChannelProc *proc; /* Procedure to call in the type of * Tcl_CreateChannelHandler. */ - void *clientData; /* Argument to pass to procedure. */ + void *clientData; /* Argument to pass to procedure. */ struct ChannelHandler *nextPtr; /* Next one in list of registered handlers. */ } ChannelHandler; @@ -50,11 +50,12 @@ typedef struct ChannelHandler { */ typedef struct NextChannelHandler { - ChannelHandler *nextHandlerPtr; /* The next handler to be invoked in - * this invocation. */ + ChannelHandler *nextHandlerPtr; + /* The next handler to be invoked in + * this invocation. */ struct NextChannelHandler *nestedHandlerPtr; - /* Next nested invocation of - * Tcl_NotifyChannel. */ + /* Next nested invocation of + * Tcl_NotifyChannel. */ } NextChannelHandler; /* @@ -103,7 +104,7 @@ typedef struct CopyState { Tcl_Interp *interp; /* Interp that started the copy. */ Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */ Tcl_Size bufSize; /* Size of appended buffer. */ - char buffer[TCLFLEXARRAY]; /* Copy buffer, this must be the last + char buffer[TCLFLEXARRAY]; /* Copy buffer, this must be the last * field. */ } CopyState; @@ -141,10 +142,11 @@ static Tcl_ThreadDataKey dataKey; */ typedef struct CloseCallback { - Tcl_CloseProc *proc; /* The procedure to call. */ + Tcl_CloseProc *proc; /* The procedure to call. */ void *clientData; /* Arbitrary one-word data to pass - * to the callback. */ - struct CloseCallback *nextPtr; /* For chaining close callbacks. */ + * to the callback. */ + struct CloseCallback *nextPtr; + /* For chaining close callbacks. */ } CloseCallback; /* @@ -626,7 +628,7 @@ TclFinalizeIOSubsystem(void) continue; } if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED ) - || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { + || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { ResetFlag(statePtr, BG_FLUSH_SCHEDULED); active = 1; break; @@ -654,7 +656,7 @@ TclFinalizeIOSubsystem(void) */ (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, - "-blocking", "on"); + "-blocking", "on"); } if ((chanPtr == (Channel *) tsdPtr->stdinChannel) || @@ -2476,13 +2478,13 @@ Tcl_GetChannelHandle( int Tcl_RemoveChannelMode( - Tcl_Interp* interp, /* The interp for an error message. Allowed to be NULL. */ + Tcl_Interp *interp, /* The interp for an error message. Allowed to be NULL. */ Tcl_Channel chan, /* The channel which is modified. */ - int mode) /* The access mode to drop from the channel */ + int mode) /* The access mode to drop from the channel */ { const char* emsg; ChannelState *statePtr = ((Channel *) chan)->state; - /* State of actual channel. */ + /* State of actual channel. */ if ((mode != TCL_READABLE) && (mode != TCL_WRITABLE)) { emsg = "Illegal mode value."; @@ -3613,7 +3615,7 @@ Tcl_Close( Tcl_SetErrno(stickyError); if (interp != NULL) { Tcl_SetObjResult(interp, - Tcl_NewStringObj(Tcl_PosixError(interp), -1)); + Tcl_NewStringObj(Tcl_PosixError(interp), -1)); } return TCL_ERROR; } @@ -4355,7 +4357,7 @@ WillRead( */ if (FlushChannel(NULL, chanPtr, 0) != 0) { - return -1; + return -1; } } return 0; @@ -4393,7 +4395,7 @@ Write( /* State info for channel */ char *nextNewLine = NULL; int endEncoding, needNlFlush = 0; - int saved = 0, total = 0, flushed = 0; + Tcl_Size saved = 0, total = 0, flushed = 0; char safe[BUFFER_PADDING]; int encodingError = 0; @@ -4707,7 +4709,7 @@ Tcl_GetsObj( * newline in the available input. */ - TclGetStringFromObj(objPtr, &oldLength); + (void)TclGetStringFromObj(objPtr, &oldLength); oldFlags = statePtr->inputEncodingFlags; oldState = statePtr->inputEncodingState; oldRemoved = BUFFER_PADDING; @@ -5577,7 +5579,7 @@ FilterInputBytes( } extra = rawLen - gsPtr->rawRead; memcpy(nextPtr->buf + (BUFFER_PADDING - extra), - raw + gsPtr->rawRead, (size_t) extra); + raw + gsPtr->rawRead, extra); nextPtr->nextRemoved -= extra; bufPtr->nextAdded -= extra; } @@ -6380,11 +6382,7 @@ ReadChars( dst, dstLimit, &srcRead, &dstDecoded, &numChars); if (code == TCL_CONVERT_UNKNOWN || code == TCL_CONVERT_SYNTAX - || ( - code == TCL_CONVERT_MULTIBYTE - && GotFlag(statePtr, CHANNEL_EOF - )) - ) { + || (code == TCL_CONVERT_MULTIBYTE && GotFlag(statePtr, CHANNEL_EOF))) { SetFlag(statePtr, CHANNEL_ENCODING_ERROR); code = TCL_OK; } @@ -6759,23 +6757,28 @@ TranslateInputEOL( int numBytes = crFound - src; memmove(dst, src, numBytes); - dst += numBytes; dstLen -= numBytes; - src += numBytes; srcLen -= numBytes; + dst += numBytes; + dstLen -= numBytes; + src += numBytes; + srcLen -= numBytes; if (srcLen == 1) { /* valid src bytes end in \r */ if (eof) { *dst++ = '\r'; - src++; srcLen--; + src++; + srcLen--; } else { lesser = 0; break; } } else if (src[1] == '\n') { *dst++ = '\n'; - src += 2; srcLen -= 2; + src += 2; + srcLen -= 2; } else { *dst++ = '\r'; - src++; srcLen--; + src++; + srcLen--; } dstLen--; lesser = (dstLen < srcLen) ? dstLen : srcLen; @@ -6791,7 +6794,10 @@ TranslateInputEOL( int lesser; if (GotFlag(statePtr, INPUT_SAW_CR) && srcLen) { - if (*src == '\n') { src++; srcLen--; } + if (*src == '\n') { + src++; + srcLen--; + } ResetFlag(statePtr, INPUT_SAW_CR); } lesser = (dstLen < srcLen) ? dstLen : srcLen; @@ -6800,12 +6806,15 @@ TranslateInputEOL( memmove(dst, src, numBytes); dst[numBytes] = '\n'; - dst += numBytes + 1; dstLen -= numBytes + 1; - src += numBytes + 1; srcLen -= numBytes + 1; + dst += numBytes + 1; + dstLen -= numBytes + 1; + src += numBytes + 1; + srcLen -= numBytes + 1; if (srcLen == 0) { SetFlag(statePtr, INPUT_SAW_CR); } else if (*src == '\n') { - src++; srcLen--; + src++; + srcLen--; } lesser = (dstLen < srcLen) ? dstLen : srcLen; } @@ -8824,19 +8833,18 @@ UpdateInterest( TclChannelPreserve((Tcl_Channel)chanPtr); statePtr->timerChanPtr = chanPtr; statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - ChannelTimerProc, chanPtr); + ChannelTimerProc, chanPtr); } } } if (!statePtr->timer - && mask & TCL_WRITABLE - && GotFlag(statePtr, CHANNEL_NONBLOCKING)) { - + && mask & TCL_WRITABLE + && GotFlag(statePtr, CHANNEL_NONBLOCKING)) { TclChannelPreserve((Tcl_Channel)chanPtr); statePtr->timerChanPtr = chanPtr; statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - ChannelTimerProc,chanPtr); + ChannelTimerProc,chanPtr); } @@ -8880,9 +8888,8 @@ ChannelTimerProc( Tcl_Preserve(statePtr); statePtr->timer = NULL; if (statePtr->interestMask & TCL_WRITABLE - && GotFlag(statePtr, CHANNEL_NONBLOCKING) - && !GotFlag(statePtr, BG_FLUSH_SCHEDULED) - ) { + && GotFlag(statePtr, CHANNEL_NONBLOCKING) + && !GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { /* * Restart the timer in case a channel handler reenters the event loop * before UpdateInterest gets called by Tcl_NotifyChannel. @@ -8894,9 +8901,9 @@ ChannelTimerProc( /* The channel may have just been closed from within Tcl_NotifyChannel */ if (!GotFlag(statePtr, CHANNEL_INCLOSE)) { if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA) - && (statePtr->interestMask & TCL_READABLE) - && (statePtr->inQueueHead != NULL) - && IsBufferReady(statePtr->inQueueHead)) { + && (statePtr->interestMask & TCL_READABLE) + && (statePtr->inQueueHead != NULL) + && IsBufferReady(statePtr->inQueueHead)) { /* * Restart the timer in case a channel handler reenters the event loop * before UpdateInterest gets called by Tcl_NotifyChannel. @@ -9929,7 +9936,7 @@ CopyData( * - Fail below with a read error */ if (size < 0 && Tcl_GetErrno() == EILSEQ) { - Tcl_GetStringFromObj(bufObj, &sizePart); + TclGetStringFromObj(bufObj, &sizePart); if (sizePart > 0) { size = sizePart; } @@ -9966,8 +9973,8 @@ CopyData( if ((size == 0) && Tcl_Eof(inChan) && !(cmdPtr && (mask == 0))) { break; } - if (cmdPtr && (!Tcl_Eof(inChan) || (mask == 0)) && - !(mask & TCL_READABLE)) { + if (cmdPtr && (!Tcl_Eof(inChan) || (mask == 0)) + && !(mask & TCL_READABLE)) { if (mask & TCL_WRITABLE) { Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr); } diff --git a/generic/tclObj.c b/generic/tclObj.c index f321399..f3e1f7f 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -2261,7 +2261,7 @@ TclSetBooleanFromAny( badBoolean: if (interp != NULL) { Tcl_Size length; - const char *str = Tcl_GetStringFromObj(objPtr, &length); + const char *str = TclGetStringFromObj(objPtr, &length); Tcl_Obj *msg; TclNewLiteralStringObj(msg, "expected boolean value but got \""); @@ -2280,7 +2280,7 @@ ParseBoolean( int newBool; char lowerCase[6]; Tcl_Size i, length; - const char *str = Tcl_GetStringFromObj(objPtr, &length); + const char *str = TclGetStringFromObj(objPtr, &length); if ((length < 1) || (length > 5)) { /* @@ -4493,7 +4493,7 @@ TclHashObjKey( { Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; Tcl_Size length; - const char *string = Tcl_GetStringFromObj(objPtr, &length); + const char *string = TclGetStringFromObj(objPtr, &length); TCL_HASH_TYPE result = 0; /* diff --git a/generic/tclTest.c b/generic/tclTest.c index e656985..ddc6024 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -540,6 +540,9 @@ static const char version[] = TCL_PATCH_LEVEL "+" STRINGIFY(TCL_VERSION_UUID) #ifdef STATIC_BUILD ".static" #endif +#if TCL_UTF_MAX < 4 + ".utf-16" +#endif ; int @@ -715,7 +718,7 @@ Tcltest_Init( Tcl_CreateObjCommand(interp, "testnumutfchars", TestNumUtfCharsCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testgetunichar", - TestGetUniCharCmd, NULL, NULL); + TestGetUniCharCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfindfirst", TestFindFirstCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfindlast", @@ -886,18 +889,17 @@ TestasyncCmd( asyncPtr = (TestAsyncHandler *)ckalloc(sizeof(TestAsyncHandler)); asyncPtr->command = (char *)ckalloc(strlen(argv[2]) + 1); strcpy(asyncPtr->command, argv[2]); - Tcl_MutexLock(&asyncTestMutex); + Tcl_MutexLock(&asyncTestMutex); asyncPtr->id = nextId; nextId++; - asyncPtr->handler = Tcl_AsyncCreate(AsyncHandlerProc, - INT2PTR(asyncPtr->id)); + asyncPtr->handler = Tcl_AsyncCreate(AsyncHandlerProc, INT2PTR(asyncPtr->id)); asyncPtr->nextPtr = firstHandler; firstHandler = asyncPtr; - Tcl_MutexUnlock(&asyncTestMutex); + Tcl_MutexUnlock(&asyncTestMutex); Tcl_SetObjResult(interp, Tcl_NewWideIntObj(asyncPtr->id)); } else if (strcmp(argv[1], "delete") == 0) { if (argc == 2) { - Tcl_MutexLock(&asyncTestMutex); + Tcl_MutexLock(&asyncTestMutex); while (firstHandler != NULL) { asyncPtr = firstHandler; firstHandler = asyncPtr->nextPtr; @@ -905,7 +907,7 @@ TestasyncCmd( ckfree(asyncPtr->command); ckfree(asyncPtr); } - Tcl_MutexUnlock(&asyncTestMutex); + Tcl_MutexUnlock(&asyncTestMutex); return TCL_OK; } if (argc != 3) { @@ -914,7 +916,7 @@ TestasyncCmd( if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) { return TCL_ERROR; } - Tcl_MutexLock(&asyncTestMutex); + Tcl_MutexLock(&asyncTestMutex); for (prevPtr = NULL, asyncPtr = firstHandler; asyncPtr != NULL; prevPtr = asyncPtr, asyncPtr = asyncPtr->nextPtr) { if (asyncPtr->id != id) { @@ -930,7 +932,7 @@ TestasyncCmd( ckfree(asyncPtr); break; } - Tcl_MutexUnlock(&asyncTestMutex); + Tcl_MutexUnlock(&asyncTestMutex); } else if (strcmp(argv[1], "mark") == 0) { if (argc != 5) { goto wrongNumArgs; @@ -957,7 +959,7 @@ TestasyncCmd( if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) { return TCL_ERROR; } - Tcl_MutexLock(&asyncTestMutex); + Tcl_MutexLock(&asyncTestMutex); for (asyncPtr = firstHandler; asyncPtr != NULL; asyncPtr = asyncPtr->nextPtr) { if (asyncPtr->id == id) { @@ -972,7 +974,7 @@ TestasyncCmd( break; } } - Tcl_MutexUnlock(&asyncTestMutex); + Tcl_MutexUnlock(&asyncTestMutex); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be create, delete, int, mark, or marklater", (void *)NULL); @@ -984,7 +986,7 @@ TestasyncCmd( static int AsyncHandlerProc( void *clientData, /* If of TestAsyncHandler structure. - * in global list. */ + * in global list. */ Tcl_Interp *interp, /* Interpreter in which command was * executed, or NULL. */ int code) /* Current return code from command. */ @@ -997,16 +999,16 @@ AsyncHandlerProc( Tcl_MutexLock(&asyncTestMutex); for (asyncPtr = firstHandler; asyncPtr != NULL; - asyncPtr = asyncPtr->nextPtr) { - if (asyncPtr->id == id) { - break; - } + asyncPtr = asyncPtr->nextPtr) { + if (asyncPtr->id == id) { + break; + } } Tcl_MutexUnlock(&asyncTestMutex); if (!asyncPtr) { - /* Woops - this one was deleted between the AsyncMark and now */ - return TCL_OK; + /* Woops - this one was deleted between the AsyncMark and now */ + return TCL_OK; } TclFormatInt(string, code); @@ -1054,11 +1056,11 @@ AsyncThreadProc( Tcl_Sleep(1); Tcl_MutexLock(&asyncTestMutex); for (asyncPtr = firstHandler; asyncPtr != NULL; - asyncPtr = asyncPtr->nextPtr) { - if (asyncPtr->id == id) { - Tcl_AsyncMark(asyncPtr->handler); - break; - } + asyncPtr = asyncPtr->nextPtr) { + if (asyncPtr->id == id) { + Tcl_AsyncMark(asyncPtr->handler); + break; + } } Tcl_MutexUnlock(&asyncTestMutex); Tcl_ExitThread(TCL_OK); @@ -1869,9 +1871,9 @@ TestdoubledigitsObjCmd( } } if (status != TCL_OK - || Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK - || Tcl_GetIndexFromObj(interp, objv[3], options, "conversion type", - TCL_EXACT, &type) != TCL_OK) { + || Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK + || Tcl_GetIndexFromObj(interp, objv[3], options, "conversion type", + TCL_EXACT, &type) != TCL_OK) { fprintf(stderr, "bad value? %g\n", d); return TCL_ERROR; } @@ -2064,8 +2066,10 @@ static void SpecialFree( *------------------------------------------------------------------------ */ typedef int -UtfTransformFn(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_EncodingState *statePtr, - char *dst, Tcl_Size dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); +UtfTransformFn(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, + Tcl_Size srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, + Tcl_Size dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); + static int UtfExtWrapper( Tcl_Interp *interp, UtfTransformFn *transformer, int objc, Tcl_Obj *const objv[]) { @@ -2097,14 +2101,12 @@ static int UtfExtWrapper( Tcl_WideInt wide; if (objc < 7 || objc > 10) { - Tcl_WrongNumArgs(interp, - 2, - objv, - "encoding srcbytes flags state dstlen ?srcreadvar? ?dstwrotevar? ?dstcharsvar?"); - return TCL_ERROR; + Tcl_WrongNumArgs(interp, 2, objv, + "encoding srcbytes flags state dstlen ?srcreadvar? ?dstwrotevar? ?dstcharsvar?"); + return TCL_ERROR; } if (Tcl_GetEncodingFromObj(interp, objv[2], &encoding) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } /* Flags may be specified as list of integers and keywords */ @@ -2119,13 +2121,8 @@ static int UtfExtWrapper( flags |= flag; } else { int idx; - if (Tcl_GetIndexFromObjStruct(interp, - flagObjs[i], - flagMap, - sizeof(flagMap[0]), - "flag", - 0, - &idx) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, flagObjs[i], flagMap, sizeof(flagMap[0]), + "flag", 0, &idx) != TCL_OK) { return TCL_ERROR; } flags |= flagMap[idx].flag; @@ -2134,16 +2131,16 @@ static int UtfExtWrapper( /* Assumes state is integer if not "" */ if (Tcl_GetWideIntFromObj(interp, objv[5], &wide) == TCL_OK) { - encState = (Tcl_EncodingState)(size_t)wide; - encStatePtr = &encState; + encState = (Tcl_EncodingState)(size_t)wide; + encStatePtr = &encState; } else if (Tcl_GetCharLength(objv[5]) == 0) { - encStatePtr = NULL; + encStatePtr = NULL; } else { - return TCL_ERROR; + return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[6], &dstLen) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } srcReadVar = NULL; dstWroteVar = NULL; @@ -2155,12 +2152,12 @@ static int UtfExtWrapper( } if (objc > 8) { /* Ditto for dstWrote */ - if (Tcl_GetCharLength(objv[8])) { - dstWroteVar = objv[8]; - } + if (Tcl_GetCharLength(objv[8])) { + dstWroteVar = objv[8]; + } if (objc > 9) { - if (Tcl_GetCharLength(objv[9])) { - dstCharsVar = objv[9]; + if (Tcl_GetCharLength(objv[9])) { + dstCharsVar = objv[9]; } } } @@ -2189,69 +2186,60 @@ static int UtfExtWrapper( memmove(bufPtr + dstLen, "\xAB\xCD\xEF\xAB", 4); /* overflow detection */ bytes = Tcl_GetByteArrayFromObj(objv[3], &srcLen); /* Last! to avoid shimmering */ result = (*transformer)(interp, encoding, (const char *)bytes, srcLen, flags, - encStatePtr, (char *) bufPtr, dstLen, - srcReadVar ? &srcRead : NULL, - &dstWrote, - dstCharsVar ? &dstChars : NULL); + encStatePtr, (char *) bufPtr, dstLen, + srcReadVar ? &srcRead : NULL, + &dstWrote, + dstCharsVar ? &dstChars : NULL); if (memcmp(bufPtr + bufLen - 4, "\xAB\xCD\xEF\xAB", 4)) { - Tcl_SetResult(interp, - "Tcl_ExternalToUtf wrote past output buffer", - TCL_STATIC); - result = TCL_ERROR; + Tcl_SetResult(interp, + "Tcl_ExternalToUtf wrote past output buffer", + TCL_STATIC); + result = TCL_ERROR; } else if (result != TCL_ERROR) { - Tcl_Obj *resultObjs[3]; - switch (result) { - case TCL_OK: - resultObjs[0] = Tcl_NewStringObj("ok", TCL_INDEX_NONE); - break; - case TCL_CONVERT_MULTIBYTE: - resultObjs[0] = Tcl_NewStringObj("multibyte", TCL_INDEX_NONE); - break; - case TCL_CONVERT_SYNTAX: - resultObjs[0] = Tcl_NewStringObj("syntax", TCL_INDEX_NONE); - break; - case TCL_CONVERT_UNKNOWN: - resultObjs[0] = Tcl_NewStringObj("unknown", TCL_INDEX_NONE); - break; - case TCL_CONVERT_NOSPACE: - resultObjs[0] = Tcl_NewStringObj("nospace", TCL_INDEX_NONE); - break; - default: - resultObjs[0] = Tcl_NewIntObj(result); - break; - } - result = TCL_OK; - resultObjs[1] = - encStatePtr ? Tcl_NewWideIntObj((Tcl_WideInt)(size_t)encState) : Tcl_NewObj(); - resultObjs[2] = Tcl_NewByteArrayObj(bufPtr, dstLen); - if (srcReadVar) { - if (Tcl_ObjSetVar2(interp, - srcReadVar, - NULL, - Tcl_NewIntObj(srcRead), - TCL_LEAVE_ERR_MSG) == NULL) { + Tcl_Obj *resultObjs[3]; + switch (result) { + case TCL_OK: + resultObjs[0] = Tcl_NewStringObj("ok", TCL_INDEX_NONE); + break; + case TCL_CONVERT_MULTIBYTE: + resultObjs[0] = Tcl_NewStringObj("multibyte", TCL_INDEX_NONE); + break; + case TCL_CONVERT_SYNTAX: + resultObjs[0] = Tcl_NewStringObj("syntax", TCL_INDEX_NONE); + break; + case TCL_CONVERT_UNKNOWN: + resultObjs[0] = Tcl_NewStringObj("unknown", TCL_INDEX_NONE); + break; + case TCL_CONVERT_NOSPACE: + resultObjs[0] = Tcl_NewStringObj("nospace", TCL_INDEX_NONE); + break; + default: + resultObjs[0] = Tcl_NewIntObj(result); + break; + } + result = TCL_OK; + resultObjs[1] = + encStatePtr ? Tcl_NewWideIntObj((Tcl_WideInt)(size_t)encState) : Tcl_NewObj(); + resultObjs[2] = Tcl_NewByteArrayObj(bufPtr, dstLen); + if (srcReadVar) { + if (Tcl_ObjSetVar2(interp, srcReadVar, NULL, Tcl_NewIntObj(srcRead), + TCL_LEAVE_ERR_MSG) == NULL) { result = TCL_ERROR; } } - if (dstWroteVar) { - if (Tcl_ObjSetVar2(interp, - dstWroteVar, - NULL, - Tcl_NewIntObj(dstWrote), - TCL_LEAVE_ERR_MSG) == NULL) { + if (dstWroteVar) { + if (Tcl_ObjSetVar2(interp, dstWroteVar, NULL, Tcl_NewIntObj(dstWrote), + TCL_LEAVE_ERR_MSG) == NULL) { result = TCL_ERROR; } } - if (dstCharsVar) { - if (Tcl_ObjSetVar2(interp, - dstCharsVar, - NULL, - Tcl_NewIntObj(dstChars), - TCL_LEAVE_ERR_MSG) == NULL) { + if (dstCharsVar) { + if (Tcl_ObjSetVar2(interp, dstCharsVar, NULL, Tcl_NewIntObj(dstChars), + TCL_LEAVE_ERR_MSG) == NULL) { result = TCL_ERROR; } } - Tcl_SetObjResult(interp, Tcl_NewListObj(3, resultObjs)); + Tcl_SetObjResult(interp, Tcl_NewListObj(3, resultObjs)); } ckfree(bufPtr); @@ -2359,13 +2347,13 @@ TestencodingObjCmd( return TCL_ERROR; } Tcl_SetObjResult(interp, - Tcl_NewIntObj(Tcl_GetEncodingNulLength(encoding))); + Tcl_NewIntObj(Tcl_GetEncodingNulLength(encoding))); Tcl_FreeEncoding(encoding); - break; + break; case ENC_EXTTOUTF: - return UtfExtWrapper(interp,Tcl_ExternalToUtf,objc,objv); + return UtfExtWrapper(interp,Tcl_ExternalToUtf,objc,objv); case ENC_UTFTOEXT: - return UtfExtWrapper(interp,Tcl_UtfToExternal,objc,objv); + return UtfExtWrapper(interp,Tcl_UtfToExternal,objc,objv); } return TCL_OK; } @@ -3294,7 +3282,7 @@ TestlinkCmd( } flag = writable ? 0 : TCL_LINK_READ_ONLY; if (Tcl_LinkVar(interp, "wide", &wideVar, - TCL_LINK_WIDE_INT | flag) != TCL_OK) { + TCL_LINK_WIDE_INT | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[7], &writable) != TCL_OK) { @@ -3688,12 +3676,12 @@ TestlinkCmd( static int TestlinkarrayCmd( TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *LinkOption[] = { - "update", "remove", "create", NULL + "update", "remove", "create", NULL }; enum LinkOptionEnum { LINK_UPDATE, LINK_REMOVE, LINK_CREATE }; static const char *LinkType[] = { @@ -3891,10 +3879,10 @@ TestlistrepCmd( ListObjGetRep(objv[2], &listRep); listRepObjs[0] = Tcl_NewStringObj("store", -1); listRepObjs[1] = Tcl_NewListObj(12, NULL); - Tcl_ListObjAppendElement( - interp, listRepObjs[1], Tcl_NewStringObj("memoryAddress", -1)); - Tcl_ListObjAppendElement( - interp, listRepObjs[1], Tcl_ObjPrintf("%p", listRep.storePtr)); + Tcl_ListObjAppendElement(interp, listRepObjs[1], + Tcl_NewStringObj("memoryAddress", -1)); + Tcl_ListObjAppendElement(interp, listRepObjs[1], + Tcl_ObjPrintf("%p", listRep.storePtr)); APPEND_FIELD(listRepObjs[1], listRep.storePtr, firstUsed); APPEND_FIELD(listRepObjs[1], listRep.storePtr, numUsed); APPEND_FIELD(listRepObjs[1], listRep.storePtr, numAllocated); @@ -3903,14 +3891,12 @@ TestlistrepCmd( if (listRep.spanPtr) { listRepObjs[2] = Tcl_NewStringObj("span", -1); listRepObjs[3] = Tcl_NewListObj(8, NULL); - Tcl_ListObjAppendElement(interp, - listRepObjs[3], - Tcl_NewStringObj("memoryAddress", -1)); - Tcl_ListObjAppendElement( - interp, listRepObjs[3], Tcl_ObjPrintf("%p", listRep.spanPtr)); + Tcl_ListObjAppendElement(interp, listRepObjs[3], + Tcl_NewStringObj("memoryAddress", -1)); + Tcl_ListObjAppendElement(interp, listRepObjs[3], + Tcl_ObjPrintf("%p", listRep.spanPtr)); APPEND_FIELD(listRepObjs[3], listRep.spanPtr, spanStart); - APPEND_FIELD( - listRepObjs[3], listRep.spanPtr, spanLength); + APPEND_FIELD(listRepObjs[3], listRep.spanPtr, spanLength); APPEND_FIELD(listRepObjs[3], listRep.spanPtr, refCount); } resultObj = Tcl_NewListObj(listRep.spanPtr ? 4 : 2, listRepObjs); @@ -4613,7 +4599,7 @@ TestregexpObjCmd( * instead of the first character after the match. */ - if (end >= 0) { + if (end != TCL_INDEX_NONE) { end--; } @@ -5742,6 +5728,7 @@ TestbytestringObjCmd( if (p == NULL) { return TCL_ERROR; } + if (x.m != 1) { Tcl_AppendResult(interp, "Tcl_GetBytesFromObj() overwrites variable", (void *)NULL); return TCL_ERROR; @@ -6440,19 +6427,19 @@ TestChannelCmd( } if ((cmdName[0] == 'm') && (strncmp(cmdName, "mremove-rd", len) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (void *)NULL); - return TCL_ERROR; - } + if (argc != 3) { + Tcl_AppendResult(interp, "channel name required", (void *)NULL); + return TCL_ERROR; + } return Tcl_RemoveChannelMode(interp, chan, TCL_READABLE); } if ((cmdName[0] == 'm') && (strncmp(cmdName, "mremove-wr", len) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (void *)NULL); - return TCL_ERROR; - } + if (argc != 3) { + Tcl_AppendResult(interp, "channel name required", (void *)NULL); + return TCL_ERROR; + } return Tcl_RemoveChannelMode(interp, chan, TCL_WRITABLE); } @@ -6880,39 +6867,39 @@ TestSocketCmd( len = strlen(cmdName); if ((cmdName[0] == 't') && (strncmp(cmdName, "testflags", len) == 0)) { - Tcl_Channel hChannel; - int modePtr; - int testMode; - TcpState *statePtr; - /* Set test value in the socket driver - */ - /* Check for argument "channel name" - */ - if (argc < 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " testflags channel flags\"", (void *)NULL); - return TCL_ERROR; - } - hChannel = Tcl_GetChannel(interp, argv[2], &modePtr); - if ( NULL == hChannel ) { - Tcl_AppendResult(interp, "unknown channel:", argv[2], (void *)NULL); - return TCL_ERROR; - } - statePtr = (TcpState *)Tcl_GetChannelInstanceData(hChannel); - if ( NULL == statePtr) { - Tcl_AppendResult(interp, "No channel instance data:", argv[2], - (void *)NULL); - return TCL_ERROR; - } - if (Tcl_GetBoolean(interp, argv[3], &testMode) != TCL_OK) { - return TCL_ERROR; - } - if (testMode) { - statePtr->flags |= TCP_ASYNC_TEST_MODE; - } else { - statePtr->flags &= ~TCP_ASYNC_TEST_MODE; - } - return TCL_OK; + Tcl_Channel hChannel; + int modePtr; + int testMode; + TcpState *statePtr; + /* Set test value in the socket driver + */ + /* Check for argument "channel name" + */ + if (argc < 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " testflags channel flags\"", (void *)NULL); + return TCL_ERROR; + } + hChannel = Tcl_GetChannel(interp, argv[2], &modePtr); + if ( NULL == hChannel ) { + Tcl_AppendResult(interp, "unknown channel:", argv[2], (void *)NULL); + return TCL_ERROR; + } + statePtr = (TcpState *)Tcl_GetChannelInstanceData(hChannel); + if ( NULL == statePtr) { + Tcl_AppendResult(interp, "No channel instance data:", argv[2], + (void *)NULL); + return TCL_ERROR; + } + if (Tcl_GetBoolean(interp, argv[3], &testMode) != TCL_OK) { + return TCL_ERROR; + } + if (testMode) { + statePtr->flags |= TCP_ASYNC_TEST_MODE; + } else { + statePtr->flags &= ~TCP_ASYNC_TEST_MODE; + } + return TCL_OK; } Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be " @@ -6949,20 +6936,20 @@ TestServiceModeCmd( { int newmode, oldmode; if (argc > 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ?newmode?\"", (void *)NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " ?newmode?\"", (void *)NULL); + return TCL_ERROR; } oldmode = (Tcl_GetServiceMode() != TCL_SERVICE_NONE); if (argc == 2) { - if (Tcl_GetInt(interp, argv[1], &newmode) == TCL_ERROR) { - return TCL_ERROR; - } - if (newmode == 0) { - Tcl_SetServiceMode(TCL_SERVICE_NONE); - } else { - Tcl_SetServiceMode(TCL_SERVICE_ALL); - } + if (Tcl_GetInt(interp, argv[1], &newmode) == TCL_ERROR) { + return TCL_ERROR; + } + if (newmode == 0) { + Tcl_SetServiceMode(TCL_SERVICE_NONE); + } else { + Tcl_SetServiceMode(TCL_SERVICE_ALL); + } } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(oldmode)); return TCL_OK; @@ -7714,7 +7701,7 @@ TestUtfPrevCmd( if (TCL_OK != Tcl_GetIntForIndex(interp, objv[2], numBytes, &offset)) { return TCL_ERROR; } - if (offset < 0) { + if (offset == TCL_INDEX_NONE) { offset = 0; } if (offset > numBytes) { @@ -8043,20 +8030,20 @@ NREUnwind_callback( void *cStackPtr = TclGetCStackPtr(); if (data[0] == INT2PTR(-1)) { - Tcl_NRAddCallback(interp, NREUnwind_callback, cStackPtr, INT2PTR(-1), - INT2PTR(-1), NULL); + Tcl_NRAddCallback(interp, NREUnwind_callback, cStackPtr, INT2PTR(-1), + INT2PTR(-1), NULL); } else if (data[1] == INT2PTR(-1)) { - Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], cStackPtr, - INT2PTR(-1), NULL); + Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], cStackPtr, + INT2PTR(-1), NULL); } else if (data[2] == INT2PTR(-1)) { - Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], data[1], - cStackPtr, NULL); + Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], data[1], + cStackPtr, NULL); } else { - Tcl_Obj *idata[3]; - idata[0] = Tcl_NewWideIntObj(((char *) data[1] - (char *) data[0])); - idata[1] = Tcl_NewWideIntObj(((char *) data[2] - (char *) data[0])); - idata[2] = Tcl_NewWideIntObj(((char *) cStackPtr - (char *) data[0])); - Tcl_SetObjResult(interp, Tcl_NewListObj(3, idata)); + Tcl_Obj *idata[3]; + idata[0] = Tcl_NewWideIntObj(((char *) data[1] - (char *) data[0])); + idata[1] = Tcl_NewWideIntObj(((char *) data[2] - (char *) data[0])); + idata[2] = Tcl_NewWideIntObj(((char *) cStackPtr - (char *) data[0])); + Tcl_SetObjResult(interp, Tcl_NewListObj(3, idata)); } return TCL_OK; } @@ -8074,7 +8061,7 @@ TestNREUnwind( */ Tcl_NRAddCallback(interp, NREUnwind_callback, INT2PTR(-1), INT2PTR(-1), - INT2PTR(-1), NULL); + INT2PTR(-1), NULL); return TCL_OK; } @@ -8438,13 +8425,13 @@ TestparseargsCmd( Tcl_Size count = objc; Tcl_Obj **remObjv, *result[3]; const Tcl_ArgvInfo argTable[] = { - {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL}, - TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END + {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL}, + TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END }; foo = 0; if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } result[0] = Tcl_NewWideIntObj(foo); result[1] = Tcl_NewWideIntObj(count); @@ -8469,7 +8456,7 @@ InterpCmdResolver( Interp *iPtr = (Interp *) interp; CallFrame *varFramePtr = iPtr->varFramePtr; Proc *procPtr = (varFramePtr->isProcCallFrame & FRAME_IS_PROC) ? - varFramePtr->procPtr : NULL; + varFramePtr->procPtr : NULL; Namespace *callerNsPtr = varFramePtr->nsPtr; Tcl_Command resolvedCmdPtr = NULL; @@ -8479,74 +8466,74 @@ InterpCmdResolver( * B) the caller's namespace is "ctx1" or "ctx2" */ if ( (name[0] == 'z') && (name[1] == '\0') ) { - Namespace *ns2NsPtr = (Namespace *) Tcl_FindNamespace(interp, "::ns2", NULL, 0); - - if (procPtr != NULL - && ((procPtr->cmdPtr->nsPtr == iPtr->globalNsPtr) - || (ns2NsPtr != NULL && procPtr->cmdPtr->nsPtr == ns2NsPtr) - ) - ) { - /* - * Case A) - * - * - The context, in which this resolver becomes active, is - * determined by the name of the caller proc, which has to be - * named "x". - * - * - To determine the name of the caller proc, the proc is taken - * from the topmost stack frame. - * - * - Note that the context is NOT provided during byte-code - * compilation (e.g. in TclProcCompileProc) - * - * When these conditions hold, this function resolves the - * passed-in cmd literal into a cmd "y", which is taken from the - * the global namespace (for simplicity). - */ - - const char *callingCmdName = - Tcl_GetCommandName(interp, (Tcl_Command) procPtr->cmdPtr); - - if ( callingCmdName[0] == 'x' && callingCmdName[1] == '\0' ) { - resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY); - } - } else if (callerNsPtr != NULL) { - /* - * Case B) - * - * - The context, in which this resolver becomes active, is - * determined by the name of the parent namespace, which has - * to be named "ctx1" or "ctx2". - * - * - To determine the name of the parent namesace, it is taken - * from the 2nd highest stack frame. - * - * - Note that the context can be provided during byte-code - * compilation (e.g. in TclProcCompileProc) - * - * When these conditions hold, this function resolves the - * passed-in cmd literal into a cmd "y" or "Y" depending on the - * context. The resolved procs are taken from the the global - * namespace (for simplicity). - */ - - CallFrame *parentFramePtr = varFramePtr->callerPtr; - const char *context = parentFramePtr != NULL ? parentFramePtr->nsPtr->name : "(NULL)"; - - if (strcmp(context, "ctx1") == 0 && (name[0] == 'z') && (name[1] == '\0')) { - resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY); - /* fprintf(stderr, "... y ==> %p\n", resolvedCmdPtr);*/ - - } else if (strcmp(context, "ctx2") == 0 && (name[0] == 'z') && (name[1] == '\0')) { - resolvedCmdPtr = Tcl_FindCommand(interp, "Y", NULL, TCL_GLOBAL_ONLY); - /*fprintf(stderr, "... Y ==> %p\n", resolvedCmdPtr);*/ - } - } - - if (resolvedCmdPtr != NULL) { - *rPtr = resolvedCmdPtr; - return TCL_OK; - } + Namespace *ns2NsPtr = (Namespace *) Tcl_FindNamespace(interp, "::ns2", NULL, 0); + + if (procPtr != NULL + && ((procPtr->cmdPtr->nsPtr == iPtr->globalNsPtr) + || (ns2NsPtr != NULL && procPtr->cmdPtr->nsPtr == ns2NsPtr) + ) + ) { + /* + * Case A) + * + * - The context, in which this resolver becomes active, is + * determined by the name of the caller proc, which has to be + * named "x". + * + * - To determine the name of the caller proc, the proc is taken + * from the topmost stack frame. + * + * - Note that the context is NOT provided during byte-code + * compilation (e.g. in TclProcCompileProc) + * + * When these conditions hold, this function resolves the + * passed-in cmd literal into a cmd "y", which is taken from the + * the global namespace (for simplicity). + */ + + const char *callingCmdName = + Tcl_GetCommandName(interp, (Tcl_Command) procPtr->cmdPtr); + + if ( callingCmdName[0] == 'x' && callingCmdName[1] == '\0' ) { + resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY); + } + } else if (callerNsPtr != NULL) { + /* + * Case B) + * + * - The context, in which this resolver becomes active, is + * determined by the name of the parent namespace, which has + * to be named "ctx1" or "ctx2". + * + * - To determine the name of the parent namesace, it is taken + * from the 2nd highest stack frame. + * + * - Note that the context can be provided during byte-code + * compilation (e.g. in TclProcCompileProc) + * + * When these conditions hold, this function resolves the + * passed-in cmd literal into a cmd "y" or "Y" depending on the + * context. The resolved procs are taken from the the global + * namespace (for simplicity). + */ + + CallFrame *parentFramePtr = varFramePtr->callerPtr; + const char *context = parentFramePtr != NULL ? parentFramePtr->nsPtr->name : "(NULL)"; + + if (strcmp(context, "ctx1") == 0 && (name[0] == 'z') && (name[1] == '\0')) { + resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY); + /* fprintf(stderr, "... y ==> %p\n", resolvedCmdPtr);*/ + + } else if (strcmp(context, "ctx2") == 0 && (name[0] == 'z') && (name[1] == '\0')) { + resolvedCmdPtr = Tcl_FindCommand(interp, "Y", NULL, TCL_GLOBAL_ONLY); + /*fprintf(stderr, "... Y ==> %p\n", resolvedCmdPtr);*/ + } + } + + if (resolvedCmdPtr != NULL) { + *rPtr = resolvedCmdPtr; + return TCL_OK; + } } return TCL_CONTINUE; } @@ -8577,9 +8564,9 @@ HashVarFree( Tcl_Var var) { if (VarHashRefCount(var) < 2) { - ckfree(var); + ckfree(var); } else { - VarHashRefCount(var)--; + VarHashRefCount(var)--; } } @@ -8591,7 +8578,7 @@ MyCompiledVarFree( Tcl_DecrRefCount(resVarInfo->nameObj); if (resVarInfo->var) { - HashVarFree(resVarInfo->var); + HashVarFree(resVarInfo->var); } ckfree(vInfoPtr); } @@ -8611,27 +8598,27 @@ MyCompiledVarFetch( Tcl_HashEntry *hPtr; if (var != NULL) { - if (!(((Var *) var)->flags & VAR_DEAD_HASH)) { - /* - * The cached variable is valid, return it. - */ + if (!(((Var *) var)->flags & VAR_DEAD_HASH)) { + /* + * The cached variable is valid, return it. + */ - return var; - } + return var; + } - /* - * The variable is not valid anymore. Clean it up. - */ + /* + * The variable is not valid anymore. Clean it up. + */ - HashVarFree(var); + HashVarFree(var); } hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) &iPtr->globalNsPtr->varTable, - (char *)resVarInfo->nameObj, &isNewVar); + resVarInfo->nameObj, &isNewVar); if (hPtr) { - var = (Tcl_Var) TclVarHashGetValue(hPtr); + var = (Tcl_Var) TclVarHashGetValue(hPtr); } else { - var = NULL; + var = NULL; } resVarInfo->var = var; @@ -8674,7 +8661,7 @@ TestInterpResolverCmd( Tcl_Obj *const objv[]) { static const char *const table[] = { - "down", "up", NULL + "down", "up", NULL }; int idx; #define RESOLVER_KEY "testInterpResolver" @@ -8691,20 +8678,20 @@ TestInterpResolverCmd( } } if (Tcl_GetIndexFromObj(interp, objv[1], table, "operation", TCL_EXACT, - &idx) != TCL_OK) { - return TCL_ERROR; + &idx) != TCL_OK) { + return TCL_ERROR; } switch (idx) { case 1: /* up */ - Tcl_AddInterpResolvers(interp, RESOLVER_KEY, InterpCmdResolver, - InterpVarResolver, InterpCompiledVarResolver); - break; + Tcl_AddInterpResolvers(interp, RESOLVER_KEY, InterpCmdResolver, + InterpVarResolver, InterpCompiledVarResolver); + break; case 0: /*down*/ - if (!Tcl_RemoveInterpResolvers(interp, RESOLVER_KEY)) { - Tcl_AppendResult(interp, "could not remove the resolver scheme", - (void *)NULL); - return TCL_ERROR; - } + if (!Tcl_RemoveInterpResolvers(interp, RESOLVER_KEY)) { + Tcl_AppendResult(interp, "could not remove the resolver scheme", + (void *)NULL); + return TCL_ERROR; + } } return TCL_OK; } diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 9f31cff..8a9dc7b 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -13,6 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ + #undef BUILD_tcl #ifndef USE_TCL_STUBS # define USE_TCL_STUBS @@ -54,17 +55,24 @@ static Tcl_ObjCmdProc TeststringobjCmd; #define VARPTR_KEY "TCLOBJTEST_VARPTR" #define NUMBER_OF_OBJECT_VARS 20 -static void VarPtrDeleteProc(void *clientData, TCL_UNUSED(Tcl_Interp *)) +static void +VarPtrDeleteProc( + void *clientData, + TCL_UNUSED(Tcl_Interp *)) { int i; Tcl_Obj **varPtr = (Tcl_Obj **) clientData; for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) { - if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]); + if (varPtr[i]) { + Tcl_DecrRefCount(varPtr[i]); + } } ckfree(varPtr); } -static Tcl_Obj **GetVarPtr(Tcl_Interp *interp) +static Tcl_Obj ** +GetVarPtr( + Tcl_Interp *interp) { Tcl_InterpDeleteProc *proc; @@ -408,7 +416,7 @@ TestbooleanobjCmd( return TCL_ERROR; } if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex], - &boolValue) != TCL_OK) { + &boolValue) != TCL_OK) { return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { @@ -508,7 +516,7 @@ TestdoubleobjCmd( return TCL_ERROR; } if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex], - &doubleValue) != TCL_OK) { + &doubleValue) != TCL_OK) { return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { @@ -947,7 +955,7 @@ TestlistobjCmd( case LISTOBJ_REPLACE: if (objc < 5) { Tcl_WrongNumArgs(interp, 2, objv, - "varIndex start count ?element...?"); + "varIndex start count ?element...?"); return TCL_ERROR; } if (Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &first) != TCL_OK @@ -959,7 +967,7 @@ TestlistobjCmd( } Tcl_ResetResult(interp); return Tcl_ListObjReplace(interp, varPtr[varIndex], first, count, - objc-5, objv+5); + objc-5, objv+5); case LISTOBJ_INDEXMEMCHECK: if (objc != 3) { @@ -1016,8 +1024,7 @@ TestlistobjCmd( * Hence this explicit test. */ if (objc != 4) { - Tcl_WrongNumArgs(interp, 2, objv, - "varIndex listIndex"); + Tcl_WrongNumArgs(interp, 2, objv, "varIndex listIndex"); return TCL_ERROR; } if (Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &first) != TCL_OK) { diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c index 2139b81..a86499e 100644 --- a/generic/tclTestProcBodyObj.c +++ b/generic/tclTestProcBodyObj.c @@ -146,7 +146,7 @@ RegisterCommand( if (cmdTablePtr->exportIt) { snprintf(buf, sizeof(buf), "namespace eval %s { namespace export %s }", namesp, cmdTablePtr->cmdName); - if (Tcl_EvalEx(interp, buf, -1, 0) != TCL_OK) { + if (Tcl_EvalEx(interp, buf, TCL_INDEX_NONE, 0) != TCL_OK) { return TCL_ERROR; } } diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index eb40b3b..3ff3d24 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -202,8 +202,8 @@ TclMacOSXGetFileAttribute( return TCL_OK; #else Tcl_SetObjResult(interp, Tcl_NewStringObj( - "Mac OS X file attributes not supported", -1)); - Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (void *)NULL); + "Mac OS X file attributes not supported", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (char *)NULL); return TCL_ERROR; #endif /* HAVE_GETATTRLIST */ } @@ -334,8 +334,8 @@ TclMacOSXSetFileAttribute( if (newRsrcForkSize != 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "setting nonzero rsrclength not supported", -1)); - Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (void *)NULL); + "setting nonzero rsrclength not supported", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (char *)NULL); return TCL_ERROR; } @@ -375,8 +375,8 @@ TclMacOSXSetFileAttribute( return TCL_OK; #else Tcl_SetObjResult(interp, Tcl_NewStringObj( - "Mac OS X file attributes not supported", -1)); - Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (void *)NULL); + "Mac OS X file attributes not supported", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (char *)NULL); return TCL_ERROR; #endif } @@ -639,15 +639,16 @@ SetOSTypeFromAny( int result = TCL_OK; Tcl_DString ds; Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman"); + Tcl_Size length; - string = TclGetString(objPtr); - Tcl_UtfToExternalDString(encoding, string, objPtr->length, &ds); + 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", (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "MAC_OSTYPE", (char *)NULL); } result = TCL_ERROR; } else { diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index 515f234..2358d06 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -102,7 +102,7 @@ TclplatformtestInit( Tcl_CreateObjCommand(interp, "testfindexecutable", TestfindexecutableCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfork", TestforkCmd, - NULL, NULL); + NULL, NULL); Tcl_CreateObjCommand(interp, "testalarm", TestalarmCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testgotsig", TestgotsigCmd, @@ -154,7 +154,7 @@ TestfilehandlerCmd( if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ..."); - return TCL_ERROR; + return TCL_ERROR; } pipePtr = NULL; if (objc >= 3) { @@ -162,7 +162,7 @@ TestfilehandlerCmd( return TCL_ERROR; } if (i >= MAX_PIPES) { - Tcl_AppendResult(interp, "bad index ", objv[2], (void *)NULL); + Tcl_AppendResult(interp, "bad index ", objv[2], (char *)NULL); return TCL_ERROR; } pipePtr = &testPipes[i]; @@ -191,7 +191,7 @@ TestfilehandlerCmd( return TCL_ERROR; } snprintf(buf, sizeof(buf), "%d %d", pipePtr->readCount, pipePtr->writeCount); - Tcl_AppendResult(interp, buf, (void *)NULL); + Tcl_AppendResult(interp, buf, (char *)NULL); } else if (strcmp(Tcl_GetString(objv[1]), "create") == 0) { if (objc != 5) { Tcl_WrongNumArgs(interp, 2, objv, "index readMode writeMode"); @@ -200,7 +200,7 @@ TestfilehandlerCmd( if (pipePtr->readFile == NULL) { if (!TclpCreatePipe(&pipePtr->readFile, &pipePtr->writeFile)) { Tcl_AppendResult(interp, "couldn't open pipe: ", - Tcl_PosixError(interp), (void *)NULL); + Tcl_PosixError(interp), (char *)NULL); return TCL_ERROR; } #ifdef O_NONBLOCK @@ -208,7 +208,7 @@ TestfilehandlerCmd( fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK); #else Tcl_AppendResult(interp, "can't make pipes non-blocking", - (void *)NULL); + (char *)NULL); return TCL_ERROR; #endif } @@ -224,7 +224,7 @@ TestfilehandlerCmd( Tcl_CreateFileHandler(GetFd(pipePtr->readFile), 0, TestFileHandlerProc, pipePtr); } else { - Tcl_AppendResult(interp, "bad read mode \"", Tcl_GetString(objv[3]), "\"", (void *)NULL); + Tcl_AppendResult(interp, "bad read mode \"", Tcl_GetString(objv[3]), "\"", (char *)NULL); return TCL_ERROR; } if (strcmp(Tcl_GetString(objv[4]), "writable") == 0) { @@ -236,7 +236,7 @@ TestfilehandlerCmd( Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), 0, TestFileHandlerProc, pipePtr); } else { - Tcl_AppendResult(interp, "bad read mode \"", Tcl_GetString(objv[4]), "\"", (void *)NULL); + Tcl_AppendResult(interp, "bad read mode \"", Tcl_GetString(objv[4]), "\"", (char *)NULL); return TCL_ERROR; } } else if (strcmp(Tcl_GetString(objv[1]), "empty") == 0) { @@ -245,9 +245,9 @@ TestfilehandlerCmd( return TCL_ERROR; } - while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) { + while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) { /* Empty loop body. */ - } + } } else if (strcmp(Tcl_GetString(objv[1]), "fill") == 0) { if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "index"); @@ -268,7 +268,7 @@ TestfilehandlerCmd( memset(buffer, 'b', 10); TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10)); - Tcl_AppendResult(interp, buf, (void *)NULL); + Tcl_AppendResult(interp, buf, (char *)NULL); } else if (strcmp(Tcl_GetString(objv[1]), "oneevent") == 0) { Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT); } else if (strcmp(Tcl_GetString(objv[1]), "wait") == 0) { @@ -277,7 +277,7 @@ TestfilehandlerCmd( return TCL_ERROR; } if (pipePtr->readFile == NULL) { - Tcl_AppendResult(interp, "pipe ", Tcl_GetString(objv[2]), " doesn't exist", (void *)NULL); + Tcl_AppendResult(interp, "pipe ", Tcl_GetString(objv[2]), " doesn't exist", (char *)NULL); return TCL_ERROR; } if (strcmp(Tcl_GetString(objv[3]), "readable") == 0) { @@ -302,7 +302,7 @@ TestfilehandlerCmd( } else { Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), "\": must be close, clear, counts, create, empty, fill, " - "fillpartial, oneevent, wait, or windowevent", (void *)NULL); + "fillpartial, oneevent, wait, or windowevent", (char *)NULL); return TCL_ERROR; } return TCL_OK; @@ -369,13 +369,13 @@ TestfilewaitCmd( mask = TCL_WRITABLE|TCL_READABLE; } else { Tcl_AppendResult(interp, "bad argument \"", Tcl_GetString(objv[2]), - "\": must be readable, writable, or both", (void *)NULL); + "\": must be readable, writable, or both", (char *)NULL); return TCL_ERROR; } if (Tcl_GetChannelHandle(channel, (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE, (void **) &data) != TCL_OK) { - Tcl_AppendResult(interp, "couldn't get channel file", (void *)NULL); + Tcl_AppendResult(interp, "couldn't get channel file", (char *)NULL); return TCL_ERROR; } fd = PTR2INT(data); @@ -461,14 +461,14 @@ TestforkCmd( pid_t pid; if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, ""); - return TCL_ERROR; + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; } pid = fork(); if (pid == -1) { - Tcl_AppendResult(interp, - "Cannot fork", (void *)NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, + "Cannot fork", (char *)NULL); + return TCL_ERROR; } /* Only needed when pthread_atfork is not present, * should not hurt otherwise. */ @@ -518,11 +518,11 @@ TestalarmCmd( */ action.sa_handler = AlarmHandler; - memset((void *) &action.sa_mask, 0, sizeof(sigset_t)); + memset((void *)&action.sa_mask, 0, sizeof(sigset_t)); action.sa_flags = SA_RESTART; if (sigaction(SIGALRM, &action, NULL) < 0) { - Tcl_AppendResult(interp, "sigaction: ", Tcl_PosixError(interp), (void *)NULL); + Tcl_AppendResult(interp, "sigaction: ", Tcl_PosixError(interp), (char *)NULL); return TCL_ERROR; } (void) alarm(sec); @@ -531,7 +531,7 @@ TestalarmCmd( Tcl_AppendResult(interp, "warning: sigaction SA_RESTART not support on this platform", - (void *)NULL); + (char *)NULL); return TCL_ERROR; #endif } @@ -582,7 +582,7 @@ TestgotsigCmd( TCL_UNUSED(int) /*objc*/, TCL_UNUSED(Tcl_Obj *const *)) { - Tcl_AppendResult(interp, gotsig, (void *)NULL); + Tcl_AppendResult(interp, gotsig, (char *)NULL); gotsig = "0"; return TCL_OK; } @@ -634,7 +634,7 @@ TestchmodCmd( } if (chmod(translated, mode) != 0) { Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp), - (void *)NULL); + (char *)NULL); return TCL_ERROR; } Tcl_DStringFree(&buffer); -- cgit v0.12 From 2a73478b44cda0664382a2ab4c1468930053c770 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 22 Mar 2024 13:06:51 +0000 Subject: Add more testcases, 0-measurement of current behavior. integervalueTooLarge -> dateTooLarge. --- library/clock.tcl | 2 +- tests/clock.test | 24 ++++++++++++++++++++---- 2 files changed, 21 insertions(+), 5 deletions(-) diff --git a/library/clock.tcl b/library/clock.tcl index b468fea..d80fb2f 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -2683,7 +2683,7 @@ proc ::tcl::clock::ScanWide { str } { "\"$str\" is not an integer" } if { [incr result 0] != $str } { - return -code error -errorcode [list CLOCK integervalueTooLarge] \ + return -code error -errorcode [list CLOCK dateTooLarge] \ "integer value too large to represent" } return $result diff --git a/tests/clock.test b/tests/clock.test index 189b83a..b75237e 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18532,12 +18532,28 @@ test clock-6.8 {input of seconds} { } 9223372036854775807 test clock-6.9 {input of seconds - overflow} { - list [catch {clock scan -9223372036854775809 -format %s -gmt true} result] $result -} {1 {integer value too large to represent}} + list [catch {clock scan -9223372036854775809 -format %s -gmt true} result] $result $::errorCode +} {1 {integer value too large to represent} {CLOCK dateTooLarge}} test clock-6.10 {input of seconds - overflow} { - list [catch {clock scan 9223372036854775808 -format %s -gmt true} result] $result -} {1 {integer value too large to represent}} + list [catch {clock scan 9223372036854775808 -format %s -gmt true} result] $result $::errorCode +} {1 {integer value too large to represent} {CLOCK dateTooLarge}} + +test clock-6.10a {input of seconds - overflow, bug [1f40aa83c5]} { + list [catch {clock scan 27670116110564327423 -format %s -gmt true} result] $result $::errorCode +} {1 {integer value too large to represent} {CLOCK dateTooLarge}} + +test clock-6.10b {input of seconds - overflow ??, bug [1f40aa83c5]} { + clock scan 27670116110564327423 -gmt true +} 89170590268800 + +test clock-6.10c {input of seconds - overflow, bug [1f40aa83c5]} { + list [catch {clock scan 27670116110564327424 -format %s -gmt true} result] $result $::errorCode +} {1 {integer value too large to represent} {CLOCK dateTooLarge}} + +test clock-6.10d {input of seconds - overflow ??, bug [1f40aa83c5]} { + clock scan 27670116110564327424 -gmt true +} -90247104115200 test clock-6.11 {input of seconds - two values} { clock scan {1 2} -format {%s %s} -gmt true -- cgit v0.12 From 28573421f8d41f2919af73492bcf0b09ba499470 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 22 Mar 2024 13:41:36 +0000 Subject: Mark clock-6.10b/clock-6.10d as "knownBug": Those testcases crash with CFLAGS=-ftrapv, even with current clock code. --- tests/clock.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index b75237e..7cb86a3 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18543,7 +18543,7 @@ test clock-6.10a {input of seconds - overflow, bug [1f40aa83c5]} { list [catch {clock scan 27670116110564327423 -format %s -gmt true} result] $result $::errorCode } {1 {integer value too large to represent} {CLOCK dateTooLarge}} -test clock-6.10b {input of seconds - overflow ??, bug [1f40aa83c5]} { +test clock-6.10b {input of seconds - overflow ??, bug [1f40aa83c5]} knownBug { clock scan 27670116110564327423 -gmt true } 89170590268800 @@ -18551,7 +18551,7 @@ test clock-6.10c {input of seconds - overflow, bug [1f40aa83c5]} { list [catch {clock scan 27670116110564327424 -format %s -gmt true} result] $result $::errorCode } {1 {integer value too large to represent} {CLOCK dateTooLarge}} -test clock-6.10d {input of seconds - overflow ??, bug [1f40aa83c5]} { +test clock-6.10d {input of seconds - overflow ??, bug [1f40aa83c5]} knownBug { clock scan 27670116110564327424 -gmt true } -90247104115200 -- cgit v0.12