diff options
author | msofer <msofer@noemail.net> | 2002-04-15 17:45:05 (GMT) |
---|---|---|
committer | msofer <msofer@noemail.net> | 2002-04-15 17:45:05 (GMT) |
commit | 839b9d66e41624b9cc9808396de69008ef1d01b4 (patch) | |
tree | a2089c7e0c492fc71493d5dc30e2c0ebca6af8c6 /generic/tclProc.c | |
parent | 8a1a3c328747e97b557d5b4304dfe89297db301f (diff) | |
download | tcl-839b9d66e41624b9cc9808396de69008ef1d01b4.zip tcl-839b9d66e41624b9cc9808396de69008ef1d01b4.tar.gz tcl-839b9d66e41624b9cc9808396de69008ef1d01b4.tar.bz2 |
Improved stack trace for TCL_BREAK and TCL_CONTINUE returns from procs. [Bug 536955].
FossilOrigin-Name: 0e4b466ad7f4c21e9e2e7e19792d21a3db7eee2a
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; } /* |