Attachment "1444291-85.patch" to
ticket [1444291fff]
added by
dgp
2006-03-07 04:48:14.
? all
? debug
? mem
? patched
? pkgs
? solall
? solaris
? solbug
? solthread
? thread
? 1047286.patch
? 1077005.patch
? 1077194.patch
? 1077229.patch
? 1077242.patch
? 1077242.patch-old
? 1077242a.patch
? 1161550-tcl.patch
? 1162286.patch
? 1175180.patch
? 1189657.patch
? 1194015.patch
? 1208108.patch
? 1214462.patch
? 1236896.patch
? 1237755.patch
? 1242844.patch
? 1243354.patch
? 1264637-old.patch
? 1264637.patch
? 1283976-85.patch
? 1283976.patch
? 1337941.patch
? 1338280.patch
? 1355342.patch
? 1379287.patch
? auto.patch
? checkme
? crap.patch
? final.patch
? format.patch
? import.patch
? mask.patch
? mo.patch
? mwp.patch
? nsPtr
? pod.patch
? purge.patch
? remove.patch
? shimmer.patch
? h
? sift
? stringfirst.patch
? tip86.patch
? trial.patch
? type.patch
? undo.patch
? 1077242a,patch
? 1284178.patch
? TclUtfCasecmp-10.patch
? TclUtfCasecmp-4.patch
? TclUtfcasecmp-3.patch
? Tcl_Utfcasecmp.patch
? bccDict.diff
? bccDict_2.diff
? main-85.patch
? round.patch
? tclLink.patch
? tclTrace.diff.dos
? tip181-4.patch
? 1372348.patch
? 1382287.patch
? 1380662.patch-hacked
? 1397843.patch
? 1400572.patch
? apply2.patch
? apply3.patch
? nsupvar.patch
? 1275435.patch
? tip181-5.patch
? tip181-6.patch
? apply4.patch
? apply5.patch
? tip215.patch
? tip258.patch
? 958222.patch
? 944803.patch
? 1413934.patch
? 1422736.patch
? 1413115.patch
? 1380662.patch-old
? 958222-supp.patch
? 958222-supp.patch-old
? 1439836-85.patch
? 1444291-85.patch
? doc/newdocs
? generic/tclBasic.c.ip
? generic/tclCmdAH.c.head
? generic/tclCompile.c.sift
? generic/tclExecute.c-hacker
? generic/tclExecute.c.head
? generic/tclGet.c.ip
? generic/c
? generic/tclIO.c-hacked
? generic/tclInt.h.nuc
? generic/tclInterp.c.HEAD
? generic/tclInterp.c.ip
? generic/tclInterp.c.trial
? generic/patch21
? generic/tclObj.c.bool
? generic/tclObj.c.notyet
? generic/patch18
? generic/tclTrace.diff
? generic/tclUtil.c.tfi
? generic/sdfsdf
? generic/undo.patch
? generic/patch20
? library/package.tcl.ip
? library/ppp
? tests/zip
? tests/trace.test.hacked
? unix/pkgs
? unix/conf21848.file
? unix/exit.tcl
? unix/foo.tcl
? unix/httpd_3274
? unix/pkgIndex.tcl
? unix/st1zQ1vB
? unix/stByWMDa
? unix/stEsfQdJ
? unix/stMo5DK9
? unix/stPshuKG
? unix/stTtxMuk
? unix/stWm0KwI
? unix/stfNqFeB
? unix/stg1V94g
? unix/study
? unix/.nfs000000000006295600000030
? unix/demo
? unix/tclUnixInit.c.ip
? unix/stJSQYee
? unix/dltest.marker
? unix/strzmGWh
? unix/stXC2kzx
? unix/.nfs00000000000629b500000006
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.192
diff -u -r1.192 tclBasic.c
--- generic/tclBasic.c 28 Feb 2006 15:47:10 -0000 1.192
+++ generic/tclBasic.c 6 Mar 2006 21:38:01 -0000
@@ -3244,6 +3244,7 @@
int traceCode = TCL_OK;
int checkTraces = 1;
int cmdEpoch;
+ Namespace *savedNsPtr = NULL;
if (TclInterpReady(interp) == TCL_ERROR) {
return TCL_ERROR;
@@ -3253,6 +3254,15 @@
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 @@
* 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 @@
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 @@
} 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 @@
* 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 @@
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 @@
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 @@
*/
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 @@
traceCode = TclCheckInterpTraces(interp, command, length,
cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
}
- iPtr->varFramePtr = savedVarFramePtr;
}
TclCleanupCommand(cmdPtr);
@@ -3439,6 +3423,9 @@
if (*(iPtr->result) != 0) {
(void) Tcl_GetObjResult(interp);
}
+
+ done:
+ iPtr->varFramePtr = savedVarFramePtr;
return code;
}
Index: tests/parse.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/parse.test,v
retrieving revision 1.22
diff -u -r1.22 parse.test
--- tests/parse.test 28 Feb 2006 15:47:10 -0000 1.22
+++ tests/parse.test 6 Mar 2006 21:38:03 -0000
@@ -398,7 +398,28 @@
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}
