summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog13
-rw-r--r--generic/tclBasic.c84
-rw-r--r--generic/tclDictObj.c18
-rw-r--r--generic/tclNamesp.c20
4 files changed, 69 insertions, 66 deletions
diff --git a/ChangeLog b/ChangeLog
index 806b7ba..38ac7af 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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);