From 1438a1b7f7a2fa985d02d45337bd9e98c901ee11 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 12 May 2016 19:44:41 +0000 Subject: Remove the nsPtr field from the EnsembleCmdRep struct. Cannot see any justification for keeping it (can get via token), and test suite doesn't care. --- generic/tclEnsemble.c | 9 +-------- generic/tclInt.h | 2 -- 2 files changed, 1 insertion(+), 10 deletions(-) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 986a553..ecf10ff 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -1707,8 +1707,7 @@ NsEnsembleImplementationCmdNR( EnsembleCmdRep *ensembleCmd = objv[1+ensemblePtr->numParameters] ->internalRep.twoPtrValue.ptr1; - if (ensembleCmd->nsPtr == ensemblePtr->nsPtr && - ensembleCmd->epoch == ensemblePtr->epoch && + if (ensembleCmd->epoch == ensemblePtr->epoch && ensembleCmd->token == ensemblePtr->token) { prefixObj = ensembleCmd->realPrefixObj; Tcl_IncrRefCount(prefixObj); @@ -2227,7 +2226,6 @@ MakeCachedEnsembleCommand( if (objPtr->typePtr == &tclEnsembleCmdType) { ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1; Tcl_DecrRefCount(ensembleCmd->realPrefixObj); - TclNsDecrRefCount(ensembleCmd->nsPtr); ckfree(ensembleCmd->fullSubcmdName); } else { /* @@ -2245,10 +2243,8 @@ MakeCachedEnsembleCommand( * Populate the internal rep. */ - ensembleCmd->nsPtr = ensemblePtr->nsPtr; ensembleCmd->epoch = ensemblePtr->epoch; ensembleCmd->token = ensemblePtr->token; - ensemblePtr->nsPtr->refCount++; ensembleCmd->realPrefixObj = prefixObjPtr; length = strlen(subcommandName)+1; ensembleCmd->fullSubcmdName = ckalloc(length); @@ -2636,7 +2632,6 @@ FreeEnsembleCmdRep( Tcl_DecrRefCount(ensembleCmd->realPrefixObj); ckfree(ensembleCmd->fullSubcmdName); - TclNsDecrRefCount(ensembleCmd->nsPtr); ckfree(ensembleCmd); objPtr->typePtr = NULL; } @@ -2670,10 +2665,8 @@ DupEnsembleCmdRep( copyPtr->typePtr = &tclEnsembleCmdType; copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy; - ensembleCopy->nsPtr = ensembleCmd->nsPtr; ensembleCopy->epoch = ensembleCmd->epoch; ensembleCopy->token = ensembleCmd->token; - ensembleCopy->nsPtr->refCount++; ensembleCopy->realPrefixObj = ensembleCmd->realPrefixObj; Tcl_IncrRefCount(ensembleCopy->realPrefixObj); ensembleCopy->fullSubcmdName = ckalloc(length + 1); diff --git a/generic/tclInt.h b/generic/tclInt.h index 42c13dd..e00c392 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -395,8 +395,6 @@ struct NamespacePathEntry { */ typedef struct { - Namespace *nsPtr; /* The namespace backing the ensemble which - * this is a subcommand of. */ int epoch; /* Used to confirm when the data in this * really structure matches up with the * ensemble. */ -- cgit v0.12 From 76f6131b819bc1430e3465195a6ed90b78c71dad Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 12 May 2016 19:49:06 +0000 Subject: The "ensembleCommand" Tcl_ObjType has no need for an UpdateString routine. It is entirely a caching type. No "pure" value can exist. --- generic/tclEnsemble.c | 32 +------------------------------- 1 file changed, 1 insertion(+), 31 deletions(-) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index ecf10ff..ead96a3 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -34,7 +34,6 @@ static void MakeCachedEnsembleCommand(Tcl_Obj *objPtr, const char *subcmdName, Tcl_Obj *prefixObjPtr); static void FreeEnsembleCmdRep(Tcl_Obj *objPtr); static void DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); -static void StringOfEnsembleCmdRep(Tcl_Obj *objPtr); static void CompileToInvokedCommand(Tcl_Interp *interp, Tcl_Parse *parsePtr, Tcl_Obj *replacements, Command *cmdPtr, CompileEnv *envPtr); @@ -81,7 +80,7 @@ const Tcl_ObjType tclEnsembleCmdType = { "ensembleCommand", /* the type's name */ FreeEnsembleCmdRep, /* freeIntRepProc */ DupEnsembleCmdRep, /* dupIntRepProc */ - StringOfEnsembleCmdRep, /* updateStringProc */ + NULL, /* updateStringProc */ NULL /* setFromAnyProc */ }; @@ -2677,35 +2676,6 @@ DupEnsembleCmdRep( /* *---------------------------------------------------------------------- * - * StringOfEnsembleCmdRep -- - * - * Creates a string representation of a Tcl_Obj that holds a subcommand - * of an ensemble. - * - * Results: - * None. - * - * Side effects: - * The object gains a string (UTF-8) representation. - * - *---------------------------------------------------------------------- - */ - -static void -StringOfEnsembleCmdRep( - Tcl_Obj *objPtr) -{ - EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1; - int length = strlen(ensembleCmd->fullSubcmdName); - - objPtr->length = length; - objPtr->bytes = ckalloc(length + 1); - memcpy(objPtr->bytes, ensembleCmd->fullSubcmdName, (unsigned) length+1); -} - -/* - *---------------------------------------------------------------------- - * * TclCompileEnsemble -- * * Procedure called to compile an ensemble command. Note that most -- cgit v0.12 From 76d0eb32fc60d020bd820d306a71680d4830d7ea Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 12 May 2016 20:23:23 +0000 Subject: Don't see why the intrep should make and keep copies of things already stored in the hash table. --- generic/tclEnsemble.c | 37 ++++++++++--------------------------- generic/tclIndexObj.c | 6 ++++-- generic/tclInt.h | 8 +++----- 3 files changed, 17 insertions(+), 34 deletions(-) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index ead96a3..986b7c1 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -30,8 +30,7 @@ static int NsEnsembleStringOrder(const void *strPtr1, const void *strPtr2); static void DeleteEnsembleConfig(ClientData clientData); static void MakeCachedEnsembleCommand(Tcl_Obj *objPtr, - EnsembleConfig *ensemblePtr, - const char *subcmdName, Tcl_Obj *prefixObjPtr); + EnsembleConfig *ensemblePtr, Tcl_HashEntry *hPtr); static void FreeEnsembleCmdRep(Tcl_Obj *objPtr); static void DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void CompileToInvokedCommand(Tcl_Interp *interp, @@ -1708,7 +1707,7 @@ NsEnsembleImplementationCmdNR( if (ensembleCmd->epoch == ensemblePtr->epoch && ensembleCmd->token == ensemblePtr->token) { - prefixObj = ensembleCmd->realPrefixObj; + prefixObj = Tcl_GetHashValue(ensembleCmd->hPtr); Tcl_IncrRefCount(prefixObj); goto runResultingSubcommand; } @@ -1726,16 +1725,13 @@ NsEnsembleImplementationCmdNR( hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable, TclGetString(objv[1 + ensemblePtr->numParameters])); if (hPtr != NULL) { - char *fullName = Tcl_GetHashKey(&ensemblePtr->subcommandTable, hPtr); - - prefixObj = Tcl_GetHashValue(hPtr); /* * Cache for later in the subcommand object. */ MakeCachedEnsembleCommand(objv[1 + ensemblePtr->numParameters], - ensemblePtr, fullName, prefixObj); + ensemblePtr, hPtr); } else if (!(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX)) { /* * Could not map, no prefixing, go to unknown/error handling. @@ -1797,16 +1793,16 @@ NsEnsembleImplementationCmdNR( Tcl_Panic("full name %s not found in supposedly synchronized hash", fullName); } - prefixObj = Tcl_GetHashValue(hPtr); /* * Cache for later in the subcommand object. */ MakeCachedEnsembleCommand(objv[1 + ensemblePtr->numParameters], - ensemblePtr, fullName, prefixObj); + ensemblePtr, hPtr); } + prefixObj = Tcl_GetHashValue(hPtr); Tcl_IncrRefCount(prefixObj); runResultingSubcommand: @@ -2216,16 +2212,12 @@ static void MakeCachedEnsembleCommand( Tcl_Obj *objPtr, EnsembleConfig *ensemblePtr, - const char *subcommandName, - Tcl_Obj *prefixObjPtr) + Tcl_HashEntry *hPtr) { register EnsembleCmdRep *ensembleCmd; - int length; if (objPtr->typePtr == &tclEnsembleCmdType) { ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1; - Tcl_DecrRefCount(ensembleCmd->realPrefixObj); - ckfree(ensembleCmd->fullSubcmdName); } else { /* * Kill the old internal rep, and replace it with a brand new one of @@ -2244,11 +2236,8 @@ MakeCachedEnsembleCommand( ensembleCmd->epoch = ensemblePtr->epoch; ensembleCmd->token = ensemblePtr->token; - ensembleCmd->realPrefixObj = prefixObjPtr; - length = strlen(subcommandName)+1; - ensembleCmd->fullSubcmdName = ckalloc(length); - memcpy(ensembleCmd->fullSubcmdName, subcommandName, (unsigned) length); - Tcl_IncrRefCount(ensembleCmd->realPrefixObj); + ensembleCmd->tablePtr = &ensemblePtr->subcommandTable; + ensembleCmd->hPtr = hPtr; } /* @@ -2629,8 +2618,6 @@ FreeEnsembleCmdRep( { EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1; - Tcl_DecrRefCount(ensembleCmd->realPrefixObj); - ckfree(ensembleCmd->fullSubcmdName); ckfree(ensembleCmd); objPtr->typePtr = NULL; } @@ -2660,17 +2647,13 @@ DupEnsembleCmdRep( { EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1; EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep)); - int length = strlen(ensembleCmd->fullSubcmdName); copyPtr->typePtr = &tclEnsembleCmdType; copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy; ensembleCopy->epoch = ensembleCmd->epoch; ensembleCopy->token = ensembleCmd->token; - ensembleCopy->realPrefixObj = ensembleCmd->realPrefixObj; - Tcl_IncrRefCount(ensembleCopy->realPrefixObj); - ensembleCopy->fullSubcmdName = ckalloc(length + 1); - memcpy(ensembleCopy->fullSubcmdName, ensembleCmd->fullSubcmdName, - (unsigned) length+1); + ensembleCopy->tablePtr = ensembleCmd->tablePtr; + ensembleCopy->hPtr = ensembleCmd->hPtr; } /* diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index ce8b9fb..d01e685 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -961,7 +961,7 @@ Tcl_WrongNumArgs( register EnsembleCmdRep *ecrPtr = origObjv[i]->internalRep.twoPtrValue.ptr1; - elementStr = ecrPtr->fullSubcmdName; + elementStr = Tcl_GetHashKey(ecrPtr->tablePtr, ecrPtr->hPtr); elemLen = strlen(elementStr); } else { elementStr = TclGetStringFromObj(origObjv[i], &elemLen); @@ -1014,8 +1014,10 @@ Tcl_WrongNumArgs( } else if (objv[i]->typePtr == &tclEnsembleCmdType) { register EnsembleCmdRep *ecrPtr = objv[i]->internalRep.twoPtrValue.ptr1; + const char *fullSubcmdName + = Tcl_GetHashKey(ecrPtr->tablePtr, ecrPtr->hPtr); - Tcl_AppendStringsToObj(objPtr, ecrPtr->fullSubcmdName, NULL); + Tcl_AppendStringsToObj(objPtr, fullSubcmdName, NULL); } else { /* * Quote the argument if it contains spaces (Bug 942757). diff --git a/generic/tclInt.h b/generic/tclInt.h index e00c392..48eecce 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -400,11 +400,9 @@ typedef struct { * ensemble. */ Tcl_Command token; /* Reference to the comamnd for which this * structure is a cache of the resolution. */ - char *fullSubcmdName; /* The full (local) name of the subcommand, - * allocated with ckalloc(). */ - Tcl_Obj *realPrefixObj; /* Object containing the prefix words of the - * command that implements this ensemble - * subcommand. */ + Tcl_HashTable *tablePtr; /* The subcommand hash table. */ + Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand + * hash table. */ } EnsembleCmdRep; /* -- cgit v0.12 From c1ce97106f2bcbbcad391621a3617e14a7648052 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 30 Jun 2016 13:16:44 +0000 Subject: Simplify use of "struct" keyword in many places. --- generic/tclStringRep.h | 2 +- generic/tclTimer.c | 2 +- generic/tclTrace.c | 2 +- macosx/tclMacOSXFCmd.c | 2 +- macosx/tclMacOSXNotify.c | 4 ++-- unix/tclUnixChan.c | 4 ++-- unix/tclUnixCompat.c | 2 +- unix/tclUnixInit.c | 2 +- unix/tclUnixNotfy.c | 4 ++-- unix/tclUnixPipe.c | 2 +- unix/tclUnixTest.c | 2 +- unix/tclUnixThrd.c | 8 ++++---- unix/tclUnixTime.c | 2 +- unix/tclXtNotify.c | 2 +- win/tclWinChan.c | 4 ++-- win/tclWinConsole.c | 6 +++--- win/tclWinDde.c | 2 +- win/tclWinNotify.c | 2 +- win/tclWinSerial.c | 4 ++-- win/tclWinThrd.c | 10 +++++----- win/tclWinTime.c | 4 ++-- 21 files changed, 36 insertions(+), 36 deletions(-) diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h index 227e6bc..db6f7e4 100644 --- a/generic/tclStringRep.h +++ b/generic/tclStringRep.h @@ -46,7 +46,7 @@ * tcl.h, but do not do that unless you are sure what you're doing! */ -typedef struct String { +typedef struct { int numChars; /* The number of chars in the string. -1 means * this value has not been calculated. >= 0 * means that there is a valid Unicode rep, or diff --git a/generic/tclTimer.c b/generic/tclTimer.c index c10986a..c83b5f5 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -91,7 +91,7 @@ typedef struct IdleHandler { * The structure defined below is used in this file only. */ -typedef struct ThreadSpecificData { +typedef struct { TimerHandler *firstTimerHandlerPtr; /* First event in queue. */ int lastTimerId; /* Timer identifier of most recently created * timer. */ diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 4e74c54..33e62b2 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -143,7 +143,7 @@ static int TraceVarEx(Tcl_Interp *interp, const char *part1, * trace procs */ -typedef struct StringTraceData { +typedef struct { ClientData clientData; /* Client data from Tcl_CreateTrace */ Tcl_CmdTraceProc *proc; /* Trace function from Tcl_CreateTrace */ } StringTraceData; diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index 8ecfd0b..7c643a3 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -106,7 +106,7 @@ typedef struct finderinfo { u_int32_t extendedFileInfo[4]; } __attribute__ ((__packed__)) finderinfo; -typedef struct fileinfobuf { +typedef struct { u_int32_t info_length; u_int32_t data[8]; } fileinfobuf; diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c index 9b7bd1a..a7f26b7 100644 --- a/macosx/tclMacOSXNotify.c +++ b/macosx/tclMacOSXNotify.c @@ -217,7 +217,7 @@ typedef struct FileHandler { * handlers are ready to fire. */ -typedef struct FileHandlerEvent { +typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ int fd; /* File descriptor that is ready. Used to find @@ -232,7 +232,7 @@ typedef struct FileHandlerEvent { * writable, and exceptional conditions. */ -typedef struct SelectMasks { +typedef struct { fd_set readable; fd_set writable; fd_set exceptional; diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index b4b2739..6418f48 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -61,7 +61,7 @@ * This structure describes per-instance state of a file based channel. */ -typedef struct FileState { +typedef struct { Tcl_Channel channel; /* Channel associated with this file. */ int fd; /* File handle. */ int validMask; /* OR'ed combination of TCL_READABLE, @@ -76,7 +76,7 @@ typedef struct FileState { * a platform-independant manner. */ -typedef struct TtyAttrs { +typedef struct { int baud; int parity; int data; diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index 2a68f7f..1247061 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -49,7 +49,7 @@ #ifdef TCL_THREADS -typedef struct ThreadSpecificData { +typedef struct { struct passwd pwd; #if defined(HAVE_GETPWNAM_R_5) || defined(HAVE_GETPWUID_R_5) #define NEED_PW_CLEANER 1 diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 71b20e3..aaff9ec 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -115,7 +115,7 @@ static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH; * first list checked for a mapping from env encoding to Tcl encoding name. */ -typedef struct LocaleTable { +typedef struct { const char *lang; const char *encoding; } LocaleTable; diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c index 3422089..9f9301f 100644 --- a/unix/tclUnixNotfy.c +++ b/unix/tclUnixNotfy.c @@ -39,7 +39,7 @@ typedef struct FileHandler { * handlers are ready to fire. */ -typedef struct FileHandlerEvent { +typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ int fd; /* File descriptor that is ready. Used to find @@ -54,7 +54,7 @@ typedef struct FileHandlerEvent { * writable, and exception conditions. */ -typedef struct SelectMasks { +typedef struct { fd_set readable; fd_set writable; fd_set exception; diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index 8b26694..be7b4eb 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -30,7 +30,7 @@ * This structure describes per-instance state of a pipe based channel. */ -typedef struct PipeState { +typedef struct { Tcl_Channel channel; /* Channel associated with this file. */ TclFile inFile; /* Output from pipe. */ TclFile outFile; /* Input to pipe. */ diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index c5ac52a..86e0925 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -37,7 +37,7 @@ * exercised by the "testfilehandler" command. */ -typedef struct Pipe { +typedef struct { TclFile readFile; /* File handle for reading from the pipe. NULL * means pipe doesn't exist yet. */ TclFile writeFile; /* File handle for writing from the pipe. */ diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index cf81850..8f8eb7f 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -15,7 +15,7 @@ #ifdef TCL_THREADS -typedef struct ThreadSpecificData { +typedef struct { char nabuf[16]; } ThreadSpecificData; @@ -675,7 +675,7 @@ TclpInetNtoa( #ifdef USE_THREAD_ALLOC static pthread_key_t key; -typedef struct allocMutex { +typedef struct { Tcl_Mutex tlock; pthread_mutex_t plock; } allocMutex; @@ -683,10 +683,10 @@ typedef struct allocMutex { Tcl_Mutex * TclpNewAllocMutex(void) { - struct allocMutex *lockPtr; + allocMutex *lockPtr; register pthread_mutex_t *plockPtr; - lockPtr = malloc(sizeof(struct allocMutex)); + lockPtr = malloc(sizeof(allocMutex)); if (lockPtr == NULL) { Tcl_Panic("could not allocate lock"); } diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index 315bcf9..df759d8 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -23,7 +23,7 @@ */ static Tcl_ThreadDataKey tmKey; -typedef struct ThreadSpecificData { +typedef struct { struct tm gmtime_buf; struct tm localtime_buf; } ThreadSpecificData; diff --git a/unix/tclXtNotify.c b/unix/tclXtNotify.c index a5d92d6..26db9f2 100644 --- a/unix/tclXtNotify.c +++ b/unix/tclXtNotify.c @@ -42,7 +42,7 @@ typedef struct FileHandler { * handlers are ready to fire. */ -typedef struct FileHandlerEvent { +typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ int fd; /* File descriptor that is ready. Used to find diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 78b510b..7518e3e 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -43,7 +43,7 @@ typedef struct FileInfo { * pending on the channel. */ } FileInfo; -typedef struct ThreadSpecificData { +typedef struct { /* * List of all file channels currently open. */ @@ -58,7 +58,7 @@ static Tcl_ThreadDataKey dataKey; * events are generated. */ -typedef struct FileEvent { +typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ FileInfo *infoPtr; /* Pointer to file info structure. Note that diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index ab55035..5ce8a2b 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -49,7 +49,7 @@ TCL_DECLARE_MUTEX(consoleMutex) * threads. */ -typedef struct ConsoleThreadInfo { +typedef struct { HANDLE thread; /* Handle to reader or writer thread. */ HANDLE readyEvent; /* Manual-reset event to signal _to_ the main * thread when the worker thread has finished @@ -112,7 +112,7 @@ typedef struct ConsoleInfo { /* Data consumed by reader thread. */ } ConsoleInfo; -typedef struct ThreadSpecificData { +typedef struct { /* * The following pointer refers to the head of the list of consoles that * are being watched for file events. @@ -128,7 +128,7 @@ static Tcl_ThreadDataKey dataKey; * console events are generated. */ -typedef struct ConsoleEvent { +typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ ConsoleInfo *infoPtr; /* Pointer to console info structure. Note diff --git a/win/tclWinDde.c b/win/tclWinDde.c index c852728..2589630 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -67,7 +67,7 @@ struct DdeEnumServices { HWND hwnd; }; -typedef struct ThreadSpecificData { +typedef struct { Conversation *currentConversations; /* A list of conversations currently being * processed. */ diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index 1ad022d..28c8445 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -27,7 +27,7 @@ * created for each thread that is using the notifier. */ -typedef struct ThreadSpecificData { +typedef struct { CRITICAL_SECTION crit; /* Monitor for this notifier. */ DWORD thread; /* Identifier for thread associated with this * notifier. */ diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 0730a46..0ce5f4d 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -120,7 +120,7 @@ typedef struct SerialInfo { * [fconfigure -queue] */ } SerialInfo; -typedef struct ThreadSpecificData { +typedef struct { /* * The following pointer refers to the head of the list of serials that * are being watched for file events. @@ -136,7 +136,7 @@ static Tcl_ThreadDataKey dataKey; * events are generated. */ -typedef struct SerialEvent { +typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ SerialInfo *infoPtr; /* Pointer to serial info structure. Note that diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index dbc5f26..26d745d 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -107,7 +107,7 @@ static Tcl_ThreadDataKey dataKey; * the queue. */ -typedef struct WinCondition { +typedef struct { CRITICAL_SECTION condLock; /* Lock to serialize queuing on the * condition. */ struct ThreadSpecificData *firstPtr; /* Queue pointers */ @@ -121,7 +121,7 @@ typedef struct WinCondition { #ifdef USE_THREAD_ALLOC static DWORD tlsKey; -typedef struct allocMutex { +typedef struct { Tcl_Mutex tlock; CRITICAL_SECTION wlock; } allocMutex; @@ -132,7 +132,7 @@ typedef struct allocMutex { * to TclWinThreadStart. */ -typedef struct WinThread { +typedef struct { LPTHREAD_START_ROUTINE lpStartAddress; /* Original startup routine */ LPVOID lpParameter; /* Original startup data */ unsigned int fpControl; /* Floating point control word from the @@ -940,9 +940,9 @@ TclpFinalizeCondition( Tcl_Mutex * TclpNewAllocMutex(void) { - struct allocMutex *lockPtr; + allocMutex *lockPtr; - lockPtr = malloc(sizeof(struct allocMutex)); + lockPtr = malloc(sizeof(allocMutex)); if (lockPtr == NULL) { Tcl_Panic("could not allocate lock"); } diff --git a/win/tclWinTime.c b/win/tclWinTime.c index 7045c72..7b5c18a 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -35,7 +35,7 @@ static const int leapDays[] = { -1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 }; -typedef struct ThreadSpecificData { +typedef struct { char tzName[64]; /* Time zone name */ struct tm tm; /* time information */ } ThreadSpecificData; @@ -45,7 +45,7 @@ static Tcl_ThreadDataKey dataKey; * Data for managing high-resolution timers. */ -typedef struct TimeInfo { +typedef struct { CRITICAL_SECTION cs; /* Mutex guarding this structure. */ int initialized; /* Flag == 1 if this structure is * initialized. */ -- cgit v0.12 From 286034431cf12b592ab2d79d9573006d4d8fd9bf Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 1 Jul 2016 12:21:15 +0000 Subject: Use the utility routines to eliminate the last bit of intrusion into the ensembleRewrite area. --- generic/tclProc.c | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/generic/tclProc.c b/generic/tclProc.c index b663caf..ae9e7cd 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -1087,12 +1087,10 @@ ProcWrongNumArgs( if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) { desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1); } else { - ((Interp *) interp)->ensembleRewrite.numInsertedObjs -= skip - 1; - #ifdef AVOID_HACKS_FOR_ITCL desiredObjs[0] = framePtr->objv[skip-1]; #else - desiredObjs[0] = Tcl_NewListObj(skip, framePtr->objv); + desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1); #endif /* AVOID_HACKS_FOR_ITCL */ } Tcl_IncrRefCount(desiredObjs[0]); @@ -1527,6 +1525,10 @@ InitArgsAndLocals( */ incorrectArgs: + if ((skip != 1) && + TclInitRewriteEnsemble(interp, skip-1, 0, framePtr->objv)) { + TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); + } memset(varPtr, 0, ((framePtr->compiledLocals + localCt)-varPtr) * sizeof(Var)); return ProcWrongNumArgs(interp, skip); @@ -2716,10 +2718,6 @@ TclNRApplyObjCmd( extraPtr->efi.fields[0].clientData = lambdaPtr; extraPtr->cmd.clientData = &extraPtr->efi; - if (TclInitRewriteEnsemble(interp, 1, 0, objv)) { - TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); - } - result = TclPushProcCallFrame(procPtr, interp, objc, objv, 1); if (result == TCL_OK) { TclNRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL, NULL); -- cgit v0.12 From 680d1a1513ba885fd976e2ee52f6572fe9bf5b9f Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 1 Jul 2016 13:20:37 +0000 Subject: Disable special hacks for Itcl 3 ensemble error message generation. Migration paths are in place to bring this to an end. --- generic/tclInt.h | 13 +++++++++++++ tests/indexObj.test | 2 +- 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 49a299c..85981d9 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -26,6 +26,19 @@ #undef ACCEPT_NAN /* + * In Tcl 8.7, stop supporting special hacks for legacy Itcl 3. + * Itcl 4 doesn't need them. Itcl 3 can be updated to not need them + * using the Tcl(Init|Reset)RewriteEnsemble() routines in all Tcl 8.6+ + * releases. Perhaps Tcl 8.7 will add even better public interfaces + * supporting all the re-invocation mechanisms extensions like Itcl 3 + * need. As an absolute last resort, folks who must make Itcl 3 work + * unchanged with Tcl 8.7 can remove this line to regain the migration + * support. Tcl 9 will no longer offer even that option. + */ + +#define AVOID_HACKS_FOR_ITCL 1 + +/* * Common include files needed by most of the Tcl source files are included * here, so that system-dependent personalizations for the include files only * have to be made in once place. This results in a few extra includes, but diff --git a/tests/indexObj.test b/tests/indexObj.test index 646cb02..126d062 100644 --- a/tests/indexObj.test +++ b/tests/indexObj.test @@ -109,7 +109,7 @@ test indexObj-5.6 {Tcl_WrongNumArgs} testindexobj { } "wrong # args: should be \"mycmd foo\"" # Contrast this with test proc-3.6; they have to be like this because # of [Bug 1066837] so Itcl won't break. -test indexObj-5.7 {Tcl_WrongNumArgs} testindexobj { +test indexObj-5.7 {Tcl_WrongNumArgs} {testindexobj obsolete} { testwrongnumargs 2 "fee fi" "fo fum" foo bar } "wrong # args: should be \"fo fum foo fee fi\"" -- cgit v0.12 From 38e85a2dbe88be11991f14a59ef71dcd65d5ad05 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 1 Jul 2016 13:32:19 +0000 Subject: Use same internal representation for unicode strings in test-cases than in reality, in order to prevent surprises. --- generic/tclTestObj.c | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index f36b07f..a637498 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -19,6 +19,7 @@ #endif #include "tclInt.h" #include "tommath.h" +#include "tclStringRep.h" /* @@ -46,13 +47,6 @@ static int TestobjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TeststringobjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); - -typedef struct TestString { - int numChars; - int allocated; - int maxChars; - Tcl_UniChar unicode[2]; -} TestString; #define VARPTR_KEY "TCLOBJTEST_VARPTR" #define NUMBER_OF_OBJECT_VARS 20 @@ -1141,7 +1135,7 @@ TeststringobjCmd( int varIndex, option, i, length; #define MAX_STRINGS 11 const char *index, *string, *strings[MAX_STRINGS+1]; - TestString *strPtr; + String *strPtr; Tcl_Obj **varPtr; static const char *const options[] = { "append", "appendstrings", "get", "get2", "length", "length2", -- cgit v0.12 From ced0d271ff9645626db1764b4de4739ef2b8bdc2 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 1 Jul 2016 14:08:22 +0000 Subject: Encapsulate the fetching of the ensemble rewrite root, used by [namespace]. --- generic/tclEnsemble.c | 34 ++++++++++++++++++++++++++++++++++ generic/tclInt.h | 2 ++ generic/tclNamesp.c | 19 ++----------------- 3 files changed, 38 insertions(+), 17 deletions(-) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index fd2fa67..4e06518 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -2030,6 +2030,40 @@ TclResetRewriteEnsemble( iPtr->ensembleRewrite.numInsertedObjs = 0; } } +/* + *---------------------------------------------------------------------- + * + * TclFetchEnsembleRoot -- + * + * Returns the root of ensemble rewriting, if any. + * If no root exists, returns objv instead. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj *const * +TclFetchEnsembleRoot( + Tcl_Interp *interp, + Tcl_Obj *const *objv, + int objc, + int *objcPtr) +{ + Interp *iPtr = (Interp *) interp; + + if (iPtr->ensembleRewrite.sourceObjs) { + *objcPtr = objc + iPtr->ensembleRewrite.numRemovedObjs + - iPtr->ensembleRewrite.numInsertedObjs; + return iPtr->ensembleRewrite.sourceObjs; + } + *objcPtr = objc; + return objv; +} /* * ---------------------------------------------------------------------- diff --git a/generic/tclInt.h b/generic/tclInt.h index a985206..b3cfc00 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2905,6 +2905,8 @@ MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, Tcl_DString *toAppendPtr); MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr); +MODULE_SCOPE Tcl_Obj *const * TclFetchEnsembleRoot(Tcl_Interp *interp, + Tcl_Obj *const *objv, int objc, int *objcPtr); MODULE_SCOPE void TclFinalizeAllocSubsystem(void); MODULE_SCOPE void TclFinalizeAsync(void); MODULE_SCOPE void TclFinalizeDoubleConversion(void); diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 58a86d9..2c50a60 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -3354,14 +3354,7 @@ NRNamespaceEvalCmd( (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, namespacePtr, /*isProcCallFrame*/ 0); - if (iPtr->ensembleRewrite.sourceObjs == NULL) { - framePtr->objc = objc; - framePtr->objv = objv; - } else { - framePtr->objc = objc + iPtr->ensembleRewrite.numRemovedObjs - - iPtr->ensembleRewrite.numInsertedObjs; - framePtr->objv = iPtr->ensembleRewrite.sourceObjs; - } + framePtr->objv = TclFetchEnsembleRoot(interp, objv, objc, &framePtr->objc); if (objc == 3) { /* @@ -3768,7 +3761,6 @@ NRNamespaceInscopeCmd( { Tcl_Namespace *namespacePtr; CallFrame *framePtr, **framePtrPtr; - register Interp *iPtr = (Interp *) interp; int i; Tcl_Obj *cmdObjPtr; @@ -3794,14 +3786,7 @@ NRNamespaceInscopeCmd( (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, namespacePtr, /*isProcCallFrame*/ 0); - if (iPtr->ensembleRewrite.sourceObjs == NULL) { - framePtr->objc = objc; - framePtr->objv = objv; - } else { - framePtr->objc = objc + iPtr->ensembleRewrite.numRemovedObjs - - iPtr->ensembleRewrite.numInsertedObjs; - framePtr->objv = iPtr->ensembleRewrite.sourceObjs; - } + framePtr->objv = TclFetchEnsembleRoot(interp, objv, objc, &framePtr->objc); /* * Execute the command. If there is just one argument, just treat it as a -- cgit v0.12 From a67b58390be01aa89a2ec3cb100ad5040fb6cdd1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 1 Jul 2016 14:11:38 +0000 Subject: Make test-case "for.test" pass, regardless of end-of-line spacing --- tests/for.test | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/tests/for.test b/tests/for.test index 8e701d6..c8a8187 100644 --- a/tests/for.test +++ b/tests/for.test @@ -451,7 +451,7 @@ proc formatMail {} { set c [string length $line] } } - set newline [string range $line 0 $c] + set newline [string trimright [string range $line 0 $c]] if {! $continuation} { append result $newline $NL } else { @@ -507,7 +507,7 @@ releases of the Tcl scripting language and the Tk toolk it. The first beta versions of these releases were released on August 30, 1996. These releas es contain only minor changes, -so we hope to have only a single beta release and to +so we hope to have only a single beta release and to go final in early October, 1996. @@ -519,34 +519,34 @@ and changes files in the distributions for more complet e information on what has changed, including both feature changes and bug fixes. - There are new options to the file command for + There are new options to the file command for copying files (file copy), - deleting files and directories (file delete), + deleting files and directories (file delete), creating directories (file mkdir), and renaming files (file rename). The implementation of exec has been improved great ly for Windows 95 and Windows NT. - There is a new memory allocator for the Macintosh + There is a new memory allocator for the Macintosh version, which should be more efficient than the old one. - Tk's grid geometry manager has been completely + Tk's grid geometry manager has been completely rewritten. The layout algorithm produces much better layouts than before , especially where rows or columns were stretchable. - There are new commands for creating common dialog + There are new commands for creating common dialog boxes: tk_chooseColor, tk_getOpenFile, tk_getSaveFile and - tk_messageBox. These use native dialog boxes if + tk_messageBox. These use native dialog boxes if they are available. There is a new virtual event mechanism for handlin g events in a more portable - way. See the new command event. It also allows + way. See the new command event. It also allows events (both physical and virtual) to be generated dynamically. -Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl +Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 7.5 and Tk 4.1 except for changes in the C APIs for custom channel drivers. Scrip ts written for earlier releases @@ -556,27 +556,27 @@ Obtaining The Releases Binary Releases -Pre-compiled releases are available for the following +Pre-compiled releases are available for the following platforms: Windows 3.1, Windows 95, and Windows NT: Fetch - ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then + ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then execute it. The file is a - self-extracting executable. It will install the + self-extracting executable. It will install the Tcl and Tk libraries, the wish and tclsh programs, and documentation. Macintosh (both 68K and PowerPC): Fetch - ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. + ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. The file is in binhex format, - which is understood by Fetch, StuffIt, and many + which is understood by Fetch, StuffIt, and many other Mac utilities. The - unpacked file is a self-installing executable: + unpacked file is a self-installing executable: double-click on it and it will create a - folder containing all that you need to run Tcl + folder containing all that you need to run Tcl and Tk. - UNIX (Solaris 2.* and SunOS, other systems + UNIX (Solaris 2.* and SunOS, other systems soon to follow). Easy to install - binary packages are now for sale at the Sun Labs + binary packages are now for sale at the Sun Labs Tcl/Tk Shop. Check it out! } -- cgit v0.12 From e95143affd22d28ce4a9e1edff4b6e5728605027 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 1 Jul 2016 18:54:36 +0000 Subject: [4402cfa58c] Rework the spell check machinery into something that will not be foiled by value sharing. --- generic/tclEnsemble.c | 186 ++++++++++++++++++++++++++++++++++++++++++++------ generic/tclIndexObj.c | 21 +++--- generic/tclInt.h | 5 +- 3 files changed, 177 insertions(+), 35 deletions(-) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 4e06518..75c2747 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -30,7 +30,8 @@ static int NsEnsembleStringOrder(const void *strPtr1, const void *strPtr2); static void DeleteEnsembleConfig(ClientData clientData); static void MakeCachedEnsembleCommand(Tcl_Obj *objPtr, - EnsembleConfig *ensemblePtr, Tcl_HashEntry *hPtr); + EnsembleConfig *ensemblePtr, Tcl_HashEntry *hPtr, + Tcl_Obj *fix); static void FreeEnsembleCmdRep(Tcl_Obj *objPtr); static void DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); static void CompileToInvokedCommand(Tcl_Interp *interp, @@ -1641,6 +1642,8 @@ NsEnsembleImplementationCmdNR( * names. */ int reparseCount = 0; /* Number of reparses. */ Tcl_Obj *errorObj; /* Used for building error messages. */ + Tcl_Obj *subObj; + int subIdx; /* * Must recheck objc, since numParameters might have changed. Cf. test @@ -1648,7 +1651,8 @@ NsEnsembleImplementationCmdNR( */ restartEnsembleParse: - if (objc < 2 + ensemblePtr->numParameters) { + subIdx = 1 + ensemblePtr->numParameters; + if (objc < subIdx + 1) { /* * We don't have a subcommand argument. Make error message. */ @@ -1693,6 +1697,8 @@ NsEnsembleImplementationCmdNR( * up in there and go straight to dispatch. */ + subObj = objv[subIdx]; + if (ensemblePtr->epoch == ensemblePtr->nsPtr->exportLookupEpoch) { /* * Table of subcommands is still valid; therefore there might be a @@ -1701,14 +1707,16 @@ NsEnsembleImplementationCmdNR( * part where we do the invocation of the subcommand. */ - if (objv[1+ensemblePtr->numParameters]->typePtr==&tclEnsembleCmdType){ - EnsembleCmdRep *ensembleCmd = objv[1+ensemblePtr->numParameters] - ->internalRep.twoPtrValue.ptr1; + if (subObj->typePtr==&tclEnsembleCmdType){ + EnsembleCmdRep *ensembleCmd = subObj->internalRep.twoPtrValue.ptr1; if (ensembleCmd->epoch == ensemblePtr->epoch && ensembleCmd->token == ensemblePtr->token) { prefixObj = Tcl_GetHashValue(ensembleCmd->hPtr); Tcl_IncrRefCount(prefixObj); + if (ensembleCmd->fix) { + TclSpellFix(interp, objv, objc, subIdx, subObj, ensembleCmd->fix); + } goto runResultingSubcommand; } } @@ -1723,15 +1731,14 @@ NsEnsembleImplementationCmdNR( */ hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable, - TclGetString(objv[1 + ensemblePtr->numParameters])); + TclGetString(subObj)); if (hPtr != NULL) { /* * Cache for later in the subcommand object. */ - MakeCachedEnsembleCommand(objv[1 + ensemblePtr->numParameters], - ensemblePtr, hPtr); + MakeCachedEnsembleCommand(subObj, ensemblePtr, hPtr, NULL); } else if (!(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX)) { /* * Could not map, no prefixing, go to unknown/error handling. @@ -1751,9 +1758,9 @@ NsEnsembleImplementationCmdNR( char *fullName = NULL; /* Full name of the subcommand. */ int stringLength, i; int tableLength = ensemblePtr->subcommandTable.numEntries; + Tcl_Obj *fix; - subcmdName = TclGetString(objv[1 + ensemblePtr->numParameters]); - stringLength = objv[1 + ensemblePtr->numParameters]->length; + subcmdName = Tcl_GetStringFromObj(subObj, &stringLength); for (i=0 ; isubcommandArrayPtr[i], @@ -1795,11 +1802,17 @@ NsEnsembleImplementationCmdNR( } /* + * Record the spelling correction for usage message. + */ + + fix = Tcl_NewStringObj(fullName, -1); + + /* * Cache for later in the subcommand object. */ - MakeCachedEnsembleCommand(objv[1 + ensemblePtr->numParameters], - ensemblePtr, hPtr); + MakeCachedEnsembleCommand(subObj, ensemblePtr, hPtr, fix); + TclSpellFix(interp, objv, objc, subIdx, subObj, fix); } prefixObj = Tcl_GetHashValue(hPtr); @@ -1912,20 +1925,17 @@ NsEnsembleImplementationCmdNR( Tcl_ResetResult(interp); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND", - TclGetString(objv[1+ensemblePtr->numParameters]), NULL); + TclGetString(subObj), NULL); if (ensemblePtr->subcommandTable.numEntries == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown subcommand \"%s\": namespace %s does not" - " export any commands", - TclGetString(objv[1+ensemblePtr->numParameters]), + " export any commands", TclGetString(subObj), ensemblePtr->nsPtr->fullName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND", - TclGetString(objv[1+ensemblePtr->numParameters]), NULL); return TCL_ERROR; } errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ", (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""), - TclGetString(objv[1+ensemblePtr->numParameters])); + TclGetString(subObj)); if (ensemblePtr->subcommandTable.numEntries == 1) { Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1); } else { @@ -2030,6 +2040,127 @@ TclResetRewriteEnsemble( iPtr->ensembleRewrite.numInsertedObjs = 0; } } + +/* + *---------------------------------------------------------------------- + * + * TclSpellFix -- + * + * Record a spelling correction that needs making in the + * generation of the WrongNumArgs usage message. + * + * Results: + * None. + * + * Side effects: + * Can create an alternative ensemble rewrite structure. + * + *---------------------------------------------------------------------- + */ + +static int +FreeER( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + Tcl_Obj **tmp = (Tcl_Obj **)data[0]; + + ckfree(tmp[2]); + ckfree(tmp); + return result; +} + +static int +FreeObj( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + Tcl_Obj *objPtr = (Tcl_Obj *)data[0]; + + Tcl_DecrRefCount(objPtr); + return result; +} + +void +TclSpellFix( + Tcl_Interp *interp, + Tcl_Obj *const *objv, + int objc, + int badIdx, + Tcl_Obj *bad, + Tcl_Obj *fix) +{ + Interp *iPtr = (Interp *) interp; + Tcl_Obj *const *search; + Tcl_Obj **store; + int idx; + int size; + + if (iPtr->ensembleRewrite.sourceObjs == NULL) { + iPtr->ensembleRewrite.sourceObjs = objv; + iPtr->ensembleRewrite.numRemovedObjs = 0; + iPtr->ensembleRewrite.numInsertedObjs = 0; + } + + /* Compute the valid length of the ensemble root */ + + size = iPtr->ensembleRewrite.numRemovedObjs + objc + - iPtr->ensembleRewrite.numInsertedObjs; + + search = iPtr->ensembleRewrite.sourceObjs; + if (search[0] == NULL) { + /* Awful casting abuse here */ + search = (Tcl_Obj *const *) search[1]; + } + + if (badIdx < iPtr->ensembleRewrite.numInsertedObjs) { + /* + * Misspelled value was inserted. We cannot directly jump + * to the bad value, but have to search. + */ + idx = 1; + while (idx < size) { + if (search[idx] == bad) { + break; + } + idx++; + } + if (idx == size) { + return; + } + } else { + /* Jump to the misspelled value. */ + idx = iPtr->ensembleRewrite.numRemovedObjs + badIdx + - iPtr->ensembleRewrite.numInsertedObjs; + + /* Verify */ + if (search[idx] != bad) { + Tcl_Panic("SpellFix: programming error"); + } + } + + search = iPtr->ensembleRewrite.sourceObjs; + if (search[0] == NULL) { + store = (Tcl_Obj **)search[2]; + } else { + Tcl_Obj **tmp = ckalloc(3 * sizeof(Tcl_Obj *)); + tmp[0] = NULL; + tmp[1] = (Tcl_Obj *)iPtr->ensembleRewrite.sourceObjs; + tmp[2] = (Tcl_Obj *)ckalloc(size * sizeof(Tcl_Obj *)); + memcpy(tmp[2], tmp[1], size*sizeof(Tcl_Obj *)); + + iPtr->ensembleRewrite.sourceObjs = (Tcl_Obj *const *) tmp; + TclNRAddCallback(interp, FreeER, tmp, NULL, NULL, NULL); + store = (Tcl_Obj **)tmp[2]; + } + + store[idx] = fix; + Tcl_IncrRefCount(fix); + TclNRAddCallback(interp, FreeObj, fix, NULL, NULL, NULL); +} + /* *---------------------------------------------------------------------- * @@ -2230,12 +2361,16 @@ static void MakeCachedEnsembleCommand( Tcl_Obj *objPtr, EnsembleConfig *ensemblePtr, - Tcl_HashEntry *hPtr) + Tcl_HashEntry *hPtr, + Tcl_Obj *fix) { register EnsembleCmdRep *ensembleCmd; if (objPtr->typePtr == &tclEnsembleCmdType) { ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1; + if (ensembleCmd->fix) { + Tcl_DecrRefCount(ensembleCmd->fix); + } } else { /* * Kill the old internal rep, and replace it with a brand new one of @@ -2254,7 +2389,10 @@ MakeCachedEnsembleCommand( ensembleCmd->epoch = ensemblePtr->epoch; ensembleCmd->token = ensemblePtr->token; - ensembleCmd->tablePtr = &ensemblePtr->subcommandTable; + if (fix) { + Tcl_IncrRefCount(fix); + } + ensembleCmd->fix = fix; ensembleCmd->hPtr = hPtr; } @@ -2636,6 +2774,9 @@ FreeEnsembleCmdRep( { EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1; + if (ensembleCmd->fix) { + Tcl_DecrRefCount(ensembleCmd->fix); + } ckfree(ensembleCmd); objPtr->typePtr = NULL; } @@ -2670,7 +2811,10 @@ DupEnsembleCmdRep( copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy; ensembleCopy->epoch = ensembleCmd->epoch; ensembleCopy->token = ensembleCmd->token; - ensembleCopy->tablePtr = ensembleCmd->tablePtr; + ensembleCopy->fix = ensembleCmd->fix; + if (ensembleCopy->fix) { + Tcl_IncrRefCount(ensembleCopy->fix); + } ensembleCopy->hPtr = ensembleCmd->hPtr; } diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index d01e685..0e0ddc9 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -925,6 +925,14 @@ Tcl_WrongNumArgs( Tcl_Obj *const *origObjv = iPtr->ensembleRewrite.sourceObjs; /* + * Check for spelling fixes, and substitute the fixed values. + */ + + if (origObjv[0] == NULL) { + origObjv = (Tcl_Obj *const *)origObjv[2]; + } + + /* * We only know how to do rewriting if all the replaced objects are * actually arguments (in objv) to this function. Otherwise it just * gets too complicated and we'd be better off just giving a slightly @@ -957,12 +965,6 @@ Tcl_WrongNumArgs( elementStr = EXPAND_OF(indexRep); elemLen = strlen(elementStr); - } else if (origObjv[i]->typePtr == &tclEnsembleCmdType) { - register EnsembleCmdRep *ecrPtr = - origObjv[i]->internalRep.twoPtrValue.ptr1; - - elementStr = Tcl_GetHashKey(ecrPtr->tablePtr, ecrPtr->hPtr); - elemLen = strlen(elementStr); } else { elementStr = TclGetStringFromObj(origObjv[i], &elemLen); } @@ -1011,13 +1013,6 @@ Tcl_WrongNumArgs( register IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1; Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL); - } else if (objv[i]->typePtr == &tclEnsembleCmdType) { - register EnsembleCmdRep *ecrPtr = - objv[i]->internalRep.twoPtrValue.ptr1; - const char *fullSubcmdName - = Tcl_GetHashKey(ecrPtr->tablePtr, ecrPtr->hPtr); - - Tcl_AppendStringsToObj(objPtr, fullSubcmdName, NULL); } else { /* * Quote the argument if it contains spaces (Bug 942757). diff --git a/generic/tclInt.h b/generic/tclInt.h index b3cfc00..03b648d 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -401,7 +401,7 @@ typedef struct { * ensemble. */ Tcl_Command token; /* Reference to the comamnd for which this * structure is a cache of the resolution. */ - Tcl_HashTable *tablePtr; /* The subcommand hash table. */ + Tcl_Obj *fix; /* Corrected spelling, if needed. */ Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand * hash table. */ } EnsembleCmdRep; @@ -3109,6 +3109,9 @@ MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr); MODULE_SCOPE void TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr, Tcl_Obj *newValue, Tcl_Encoding encoding); MODULE_SCOPE void TclSignalExitThread(Tcl_ThreadId id, int result); +MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp, + Tcl_Obj *const *objv, int objc, int subIdx, + Tcl_Obj *bad, Tcl_Obj *fix); MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr, int numBytes); MODULE_SCOPE int TclStringMatch(const char *str, int strLen, -- cgit v0.12 From d5617720bbdc0bf0c9ac6ac04512a418c8029ad4 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 1 Jul 2016 19:16:56 +0000 Subject: Add some tests --- tests/namespace.test | 46 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) diff --git a/tests/namespace.test b/tests/namespace.test index 2ba695a..c433241 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -2107,6 +2107,52 @@ test namespace-50.4 {chained ensembles affect error messages} -body { rename a {} rename c {} } +test namespace-50.5 {[4402cfa58c]} -setup { + proc bar {ev} {} + proc bingo {xx} {} + namespace ensemble create -command launch -map {foo bar event bingo} + set result {} +} -body { + catch {launch foo} m; lappend result $m + catch {launch ev} m; lappend result $m + catch {launch foo} m; lappend result $m +} -cleanup { + rename launch {} + rename bingo {} + rename bar {} +} -result {{wrong # args: should be "launch foo ev"} {wrong # args: should be "launch event xx"} {wrong # args: should be "launch foo ev"}} +test namespace-50.6 {[4402cfa58c]} -setup { + proc target {x y} {} + namespace ensemble create -command e2 -map {s2 target} + namespace ensemble create -command e1 -map {s1 e2} + set result {} +} -body { + set s s + catch {e1 s1 s2 a} m; lappend result $m + catch {e1 $s s2 a} m; lappend result $m + catch {e1 s1 $s a} m; lappend result $m + catch {e1 $s $s a} m; lappend result $m +} -cleanup { + rename e1 {} + rename e2 {} + rename target {} +} -result {{wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"}} +test namespace-50.7 {[4402cfa58c]} -setup { + proc target {x y} {} + namespace ensemble create -command e2 -map {s2 target} + namespace ensemble create -command e1 -map {s1 e2} -parameters foo + set result {} +} -body { + set s s + catch {e1 s2 s1 a} m; lappend result $m + catch {e1 $s s1 a} m; lappend result $m + catch {e1 s2 $s a} m; lappend result $m + catch {e1 $s $s a} m; lappend result $m +} -cleanup { + rename e1 {} + rename e2 {} + rename target {} +} -result {{wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"}} test namespace-51.1 {name resolution path control} -body { namespace eval ::test_ns_1 { -- cgit v0.12 From 42c2792287c6b609265be758ddb3779e40aa350f Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 1 Jul 2016 19:42:38 +0000 Subject: The EnsembleCmdRep struct that is the internal rep for caching ensemble dispatches and spelling corrections can now be file static. --- generic/tclEnsemble.c | 26 +++++++++++++++++++++----- generic/tclInt.h | 17 ----------------- 2 files changed, 21 insertions(+), 22 deletions(-) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 75c2747..5c47ce3 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -76,7 +76,7 @@ enum EnsConfigOpts { * that implements it. */ -const Tcl_ObjType tclEnsembleCmdType = { +static const Tcl_ObjType ensembleCmdType = { "ensembleCommand", /* the type's name */ FreeEnsembleCmdRep, /* freeIntRepProc */ DupEnsembleCmdRep, /* dupIntRepProc */ @@ -84,6 +84,22 @@ const Tcl_ObjType tclEnsembleCmdType = { NULL /* setFromAnyProc */ }; +/* + * The internal rep for caching ensemble subcommand lookups and + * spell corrections. + */ + +typedef struct { + int epoch; /* Used to confirm when the data in this + * really structure matches up with the + * ensemble. */ + Tcl_Command token; /* Reference to the comamnd for which this + * structure is a cache of the resolution. */ + Tcl_Obj *fix; /* Corrected spelling, if needed. */ + Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand + * hash table. */ +} EnsembleCmdRep; + static inline Tcl_Obj * NewNsObj( @@ -1707,7 +1723,7 @@ NsEnsembleImplementationCmdNR( * part where we do the invocation of the subcommand. */ - if (subObj->typePtr==&tclEnsembleCmdType){ + if (subObj->typePtr==&ensembleCmdType){ EnsembleCmdRep *ensembleCmd = subObj->internalRep.twoPtrValue.ptr1; if (ensembleCmd->epoch == ensemblePtr->epoch && @@ -2366,7 +2382,7 @@ MakeCachedEnsembleCommand( { register EnsembleCmdRep *ensembleCmd; - if (objPtr->typePtr == &tclEnsembleCmdType) { + if (objPtr->typePtr == &ensembleCmdType) { ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1; if (ensembleCmd->fix) { Tcl_DecrRefCount(ensembleCmd->fix); @@ -2380,7 +2396,7 @@ MakeCachedEnsembleCommand( TclFreeIntRep(objPtr); ensembleCmd = ckalloc(sizeof(EnsembleCmdRep)); objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd; - objPtr->typePtr = &tclEnsembleCmdType; + objPtr->typePtr = &ensembleCmdType; } /* @@ -2807,7 +2823,7 @@ DupEnsembleCmdRep( EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1; EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep)); - copyPtr->typePtr = &tclEnsembleCmdType; + copyPtr->typePtr = &ensembleCmdType; copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy; ensembleCopy->epoch = ensembleCmd->epoch; ensembleCopy->token = ensembleCmd->token; diff --git a/generic/tclInt.h b/generic/tclInt.h index 03b648d..fba4c7b 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -390,23 +390,6 @@ struct NamespacePathEntry { #define TCL_FIND_ONLY_NS 0x1000 /* - * The data cached in an ensemble subcommand's Tcl_Obj rep (reference in - * twoPtrValue.ptr1 field). This structure is not shared between Tcl_Objs - * referring to the same subcommand, even where one is a duplicate of another. - */ - -typedef struct { - int epoch; /* Used to confirm when the data in this - * really structure matches up with the - * ensemble. */ - Tcl_Command token; /* Reference to the comamnd for which this - * structure is a cache of the resolution. */ - Tcl_Obj *fix; /* Corrected spelling, if needed. */ - Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand - * hash table. */ -} EnsembleCmdRep; - -/* * The client data for an ensemble command. This consists of the table of * commands that are actually exported by the namespace, and an epoch counter * that, combined with the exportLookupEpoch field of the namespace structure, -- cgit v0.12 From dd879c794d6af3bab4cfb8b36708db2fc70b5f46 Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 2 Jul 2016 17:21:53 +0000 Subject: [f961d7d1dd] Repair usage message for ensemble parameters with spaces. --- generic/tclEnsemble.c | 13 +++---------- tests/namespace.test | 9 +++++++++ 2 files changed, 12 insertions(+), 10 deletions(-) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 5c47ce3..a86b5c4 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -1674,18 +1674,11 @@ NsEnsembleImplementationCmdNR( */ Tcl_DString buf; /* Message being built */ - Tcl_Obj **elemPtrs; /* Parameter names */ - int len; /* Number of parameters to append */ Tcl_DStringInit(&buf); - if (ensemblePtr->parameterList == NULL) { - len = 0; - } else if (TclListObjGetElements(NULL, ensemblePtr->parameterList, - &len, &elemPtrs) != TCL_OK) { - Tcl_Panic("List of ensemble parameters is not a list"); - } - for (; len>0; len--,elemPtrs++) { - TclDStringAppendObj(&buf, *elemPtrs); + if (ensemblePtr->parameterList) { + Tcl_DStringAppend(&buf, + TclGetString(ensemblePtr->parameterList), -1); TclDStringAppendLiteral(&buf, " "); } TclDStringAppendLiteral(&buf, "subcommand ?arg ...?"); diff --git a/tests/namespace.test b/tests/namespace.test index c433241..dc1d3bf 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -2153,6 +2153,15 @@ test namespace-50.7 {[4402cfa58c]} -setup { rename e2 {} rename target {} } -result {{wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"}} +test namespace-50.8 {[f961d7d1dd]} -setup { + proc target {} {} + namespace ensemble create -command e -map {s target} -parameters {{a b}} +} -body { + e +} -returnCodes error -result {wrong # args: should be "e {a b} subcommand ?arg ...?"} -cleanup { + rename e {} + rename target {} +} test namespace-51.1 {name resolution path control} -body { namespace eval ::test_ns_1 { -- cgit v0.12 From 65bd912b775ebf56f5c549e4a7f8387768369d3b Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 2 Jul 2016 17:55:51 +0000 Subject: [09fabeb1fd] test subdirs in sorted order. --- library/tcltest/tcltest.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 169b7d4..f1ce970 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -2709,7 +2709,7 @@ proc tcltest::GetMatchingDirectories {rootdir} { DebugPuts 1 "No test directories remain after applying match\ and skip patterns!" } - return $matchDirs + return [lsort $matchDirs] } # tcltest::runAllTests -- -- cgit v0.12