* generic/tclStringObj.c: Bug fixes: ObjPrintfVA needed to

        support "*" fields and needed to interpret precision limits on
        %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/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:

10 files changed, 67 insertions, 97 deletions

diff --git a/ChangeLog b/ChangeLog
index 87c7b60..b2c611b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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':