summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2006-03-06 21:56:11 (GMT)
committerdgp <dgp@users.sourceforge.net>2006-03-06 21:56:11 (GMT)
commitf04a0f4fc371aae20e1d651be91414b3591fc4a4 (patch)
treeb356d298e243eae44defe680c0ea954259723513
parent76f698cfd03687bdb68303ca5f307f327006c40b (diff)
downloadtcl-f04a0f4fc371aae20e1d651be91414b3591fc4a4.zip
tcl-f04a0f4fc371aae20e1d651be91414b3591fc4a4.tar.gz
tcl-f04a0f4fc371aae20e1d651be91414b3591fc4a4.tar.bz2
* 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].
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclBasic.c47
-rw-r--r--tests/parse.test24
3 files changed, 47 insertions, 30 deletions
diff --git a/ChangeLog b/ChangeLog
index a9b6b61..128ece3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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-02 Jeff Hobbs <jeffh@ActiveState.com>
* win/Makefile.in: convert _NATIVE paths to use / to avoid ".\"
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index f70af71..1941ca0 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.75.2.20 2006/02/28 15:44:35 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.75.2.21 2006/03/06 21:56:13 dgp Exp $
*/
#include "tclInt.h"
@@ -2984,6 +2984,7 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
int code = TCL_OK;
int traceCode = TCL_OK;
int checkTraces = 1;
+ Namespace *savedNsPtr = NULL;
if (TclInterpReady(interp) == TCL_ERROR) {
return TCL_ERROR;
@@ -2993,6 +2994,15 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
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;
+ }
+
/*
* If any execution traces rename or delete the current command,
* we may need (at most) two passes here.
@@ -3005,19 +3015,8 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
* word array with "unknown" as the first word and 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.
*/
-
- savedVarFramePtr = iPtr->varFramePtr;
- if (flags & (TCL_EVAL_INVOKE | TCL_EVAL_GLOBAL)) {
- iPtr->varFramePtr = NULL;
- }
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
- iPtr->varFramePtr = savedVarFramePtr;
-
if (cmdPtr == NULL) {
newObjv = (Tcl_Obj **) ckalloc((unsigned)
((objc + 1) * sizeof (Tcl_Obj *)));
@@ -3035,13 +3034,19 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
} else {
iPtr->numLevels++;
code = TclEvalObjvInternal(interp, objc+1, newObjv,
- command, length, flags);
+ command, length, 0);
iPtr->numLevels--;
}
Tcl_DecrRefCount(newObjv[0]);
ckfree((char *) newObjv);
+ if (savedNsPtr) {
+ iPtr->varFramePtr->nsPtr = savedNsPtr;
+ }
goto done;
}
+ if (savedNsPtr) {
+ iPtr->varFramePtr->nsPtr = savedNsPtr;
+ }
/*
* Call trace procedures if needed.
@@ -3054,10 +3059,6 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
* any existing traces, then the set checkTraces to 0 and
* go through this while loop one more time.
*/
- savedVarFramePtr = iPtr->varFramePtr;
- 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);
@@ -3067,7 +3068,6 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
traceCode = TclCheckExecutionTraces(interp, command, length,
cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
}
- iPtr->varFramePtr = savedVarFramePtr;
cmdPtr->refCount--;
if (cmdEpoch != cmdPtr->cmdEpoch) {
/* The command has been modified in some way */
@@ -3084,12 +3084,7 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
cmdPtr->refCount++;
iPtr->cmdCount++;
if ( code == TCL_OK && traceCode == TCL_OK) {
- savedVarFramePtr = iPtr->varFramePtr;
- if (flags & TCL_EVAL_GLOBAL) {
- iPtr->varFramePtr = NULL;
- }
code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
- iPtr->varFramePtr = savedVarFramePtr;
}
if (Tcl_AsyncReady()) {
code = Tcl_AsyncInvoke(interp, code);
@@ -3101,10 +3096,6 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
if (!(cmdPtr->flags & CMD_IS_DELETED)) {
int saveErrFlags = iPtr->flags
& (ERR_IN_PROGRESS | ERR_ALREADY_LOGGED | ERROR_CODE_SET);
- savedVarFramePtr = iPtr->varFramePtr;
- 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);
@@ -3113,7 +3104,6 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
traceCode = TclCheckInterpTraces(interp, command, length,
cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
}
- iPtr->varFramePtr = savedVarFramePtr;
if (traceCode == TCL_OK) {
iPtr->flags |= saveErrFlags;
}
@@ -3143,6 +3133,7 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
}
done:
+ iPtr->varFramePtr = savedVarFramePtr;
return code;
}
diff --git a/tests/parse.test b/tests/parse.test
index dae14e9..6820d80 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.11.2.3 2006/02/28 15:44:36 dgp Exp $
+# RCS: @(#) $Id: parse.test,v 1.11.2.4 2006/03/06 21:56:13 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -312,7 +312,27 @@ 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} {
catch {unset x}