Attachment "760872.patch" to
ticket [760872ffff]
added by
dgp
2003-07-08 23:58:24.
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.85
diff -u -r1.85 tclBasic.c
--- generic/tclBasic.c 25 Jun 2003 23:02:11 -0000 1.85
+++ generic/tclBasic.c 8 Jul 2003 16:55:40 -0000
@@ -3313,6 +3313,14 @@
length = 150;
ellipsis = "...";
}
+ while ( (command[length] & 0xC0) == 0x80 ) {
+ /*
+ * Back up truncation point so that we don't truncate in the
+ * middle of a multi-byte character (in UTF-8)
+ */
+ length--;
+ ellipsis = "...";
+ }
if (!(iPtr->flags & ERR_IN_PROGRESS)) {
sprintf(buffer, "\n while executing\n\"%.*s%s\"",
length, command, ellipsis);
@@ -4323,8 +4331,7 @@
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;
@@ -4417,29 +4424,41 @@
if ((result == TCL_ERROR)
&& ((flags & TCL_INVOKE_NO_TRACEBACK) == 0)
&& ((iPtr->flags & ERR_ALREADY_LOGGED) == 0)) {
- Tcl_DString ds;
+ Tcl_Obj *msg;
- Tcl_DStringInit(&ds);
if (!(iPtr->flags & ERR_IN_PROGRESS)) {
- Tcl_DStringAppend(&ds, "\n while invoking\n\"", -1);
+ msg = Tcl_NewStringObj("\n while invoking\n\"", -1);
} else {
- Tcl_DStringAppend(&ds, "\n invoked from within\n\"", -1);
+ msg = Tcl_NewStringObj("\n invoked from within\n\"", -1);
}
+ Tcl_IncrRefCount(msg);
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;
- }
+ CONST char *bytes;
+ int length;
+
+ Tcl_AppendObjToObj(msg, objv[i]);
+ bytes = Tcl_GetStringFromObj(msg, &length);
+ if (length > 100) {
+ /*
+ * Back up truncation point so that we don't truncate
+ * in the middle of a multi-byte character.
+ */
+ length = 100;
+ while ( (bytes[length] & 0xC0) == 0x80 ) {
+ length--;
+ }
+ Tcl_SetObjLength(msg, length);
+ Tcl_AppendToObj(msg, "...", -1);
+ break;
+ }
+ if (i != (objc - 1)) {
+ Tcl_AppendToObj(msg, " ", -1);
+ }
}
-
- Tcl_DStringAppend(&ds, "\"", -1);
- Tcl_AddObjErrorInfo(interp, Tcl_DStringValue(&ds), -1);
- Tcl_DStringFree(&ds);
+
+ Tcl_AppendToObj(msg, "\"", -1);
+ Tcl_AddObjErrorInfo(interp, Tcl_GetString(msg), -1);
+ Tcl_DecrRefCount(msg);
iPtr->flags &= ~ERR_ALREADY_LOGGED;
}
Index: generic/tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.49
diff -u -r1.49 tclCompile.c
--- generic/tclCompile.c 9 May 2003 13:53:42 -0000 1.49
+++ generic/tclCompile.c 8 Jul 2003 16:55:41 -0000
@@ -1648,6 +1648,14 @@
length = 150;
ellipsis = "...";
}
+ while ( (command[length] & 0xC0) == 0x80 ) {
+ /*
+ * Back up truncation point so that we don't truncate in the
+ * middle of a multi-byte character (in UTF-8)
+ */
+ length--;
+ ellipsis = "...";
+ }
sprintf(buffer, "\n while compiling\n\"%.*s%s\"",
length, command, ellipsis);
Tcl_AddObjErrorInfo(interp, buffer, -1);
Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.46
diff -u -r1.46 tclProc.c
--- generic/tclProc.c 8 May 2003 00:44:29 -0000 1.46
+++ generic/tclProc.c 8 Jul 2003 16:55:41 -0000
@@ -1227,6 +1227,14 @@
numChars = 50;
ellipsis = "...";
}
+ while ( (procName[numChars] & 0xC0) == 0x80 ) {
+ /*
+ * Back up truncation point so that we don't truncate
+ * in the middle of a multi-byte character (in UTF-8)
+ */
+ numChars--;
+ ellipsis = "...";
+ }
sprintf(buf, "\n (compiling %s \"%.*s%s\", line %d)",
description, numChars, procName, ellipsis,
interp->errorLine);
@@ -1309,6 +1317,14 @@
}
if (nameLen > 60) {
nameLen = 60;
+ ellipsis = "...";
+ }
+ while ( (procName[nameLen] & 0xC0) == 0x80 ) {
+ /*
+ * Back up truncation point so that we don't truncate in the
+ * middle of a multi-byte character (in UTF-8)
+ */
+ nameLen--;
ellipsis = "...";
}
sprintf(msg, "\n (procedure \"%.*s%s\" line %d)", nameLen, procName,
Index: library/init.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/init.tcl,v
retrieving revision 1.56
diff -u -r1.56 init.tcl
--- library/init.tcl 4 Mar 2003 23:46:00 -0000 1.56
+++ library/init.tcl 8 Jul 2003 16:55:41 -0000
@@ -220,10 +220,12 @@
# construct the stack trace.
#
set cinfo $args
- if {[string length $cinfo] > 150} {
- set cinfo "[string range $cinfo 0 149]..."
+ set ellipsis ""
+ while {[string bytelength $cinfo] > 150} {
+ set cinfo [string range $cinfo 0 end-1]
+ set ellipsis "..."
}
- append cinfo "\"\n (\"uplevel\" body line 1)"
+ append cinfo $ellipsis "\"\n (\"uplevel\" body line 1)"
append cinfo "\n invoked from within"
append cinfo "\n\"uplevel 1 \$args\""
#
