Attachment "infolevel.patch" to
ticket [1577492fff]
added by
msofer
2006-10-15 10:02:05.
Index: generic/tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.217
diff -u -r1.217 tcl.h
--- generic/tcl.h 5 Oct 2006 21:24:39 -0000 1.217
+++ generic/tcl.h 15 Oct 2006 02:56:28 -0000
@@ -1066,11 +1066,14 @@
* o Cut out of error traces
* o Don't reset the flags controlling ensemble
* error message rewriting.
+ * TCL_EVAL_NOREWRITE Do not update the interp's last call info;
+ * used by the ensemble rewrite machinery
*/
#define TCL_NO_EVAL 0x10000
#define TCL_EVAL_GLOBAL 0x20000
#define TCL_EVAL_DIRECT 0x40000
#define TCL_EVAL_INVOKE 0x80000
+#define TCL_EVAL_NOREWRITE 0x100000
/*
* Special freeProc values that may be passed to Tcl_SetResult (see the man
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.197
diff -u -r1.197 tclBasic.c
--- generic/tclBasic.c 22 Sep 2006 18:13:27 -0000 1.197
+++ generic/tclBasic.c 15 Oct 2006 02:56:31 -0000
@@ -357,6 +357,8 @@
if (iPtr->globalNsPtr == NULL) {
Tcl_Panic("Tcl_CreateInterp: can't create global namespace");
}
+ iPtr->callObjc = 0;
+ iPtr->callObjv = NULL;
/*
* Initialize support for code compilation and execution. We call
@@ -3265,6 +3267,16 @@
iPtr->varFramePtr->nsPtr = iPtr->globalNsPtr;
}
+
+ /*
+ * Record the calling objc/objv except if requested not to
+ */
+
+ if (!(flags & TCL_EVAL_NOREWRITE)) {
+ iPtr->callObjc = objc;
+ iPtr->callObjv = objv;
+ }
+
/*
* 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.
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.279
diff -u -r1.279 tclInt.h
--- generic/tclInt.h 30 Sep 2006 19:00:12 -0000 1.279
+++ generic/tclInt.h 15 Oct 2006 02:56:37 -0000
@@ -1530,8 +1530,16 @@
* i.e the package require preferences.
*/
- int packagePrefer; /* Current package selection mode.
- */
+ int packagePrefer; /* Current package selection mode. */
+
+ /*
+ * Let [info level] know about ensemble rewriting
+ */
+
+ int callObjc;
+ Tcl_Obj *CONST *callObjv;
+
+
/*
* Statistical information about the bytecode compiler and interpreter's
* operation.
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.101
diff -u -r1.101 tclNamesp.c
--- generic/tclNamesp.c 10 Oct 2006 16:45:04 -0000 1.101
+++ generic/tclNamesp.c 15 Oct 2006 02:56:37 -0000
@@ -429,8 +429,8 @@
nsPtr->activationCount++;
framePtr->nsPtr = nsPtr;
framePtr->isProcCallFrame = isProcCallFrame;
- framePtr->objc = 0;
- framePtr->objv = NULL;
+ framePtr->objc = iPtr->callObjc;
+ framePtr->objv = iPtr->callObjv;
framePtr->callerPtr = iPtr->framePtr;
framePtr->callerVarPtr = iPtr->varFramePtr;
if (iPtr->varFramePtr != NULL) {
@@ -3436,9 +3436,6 @@
if (result != TCL_OK) {
return TCL_ERROR;
}
- framePtr->objc = objc;
- framePtr->objv = objv; /* Reference counts do not need to be
- * incremented here. */
if (objc == 4) {
result = Tcl_EvalObjEx(interp, objv[3], 0);
@@ -3837,8 +3834,6 @@
if (result != TCL_OK) {
return result;
}
- framePtr->objc = objc;
- framePtr->objv = objv;
/*
* Execute the command. If there is just one argument, just treat it as a
@@ -6283,7 +6278,7 @@
memcpy(tempObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
memcpy(tempObjv+prefixObjc, objv+2, sizeof(Tcl_Obj *) * (objc-2));
result = Tcl_EvalObjv(interp, objc-2+prefixObjc, tempObjv,
- TCL_EVAL_INVOKE);
+ TCL_EVAL_INVOKE|TCL_EVAL_NOREWRITE);
Tcl_DecrRefCount(prefixObj);
ckfree((char *) tempObjv);
if (isRootEnsemble) {
@@ -6303,10 +6298,11 @@
*/
if (ensemblePtr->unknownHandler != NULL && reparseCount++ < 1) {
+ Interp *iPtr = (Interp *) interp;
int paramc, i;
Tcl_Obj **paramv, *unknownCmd, *ensObj;
- unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);
+ unknownCmd = Tcl_NewListObj(1, &ensemblePtr->unknownHandler);
TclNewObj(ensObj);
Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj);
Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj);
@@ -6348,6 +6344,14 @@
}
/*
+ * Restore the interp's call data, which may have been wiped out
+ * while processing the unknown handler.
+ */
+
+ iPtr->callObjc = objc;
+ iPtr->callObjv = objv;
+
+ /*
* Namespace alive & empty result => reparse.
*/
Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.92
diff -u -r1.92 tclProc.c
--- generic/tclProc.c 30 Sep 2006 17:56:47 -0000 1.92
+++ generic/tclProc.c 15 Oct 2006 02:56:39 -0000
@@ -1205,9 +1205,6 @@
return result;
}
-
- framePtr->objc = objc;
- framePtr->objv = objv; /* ref counts for args are incremented below */
framePtr->procPtr = procPtr;
/*
Index: tests/namespace.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/namespace.test,v
retrieving revision 1.58
diff -u -r1.58 namespace.test
--- tests/namespace.test 10 Oct 2006 18:23:03 -0000 1.58
+++ tests/namespace.test 15 Oct 2006 02:56:40 -0000
@@ -1529,7 +1529,7 @@
set result [list [ns x0 z] [ns x1] [ns x2] [ns x3]]
namespace delete ns
set result
-} {{1 ::ns::x0::z} 1 2 3}
+} {{1 {ns x0 z}} 1 2 3}
test namespace-43.1 {ensembles: dict-driven} {
namespace eval ns {
@@ -1815,7 +1815,7 @@
lappend result [catch {ns c d e} msg] $msg
lappend result [catch {ns Magic foo bar spong wibble} msg] $msg
list $result [lsort [info commands ::ns::*]] $log [namespace delete ns]
-} {{0 2 0 2 0 2 0 2 1 {unknown or protected subcommand "Magic"}} {::ns::Magic ::ns::a ::ns::b ::ns::c} {{making a} {running ::ns::a b c} {running ::ns::a b c} {making b} {running ::ns::b c d} {making c} {running ::ns::c d e} {unknown Magic - args = foo bar spong wibble}} {}}
+} {{0 2 0 2 0 2 0 2 1 {unknown or protected subcommand "Magic"}} {::ns::Magic ::ns::a ::ns::b ::ns::c} {{making a} {running ns a b c} {running ns a b c} {making b} {running ns b c d} {making c} {running ns c d e} {unknown Magic - args = foo bar spong wibble}} {}}
test namespace-47.2 {ensemble: unknown handler} {
namespace eval ns {
namespace export {[a-z]*}
