diff options
| -rw-r--r-- | generic/tclCmdIL.c | 30 | ||||
| -rw-r--r-- | 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} |