diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclBasic.c | 59 | ||||
| -rw-r--r-- | generic/tclCompile.c | 10 | ||||
| -rw-r--r-- | generic/tclProc.c | 18 |
3 files changed, 65 insertions, 22 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 80f5bda..629293f 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.75.2.4 2003/06/10 19:58:34 msofer Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.75.2.5 2003/07/18 23:35:38 dgp Exp $ */ #include "tclInt.h" @@ -3304,6 +3304,14 @@ Tcl_LogCommandInfo(interp, script, command, length) 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); @@ -4562,8 +4570,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; @@ -4656,29 +4663,41 @@ 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_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; } diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 46628b1..6c619e9 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.43.2.2 2003/04/18 21:54:24 dgp Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.43.2.3 2003/07/18 23:35:38 dgp Exp $ */ #include "tclInt.h" @@ -1727,6 +1727,14 @@ LogCompilationInfo(interp, script, command, length) 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); diff --git a/generic/tclProc.c b/generic/tclProc.c index 4e3d4b8..1ec50f1 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.44 2002/12/11 21:29:52 dgp Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.44.2.1 2003/07/18 23:35:39 dgp Exp $ */ #include "tclInt.h" @@ -1229,6 +1229,14 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName) 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); @@ -1313,6 +1321,14 @@ ProcessProcResultCode(interp, procName, nameLen, returnCode) 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, ellipsis, iPtr->errorLine); Tcl_AddObjErrorInfo(interp, msg, -1); |