summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2006-11-03 23:24:43 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2006-11-03 23:24:43 (GMT)
commit582529b442db759535075226bac5cb74b4b5c783 (patch)
treeb21863c4864afd6ce4e8ff900e3c7a8d28946a0a
parent2afbba78fdfe1f2fb3310a5b778aac9ee5c5843c (diff)
downloadtcl-582529b442db759535075226bac5cb74b4b5c783.zip
tcl-582529b442db759535075226bac5cb74b4b5c783.tar.gz
tcl-582529b442db759535075226bac5cb74b4b5c783.tar.bz2
* generic/tclBasic.c (TEOVI):
* tests/trace.test (trace-21.11): fix for [Bug 1590232], execution traces may cause a second command resolution in the wrong namespace.
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclBasic.c24
-rw-r--r--tests/trace.test22
3 files changed, 41 insertions, 12 deletions
diff --git a/ChangeLog b/ChangeLog
index 63bccff..c3250cd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2006-11-03 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (TEOVI):
+ * tests/trace.test (trace-21.11): fix for [Bug 1590232], execution
+ traces may cause a second command resolution in the wrong
+ namespace.
+
2006-11-03 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
* tests/event.test (event-11.5): Rewrote tests to stop Tcl from
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 71fa572..0f5c535 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.214 2006/11/02 16:39:06 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.215 2006/11/03 23:24:43 msofer Exp $
*/
#include "tclInt.h"
@@ -3279,6 +3279,7 @@ TclEvalObjvInternal(
int traceCode = TCL_OK;
int checkTraces = 1;
Namespace *savedNsPtr = NULL;
+ Namespace *lookupNsPtr = iPtr->lookupNsPtr;
if (TclInterpReady(interp) == TCL_ERROR) {
return TCL_ERROR;
@@ -3289,17 +3290,26 @@ TclEvalObjvInternal(
}
/*
+ * If any execution traces rename or delete the current command, we may
+ * need (at most) two passes here.
+ */
+
+ reparseBecauseOfTraces:
+
+ /*
* Configure evaluation context to match the requested flags.
*/
- if ((flags & TCL_EVAL_GLOBAL) && (varFramePtr != iPtr->rootFramePtr)) {
+ if ((flags & TCL_EVAL_GLOBAL) && (varFramePtr != iPtr->rootFramePtr)
+ && !savedVarFramePtr) {
varFramePtr = iPtr->rootFramePtr;
savedVarFramePtr = iPtr->varFramePtr;
iPtr->varFramePtr = varFramePtr;
} else if (flags & TCL_EVAL_INVOKE) {
savedNsPtr = varFramePtr->nsPtr;
- if (iPtr->lookupNsPtr) {
- varFramePtr->nsPtr = iPtr->lookupNsPtr;
+ if (lookupNsPtr) {
+ varFramePtr->nsPtr = lookupNsPtr;
+ iPtr->lookupNsPtr = NULL;
} else {
varFramePtr->nsPtr = iPtr->globalNsPtr;
}
@@ -3311,12 +3321,8 @@ TclEvalObjvInternal(
* If so, create a new word array with the handler as the first words and
* the original command words as arguments. Then call ourselves
* recursively to execute it.
- *
- * If any execution traces rename or delete the current command, we may
- * need (at most) two passes here.
*/
- reparseBecauseOfTraces:
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
if (cmdPtr == NULL) {
Namespace *currNsPtr = NULL; /* Used to check for and invoke any
@@ -3399,13 +3405,11 @@ TclEvalObjvInternal(
TclStackFree(interp);
if (savedNsPtr) {
varFramePtr->nsPtr = savedNsPtr;
- iPtr->lookupNsPtr = NULL;
}
goto done;
}
if (savedNsPtr) {
varFramePtr->nsPtr = savedNsPtr;
- iPtr->lookupNsPtr = NULL;
}
/*
diff --git a/tests/trace.test b/tests/trace.test
index 7c74c0c..5ab6a72 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: trace.test,v 1.50 2006/11/03 00:34:53 hobbs Exp $
+# RCS: @(#) $Id: trace.test,v 1.51 2006/11/03 23:24:43 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -1610,7 +1610,7 @@ test trace-21.9 {trace execution: TCL_EVAL_GLOBAL} testevalobjv {
trace remove execution foo enter soom
set ::info
} {SUCCESS 1 SUCCESS 1}
-
+
test trace-21.10 {trace execution: TCL_EVAL_GLOBAL} testevalobjv {
trace add execution foo leave soom
proc ::soom args {lappend ::info SUCCESS [info level]}
@@ -1627,6 +1627,24 @@ test trace-21.10 {trace execution: TCL_EVAL_GLOBAL} testevalobjv {
set ::info
} {SUCCESS 1 SUCCESS 1}
+test trace-21.11 {trace execution and alias} -setup {
+ set res {}
+ proc ::x {} {return ::}
+ namespace eval a {}
+ proc ::a::x {} {return ::a}
+ interp alias {} y {} x
+} -body {
+ lappend res [namespace eval ::a y]
+ trace add execution ::x enter {
+ rename ::x {}
+ proc ::x {} {return ::}
+ #}
+ lappend res [namespace eval ::a y]
+} -cleanup {
+ namespace delete a
+ rename ::x {}
+} -result {:: ::}
+
proc factorial {n} {
if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }
return 1