diff options
| -rw-r--r-- | ChangeLog | 14 | ||||
| -rw-r--r-- | generic/tclBasic.c | 8 | ||||
| -rw-r--r-- | generic/tclCkalloc.c | 7 | ||||
| -rw-r--r-- | generic/tclCmdAH.c | 35 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 20 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 16 | ||||
| -rw-r--r-- | generic/tclDictObj.c | 13 | ||||
| -rw-r--r-- | generic/tclExecute.c | 12 | ||||
| -rw-r--r-- | generic/tclIORChan.c | 22 | ||||
| -rw-r--r-- | generic/tclStringObj.c | 17 |
10 files changed, 67 insertions, 97 deletions
@@ -2,12 +2,18 @@ * 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. + %s conversions as a maximum 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: + * generic/tclCkalloc.c: TclFormatToErrorInfo() and/or + * generic/tclCmdAH.c: TclObjPrintf(). + * generic/tclCmdIL.c: + * generic/tclCmdMZ.c: + * generic/tclDictObj.c: + * generic/tclExecute.c: + * generic/tclIORChan.c: + * generic/tclIOUtil.c: * generic/tclNamesp.c: * generic/tclProc.c: diff --git a/generic/tclBasic.c b/generic/tclBasic.c index c70b5ad..a58c781 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.172 2005/09/14 17:13:18 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.173 2005/09/14 21:32:17 dgp Exp $ */ #include "tclInt.h" @@ -4156,10 +4156,8 @@ ProcessUnexpectedResult(interp, returnCode) Tcl_AppendResult(interp, "invoked \"continue\" outside of a loop", (char *) NULL); } else { - char buf[30 + TCL_INTEGER_SPACE]; - - sprintf(buf, "command returned bad code: %d", returnCode); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + TclObjPrintf(NULL, Tcl_GetObjResult(interp), + "command returned bad code: %d", returnCode); } } diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 595c24a..43e0862 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -14,7 +14,7 @@ * * This code contributed by Karl Lehenbauer and Mark Diekhans * - * RCS: @(#) $Id: tclCkalloc.c,v 1.23 2005/07/19 22:45:35 dkf Exp $ + * RCS: @(#) $Id: tclCkalloc.c,v 1.24 2005/09/14 21:32:17 dgp Exp $ */ #include "tclInt.h" @@ -843,14 +843,13 @@ MemoryCmd(clientData, interp, argc, argv) return TCL_OK; } if (strcmp(argv[1],"info") == 0) { - char buf[400]; - sprintf(buf, "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n", + TclObjPrintf(NULL, Tcl_GetObjResult(interp), + "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n", "total mallocs", total_mallocs, "total frees", total_frees, "current packets allocated", current_malloc_packets, "current bytes allocated", current_bytes_malloced, "maximum packets allocated", maximum_malloc_packets, "maximum bytes allocated", maximum_bytes_malloced); - Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_OK; } if (strcmp(argv[1],"init") == 0) { diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 9d84adf..a5124c2 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.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: tclCmdAH.c,v 1.67 2005/09/09 15:44:27 dgp Exp $ + * RCS: @(#) $Id: tclCmdAH.c,v 1.68 2005/09/14 21:32:17 dgp Exp $ */ #include "tclInt.h" @@ -185,12 +185,8 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv) armPtr = caseObjv[body - 1]; result = Tcl_EvalObjEx(interp, caseObjv[body], 0); if (result == TCL_ERROR) { - char msg[100 + TCL_INTEGER_SPACE]; - - arg = TclGetString(armPtr); - sprintf(msg, "\n (\"%.50s\" arm line %d)", arg, - interp->errorLine); - Tcl_AddObjErrorInfo(interp, msg, -1); + TclFormatToErrorInfo(interp, "\n (\"%.50s\" arm line %d)", + TclGetString(armPtr), interp->errorLine); } return result; } @@ -251,10 +247,8 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv) */ if (Tcl_LimitExceeded(interp)) { - char msg[32 + TCL_INTEGER_SPACE]; - - sprintf(msg, "\n (\"catch\" body line %d)", interp->errorLine); - Tcl_AddErrorInfo(interp, msg); + TclFormatToErrorInfo(interp, "\n (\"catch\" body line %d)", + interp->errorLine); return TCL_ERROR; } @@ -661,10 +655,8 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv) result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT); } if (result == TCL_ERROR) { - char msg[32 + TCL_INTEGER_SPACE]; - - sprintf(msg, "\n (\"eval\" body line %d)", interp->errorLine); - Tcl_AddObjErrorInfo(interp, msg, -1); + TclFormatToErrorInfo(interp,"\n (\"eval\" body line %d)", + interp->errorLine); } return result; } @@ -1627,10 +1619,8 @@ Tcl_ForObjCmd(dummy, interp, objc, objv) result = Tcl_EvalObjEx(interp, objv[4], 0); if ((result != TCL_OK) && (result != TCL_CONTINUE)) { if (result == TCL_ERROR) { - char msg[32 + TCL_INTEGER_SPACE]; - - sprintf(msg, "\n (\"for\" body line %d)",interp->errorLine); - Tcl_AddErrorInfo(interp, msg); + TclFormatToErrorInfo(interp, "\n (\"for\" body line %d)", + interp->errorLine); } break; } @@ -1844,11 +1834,8 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv) result = TCL_OK; break; } else if (result == TCL_ERROR) { - char msg[32 + TCL_INTEGER_SPACE]; - - sprintf(msg, "\n (\"foreach\" body line %d)", - interp->errorLine); - Tcl_AddObjErrorInfo(interp, msg, -1); + TclFormatToErrorInfo(interp, + "\n (\"foreach\" body line %d)", interp->errorLine); break; } else { break; diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index bbcab68..b98cf56 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdIL.c,v 1.80 2005/08/26 13:26:55 dkf Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.81 2005/09/14 21:32:17 dgp Exp $ */ #include "tclInt.h" @@ -3404,16 +3404,11 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) for (j=0 ; j<sortInfo.indexc ; j++) { if (TclGetIntForIndex(interp, indices[j], SORTIDX_END, &sortInfo.indexv[j]) != TCL_OK) { - char buffer[TCL_INTEGER_SPACE]; - if (sortInfo.indexc > 1) { ckfree((char *) sortInfo.indexv); } - sprintf(buffer, "%d", j); - Tcl_AddErrorInfo(interp, - "\n (-index option item number "); - Tcl_AddErrorInfo(interp, buffer); - Tcl_AddErrorInfo(interp, ")"); + TclFormatToErrorInfo(interp, + "\n (-index option item number %d)", j); return TCL_ERROR; } } @@ -4019,16 +4014,11 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv) for (j=0 ; j<sortInfo.indexc ; j++) { if (TclGetIntForIndex(interp, indices[j], SORTIDX_END, &sortInfo.indexv[j]) != TCL_OK) { - char buffer[TCL_INTEGER_SPACE]; - if (sortInfo.indexc > 1) { ckfree((char *) sortInfo.indexv); } - sprintf(buffer, "%d", j); - Tcl_AddErrorInfo(interp, - "\n (-index option item number "); - Tcl_AddErrorInfo(interp, buffer); - Tcl_AddErrorInfo(interp, ")"); + TclFormatToErrorInfo(interp, + "\n (-index option item number %d)", j); return TCL_ERROR; } } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index e59360d..ebc27f6 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.129 2005/09/14 17:13:18 dgp Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.130 2005/09/14 21:32:17 dgp Exp $ */ #include "tclInt.h" @@ -2158,12 +2158,9 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) length2 = length1 * count; if ((length2 / count) != length1) { - char buf[TCL_INTEGER_SPACE+1]; - - sprintf(buf, "%d", INT_MAX); - Tcl_AppendResult(interp, - "string size overflow, must be less than ", - buf, (char *) NULL); + TclObjPrintf(NULL, Tcl_GetObjResult(interp), + "string size overflow, must be less than %d", + INT_MAX); return TCL_ERROR; } @@ -3058,11 +3055,8 @@ Tcl_WhileObjCmd(dummy, interp, objc, objv) result = Tcl_EvalObjEx(interp, objv[2], 0); if ((result != TCL_OK) && (result != TCL_CONTINUE)) { if (result == TCL_ERROR) { - char msg[32 + TCL_INTEGER_SPACE]; - - sprintf(msg, "\n (\"while\" body line %d)", + TclFormatToErrorInfo(interp, "\n (\"while\" body line %d)", interp->errorLine); - Tcl_AddErrorInfo(interp, msg); } break; } diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 1e428a1..a64fb6c 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDictObj.c,v 1.33 2005/07/21 21:49:05 dkf Exp $ + * RCS: @(#) $Id: tclDictObj.c,v 1.34 2005/09/14 21:32:17 dgp Exp $ */ #include "tclInt.h" @@ -2294,11 +2294,8 @@ DictForCmd(interp, objc, objv) if (result == TCL_BREAK) { result = TCL_OK; } else if (result == TCL_ERROR) { - char msg[32 + TCL_INTEGER_SPACE]; - - sprintf(msg, "\n (\"dict for\" body line %d)", - interp->errorLine); - Tcl_AddObjErrorInfo(interp, msg, -1); + TclFormatToErrorInfo(interp, + "\n (\"dict for\" body line %d)", interp->errorLine); } break; } @@ -2642,9 +2639,9 @@ DictFilterCmd(interp, objc, objv) result = TCL_OK; break; case TCL_ERROR: - sprintf(msg, "\n (\"dict filter\" script line %d)", + TclFormatToErrorInfo(interp, + "\n (\"dict filter\" script line %d)", interp->errorLine); - Tcl_AddObjErrorInfo(interp, msg, -1); default: goto abnormalResult; } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 94e489f..52556fd 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.199 2005/08/25 10:40:02 dkf Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.200 2005/09/14 21:32:17 dgp Exp $ */ #include "tclInt.h" @@ -6094,11 +6094,11 @@ TclExprFloatError(interp, value) Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *) NULL); } } else { - char msg[64 + TCL_INTEGER_SPACE]; - - sprintf(msg, "unknown floating-point error, errno = %d", errno); - Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); - Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", msg, (char *) NULL); + Tcl_Obj *objPtr = Tcl_GetObjResult(interp); + TclObjPrintf(NULL, objPtr, + "unknown floating-point error, errno = %d", errno); + Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", + Tcl_GetString(objPtr), (char *) NULL); } } diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 26cc50c..13b8028 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.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: tclIORChan.c,v 1.3 2005/09/09 19:09:48 andreas_kupries Exp $ + * RCS: @(#) $Id: tclIORChan.c,v 1.4 2005/09/14 21:32:17 dgp Exp $ */ #include <tclInt.h> @@ -1723,16 +1723,10 @@ RcGetOption (clientData, interp, optionName, dsPtr) if ((listc % 2) == 1) { /* Odd number of elements is wrong. */ - - char buf [20]; - - sprintf (buf, "%d", listc); - Tcl_ResetResult (interp); - Tcl_AppendResult (interp, - "Expected list with even number of elements, got ", - buf, (listc == 1 ? " element" : " elements"), - " instead", (char*) NULL); - + Tcl_ResetResult(interp); + TclObjPrintf(NULL, Tcl_GetObjResult(interp), + "Expected list with even number of elements, got %d element%s instead", + listc, (listc == 1 ? "" : "s")); Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */ return TCL_ERROR; } @@ -1965,21 +1959,19 @@ RcNewHandle () #endif static unsigned long rcCounter = 0; - char channelName [50]; - Tcl_Obj* res = Tcl_NewStringObj ("rc", -1); + Tcl_Obj* res = Tcl_NewObj (); #ifdef TCL_THREADS Tcl_MutexLock (&rcCounterMutex); #endif - sprintf (channelName, "%lu", (unsigned long) rcCounter); + TclObjPrintf(NULL, res, "rc%lu", rcCounter); rcCounter ++; #ifdef TCL_THREADS Tcl_MutexUnlock (&rcCounterMutex); #endif - Tcl_AppendStringsToObj (res, channelName, (char*) NULL); return res; } diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index a2bce94..d5aa6d8 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.46 2005/09/14 17:13:18 dgp Exp $ */ + * RCS: @(#) $Id: tclStringObj.c,v 1.47 2005/09/14 21:32:17 dgp Exp $ */ #include "tclInt.h" @@ -2305,13 +2305,19 @@ ObjPrintfVA( case '\0': seekingConversion = 0; break; - case 's': + case 's': { + char *bytes = va_arg(argList, char *); seekingConversion = 0; if (gotPrecision) { - numBytes = lastNum; + char *end = bytes + lastNum; + char *q = bytes; + while ((q < end) && (*q != '\0')) { + q++; + } + numBytes = (int)(q - bytes); } - Tcl_ListObjAppendElement(NULL, list, Tcl_NewStringObj( - va_arg(argList, char *), numBytes)); + Tcl_ListObjAppendElement(NULL, list, + Tcl_NewStringObj(bytes , 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 @@ -2319,6 +2325,7 @@ ObjPrintfVA( * will have no effect and we can just pass it through. */ break; + } case 'c': case 'i': case 'u': |