diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclProc.c | 14 | ||||
| -rw-r--r-- | generic/tclVar.c | 46 |
2 files changed, 49 insertions, 11 deletions
diff --git a/generic/tclProc.c b/generic/tclProc.c index 611ae45..2062672 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclProc.c,v 1.170 2009/02/10 22:50:07 nijtmans Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.171 2009/03/24 09:30:07 dkf Exp $ */ #include "tclInt.h" @@ -787,7 +787,7 @@ TclObjGetFrame( register Interp *iPtr = (Interp *) interp; int curLevel, level, result; CallFrame *framePtr; - const char *name = TclGetString(objPtr); + const char *name; /* * Parse object to figure out which level number to go to. @@ -795,6 +795,12 @@ TclObjGetFrame( result = 1; curLevel = iPtr->varFramePtr->level; + if (objPtr == NULL) { + name = "1"; + goto haveLevel1; + } + + name = TclGetString(objPtr); if (objPtr->typePtr == &levelReferenceType) { if (objPtr->internalRep.ptrAndLongRep.ptr != NULL) { level = curLevel - objPtr->internalRep.ptrAndLongRep.value; @@ -847,9 +853,11 @@ TclObjGetFrame( level = curLevel - level; } else { /* - * Don't cache as the object *isn't* a level reference. + * Don't cache as the object *isn't* a level reference (might even be + * NULL...) */ + haveLevel1: level = curLevel - 1; result = 0; } diff --git a/generic/tclVar.c b/generic/tclVar.c index e61e06e..d87cdf9 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.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: tclVar.c,v 1.177 2009/03/18 16:52:20 dgp Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.178 2009/03/24 09:30:07 dkf Exp $ */ #include "tclInt.h" @@ -4077,29 +4077,59 @@ Tcl_UpvarObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { CallFrame *framePtr; - int result; + int result, hasLevel; + Tcl_Obj *levelObj; if (objc < 3) { - upvarSyntax: Tcl_WrongNumArgs(interp, 1, objv, "?level? otherVar localVar ?otherVar localVar ...?"); return TCL_ERROR; } + if (objc & 1) { + /* + * Even number of arguments, so use the default level of "1" by + * passing NULL to TclObjGetFrame. + */ + + levelObj = NULL; + hasLevel = 0; + } else { + /* + * Odd number of arguments, so objv[1] must contain the level. + */ + + levelObj = objv[1]; + hasLevel = 1; + } + /* * Find the call frame containing each of the "other variables" to be * linked to. */ - result = TclObjGetFrame(interp, objv[1], &framePtr); + result = TclObjGetFrame(interp, levelObj, &framePtr); if (result == -1) { return TCL_ERROR; } - objc -= result+1; - if ((objc & 1) != 0) { - goto upvarSyntax; + if ((result == 0) && hasLevel) { + /* + * Synthesize an error message since TclObjGetFrame doesn't do this + * for this particular case. + */ + + Tcl_AppendResult(interp, "bad level \"", TclGetString(levelObj), "\"", + NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "LEVEL", NULL); + return TCL_ERROR; } - objv += result+1; + + /* + * We've now finished with parsing levels; skip to the variable names. + */ + + objc -= hasLevel+1; + objv += hasLevel+1; /* * Iterate over each (other variable, local variable) pair. Divide the |