diff options
| -rw-r--r-- | ChangeLog | 2 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 41 | ||||
| -rw-r--r-- | generic/tclProc.c | 39 |
3 files changed, 33 insertions, 49 deletions
@@ -8,6 +8,8 @@ * generic/tclBasic.c: Updated several callers to use * generic/tclCmdMZ.c: TclFormatToErrorInfo(). * generic/tclIOUtil.c: + * generic/tclNamesp.c: + * generic/tclProc.c: * library/init.tcl: Keep [unknown] in sync with errorInfo formatting rules. diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 5702304..2acedcb 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -21,7 +21,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclNamesp.c,v 1.83 2005/08/26 11:00:31 dkf Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.84 2005/09/14 18:35:56 dgp Exp $ */ #include "tclInt.h" @@ -3403,17 +3403,14 @@ NamespaceEvalCmd(dummy, interp, objc, objv) } if (result == TCL_ERROR) { - Tcl_Obj *errorLine = Tcl_NewIntObj(interp->errorLine); - Tcl_Obj *msg = Tcl_NewStringObj("\n (in namespace eval \"", -1); - Tcl_IncrRefCount(errorLine); - Tcl_IncrRefCount(msg); - TclAppendLimitedToObj(msg, namespacePtr->fullName, -1, 200, ""); - Tcl_AppendToObj(msg, "\" script line ", -1); - Tcl_AppendObjToObj(msg, errorLine); - Tcl_DecrRefCount(errorLine); - Tcl_AppendToObj(msg, ")", -1); - TclAppendObjToErrorInfo(interp, msg); - Tcl_DecrRefCount(msg); + int length = strlen(namespacePtr->fullName); + int limit = 200; + int overflow = (length > limit); + + TclFormatToErrorInfo(interp, + "\n (in namespace eval \"%.*s%s\" script line %d)", + (overflow ? limit : length), namespacePtr->fullName, + (overflow ? "..." : ""), interp->errorLine); } /* @@ -3816,18 +3813,14 @@ NamespaceInscopeCmd(dummy, interp, objc, objv) } if (result == TCL_ERROR) { - Tcl_Obj *errorLine = Tcl_NewIntObj(interp->errorLine); - Tcl_Obj *msg = Tcl_NewStringObj("\n (in namespace inscope \"", -1); - - Tcl_IncrRefCount(errorLine); - Tcl_IncrRefCount(msg); - TclAppendLimitedToObj(msg, namespacePtr->fullName, -1, 200, ""); - Tcl_AppendToObj(msg, "\" script line ", -1); - Tcl_AppendObjToObj(msg, errorLine); - Tcl_DecrRefCount(errorLine); - Tcl_AppendToObj(msg, ")", -1); - TclAppendObjToErrorInfo(interp, msg); - Tcl_DecrRefCount(msg); + int length = strlen(namespacePtr->fullName); + int limit = 200; + int overflow = (length > limit); + + TclFormatToErrorInfo(interp, + "\n (in namespace inscope \"%.*s%s\" script line %d)", + (overflow ? limit : length), namespacePtr->fullName, + (overflow ? "..." : ""), interp->errorLine); } /* diff --git a/generic/tclProc.c b/generic/tclProc.c index 8626eaf..3a962d2 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.78 2005/07/21 14:38:50 dkf Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.79 2005/09/14 18:35:56 dgp Exp $ */ #include "tclInt.h" @@ -1488,19 +1488,14 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName) if (result != TCL_OK) { if (result == TCL_ERROR) { - Tcl_Obj *errorLine = Tcl_NewIntObj(interp->errorLine); - Tcl_Obj *message = - Tcl_NewStringObj("\n (compiling ", -1); - - Tcl_IncrRefCount(message); - Tcl_AppendStringsToObj(message, description, " \"", NULL); - TclAppendLimitedToObj(message, procName, -1, 50, NULL); - Tcl_AppendToObj(message, "\", line ", -1); - Tcl_AppendObjToObj(message, errorLine); - Tcl_DecrRefCount(errorLine); - Tcl_AppendToObj(message, ")", -1); - TclAppendObjToErrorInfo(interp, message); - Tcl_DecrRefCount(message); + int length = strlen(procName); + int limit = 50; + int overflow = (length > limit); + + TclFormatToErrorInfo(interp, + "\n (compiling %s \"%.*s%s\", line %d)", + description, (overflow ? limit : length), procName, + (overflow ? "..." : ""), interp->errorLine); } return result; } @@ -1546,7 +1541,7 @@ ProcessProcResultCode(interp, procName, nameLen, returnCode) int returnCode; /* The unexpected result code. */ { Interp *iPtr = (Interp *) interp; - Tcl_Obj *message, *errorLine; + int overflow, limit = 60; if (returnCode == TCL_OK) { return TCL_OK; @@ -1563,16 +1558,10 @@ ProcessProcResultCode(interp, procName, nameLen, returnCode) ((returnCode == TCL_BREAK) ? "break" : "continue"), "\" outside of a loop", NULL); } - errorLine = Tcl_NewIntObj(interp->errorLine); - message = Tcl_NewStringObj("\n (procedure \"", -1); - Tcl_IncrRefCount(message); - TclAppendLimitedToObj(message, procName, nameLen, 60, NULL); - Tcl_AppendToObj(message, "\" line ", -1); - Tcl_AppendObjToObj(message, errorLine); - Tcl_DecrRefCount(errorLine); - Tcl_AppendToObj(message, ")", -1); - TclAppendObjToErrorInfo(interp, message); - Tcl_DecrRefCount(message); + overflow = (nameLen > limit); + TclFormatToErrorInfo(interp, "\n (procedure \"%.*s%s\" line %d)", + (overflow ? limit : nameLen), procName, + (overflow ? "..." : ""), interp->errorLine); return TCL_ERROR; } |