extend TclObjGetFrame with flags, currently supports 1 only - signaling that a supplied level-argument (objPtr) is optional

(e. g. in case of [uplevel $something]) to proper distinguish the level/body (in order to handle syntax error, TIP 515),
see bug [775ee88560]

generic/tclExecute.c

@@ -4132,7 +4132,7 @@ TEBCresume(
 	TRACE(("%d %.30s %.30s => ", TclGetInt4AtPtr(pc+1),
 		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
 
-	if (TclObjGetFrame(interp, OBJ_UNDER_TOS, &framePtr) == -1) {
+	if (TclObjGetFrame(interp, OBJ_UNDER_TOS, &framePtr, 0) == -1) {
 	    TRACE_ERROR(interp);
 	    goto gotError;
 	}

generic/tclInt.decls

@@ -802,7 +802,7 @@ declare 183 {deprecated {}}  {
 #}
 declare 198 {
     int TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr,
-	    CallFrame **framePtrPtr)
+	    CallFrame **framePtrPtr, int flags)
 }
 
 #declare 199 {

generic/tclIntDecls.h

@@ -493,7 +493,7 @@ struct tm *		TclpGmtime(const time_t *clock);
 /* Slot 197 is reserved */
 /* 198 */
 EXTERN int		TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr,
-				CallFrame **framePtrPtr);
+				CallFrame **framePtrPtr, int flags);
 /* Slot 199 is reserved */
 /* 200 */
 EXTERN int		TclpObjRemoveDirectory(Tcl_Obj *pathPtr,

generic/tclProc.c

@@ -724,7 +724,7 @@ TclGetFrame(
 	obj.bytes = (char *) name;
 	obj.length = strlen(name);
 	obj.typePtr = NULL;
-	result = TclObjGetFrame(interp, &obj, framePtrPtr);
+	result = TclObjGetFrame(interp, &obj, framePtrPtr, 0);
 	TclFreeIntRep(&obj);
 	return result;
 }
@@ -758,8 +758,9 @@ int
 TclObjGetFrame(
     Tcl_Interp *interp,		/* Interpreter in which to find frame. */
     Tcl_Obj *objPtr,		/* Object describing frame. */
-    CallFrame **framePtrPtr)	/* Store pointer to frame here (or NULL if
+    CallFrame **framePtrPtr,	/* Store pointer to frame here (or NULL if
 				 * global frame indicated). */
+    int flags)			/* 1 means the frame level (objPtr) is optional. */
 {
     Interp *iPtr = (Interp *) interp;
     int curLevel, level, result;
@@ -817,10 +818,10 @@ TclObjGetFrame(
 	}
     }
 
-    if (result == 0) {
-	level = curLevel - 1;
-    }
     if (result != -1) {
+	if (result == 0) {
+	    level = curLevel - 1;
+	}
 	if (level >= 0) {
 	    CallFrame *framePtr;
 	    for (framePtr = iPtr->varFramePtr; framePtr != NULL;
@@ -833,10 +834,15 @@ TclObjGetFrame(
 	}
     }
 
-    if (name == NULL) {
-	name = TclGetString(objPtr);
+    if (objPtr != NULL && (result != 0 || !(flags & 1))) {
+	if (name == NULL) {
+	    name = TclGetString(objPtr);
+	}
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
+    } else {
+	/* below of top-level (e. g. [uplevel cmd] at top-level) */
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("bad level \"1\"", -1));
     }
-    Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
     Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL);
     return -1;
 }
@@ -915,7 +921,7 @@ TclNRUplevelObjCmd(
      * Find the level to use for executing the command.
      */
 
-    result = TclObjGetFrame(interp, objv[1], &framePtr);
+    result = TclObjGetFrame(interp, objv[1], &framePtr, (objc == 2)? 1 : 0);
     if (result == -1) {
 	return TCL_ERROR;
     }

generic/tclVar.c

@@ -5282,7 +5282,7 @@ Tcl_UpvarObjCmd(
      * linked to.
      */
 
-    result = TclObjGetFrame(interp, levelObj, &framePtr);
+    result = TclObjGetFrame(interp, levelObj, &framePtr, 0);
     if (result == -1) {
 	return TCL_ERROR;
     }

tests/uplevel.test

@@ -83,6 +83,16 @@ test uplevel-3.4 {uplevel to same level} {
     a1
 } 55
 
+test uplevel-4.0.1 {error: non-existent level} -body {
+    uplevel #0 { uplevel { set y 222 } }
+} -returnCodes error -result {bad level "1"}
+test uplevel-4.0.2 {error: non-existent level} -setup {
+    interp create i
+} -body {
+    i eval { uplevel { set y 222 } }
+} -returnCodes error -result {bad level "1"} -cleanup {
+    interp delete i
+}
 test uplevel-4.1 {error: non-existent level} -returnCodes error -body {
     apply {{} {
 	uplevel #2 {set y 222}

tests/upvar.test

@@ -304,6 +304,17 @@ test upvar-8.3 {errors in upvar command} -returnCodes error -body {
     proc p1 {} {upvar a b c}
     p1
 } -result {bad level "a"}
+test upvar-8.3.1 {bad level for upvar (upvar at top-level, bug [775ee88560])} -body {
+    proc p1 {} { uplevel { upvar b b; lappend b UNEXPECTED } }
+    uplevel #0 { p1 }
+} -returnCodes error -result {bad level "1"}
+test upvar-8.3.2 {bad level for upvar (upvar at top-level, bug [775ee88560])} -setup {
+    interp create i
+} -body {
+    i eval { upvar b b; lappend b UNEXPECTED }
+} -returnCodes error -result {bad level "1"} -cleanup {
+    interp delete i
+}
 test upvar-8.4 {errors in upvar command} -returnCodes error -body {
     proc p1 {} {upvar 0 b b}
     p1