diff options
author | Miguel Sofer <miguel.sofer@gmail.com> | 2002-04-15 17:45:06 (GMT) |
---|---|---|
committer | Miguel Sofer <miguel.sofer@gmail.com> | 2002-04-15 17:45:06 (GMT) |
commit | ce77e262200ad395011337df26e7e52292d83c17 (patch) | |
tree | a2089c7e0c492fc71493d5dc30e2c0ebca6af8c6 /generic/tclProc.c | |
parent | c57b1b3f7c6afcd33faa0e7f8451d07435660464 (diff) | |
download | tcl-ce77e262200ad395011337df26e7e52292d83c17.zip tcl-ce77e262200ad395011337df26e7e52292d83c17.tar.gz tcl-ce77e262200ad395011337df26e7e52292d83c17.tar.bz2 |
Improved stack trace for TCL_BREAK and TCL_CONTINUE returns from procs. [Bug 536955].
Diffstat (limited to 'generic/tclProc.c')
-rw-r--r-- | generic/tclProc.c | 47 |
1 files changed, 23 insertions, 24 deletions
diff --git a/generic/tclProc.c b/generic/tclProc.c index f1e7510..446bf09 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclProc.c,v 1.36 2002/01/25 20:40:55 dgp Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.37 2002/04/15 17:45:06 msofer Exp $ */ #include "tclInt.h" @@ -1283,33 +1283,32 @@ ProcessProcResultCode(interp, procName, nameLen, returnCode) int returnCode; /* The unexpected result code. */ { Interp *iPtr = (Interp *) interp; + char msg[100 + TCL_INTEGER_SPACE]; + char *ellipsis = ""; + if (returnCode == TCL_OK) { + return TCL_OK; + } + if (returnCode > TCL_CONTINUE) { + return returnCode; + } if (returnCode == TCL_RETURN) { - returnCode = TclUpdateReturnInfo(iPtr); - } else if (returnCode == TCL_ERROR) { - char msg[100 + TCL_INTEGER_SPACE]; - char *ellipsis = ""; - int numChars = nameLen; - - if (numChars > 60) { - numChars = 60; - ellipsis = "..."; - } - sprintf(msg, "\n (procedure \"%.*s%s\" line %d)", - numChars, procName, ellipsis, iPtr->errorLine); - Tcl_AddObjErrorInfo(interp, msg, -1); - } else if (returnCode == TCL_BREAK) { + return TclUpdateReturnInfo(iPtr); + } + if (returnCode != TCL_ERROR) { Tcl_ResetResult(interp); - Tcl_AppendToObj(Tcl_GetObjResult(interp), - "invoked \"break\" outside of a loop", -1); - returnCode = TCL_ERROR; - } else if (returnCode == TCL_CONTINUE) { - Tcl_ResetResult(interp); - Tcl_AppendToObj(Tcl_GetObjResult(interp), - "invoked \"continue\" outside of a loop", -1); - returnCode = TCL_ERROR; + Tcl_AppendToObj(Tcl_GetObjResult(interp), ((returnCode == TCL_BREAK) + ? "invoked \"break\" outside of a loop" + : "invoked \"continue\" outside of a loop"), -1); + } + if (nameLen > 60) { + nameLen = 60; + ellipsis = "..."; } - return returnCode; + sprintf(msg, "\n (procedure \"%.*s%s\" line %d)", nameLen, procName, + ellipsis, iPtr->errorLine); + Tcl_AddObjErrorInfo(interp, msg, -1); + return TCL_ERROR; } /* |