Fix for [b9ecf3ce98], [uplevel] unnecessarily generates string representation.

2 files changed, 51 insertions, 11 deletions

diff --git a/generic/tclProc.c b/generic/tclProc.c
index 67c8c41..0e49664 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -905,29 +905,52 @@ TclNRUplevelObjCmd(
     Interp *iPtr = (Interp *) interp;
     CmdFrame *invoker = NULL;
     int word = 0;
+    int havelevel = 0;
     int result;
     CallFrame *savedVarFramePtr, *framePtr;
     Tcl_Obj *objPtr;
 
     if (objc < 2) {
+    /* to do 
+    *    simplify things by interpreting the argument as a command when there
+    *    is only one argument.  This requires a TIP since currently a single
+    *    argument is interpreted as a level indicator if possible.
+    */
     uplevelSyntax:
 	Tcl_WrongNumArgs(interp, 1, objv, "?level? command ?arg ...?");
 	return TCL_ERROR;
+    } else if (objc == 2) {
+	int status ,llength;
+	status = Tcl_ListObjLength(interp, objv[1], &llength);
+	if (status == TCL_OK && llength > 1) {
+	    /* the first argument can't interpreted as a level. Avoid
+	     * generating a string representation of the script. */
+	    result = TclGetFrame(interp, "1", &framePtr);
+	    if (result == -1) {
+		return TCL_ERROR;
+	    }
+	    havelevel = 1;
+	    objc -= 1;
+	    objv += 1;
+	}
     }
 
-    /*
-     * Find the level to use for executing the command.
-     */
+    if (!havelevel) {
+	/*
+	 * Find the level to use for executing the command.
+	 */
 
-    result = TclObjGetFrame(interp, objv[1], &framePtr);
-    if (result == -1) {
-	return TCL_ERROR;
-    }
-    objc -= result + 1;
-    if (objc == 0) {
-	goto uplevelSyntax;
+	result = TclObjGetFrame(interp, objv[1], &framePtr);
+	if (result == -1) {
+	    return TCL_ERROR;
+	}
+	objc -= result + 1;
+	if (objc == 0) {
+	    goto uplevelSyntax;
+	}
+	objv += result + 1;
     }
-    objv += result + 1;
+
 
     /*
      * Modify the interpreter state to execute in the given frame.
diff --git a/tests/uplevel.test b/tests/uplevel.test
index 7ba129a..5dc2806 100644
--- a/tests/uplevel.test
+++ b/tests/uplevel.test
@@ -304,7 +304,24 @@ test uplevel-7.3 {var access, LVT in upper level} -setup {
     rename foo {}
     rename moo {}
 } -result {3 3 3}
+
+
+test uplevel-8.0 {
+    string representation isn't generated when there is only one argument
+} -body {
+    set res {} 
+    set script [list lindex 5]
+    lappend res [apply {script {
+	uplevel $script
+    }} $script]
+    lappend res [string match {value is a list *no string representation*} [
+	::tcl::unsupported::representation $script]]
+} -cleanup {
+    unset script
+    unset res
+} -result {5 1}
 
+
 # cleanup
 ::tcltest::cleanupTests
 return