diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclBasic.c | 57 | ||||
| -rw-r--r-- | tests/parse.test | 25 |
3 files changed, 51 insertions, 37 deletions
@@ -1,3 +1,9 @@ +2006-03-06 Don Porter <dgp@users.sourceforge.net> + + * generic/tclBasic.c: Revised handling of TCL_EVAL_* flags to + * tests/parse.test: simplify TclEvalObjvInternal and to correct + the auto-loading of alias targets (parse-8.12). [Bug 1444291]. + 2006-03-03 Don Porter <dgp@users.sourceforge.net> * generic/tclPathObj.c: Revised yesterday's fix for [Bug 1379287] diff --git a/generic/tclBasic.c b/generic/tclBasic.c index dcfedc4..511258f 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,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.192 2006/02/28 15:47:10 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.193 2006/03/06 21:56:34 dgp Exp $ */ #include "tclInt.h" @@ -3244,6 +3244,7 @@ TclEvalObjvInternal( int traceCode = TCL_OK; int checkTraces = 1; int cmdEpoch; + Namespace *savedNsPtr = NULL; if (TclInterpReady(interp) == TCL_ERROR) { return TCL_ERROR; @@ -3253,6 +3254,15 @@ TclEvalObjvInternal( return TCL_OK; } + /* Configure evaluation context to match the requested flags */ + savedVarFramePtr = iPtr->varFramePtr; + if (flags & TCL_EVAL_GLOBAL) { + iPtr->varFramePtr = NULL; + } else if ((flags & TCL_EVAL_INVOKE) && iPtr->varFramePtr) { + savedNsPtr = iPtr->varFramePtr->nsPtr; + iPtr->varFramePtr->nsPtr = iPtr->globalNsPtr; + } + /* * Find the function to execute this command. If there isn't one, then see * if there is an unknown command handler registered for this namespace. @@ -3260,23 +3270,11 @@ TclEvalObjvInternal( * the original command words as arguments. Then call ourselves * recursively to execute it. * - * If caller requests, or if we're resolving the target end of an - * interpeter alias (TCL_EVAL_INVOKE), be sure to do command name - * resolution in the global namespace. - * * If any execution traces rename or delete the current command, we may * need (at most) two passes here. */ reparseBecauseOfTraces: - savedVarFramePtr = iPtr->varFramePtr; - /* - * Both INVOKE and GLOBAL flags dictate that command resolution - * happens in an [uplevel #0] context. (iPtr->varFramePtr == NULL) - */ - if (flags & (TCL_EVAL_INVOKE | TCL_EVAL_GLOBAL)) { - iPtr->varFramePtr = NULL; - } cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]); if (cmdPtr == NULL) { Namespace *currNsPtr = NULL; /* Used to check for and invoke any @@ -3315,7 +3313,6 @@ TclEvalObjvInternal( newObjv[i+handlerObjc] = objv[i]; } cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]); - iPtr->varFramePtr = savedVarFramePtr; if (cmdPtr == NULL) { Tcl_AppendResult(interp, "invalid command name \"", TclGetString(objv[0]), "\"", NULL); @@ -3323,16 +3320,21 @@ TclEvalObjvInternal( } else { iPtr->numLevels++; code = TclEvalObjvInternal(interp, newObjc, newObjv, command, - length, flags); + length, 0); iPtr->numLevels--; } for (i = 0; i < handlerObjc; ++i) { Tcl_DecrRefCount(newObjv[i]); } ckfree((char *) newObjv); - return code; + if (savedNsPtr) { + iPtr->varFramePtr->nsPtr = savedNsPtr; + } + goto done; + } + if (savedNsPtr) { + iPtr->varFramePtr->nsPtr = savedNsPtr; } - iPtr->varFramePtr = savedVarFramePtr; /* * Call trace functions if needed. @@ -3348,9 +3350,6 @@ TclEvalObjvInternal( * while loop one more time. */ - if (flags & TCL_EVAL_GLOBAL) { - iPtr->varFramePtr = NULL; - } if (iPtr->tracePtr != NULL && traceCode == TCL_OK) { traceCode = TclCheckInterpTraces(interp, command, length, cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv); @@ -3359,7 +3358,6 @@ TclEvalObjvInternal( traceCode = TclCheckExecutionTraces(interp, command, length, cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv); } - iPtr->varFramePtr = savedVarFramePtr; cmdPtr->refCount--; } if (cmdEpoch != cmdPtr->cmdEpoch) { @@ -3375,22 +3373,12 @@ TclEvalObjvInternal( cmdPtr->refCount++; iPtr->cmdCount++; if (code == TCL_OK && traceCode == TCL_OK && !Tcl_LimitExceeded(interp)) { - savedVarFramePtr = iPtr->varFramePtr; - /* - * Only the GLOBAL flag dictates command procedure exection (distinct - * from command name resolution above) happens in an [uplevel #0] - * context. (iPtr->varFramePtr == NULL) - */ - if (flags & TCL_EVAL_GLOBAL) { - iPtr->varFramePtr = NULL; - } if (!(flags & TCL_EVAL_INVOKE) && (iPtr->ensembleRewrite.sourceObjs != NULL) && !Tcl_IsEnsemble((Tcl_Command) cmdPtr)) { iPtr->ensembleRewrite.sourceObjs = NULL; } code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv); - iPtr->varFramePtr = savedVarFramePtr; } if (Tcl_AsyncReady()) { code = Tcl_AsyncInvoke(interp, code); @@ -3404,9 +3392,6 @@ TclEvalObjvInternal( */ if (!(cmdPtr->flags & CMD_IS_DELETED)) { - if (flags & TCL_EVAL_GLOBAL) { - iPtr->varFramePtr = NULL; - } if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) { traceCode = TclCheckExecutionTraces(interp, command, length, cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv); @@ -3415,7 +3400,6 @@ TclEvalObjvInternal( traceCode = TclCheckInterpTraces(interp, command, length, cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv); } - iPtr->varFramePtr = savedVarFramePtr; } TclCleanupCommand(cmdPtr); @@ -3439,6 +3423,9 @@ TclEvalObjvInternal( if (*(iPtr->result) != 0) { (void) Tcl_GetObjResult(interp); } + + done: + iPtr->varFramePtr = savedVarFramePtr; return code; } diff --git a/tests/parse.test b/tests/parse.test index fa1f344..9657951 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: parse.test,v 1.22 2006/02/28 15:47:10 dgp Exp $ +# RCS: @(#) $Id: parse.test,v 1.23 2006/03/06 21:56:34 dgp Exp $ if {[catch {package require tcltest 2.0.2}]} { puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." @@ -398,7 +398,28 @@ test parse-8.11 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} testevalobjv { rename ::unknown {} rename unknown.save ::unknown set ::info -} [subst {[set level 2; incr level [info level]] namespace 1 global 1 global}] +} [subst {[set level 2; incr level [info level]] global 1 global 1 global}] +test parse-8.12 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} { + set ::auto_index(noSuchCommand) { + proc noSuchCommand {} {lappend ::info global} + } + set ::auto_index(::[string trimleft [namespace current]::test_ns_1::noSuchCommand :]) [list \ + proc [namespace current]::test_ns_1::noSuchCommand {} { + lappend ::info ns + }] + catch {rename ::noSuchCommand {}} + set ::slave [interp create] + $::slave alias bar noSuchCommand + set ::info {} + namespace eval test_ns_1 { + $::slave eval bar + } + namespace delete test_ns_1 + interp delete $::slave + catch {rename ::noSuchCommand {}} + set ::info +} global + test parse-9.1 {Tcl_LogCommandInfo, line numbers} testevalex { catch {unset x} |