From 7dea0c626dd1ccef035092ff994f9f36070177e3 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Tue, 2 Jul 2024 12:36:17 +0000
Subject: fix crash [0de6c1d79c] more consistently (an error "bad level" for
 info instead of artifical dummy info)

---
 generic/tclCmdIL.c | 30 +++++-------------------------
 tests/info.test    |  9 ++++++---
 2 files changed, 11 insertions(+), 28 deletions(-)

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 3198cc9..877f94e 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -1160,32 +1160,9 @@ InfoFrameCmd(
 	}
 	corPtr = corPtr->callerEEPtr->corPtr;
     }
+    topLevel += *cmdFramePtrPtr ? (*cmdFramePtrPtr)->level : 1;
 
-    if (iPtr->cmdFramePtr == NULL || *cmdFramePtrPtr == NULL) {
-	if (objc == 1) {
-	    Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
-	} else {
-	    if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) {
-		code = TCL_ERROR;
-	    } else {
-		Tcl_Obj *objs[2];
-		/*
-		 * TODO - "precompiled" is a lie. Chosen only because as documented
-		 * no other fields in the dictionary need be returned. Should
-		 * add a new type like "unknown" meaning no further information
-		 * available.
-		 * TODO - should we check that "level" is 1 ?
-		 */
-		TclNewLiteralStringObj(objs[0], "type");
-		TclNewLiteralStringObj(objs[1], "precompiled");
-		Tcl_SetObjResult(interp, Tcl_NewListObj(2, objs));
-	    }
-	}
-	return code;
-    }
-
-    topLevel += (*cmdFramePtrPtr)->level;
-    if (topLevel != iPtr->cmdFramePtr->level) {
+    if (iPtr->cmdFramePtr && topLevel != iPtr->cmdFramePtr->level) {
 	framePtr = iPtr->cmdFramePtr;
 	while (framePtr) {
 	    framePtr->level = topLevel--;
@@ -1234,6 +1211,9 @@ InfoFrameCmd(
     }
 
     framePtr = iPtr->cmdFramePtr;
+    if (!framePtr) {
+	goto levelError;
+    }
     while (++level <= 0) {
 	framePtr = framePtr->nextPtr;
 	if (!framePtr) {
diff --git a/tests/info.test b/tests/info.test
index ff3457f..17c114b 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -2418,11 +2418,14 @@ test info-39.2 {Bug 4b61afd660} -setup {
 test info-40.0 {Bug 0de6c1d79c crash} -setup {
     interp create child
     child hide info
+} -body {
+    list [child invokehidden info frame] \
+	[catch {child invokehidden info frame 0} msg] $msg \
+	[catch {child invokehidden info frame 1} msg] $msg
 } -cleanup {
     interp delete child
-} -body {
-    child invokehidden info frame
-} -result 1
+    unset -nocomplain msg
+} -result {1 1 {bad level "0"} 1 {bad level "1"}}
 
 # cleanup
 catch {namespace delete test_ns_info1 test_ns_info2}
-- 
cgit v0.12