* library/clock.tcl (format, scan): corrected wrong # args

	* tests/clock.test (3.1, 34.1):     messages to make use of the
	new rewrite capabilities of [info level]

	* generic/tcl.h:           Lets TEOV update the iPtr->objc/objv
	* generic/tclBasic.c:      fields, except when the (new) flag bit
	* generic/tclInt.h:        TCL_EVAL_NOREWRITE is present. This
	* generic/tclNamesp.c:     causes [info level] to know and use
	* generic/tclProc.c:       ensemble rewrites [Bug 1577492]
	* tests/namespace.test:

	***POTENTIAL INCOMPATIBILITY***
	The return value from [info level 0] on interp alias calls is
	changed: previously returned the target command (including curried
	values), now returns the source - what was actually called.


FossilOrigin-Name: db2a3f31b390f3aa535dbbaae83fcf5233114fbc

9 files changed, 72 insertions, 28 deletions

diff --git a/ChangeLog b/ChangeLog
index 0e75aa7..96c0cb1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,23 @@
 2006-10-23  Miguel Sofer  <msofer@users.sf.net>
 
+	* library/clock.tcl (format, scan): corrected wrong # args
+	* tests/clock.test (3.1, 34.1):     messages to make use of the
+	new rewrite capabilities of [info level]
+
+	* generic/tcl.h:           Lets TEOV update the iPtr->objc/objv
+	* generic/tclBasic.c:      fields, except when the (new) flag bit 
+	* generic/tclInt.h:        TCL_EVAL_NOREWRITE is present. This 
+	* generic/tclNamesp.c:     causes [info level] to know and use  
+	* generic/tclProc.c:       ensemble rewrites [Bug 1577492]
+	* tests/namespace.test:
+
+	***POTENTIAL INCOMPATIBILITY*** 
+	The return value from [info level 0] on interp alias calls is
+	changed: previously returned the target command (including curried
+	values), now returns the source - what was actually called. 
+
+2006-10-23  Miguel Sofer  <msofer@users.sf.net>
+
 	* generic/tcl.h:           Modified the Tcl call stack so 
 	* generic/tclBasic.c:      there is always a valid CallFrame, even 
 	* generic/tclCmdIL.c:      at level 0 [Patch 1577278]. Most of the 
diff --git a/generic/tcl.h b/generic/tcl.h
index 2522fa2..8e309a2 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -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: tcl.h,v 1.223 2006/10/23 21:36:54 msofer Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.224 2006/10/23 22:49:24 msofer Exp $
  */
 
 #ifndef _TCL
