summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c8
-rw-r--r--generic/tclCkalloc.c7
-rw-r--r--generic/tclCmdAH.c35
-rw-r--r--generic/tclCmdIL.c20
-rw-r--r--generic/tclCmdMZ.c16
-rw-r--r--generic/tclDictObj.c13
-rw-r--r--generic/tclExecute.c12
-rw-r--r--generic/tclIORChan.c22
-rw-r--r--generic/tclStringObj.c17
9 files changed, 57 insertions, 93 deletions
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':
generated by cgit v0.12 at 2024-11-05 06:11:35 (GMT)