summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2005-09-14 17:13:18 (GMT)
committerdgp <dgp@users.sourceforge.net>2005-09-14 17:13:18 (GMT)
commit9e5a076c152f19abbf9f1b67392bd2072bac77c7 (patch)
tree6faa8807c6893dae4bd8cd9d5668a911697e0dfe /generic
parentd6a5a988b1a1360a77a043ec10d175c8a6c0fd36 (diff)
downloadtcl-9e5a076c152f19abbf9f1b67392bd2072bac77c7.zip
tcl-9e5a076c152f19abbf9f1b67392bd2072bac77c7.tar.gz
tcl-9e5a076c152f19abbf9f1b67392bd2072bac77c7.tar.bz2
* generic/tclStringObj.c: Bug fixes: ObjPrintfVA needed to
support "*" fields and needed to interpret precision limits on %s conversions as a number of bytes, not Tcl_UniChars, to take from the (char *) argument. * generic/tclBasic.c: Updated several callers to use * generic/tclCmdMZ.c: TclFormatToErrorInfo(). * generic/tclIOUtil.c: * library/init.tcl: Keep [unknown] in sync with errorInfo formatting rules.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c19
-rw-r--r--generic/tclCmdMZ.c22
-rw-r--r--generic/tclIOUtil.c20
-rw-r--r--generic/tclStringObj.c36
4 files changed, 53 insertions, 44 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index a038550..c70b5ad 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.171 2005/09/14 03:46:50 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.172 2005/09/14 17:13:18 dgp Exp $
*/
#include "tclInt.h"
@@ -3540,7 +3540,7 @@ Tcl_LogCommandInfo(interp, script, command, length)
{
register CONST char *p;
Interp *iPtr = (Interp *) interp;
- Tcl_Obj *message;
+ int overflow, limit = 150;
if (iPtr->flags & ERR_ALREADY_LOGGED) {
/*
@@ -3562,16 +3562,11 @@ Tcl_LogCommandInfo(interp, script, command, length)
}
}
- if (iPtr->errorInfo == NULL) {
- message = Tcl_NewStringObj("\n while executing\n\"", -1);
- } else {
- message = Tcl_NewStringObj("\n invoked from within\n\"", -1);
- }
- Tcl_IncrRefCount(message);
- TclAppendLimitedToObj(message, command, length, 153, NULL);
- Tcl_AppendToObj(message, "\"", -1);
- TclAppendObjToErrorInfo(interp, message);
- Tcl_DecrRefCount(message);
+ overflow = (length > limit);
+ TclFormatToErrorInfo(interp, "\n %s\n\"%.*s%s\"",
+ ((iPtr->errorInfo == NULL)
+ ? "while executing" : "invoked from within"),
+ (overflow ? limit : length), command, (overflow ? "..." : ""));
}
/*
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 2a94eb8..e59360d 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.128 2005/08/26 13:26:55 dkf Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.129 2005/09/14 17:13:18 dgp Exp $
*/
#include "tclInt.h"
@@ -2566,6 +2566,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
int i,j, index, mode, foundmode, result, splitObjs, numMatchesSaved, noCase;
+ int patternLength;
char *pattern;
Tcl_Obj *stringObj, *indexVarObj, *matchVarObj;
Tcl_Obj *CONST *savedObjv = objv;
@@ -2745,7 +2746,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
* See if the pattern matches the string.
*/
- pattern = TclGetString(objv[i]);
+ pattern = Tcl_GetStringFromObj(objv[i], &patternLength);
if ((i == objc - 2) && (*pattern == 'd')
&& (strcmp(pattern, "default") == 0)) {
@@ -2920,18 +2921,11 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
*/
if (result == TCL_ERROR) {
- Tcl_Obj *msg = Tcl_NewStringObj("\n (\"", -1);
- Tcl_Obj *errorLine = Tcl_NewIntObj(interp->errorLine);
-
- Tcl_IncrRefCount(msg);
- Tcl_IncrRefCount(errorLine);
- TclAppendLimitedToObj(msg, pattern, -1, 50, "");
- Tcl_AppendToObj(msg,"\" arm line ", -1);
- Tcl_AppendObjToObj(msg, errorLine);
- Tcl_DecrRefCount(errorLine);
- Tcl_AppendToObj(msg,")", -1);
- TclAppendObjToErrorInfo(interp, msg);
- Tcl_DecrRefCount(msg);
+ int limit = 50;
+ int overflow = (patternLength > limit);
+ TclFormatToErrorInfo(interp, "\n (\"%.*s%s\" arm line %d)",
+ (overflow ? limit : patternLength), pattern,
+ (overflow ? "..." : ""), interp->errorLine);
}
return result;
}
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index b540f90..124da3a 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIOUtil.c,v 1.122 2005/08/31 15:12:18 vincentdarley Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.123 2005/09/14 17:13:18 dgp Exp $
*/
#include "tclInt.h"
@@ -1812,19 +1812,13 @@ Tcl_FSEvalFileEx(interp, pathPtr, encodingName)
/*
* Record information telling where the error occurred.
*/
-
- Tcl_Obj *errorLine = Tcl_NewIntObj(interp->errorLine);
- Tcl_Obj *msg = Tcl_NewStringObj("\n (file \"", -1);
CONST char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
- Tcl_IncrRefCount(msg);
- Tcl_IncrRefCount(errorLine);
- TclAppendLimitedToObj(msg, pathString, length, 150, "");
- Tcl_AppendToObj(msg, "\" line ", -1);
- Tcl_AppendObjToObj(msg, errorLine);
- Tcl_DecrRefCount(errorLine);
- Tcl_AppendToObj(msg, ")", -1);
- TclAppendObjToErrorInfo(interp, msg);
- Tcl_DecrRefCount(msg);
+ int limit = 150;
+ int overflow = (length > limit);
+
+ TclFormatToErrorInfo(interp, "\n (file \"%.*s%s\" line %d)",
+ (overflow ? limit : length), pathString,
+ (overflow ? "..." : ""), interp->errorLine);
}
end:
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 802e94a..a2bce94 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -33,7 +33,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclStringObj.c,v 1.45 2005/09/14 03:46:50 dgp Exp $ */
+ * RCS: @(#) $Id: tclStringObj.c,v 1.46 2005/09/14 17:13:18 dgp Exp $ */
#include "tclInt.h"
@@ -2284,12 +2284,14 @@ ObjPrintfVA(
int code, objc;
Tcl_Obj **objv, *list = Tcl_NewObj();
CONST char *p;
+ char *end;
p = format;
Tcl_IncrRefCount(list);
while (*p != '\0') {
- int size = 0;
- int seekingConversion = 1;
+ int size = 0, seekingConversion = 1, gotPrecision = 0;
+ int lastNum = -1, numBytes = -1;
+
if (*p++ != '%') {
continue;
}
@@ -2304,9 +2306,18 @@ ObjPrintfVA(
seekingConversion = 0;
break;
case 's':
- Tcl_ListObjAppendElement(NULL, list, Tcl_NewStringObj(
- va_arg(argList, char *), -1));
seekingConversion = 0;
+ if (gotPrecision) {
+ numBytes = lastNum;
+ }
+ Tcl_ListObjAppendElement(NULL, list, Tcl_NewStringObj(
+ va_arg(argList, char *), numBytes));
+ /* We took no more than numBytes bytes from the (char *).
+ * In turn, [format] will take no more than numBytes
+ * characters from the Tcl_Obj. Since numBytes characters
+ * must be no less than numBytes bytes, the character limit
+ * will have no effect and we can just pass it through.
+ */
break;
case 'c':
case 'i':
@@ -2337,6 +2348,21 @@ ObjPrintfVA(
va_arg(argList, double)));
seekingConversion = 0;
break;
+ case '*':
+ lastNum = (int)va_arg(argList, int);
+ Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum));
+ p++;
+ break;
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7': case '8': case '9':
+ lastNum = (int) strtoul(p, &end, 10);
+ p = end;
+ break;
+ case '.':
+ gotPrecision = 1;
+ p++;
+ break;
+ /* TODO: support for wide (and bignum?) arguments */
case 'l':
size = 1;
p++;