diff options
| -rw-r--r-- | ChangeLog | 13 | ||||
| -rw-r--r-- | generic/tclBasic.c | 84 | ||||
| -rw-r--r-- | generic/tclDictObj.c | 18 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 20 |
4 files changed, 69 insertions, 66 deletions
@@ -1,3 +1,14 @@ +2009-01-28 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclBasic.c (TclInvokeObjectCommand): Made this understand + what to do if it ends up being used on a command with no objProc; that + shouldn't happen, but... + + * generic/tclNamesp.c (TclMakeEnsemble): [Bug 2529157]: Made this + understand NRE command implementations better. + * generic/tclDictObj.c (DictForCmd): Eliminate unnecessary command + implementation. + 2009-01-27 Donal K. Fellows <dkf@users.sf.net> * generic/tclOODefineCmds.c (Tcl_ClassSetConstructor): @@ -12,7 +23,7 @@ 2009-01-26 Alexandre Ferrieux <ferrieux@users.sourceforge.net> - * win/tclWinSocl.c: Fix [Bug 2446662]: resync Win behavior on RST + * win/tclWinSock.c: Fix [Bug 2446662]: resync Win behavior on RST with that of unix (EOF). 2009-01-26 Donal K. Fellows <dkf@users.sf.net> diff --git a/generic/tclBasic.c b/generic/tclBasic.c index e9aa6e1..0cd1196 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.383 2009/01/14 06:10:04 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.384 2009/01/28 16:28:32 dkf Exp $ */ #include "tclInt.h" @@ -373,12 +373,12 @@ static const OpCmdInfo mathOpCmds[] = { */ typedef struct { - Tcl_Interp *interp; /* Interp this struct belongs to */ + Tcl_Interp *interp; /* Interp this struct belongs to. */ Tcl_AsyncHandler async; /* Async handler token for script - * cancellation */ - char *result; /* The script cancellation result or - * NULL for a default result */ - int length; /* Length of the above error message */ + * cancellation. */ + char *result; /* The script cancellation result or NULL for + * a default result. */ + int length; /* Length of the above error message. */ ClientData clientData; /* Ignored */ int flags; /* Additional flags */ } CancelInfo; @@ -501,8 +501,8 @@ Tcl_CreateInterp(void) iPtr->varFramePtr = NULL; /* Initialise as soon as :: is available */ /* - * TIP #280 - Initialize the arrays used to extend the ByteCode and - * Proc structures. + * TIP #280 - Initialize the arrays used to extend the ByteCode and Proc + * structures. */ iPtr->cmdFramePtr = NULL; @@ -784,13 +784,11 @@ Tcl_CreateInterp(void) * Create the 'tailcall' command an unsupported command for 'atProcExit' */ - Tcl_NRCreateCommand(interp, "tailcall", - /*objProc*/ NULL, TclNRAtProcExitObjCmd, INT2PTR(TCL_NR_TAILCALL_TYPE), - NULL); + Tcl_NRCreateCommand(interp, "tailcall", NULL, TclNRAtProcExitObjCmd, + INT2PTR(TCL_NR_TAILCALL_TYPE), NULL); - Tcl_NRCreateCommand(interp, "::tcl::unsupported::atProcExit", - /*objProc*/ NULL, TclNRAtProcExitObjCmd, INT2PTR(TCL_NR_ATEXIT_TYPE), - NULL); + Tcl_NRCreateCommand(interp, "::tcl::unsupported::atProcExit", NULL, + TclNRAtProcExitObjCmd, INT2PTR(TCL_NR_ATEXIT_TYPE), NULL); #ifdef USE_DTRACE /* @@ -1555,9 +1553,9 @@ DeleteInterpProc( /* * Location stack for uplevel/eval/... scripts which were passed - * through proc arguments. Actually we track all arguments as we - * don't, cannot know which arguments will be used as scripts and - * which won't. + * through proc arguments. Actually we track all arguments as we do + * not and cannot know which arguments will be used as scripts and + * which will not. */ if (iPtr->lineLAPtr->numEntries) { @@ -2008,7 +2006,7 @@ Tcl_CreateCommand( * stuck in an infinite loop). */ - ckfree(Tcl_GetHashValue(hPtr)); + ckfree(Tcl_GetHashValue(hPtr)); } } else { /* @@ -2329,7 +2327,12 @@ TclInvokeObjectCommand( * Invoke the command's object-based Tcl_ObjCmdProc. */ - result = cmdPtr->objProc(cmdPtr->objClientData, interp, argc, objv); + if (cmdPtr->objProc != NULL) { + result = cmdPtr->objProc(cmdPtr->objClientData, interp, argc, objv); + } else { + result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc, + cmdPtr->objClientData, argc, objv); + } /* * Move the interpreter's object result to the string result, then reset @@ -2603,7 +2606,7 @@ Tcl_SetCommandInfoFromToken( { Command *cmdPtr; /* Internal representation of the command */ - if (cmd == (Tcl_Command) NULL) { + if (cmd == NULL) { return 0; } @@ -2687,7 +2690,7 @@ Tcl_GetCommandInfoFromToken( { Command *cmdPtr; /* Internal representation of the command */ - if (cmd == (Tcl_Command) NULL) { + if (cmd == NULL) { return 0; } @@ -2832,7 +2835,7 @@ Tcl_DeleteCommand( */ cmd = Tcl_FindCommand(interp, cmdName, NULL, /*flags*/ 0); - if (cmd == (Tcl_Command) NULL) { + if (cmd == NULL) { return -1; } return Tcl_DeleteCommandFromToken(interp, cmd); @@ -3859,11 +3862,11 @@ Tcl_Canceled( } else { /* * FIXME: If this interpreter is being deleted we cannot continue - * to traverse up the interp chain due to an issue with - * Tcl_GetMaster (really the slave interp bookkeeping) that - * causes us to run off into a freed interp struct. Ideally, this - * check would not be necessary because Tcl_GetMaster would - * return NULL instead of a pointer to invalid (freed) memory. + * to traverse up the interp chain due to an issue with + * Tcl_GetMaster (really the slave interp bookkeeping) that causes + * us to run off into a freed interp struct. Ideally, this check + * would not be necessary because Tcl_GetMaster would return NULL + * instead of a pointer to invalid (freed) memory. */ if (iPtr->flags & DELETED) { @@ -4312,8 +4315,9 @@ NRCallTEBC( { /* * This is not run normally, the callback is passed up to tebc. This - function is only called when no tebc is above. + * function is only called when no tebc is above. */ + int type = PTR2INT(data[0]); Interp *iPtr = ((Interp *) interp); @@ -4465,7 +4469,7 @@ TEOV_Error( /* * If there was an error, a command string will be needed for the * error log: get it out of the itemPtr. The details depend on the - * type + * type. */ listPtr = Tcl_NewListObj(objc, objv); @@ -5346,10 +5350,10 @@ TclArgumentEnter( * * TclArgumentRelease -- * - * This procedure is a helper for the TIP #280 uplevel extension. - * It removes the location references for the arguments of a command - * just done. Usage is counted down, the data is removed only when - * no user is left over. + * This procedure is a helper for the TIP #280 uplevel extension. It + * removes the location references for the arguments of a command just + * done. Usage is counted down, the data is removed only when no user is + * left over. * * Results: * None. @@ -5378,7 +5382,7 @@ TclArgumentRelease( if (!hPtr) { continue; } - cfwPtr = (CFWord *) Tcl_GetHashValue(hPtr); + cfwPtr = Tcl_GetHashValue(hPtr); cfwPtr->refCount--; if (cfwPtr->refCount > 0) { @@ -5518,8 +5522,8 @@ TclArgumentBCRelease( * * TclArgumentGet -- * - * This procedure is a helper for the TIP #280 uplevel extension. - * It find the location references for a Tcl_Obj, if any. + * This procedure is a helper for the TIP #280 uplevel extension. It + * finds the location references for a Tcl_Obj, if any. * * Results: * None. @@ -5550,7 +5554,7 @@ TclArgumentGet( */ if ((!obj->bytes) || ((obj->typePtr == &tclListType) && - ((List *)obj->internalRep.twoPtrValue.ptr1)->canonicalFlag)) { + ((List *) obj->internalRep.twoPtrValue.ptr1)->canonicalFlag)) { return; } @@ -8280,9 +8284,9 @@ NRCoroutineCallerCallback( if (cmdPtr->flags & CMD_IS_DELETED) { /* - * The command was deleted while it was running: wind down the execEnv, - * this will do the complete cleanup. RewindCoroutine will restore both - * the caller's context and interp state. + * The command was deleted while it was running: wind down the + * execEnv, this will do the complete cleanup. RewindCoroutine will + * restore both the caller's context and interp state. */ return RewindCoroutine(corPtr, result); diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 5c4295e..c800441 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDictObj.c,v 1.75 2009/01/09 11:21:45 dkf Exp $ + * RCS: @(#) $Id: tclDictObj.c,v 1.76 2009/01/28 16:28:32 dkf Exp $ */ #include "tclInt.h" @@ -33,8 +33,6 @@ static int DictExistsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictFilterCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); -static int DictForCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); static int DictGetCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictIncrCmd(ClientData dummy, Tcl_Interp *interp, @@ -93,7 +91,7 @@ static const EnsembleImplMap implementationMap[] = { {"create", DictCreateCmd }, {"exists", DictExistsCmd }, {"filter", DictFilterCmd }, - {"for", DictForCmd, TclCompileDictForCmd, DictForNRCmd }, + {"for", NULL, TclCompileDictForCmd, DictForNRCmd }, {"get", DictGetCmd, TclCompileDictGetCmd }, {"incr", DictIncrCmd, TclCompileDictIncrCmd }, {"info", DictInfoCmd }, @@ -2368,7 +2366,7 @@ DictAppendCmd( /* *---------------------------------------------------------------------- * - * DictForCmd -- + * DictForNRCmd -- * * This function implements the "dict for" Tcl command. See the user * documentation for details on what it does, and TIP#111 for the formal @@ -2384,16 +2382,6 @@ DictAppendCmd( */ static int -DictForCmd( - ClientData dummy, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const *objv) -{ - return Tcl_NRCallObjProc(interp, DictForNRCmd, dummy, objc, objv); -} - -static int DictForNRCmd( ClientData dummy, Tcl_Interp *interp, diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 79b7d48..a122164 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -23,7 +23,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclNamesp.c,v 1.185 2009/01/09 15:00:27 dkf Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.186 2009/01/28 16:28:32 dkf Exp $ */ #include "tclInt.h" @@ -6179,11 +6179,11 @@ TclMakeEnsemble( Tcl_DStringAppend(&buf, nameParts[i], -1); } - ns = Tcl_FindNamespace(interp, Tcl_DStringValue(&buf), - NULL, TCL_CREATE_NS_IF_UNKNOWN); + ns = Tcl_FindNamespace(interp, Tcl_DStringValue(&buf), NULL, + TCL_CREATE_NS_IF_UNKNOWN); if (!ns) { Tcl_Panic("unable to find or create %s namespace!", - Tcl_DStringValue(&buf)); + Tcl_DStringValue(&buf)); } /* @@ -6217,14 +6217,14 @@ TclMakeEnsemble( Tcl_DStringLength(&buf)); Tcl_AppendToObj(toObj, map[i].name, -1); Tcl_DictObjPut(NULL, mapDict, fromObj, toObj); - if (map[i].proc) { - cmdPtr = (Command *)Tcl_CreateObjCommand(interp, - TclGetString(toObj), map[i].proc, - map[i].clientData, NULL); + if (map[i].proc || map[i].nreProc) { + cmdPtr = (Command *) + Tcl_NRCreateCommand(interp, TclGetString(toObj), + map[i].proc, map[i].nreProc, map[i].clientData, NULL); cmdPtr->compileProc = map[i].compileProc; - cmdPtr->nreProc = map[i].nreProc; - if (map[i].compileProc != NULL) + if (map[i].compileProc != NULL) { ensembleFlags |= ENSEMBLE_COMPILE; + } } } Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict); |