summaryrefslogtreecommitdiffstats
path: root/generic/tclBasic.c
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2003-10-14 15:44:52 (GMT)
committerdgp <dgp@users.sourceforge.net>2003-10-14 15:44:52 (GMT)
commitb7c8b125de1f42a74d05bd5882afc2da0a88604a (patch)
treebdeafc412fed0f5ab5d71500254ea6d40c14174c /generic/tclBasic.c
parent53f461a314e8fda45504e3e1d7a51595d470604e (diff)
downloadtcl-b7c8b125de1f42a74d05bd5882afc2da0a88604a.zip
tcl-b7c8b125de1f42a74d05bd5882afc2da0a88604a.tar.gz
tcl-b7c8b125de1f42a74d05bd5882afc2da0a88604a.tar.bz2
* generic/tclBasic.c (TclAppendObjToErrorInfo): New internal routine
that appends a Tcl_Obj to the errorInfo, saving the caller the trouble of extracting the string rep. * generic/tclStringObj.c (TclAppendLimitedToObj): New internal routine that supports truncated appends with optional ellipsis marking. This single routine supports UTF-8-safe truncated appends needed in several places throughout the Tcl source code, mostly for error and stack messages. Clean fix for [Bug 760872]. * generic/tclInt.h: Declarations for new internal routines. * generic/tclCmdMZ.c: Updated callers to use the new routines. * generic/tclCompExpr.c: * generic/tclCompile.c: * generic/tclExecute.c: * generic/tclIOUtil.c: * generic/tclNamesp.c: * generic/tclObj.c: * generic/tclParseExpr.c: * generic/tclProc.c: * generic/tclStringObj.c: * mac/tclMacResource.c: * library/init.tcl: Updated ::errorInfo cleanup in [unknown] to reflect slight modifications to Tcl_LogCommandInfo(). Corrects failing init-4.* tests.
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r--generic/tclBasic.c98
1 files changed, 56 insertions, 42 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index d356ddf..7f89d7e 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.91 2003/10/08 23:18:35 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.92 2003/10/14 15:44:52 dgp Exp $
*/
#include "tclInt.h"
@@ -3337,10 +3337,9 @@ Tcl_LogCommandInfo(interp, script, command, length)
int length; /* Number of bytes in command (-1 means
* use all bytes up to first null byte). */
{
- char buffer[200];
register CONST char *p;
- char *ellipsis = "";
Interp *iPtr = (Interp *) interp;
+ Tcl_Obj *message;
if (iPtr->flags & ERR_ALREADY_LOGGED) {
/*
@@ -3362,26 +3361,16 @@ Tcl_LogCommandInfo(interp, script, command, length)
}
}
- /*
- * Create an error message to add to errorInfo, including up to a
- * maximum number of characters of the command.
- */
-
- if (length < 0) {
- length = strlen(command);
- }
- if (length > 150) {
- length = 150;
- ellipsis = "...";
- }
if (!(iPtr->flags & ERR_IN_PROGRESS)) {
- sprintf(buffer, "\n while executing\n\"%.*s%s\"",
- length, command, ellipsis);
+ message = Tcl_NewStringObj("\n while executing\n\"", -1);
} else {
- sprintf(buffer, "\n invoked from within\n\"%.*s%s\"",
- length, command, ellipsis);
+ message = Tcl_NewStringObj("\n invoked from within\n\"", -1);
}
- Tcl_AddObjErrorInfo(interp, buffer, -1);
+ Tcl_IncrRefCount(message);
+ TclAppendLimitedToObj(message, command, length, 153, NULL);
+ Tcl_AppendToObj(message, "\"", -1);
+ TclAppendObjToErrorInfo(interp, message);
+ Tcl_DecrRefCount(message);
iPtr->flags &= ~ERR_ALREADY_LOGGED;
}
@@ -4384,8 +4373,7 @@ TclObjInvoke(interp, objc, objv, flags)
int localObjc; /* Used to invoke "unknown" if the */
Tcl_Obj **localObjv = NULL; /* command is not found. */
register int i;
- int length, result;
- char *bytes;
+ int result;
if (interp == (Tcl_Interp *) NULL) {
return TCL_ERROR;
@@ -4478,29 +4466,23 @@ TclObjInvoke(interp, objc, objv, flags)
if ((result == TCL_ERROR)
&& ((flags & TCL_INVOKE_NO_TRACEBACK) == 0)
&& ((iPtr->flags & ERR_ALREADY_LOGGED) == 0)) {
- Tcl_DString ds;
-
- Tcl_DStringInit(&ds);
+ int length;
+ CONST char* cmdString;
+ Tcl_Obj *message, *command = Tcl_NewListObj(objc, objv);
+
if (!(iPtr->flags & ERR_IN_PROGRESS)) {
- Tcl_DStringAppend(&ds, "\n while invoking\n\"", -1);
+ message = Tcl_NewStringObj("\n while invoking\n\"", -1);
} else {
- Tcl_DStringAppend(&ds, "\n invoked from within\n\"", -1);
+ message = Tcl_NewStringObj("\n invoked from within\n\"", -1);
}
- for (i = 0; i < objc; i++) {
- bytes = Tcl_GetStringFromObj(objv[i], &length);
- Tcl_DStringAppend(&ds, bytes, length);
- if (i < (objc - 1)) {
- Tcl_DStringAppend(&ds, " ", -1);
- } else if (Tcl_DStringLength(&ds) > 100) {
- Tcl_DStringSetLength(&ds, 100);
- Tcl_DStringAppend(&ds, "...", -1);
- break;
- }
- }
-
- Tcl_DStringAppend(&ds, "\"", -1);
- Tcl_AddObjErrorInfo(interp, Tcl_DStringValue(&ds), -1);
- Tcl_DStringFree(&ds);
+ Tcl_IncrRefCount(message);
+ Tcl_IncrRefCount(command);
+ cmdString = Tcl_GetStringFromObj(command, &length);
+ TclAppendLimitedToObj(message, cmdString, length, 100, NULL);
+ Tcl_DecrRefCount(command);
+ Tcl_AppendToObj(message, "\"", -1);
+ TclAppendObjToErrorInfo(interp, message);
+ Tcl_DecrRefCount(message);
iPtr->flags &= ~ERR_ALREADY_LOGGED;
}
@@ -4598,6 +4580,38 @@ Tcl_ExprString(interp, string)
/*
*----------------------------------------------------------------------
*
+ * TclAppendObjToErrorInfo --
+ *
+ * Add a Tcl_Obj value to the "errorInfo" variable that describes the
+ * current error.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The value of the Tcl_obj is added to the "errorInfo" variable.
+ * If Tcl_Eval has been called since the current value of errorInfo
+ * was set, errorInfo is cleared before adding the new message.
+ * If we are just starting to log an error, errorInfo is initialized
+ * from the error message in the interpreter's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclAppendObjToErrorInfo(interp, objPtr)
+ Tcl_Interp *interp; /* Interpreter to which error information
+ * pertains. */
+ Tcl_Obj *objPtr; /* Message to record. */
+{
+ int length;
+ CONST char *message = Tcl_GetStringFromObj(objPtr, &length);
+ Tcl_AddObjErrorInfo(interp, message, length);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_AddErrorInfo --
*
* Add information to the "errorInfo" variable that describes the