summaryrefslogtreecommitdiffstats
path: root/generic/tclProc.c
diff options
context:
space:
mode:
authormsofer <msofer@noemail.net>2002-04-15 17:45:05 (GMT)
committermsofer <msofer@noemail.net>2002-04-15 17:45:05 (GMT)
commit839b9d66e41624b9cc9808396de69008ef1d01b4 (patch)
treea2089c7e0c492fc71493d5dc30e2c0ebca6af8c6 /generic/tclProc.c
parent8a1a3c328747e97b557d5b4304dfe89297db301f (diff)
downloadtcl-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.c47
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;
}
/*