Attachment "958222-supp.patch" to
ticket [958222ffff]
added by
dgp
2006-02-23 00:39:53.
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.190
diff -u -r1.190 tclBasic.c
--- generic/tclBasic.c 8 Feb 2006 21:41:27 -0000 1.190
+++ generic/tclBasic.c 22 Feb 2006 17:27:25 -0000
@@ -3240,13 +3240,10 @@
int i;
CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
* TCL_EVAL_GLOBAL was set. */
- Namespace *currNsPtr = NULL;/* Used to check for and invoke any
- * registered unknown command
- * handler for the current namespace
- * (see TIP 181). */
int code = TCL_OK;
int traceCode = TCL_OK;
int checkTraces = 1;
+ int cmdEpoch;
if (TclInterpReady(interp) == TCL_ERROR) {
return TCL_ERROR;
@@ -3273,61 +3270,52 @@
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]);
- /*
- * Grab current namespace before restoring var frame, for unknown
- * handler check below.
- */
- if (iPtr->varFramePtr != NULL && iPtr->varFramePtr->nsPtr != NULL) {
- currNsPtr = iPtr->varFramePtr->nsPtr;
- } else {
- /* Note: assumes globalNsPtr can never be NULL. */
- currNsPtr = iPtr->globalNsPtr;
- if (currNsPtr == NULL) {
- Tcl_Panic("TclEvalObjvInternal: NULL global namespace pointer");
- }
- }
- iPtr->varFramePtr = savedVarFramePtr;
-
if (cmdPtr == NULL) {
+ Namespace *currNsPtr = NULL; /* Used to check for and invoke any
+ * registered unknown command handler
+ * for the current namespace
+ * (TIP 181). */
int newObjc, handlerObjc;
Tcl_Obj **handlerObjv;
- /*
- * Check if there is an unknown handler registered for this namespace.
- * Otherwise, use the global namespace unknown handler.
- */
+
+ if (iPtr->varFramePtr != NULL) {
+ currNsPtr = iPtr->varFramePtr->nsPtr;
+ }
+ if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) {
+ currNsPtr = iPtr->globalNsPtr;
+ }
+ if (currNsPtr == NULL) {
+ Tcl_Panic("TclEvalObjvInternal: NULL global namespace pointer");
+ }
if (currNsPtr->unknownHandlerPtr == NULL) {
- currNsPtr = iPtr->globalNsPtr;
- }
- if (currNsPtr == iPtr->globalNsPtr &&
- currNsPtr->unknownHandlerPtr == NULL) {
/* Global namespace has lost unknown handler, reset. */
- currNsPtr->unknownHandlerPtr =
- Tcl_NewStringObj("::unknown", -1);
+ currNsPtr->unknownHandlerPtr = Tcl_NewStringObj("::unknown", -1);
Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
}
- if (Tcl_ListObjGetElements(interp,
- currNsPtr->unknownHandlerPtr, &handlerObjc, &handlerObjv)
- != TCL_OK) {
- return TCL_ERROR;
- }
+ Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
+ &handlerObjc, &handlerObjv);
newObjc = objc + handlerObjc;
newObjv = (Tcl_Obj **) ckalloc((unsigned)
(newObjc * sizeof(Tcl_Obj *)));
/* Copy command prefix from unknown handler. */
for (i = 0; i < handlerObjc; ++i) {
newObjv[i] = handlerObjv[i];
+ Tcl_IncrRefCount(newObjv[i]);
}
/* Add in command name and arguments. */
for (i = objc-1; i >= 0; --i) {
newObjv[i+handlerObjc] = objv[i];
}
- Tcl_IncrRefCount(newObjv[0]);
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]);
-
+ iPtr->varFramePtr = savedVarFramePtr;
if (cmdPtr == NULL) {
Tcl_AppendResult(interp, "invalid command name \"",
TclGetString(objv[0]), "\"", NULL);
@@ -3335,20 +3323,23 @@
} else {
iPtr->numLevels++;
code = TclEvalObjvInternal(interp, newObjc, newObjv, command,
- length, 0);
+ length, flags);
iPtr->numLevels--;
}
- Tcl_DecrRefCount(newObjv[0]);
+ for (i = 0; i < handlerObjc; ++i) {
+ Tcl_DecrRefCount(newObjv[i]);
+ }
ckfree((char *) newObjv);
- goto done;
+ return code;
}
+ iPtr->varFramePtr = savedVarFramePtr;
/*
* Call trace functions if needed.
*/
+ cmdEpoch = cmdPtr->cmdEpoch;
if ((checkTraces) && (command != NULL)) {
- int cmdEpoch = cmdPtr->cmdEpoch;
cmdPtr->refCount++;
/*
@@ -3366,14 +3357,11 @@
cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
}
cmdPtr->refCount--;
- if (cmdEpoch != cmdPtr->cmdEpoch) {
- /*
- * The command has been modified in some way.
- */
-
- checkTraces = 0;
- goto reparseBecauseOfTraces;
- }
+ }
+ if (cmdEpoch != cmdPtr->cmdEpoch) {
+ /* The command has been modified in some way. */
+ checkTraces = 0;
+ goto reparseBecauseOfTraces;
}
/*
@@ -3384,6 +3372,11 @@
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;
}
@@ -3438,8 +3431,6 @@
if (*(iPtr->result) != 0) {
(void) Tcl_GetObjResult(interp);
}
-
- done:
return code;
}
Index: tests/namespace.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/namespace.test,v
retrieving revision 1.53
diff -u -r1.53 namespace.test
--- tests/namespace.test 1 Feb 2006 18:27:48 -0000 1.53
+++ tests/namespace.test 22 Feb 2006 17:27:28 -0000
@@ -2492,6 +2492,73 @@
$i invokehidden proc unknown args { return "FINE" }
$i eval { foo bar bob }
} {FINE}
+test namespace-52.9 {unknown: refcounting} -setup {
+ proc this args {
+ unset args ;# stop sharing
+ set copy [namespace unknown]
+ string length $copy ;# shimmer away list rep
+ info level 0
+ }
+ set handler [namespace unknown]
+ namespace unknown {this is a test}
+ catch {rename noSuchCommand {}}
+} -body {
+ noSuchCommand
+} -cleanup {
+ namespace unknown $handler
+ rename this {}
+} -result {this is a test noSuchCommand}
+test namespace-52.10 {unknown: with TCL_EVAL_GLOBAL} -setup {
+ rename ::unknown unknown.save
+ proc ::unknown args {
+ set caller [uplevel 1 {namespace current}]
+ namespace eval $caller {
+ variable foo
+ return $foo
+ }
+ }
+ catch {rename ::noSuchCommand {}}
+} -body {
+ namespace eval :: {
+ variable foo SUCCESS
+ }
+ namespace eval test_ns_1 {
+ variable foo FAIL
+ testevalobjv 1 noSuchCommand
+ }
+} -cleanup {
+ unset -nocomplain ::foo
+ namespace delete test_ns_1
+ rename ::unknown {}
+ rename unknown.save ::unknown
+} -result SUCCESS
+test namespace-52.11 {unknown: with TCL_EVAL_INVOKE} -setup {
+ set handler [namespace eval :: {namespace unknown}]
+ namespace eval :: {namespace unknown unknown}
+ rename ::unknown unknown.save
+ namespace eval :: {
+ proc unknown args {
+ return SUCCESS
+ }
+ }
+ catch {rename ::noSuchCommand {}}
+ set slave [interp create]
+} -body {
+ $slave alias bar noSuchCommand
+ namespace eval test_ns_1 {
+ namespace unknown unknown
+ proc unknown args {
+ return FAIL
+ }
+ $slave eval bar
+ }
+} -cleanup {
+ interp delete $slave
+ namespace delete test_ns_1
+ rename ::unknown {}
+ rename unknown.save ::unknown
+ namespace eval :: [list namespace unknown $handler]
+} -result SUCCESS
# cleanup
catch {rename cmd1 {}}