@@ -1066,11 +1066,14 @@ typedef struct Tcl_DString {
  *				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
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 5bccd2e..a633a85 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.201 2006/10/23 21:36:54 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.202 2006/10/23 22:49:24 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -362,6 +362,8 @@ Tcl_CreateInterp(void)
     if (iPtr->globalNsPtr == NULL) {
 	Tcl_Panic("Tcl_CreateInterp: can't create global namespace");
     }
+    iPtr->callObjc = 0;
+    iPtr->callObjv = NULL;
 
     /*
      * Initialise the rootCallframe. It cannot be allocated on the stack, as
@@ -3301,6 +3303,16 @@ TclEvalObjvInternal(
 	}
     }
 
+
+    /*
+     * 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.
diff --git a/generic/tclInt.h b/generic/tclInt.h
index fffcffe..6a06fb0 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.282 2006/10/23 21:36:55 msofer Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.283 2006/10/23 22:49:25 msofer Exp $
  */
 
 #ifndef _TCLINT
@@ -1529,8 +1529,16 @@ typedef struct Interp {
      * 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.
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index b360211..a2a1632 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -22,7 +22,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.104 2006/10/23 21:36:55 msofer Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.105 2006/10/23 22:49:25 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -425,8 +425,8 @@ Tcl_PushCallFrame(
     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) {
@@ -3433,9 +3433,6 @@ NamespaceEvalCmd(
     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);
@@ -3834,8 +3831,6 @@ NamespaceInscopeCmd(
     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
@@ -6281,7 +6276,7 @@ NsEnsembleImplementationCmd(
 	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) {
@@ -6301,10 +6296,11 @@ NsEnsembleImplementationCmd(
      */
 
     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);
@@ -6346,6 +6342,14 @@ NsEnsembleImplementationCmd(
 	    }
 
 	    /*
+	     * 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.
 	     */
 
diff --git a/generic/tclProc.c b/generic/tclProc.c
index e6a70ab..b0df000 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -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: tclProc.c,v 1.96 2006/10/23 21:36:55 msofer Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.97 2006/10/23 22:49:25 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1198,9 +1198,6 @@ ObjInterpProcEx(
 	return result;
     }
 
-
-    framePtr->objc = objc;
-    framePtr->objv = objv;	/* ref counts for args are incremented below */
     framePtr->procPtr = procPtr;
 
     /*
diff --git a/library/clock.tcl b/library/clock.tcl
index ab60089..61f905b 100644
--- a/library/clock.tcl
+++ b/library/clock.tcl
@@ -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: clock.tcl,v 1.35 2006/08/24 21:47:49 kennykb Exp $
+# RCS: @(#) $Id: clock.tcl,v 1.36 2006/10/23 22:49:25 msofer Exp $
 #
 #----------------------------------------------------------------------
 
@@ -653,10 +653,11 @@ proc ::tcl::clock::format { args } {
     # Check the count of args
 
     if { [llength $args] < 1 || [llength $args] % 2 != 1 } {
+	set cmdName [lrange [info level 0] 0 end-[llength $args]]
 	return -code error \
 	    -errorcode [list CLOCK wrongNumArgs] \
 	    "wrong \# args: should be\
-             \"[lindex [info level 0] 0] clockval\
+             \"$cmdName clockval\
              ?-format string? ?-gmt boolean?\
              ?-locale LOCALE? ?-timezone ZONE?\""
     }
@@ -1243,10 +1244,11 @@ proc ::tcl::clock::scan { args } {
     # Check the count of args
 
     if { [llength $args] < 1 || [llength $args] % 2 != 1 } {
+	set cmdName [lrange [info level 0] 0 end-[llength $args]]
 	return -code error \
 	    -errorcode [list CLOCK wrongNumArgs] \
 	    "wrong \# args: should be\
-             \"[lindex [info level 0] 0] string\
+             \"$cmdName string\
              ?-base seconds?\
              ?-format string? ?-gmt boolean?\
              ?-locale LOCALE? ?-timezone ZONE?\""
diff --git a/tests/clock.test b/tests/clock.test
index 3eb6ed0..c1b9965 100644
--- a/tests/clock.test
+++ b/tests/clock.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: clock.test,v 1.68 2006/10/01 20:59:01 kennykb Exp $
+# RCS: @(#) $Id: clock.test,v 1.69 2006/10/23 22:49:25 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -252,7 +252,7 @@ proc ::testClock::registry { cmd path key } {
 
 test clock-1.0 "clock format - wrong # args" {
     list [catch {clock format} msg] $msg $::errorCode
-} {1 {wrong # args: should be "::tcl::clock::format clockval ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"} {CLOCK wrongNumArgs}}
+} {1 {wrong # args: should be "clock format clockval ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"} {CLOCK wrongNumArgs}}
 
 test clock-1.1 "clock format - bad time" {
     list [catch {clock format foo} msg] $msg
@@ -35523,7 +35523,7 @@ test clock-33.11a {clock test, millis align with micros} {
 # clock scan
 test clock-34.1 {clock scan tests} {
     list [catch {clock scan} msg] $msg
-} {1 {wrong # args: should be "::tcl::clock::scan string ?-base seconds? ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"}}
+} {1 {wrong # args: should be "clock scan string ?-base seconds? ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"}}
 test clock-34.2 {clock scan tests} {
     list [catch {clock scan "bad-string"} msg] $msg
 } {1 {unable to convert date-time string "bad-string"}}
diff --git a/tests/namespace.test b/tests/namespace.test
index 4597b6f..2bc0f04 100644
--- a/tests/namespace.test
+++ b/tests/namespace.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: namespace.test,v 1.58 2006/10/10 18:23:03 dgp Exp $
+# RCS: @(#) $Id: namespace.test,v 1.59 2006/10/23 22:49:26 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -1529,7 +1529,7 @@ test namespace-42.7 {ensembles: nested} {
     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 @@ test namespace-47.1 {ensemble: unknown handler} {
     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]*}