From ac45c8d85147e6927979c08d95567504148b74cd Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Sat, 19 Sep 2020 14:33:24 +0000
Subject: Fix for [b9ecf3ce98], [uplevel] unnecessarily generates  string
 representation.

---
 generic/tclProc.c  | 45 ++++++++++++++++++++++++++++++++++-----------
 tests/uplevel.test | 17 +++++++++++++++++
 2 files changed, 51 insertions(+), 11 deletions(-)

diff --git a/generic/tclProc.c b/generic/tclProc.c
index a9134f2..0313b29 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -898,29 +898,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 f44cedc..5f0dd5c 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
-- 
cgit v0.12