summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog22
-rw-r--r--generic/tclBasic.c19
-rw-r--r--generic/tclCkalloc.c9
-rw-r--r--generic/tclCmdAH.c23
-rw-r--r--generic/tclCmdIL.c10
-rw-r--r--generic/tclCmdMZ.c17
-rw-r--r--generic/tclDictObj.c10
-rw-r--r--generic/tclExecute.c11
-rw-r--r--generic/tclIORChan.c23
-rw-r--r--generic/tclIOUtil.c7
-rw-r--r--generic/tclInt.h16
-rw-r--r--generic/tclMain.c5
-rw-r--r--generic/tclNamesp.c24
-rw-r--r--generic/tclParseExpr.c45
-rw-r--r--generic/tclPkg.c6
-rw-r--r--generic/tclProc.c43
-rw-r--r--generic/tclStringObj.c85
-rw-r--r--generic/tclTimer.c10
-rw-r--r--generic/tclUtil.c14
-rw-r--r--unix/tclUnixFCmd.c8
20 files changed, 212 insertions, 195 deletions
diff --git a/ChangeLog b/ChangeLog
index fa1bbe7..61746e5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,25 @@
+2006-10-31 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Refactored and renamed the routines
+ * generic/tclCkalloc.c: TclObjPrintf, TclFormatObj, and
+ * generic/tclCmdAH.c: TclFormatToErrorInfo to a new set of
+ * generic/tclCmdIL.c: routines TclAppendPrintfToObj,
+ * generic/tclCmdMZ.c: TclAppendFormatToObj, TclObjPrintf, and
+ * generic/tclDictObj.c: TclObjFormat, with the intent of making
+ * generic/tclExecute.c: the latter list, plus TclAppendLimitedToObj
+ * generic/tclIORChan.c: and TclAppendObjToErrorInfo, public via
+ * generic/tclIOUtil.c: a revised TIP 270.
+ * generic/tclInt.h:
+ * generic/tclMain.c:
+ * generic/tclNamesp.c:
+ * generic/tclParseExpr.c:
+ * generic/tclPkg.c:
+ * generic/tclProc.c:
+ * generic/tclStringObj.c:
+ * generic/tclTimer.c:
+ * generic/tclUtil.c:
+ * unix/tclUnixFCmd.c:
+
2006-10-31 Miguel Sofer <msofer@users.sf.net>
* generic/tclBasic.c:
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 2be44d3..2ef6a8d 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.208 2006/10/31 15:23:41 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.209 2006/10/31 20:19:44 dgp Exp $
*/
#include "tclInt.h"
@@ -3765,8 +3765,8 @@ Tcl_EvalEx(
* Attempt to expand a non-list.
*/
- TclFormatToErrorInfo(interp,
- "\n (expanding word %d)", objectsUsed);
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ "\n (expanding word %d)", objectsUsed));
Tcl_DecrRefCount(objv[objectsUsed]);
goto error;
}
@@ -4156,10 +4156,8 @@ ProcessUnexpectedResult(
Tcl_AppendResult(interp,
"invoked \"continue\" outside of a loop", NULL);
} else {
- Tcl_Obj *objPtr = Tcl_NewObj();
- TclObjPrintf(NULL, objPtr, "command returned bad code: %d",
- returnCode);
- Tcl_SetObjResult(interp, objPtr);
+ Tcl_SetObjResult(interp, TclObjPrintf(NULL,
+ "command returned bad code: %d", returnCode));
}
}
@@ -5777,7 +5775,6 @@ MathFuncWrongNumArgs(
int found, /* Actual parameter count */
Tcl_Obj *CONST *objv) /* Actual parameter vector */
{
- Tcl_Obj *errorMessage;
CONST char *name = Tcl_GetString(objv[0]);
CONST char *tail = name + strlen(name);
@@ -5788,11 +5785,9 @@ MathFuncWrongNumArgs(
break;
}
}
- TclNewObj(errorMessage);
- TclObjPrintf(NULL, errorMessage,
+ Tcl_SetObjResult(interp, TclObjPrintf(NULL,
"too %s arguments for math function \"%s\"",
- (found < expected ? "few" : "many"), name);
- Tcl_SetObjResult(interp, errorMessage);
+ (found < expected ? "few" : "many"), name));
}
/*
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index d04b45a..ee7419c 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.26 2005/11/01 15:30:52 dkf Exp $
+ * RCS: @(#) $Id: tclCkalloc.c,v 1.27 2006/10/31 20:19:44 dgp Exp $
*/
#include "tclInt.h"
@@ -842,14 +842,13 @@ MemoryCmd(
return TCL_OK;
}
if (strcmp(argv[1],"info") == 0) {
- Tcl_Obj *objPtr = Tcl_NewObj();
- TclObjPrintf(NULL, objPtr, "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n",
+ Tcl_SetObjResult(interp, TclObjPrintf(NULL,
+ "%-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_SetObjResult(interp, objPtr);
+ "maximum bytes allocated", maximum_bytes_malloced));
return TCL_OK;
}
if (strcmp(argv[1],"init") == 0) {
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index f2c49cb..07164d9 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.75 2006/08/10 12:15:30 dkf Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.76 2006/10/31 20:19:44 dgp Exp $
*/
#include "tclInt.h"
@@ -188,8 +188,9 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
armPtr = caseObjv[body - 1];
result = Tcl_EvalObjEx(interp, caseObjv[body], 0);
if (result == TCL_ERROR) {
- TclFormatToErrorInfo(interp, "\n (\"%.50s\" arm line %d)",
- TclGetString(armPtr), interp->errorLine);
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ "\n (\"%.50s\" arm line %d)",
+ TclGetString(armPtr), interp->errorLine));
}
return result;
}
@@ -250,8 +251,8 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv)
*/
if (Tcl_LimitExceeded(interp)) {
- TclFormatToErrorInfo(interp, "\n (\"catch\" body line %d)",
- interp->errorLine);
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ "\n (\"catch\" body line %d)", interp->errorLine));
return TCL_ERROR;
}
@@ -659,8 +660,8 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv)
result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
}
if (result == TCL_ERROR) {
- TclFormatToErrorInfo(interp,"\n (\"eval\" body line %d)",
- interp->errorLine);
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ "\n (\"eval\" body line %d)", interp->errorLine));
}
return result;
}
@@ -1611,8 +1612,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) {
- TclFormatToErrorInfo(interp, "\n (\"for\" body line %d)",
- interp->errorLine);
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ "\n (\"for\" body line %d)", interp->errorLine));
}
break;
}
@@ -1821,8 +1822,8 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
result = TCL_OK;
break;
} else if (result == TCL_ERROR) {
- TclFormatToErrorInfo(interp,
- "\n (\"foreach\" body line %d)", interp->errorLine);
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ "\n (\"foreach\" body line %d)", interp->errorLine));
break;
} else {
break;
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 8bf2dd3..ba10ca0 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.90 2006/10/23 21:36:54 msofer Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.91 2006/10/31 20:19:44 dgp Exp $
*/
#include "tclInt.h"
@@ -3362,8 +3362,8 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
if (sortInfo.indexc > 1) {
ckfree((char *) sortInfo.indexv);
}
- TclFormatToErrorInfo(interp,
- "\n (-index option item number %d)", j);
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ "\n (-index option item number %d)", j));
return TCL_ERROR;
}
}
@@ -4000,8 +4000,8 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
if (sortInfo.indexc > 1) {
ckfree((char *) sortInfo.indexv);
}
- TclFormatToErrorInfo(interp,
- "\n (-index option item number %d)", j);
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ "\n (-index option item number %d)", j));
return TCL_ERROR;
}
}
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index a77431c..578e977 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.135 2006/08/21 01:08:41 das Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.136 2006/10/31 20:19:45 dgp Exp $
*/
#include "tclInt.h"
@@ -2128,11 +2128,9 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
length2 = length1 * count;
if ((length2 / count) != length1) {
- resultPtr = Tcl_NewObj();
- TclObjPrintf(NULL, resultPtr,
+ Tcl_SetObjResult(interp, TclObjPrintf(NULL,
"string size overflow, must be less than %d",
- INT_MAX);
- Tcl_SetObjResult(interp, resultPtr);
+ INT_MAX));
return TCL_ERROR;
}
@@ -2884,9 +2882,10 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
if (result == TCL_ERROR) {
int limit = 50;
int overflow = (patternLength > limit);
- TclFormatToErrorInfo(interp, "\n (\"%.*s%s\" arm line %d)",
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ "\n (\"%.*s%s\" arm line %d)",
(overflow ? limit : patternLength), pattern,
- (overflow ? "..." : ""), interp->errorLine);
+ (overflow ? "..." : ""), interp->errorLine));
}
return result;
}
@@ -3031,8 +3030,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) {
- TclFormatToErrorInfo(interp, "\n (\"while\" body line %d)",
- interp->errorLine);
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ "\n (\"while\" body line %d)", interp->errorLine));
}
break;
}
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 114d933..8efc7aa 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.41 2006/08/10 12:15:31 dkf Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.42 2006/10/31 20:19:45 dgp Exp $
*/
#include "tclInt.h"
@@ -2229,9 +2229,9 @@ DictForCmd(
if (result == TCL_BREAK) {
result = TCL_OK;
} else if (result == TCL_ERROR) {
- TclFormatToErrorInfo(interp,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
"\n (\"dict for\" body line %d)",
- interp->errorLine);
+ interp->errorLine));
}
break;
}
@@ -2575,9 +2575,9 @@ DictFilterCmd(
result = TCL_OK;
break;
case TCL_ERROR:
- TclFormatToErrorInfo(interp,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
"\n (\"dict filter\" script line %d)",
- interp->errorLine);
+ interp->errorLine));
default:
goto abnormalResult;
}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index b33e6b2b..d77ef69 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.247 2006/10/30 16:30:35 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.248 2006/10/31 20:19:45 dgp Exp $
*/
#include "tclInt.h"
@@ -6350,7 +6350,6 @@ IllegalExprOperandType(
int type;
unsigned char opcode = *pc;
CONST char *description, *operator = operatorStrings[opcode - INST_LOR];
- Tcl_Obj *msg = Tcl_NewObj();
if (opcode == INST_EXPON) {
operator = "**";
@@ -6375,9 +6374,8 @@ IllegalExprOperandType(
description = "(big) integer";
}
- TclObjPrintf(NULL, msg, "can't use %s as operand of \"%s\"",
- description, operator);
- Tcl_SetObjResult(interp, msg);
+ Tcl_SetObjResult(interp, TclObjPrintf(NULL,
+ "can't use %s as operand of \"%s\"", description, operator));
}
/*
@@ -6640,8 +6638,7 @@ TclExprFloatError(
Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *) NULL);
}
} else {
- Tcl_Obj *objPtr = Tcl_NewObj();
- TclObjPrintf(NULL, objPtr,
+ Tcl_Obj *objPtr = TclObjPrintf(NULL,
"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 a69ea2e..d944287 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.15 2006/03/27 18:08:51 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclIORChan.c,v 1.16 2006/10/31 20:19:45 dgp Exp $
*/
#include <tclInt.h>
@@ -1651,13 +1651,11 @@ ReflectGetOption(
* Odd number of elements is wrong.
*/
- Tcl_Obj *objPtr = Tcl_NewObj();
-
Tcl_ResetResult(interp);
- TclObjPrintf(NULL, objPtr, "Expected list with even number of "
+ Tcl_SetObjResult(interp, TclObjPrintf(NULL,
+ "Expected list with even number of "
"elements, got %d element%s instead", listc,
- (listc == 1 ? "" : "s"));
- Tcl_SetObjResult(interp, objPtr);
+ (listc == 1 ? "" : "s")));
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
return TCL_ERROR;
} else {
@@ -1910,9 +1908,8 @@ NextHandle(void)
static unsigned long rcCounter = 0;
Tcl_Obj *resObj;
- TclNewObj(resObj);
Tcl_MutexLock(&rcCounterMutex);
- TclObjPrintf(NULL, resObj, "rc%lu", rcCounter);
+ resObj = TclObjPrintf(NULL, "rc%lu", rcCounter);
rcCounter++;
Tcl_MutexUnlock(&rcCounterMutex);
@@ -2043,19 +2040,17 @@ InvokeTclMethod(
Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rcPtr->argv);
int cmdLen;
CONST char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
- Tcl_Obj *msg = Tcl_NewObj();
Tcl_IncrRefCount(cmd);
- TclObjPrintf(NULL, msg, "chan handler returned bad code: %d",
- result);
Tcl_ResetResult(rcPtr->interp);
- Tcl_SetObjResult(rcPtr->interp, msg);
+ Tcl_SetObjResult(rcPtr->interp, TclObjPrintf(NULL,
+ "chan handler returned bad code: %d", result));
Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString, cmdLen);
Tcl_DecrRefCount(cmd);
result = TCL_ERROR;
}
- TclFormatToErrorInfo(rcPtr->interp,
- "\n (chan handler subcommand \"%s\")", method);
+ TclAppendObjToErrorInfo(rcPtr->interp, TclObjPrintf(NULL,
+ "\n (chan handler subcommand \"%s\")", method));
resObj = MarshallError(rcPtr->interp);
}
Tcl_IncrRefCount(resObj);
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 68cac51..fb4f71b 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.134 2006/08/29 00:36:57 coldstore Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.135 2006/10/31 20:19:45 dgp Exp $
*/
#include "tclInt.h"
@@ -1830,9 +1830,10 @@ Tcl_FSEvalFileEx(
int limit = 150;
int overflow = (length > limit);
- TclFormatToErrorInfo(interp, "\n (file \"%.*s%s\" line %d)",
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ "\n (file \"%.*s%s\" line %d)",
(overflow ? limit : length), pathString,
- (overflow ? "..." : ""), interp->errorLine);
+ (overflow ? "..." : ""), interp->errorLine));
}
end:
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 25a150a..2faf993 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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: tclInt.h,v 1.289 2006/10/31 13:46:31 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.290 2006/10/31 20:19:45 dgp Exp $
*/
#ifndef _TCLINT
@@ -2038,9 +2038,13 @@ MODULE_SCOPE char tclEmptyString;
MODULE_SCOPE int TclAppendFormattedObjs(Tcl_Interp *interp,
Tcl_Obj *appendObj, CONST char *format,
int objc, Tcl_Obj *CONST objv[]);
+MODULE_SCOPE int TclAppendFormatToObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, CONST char *format, ...);
MODULE_SCOPE void TclAppendLimitedToObj(Tcl_Obj *objPtr,
CONST char *bytes, int length, int limit,
CONST char *ellipsis);
+MODULE_SCOPE int TclAppendPrintfToObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, CONST char *format, ...);
MODULE_SCOPE void TclAppendObjToErrorInfo(Tcl_Interp *interp,
Tcl_Obj *objPtr);
MODULE_SCOPE int TclArraySet(Tcl_Interp *interp,
@@ -2089,10 +2093,6 @@ MODULE_SCOPE void TclFinalizeSynchronization(void);
MODULE_SCOPE void TclFinalizeThreadData(void);
MODULE_SCOPE double TclFloor(mp_int *a);
MODULE_SCOPE void TclFormatNaN(double value, char *buffer);
-MODULE_SCOPE int TclFormatObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
- CONST char *format, ...);
-MODULE_SCOPE int TclFormatToErrorInfo(Tcl_Interp *interp,
- CONST char *format, ...);
MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr,
CONST char *attributeName, int *indexPtr);
MODULE_SCOPE Tcl_Obj * TclGetBgErrorHandler(Tcl_Interp *interp);
@@ -2147,14 +2147,16 @@ MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[], Tcl_Obj **optionsPtrPtr,
int *codePtr, int *levelPtr);
MODULE_SCOPE int TclNokia770Doubles();
+MODULE_SCOPE Tcl_Obj * TclObjFormat(Tcl_Interp *interp,
+ CONST char *format, ...);
MODULE_SCOPE int TclObjInvokeNamespace(Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[],
Tcl_Namespace *nsPtr, int flags);
+MODULE_SCOPE Tcl_Obj * TclObjPrintf(Tcl_Interp *interp,
+ CONST char *format, ...);
MODULE_SCOPE int TclPtrMakeUpvar (Tcl_Interp *interp,
Var *otherP1Ptr, CONST char *myName,
int myFlags, int index);
-MODULE_SCOPE int TclObjPrintf(Tcl_Interp *interp, Tcl_Obj *objPtr,
- CONST char *format, ...);
MODULE_SCOPE int TclParseBackslash(CONST char *src,
int numBytes, int *readPtr, char *dst);
MODULE_SCOPE int TclParseHex(CONST char *src, int numBytes,
diff --git a/generic/tclMain.c b/generic/tclMain.c
index c3a75ef..841d6bd 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.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: tclMain.c,v 1.36 2006/05/05 18:09:47 dgp Exp $
+ * RCS: @(#) $Id: tclMain.c,v 1.37 2006/10/31 20:19:45 dgp Exp $
*/
#include "tclInt.h"
@@ -652,8 +652,7 @@ Tcl_Main(
if (!Tcl_InterpDeleted(interp)) {
if (!Tcl_LimitExceeded(interp)) {
- Tcl_Obj *cmd = Tcl_NewObj();
- TclObjPrintf(NULL, cmd, "exit %d", exitCode);
+ Tcl_Obj *cmd = TclObjPrintf(NULL, "exit %d", exitCode);
Tcl_IncrRefCount(cmd);
Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(cmd);
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index bbb8a7b..412e0c7 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -22,7 +22,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclNamesp.c,v 1.113 2006/10/31 15:23:41 msofer Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.114 2006/10/31 20:19:45 dgp Exp $
*/
#include "tclInt.h"
@@ -3454,10 +3454,10 @@ NamespaceEvalCmd(
int limit = 200;
int overflow = (length > limit);
- TclFormatToErrorInfo(interp,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
"\n (in namespace eval \"%.*s%s\" script line %d)",
(overflow ? limit : length), namespacePtr->fullName,
- (overflow ? "..." : ""), interp->errorLine);
+ (overflow ? "..." : ""), interp->errorLine));
}
/*
@@ -3872,10 +3872,10 @@ NamespaceInscopeCmd(
int limit = 200;
int overflow = (length > limit);
- TclFormatToErrorInfo(interp,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
"\n (in namespace inscope \"%.*s%s\" script line %d)",
(overflow ? limit : length), namespacePtr->fullName,
- (overflow ? "..." : ""), interp->errorLine);
+ (overflow ? "..." : ""), interp->errorLine));
}
/*
@@ -4602,12 +4602,8 @@ NamespaceUpvarCmd(
/*
* The namespace does not exist, leave an error message.
*/
-
- Tcl_Obj *resPtr;
-
- TclNewObj(resPtr);
- TclFormatObj(NULL, resPtr, "namespace \"%s\" does not exist", objv[2]);
- Tcl_SetObjResult(interp, resPtr);
+ Tcl_SetObjResult(interp, TclObjFormat(NULL,
+ "namespace \"%s\" does not exist", objv[2]));
return TCL_ERROR;
}
@@ -6997,10 +6993,10 @@ Tcl_LogCommandInfo(
}
overflow = (length > limit);
- TclFormatToErrorInfo(interp, "\n %s\n\"%.*s%s\"",
- ((iPtr->errorInfo == NULL)
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ "\n %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL)
? "while executing" : "invoked from within"),
- (overflow ? limit : length), command, (overflow ? "..." : ""));
+ (overflow ? limit : length), command, (overflow ? "..." : "")));
varPtr = TclObjLookupVar(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY,
NULL, 0, 0, &arrayPtr);
diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c
index c6471a2..f3d9d45 100644
--- a/generic/tclParseExpr.c
+++ b/generic/tclParseExpr.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: tclParseExpr.c,v 1.44 2006/08/30 20:46:20 dgp Exp $
+ * RCS: @(#) $Id: tclParseExpr.c,v 1.45 2006/10/31 20:19:45 dgp Exp $
*/
#include "tclInt.h"
@@ -225,14 +225,12 @@ Tcl_ParseExpr(
if ((NODE_TYPE & nodePtr->lexeme) == 0) {
switch (nodePtr->lexeme) {
case INVALID:
- msg = Tcl_NewObj();
- TclObjPrintf(NULL, msg,
+ msg = TclObjPrintf(NULL,
"invalid character \"%.*s\"", scanned, start);
code = TCL_ERROR;
continue;
case INCOMPLETE:
- msg = Tcl_NewObj();
- TclObjPrintf(NULL, msg,
+ msg = TclObjPrintf(NULL,
"incomplete operator \"%.*s\"", scanned, start);
code = TCL_ERROR;
continue;
@@ -248,18 +246,18 @@ Tcl_ParseExpr(
if (code == TCL_OK) {
nodePtr->lexeme = BOOLEAN;
} else {
- msg = Tcl_NewObj();
- TclObjPrintf(NULL, msg, "invalid bareword \"%.*s%s\"",
+ msg = TclObjPrintf(NULL,
+ "invalid bareword \"%.*s%s\"",
(scanned < limit) ? scanned : limit - 3, start,
(scanned < limit) ? "" : "...");
- post = Tcl_NewObj();
- TclObjPrintf(NULL, post,
+ post = TclObjPrintf(NULL,
"should be \"$%.*s%s\" or \"{%.*s%s}\"",
(scanned < limit) ? scanned : limit - 3,
start, (scanned < limit) ? "" : "...",
(scanned < limit) ? scanned : limit - 3,
start, (scanned < limit) ? "" : "...");
- TclObjPrintf(NULL, post, " or \"%.*s%s(...)\" or ...",
+ TclAppendPrintfToObj(NULL, post,
+ " or \"%.*s%s(...)\" or ...",
(scanned < limit) ? scanned : limit - 3,
start, (scanned < limit) ? "" : "...");
continue;
@@ -286,8 +284,7 @@ Tcl_ParseExpr(
CONST char *operand =
scratch.tokenPtr[lastNodePtr->token].start;
- msg = Tcl_NewObj();
- TclObjPrintf(NULL, msg, "missing operator at %s", mark);
+ msg = TclObjPrintf(NULL, "missing operator at %s", mark);
if (operand[0] == '0') {
Tcl_Obj *copy = Tcl_NewStringObj(operand,
start + scanned - operand);
@@ -421,8 +418,7 @@ Tcl_ParseExpr(
case UNARY:
if ((NODE_TYPE & lastNodePtr->lexeme) == LEAF) {
- msg = Tcl_NewObj();
- TclObjPrintf(NULL, msg, "missing operator at %s", mark);
+ msg = TclObjPrintf(NULL, "missing operator at %s", mark);
scanned = 0;
insertMark = 1;
code = TCL_ERROR;
@@ -468,8 +464,7 @@ Tcl_ParseExpr(
break;
}
- msg = Tcl_NewObj();
- TclObjPrintf(NULL, msg, "empty subexpression at %s", mark);
+ msg = TclObjPrintf(NULL, "empty subexpression at %s", mark);
scanned = 0;
insertMark = 1;
code = TCL_ERROR;
@@ -482,8 +477,7 @@ Tcl_ParseExpr(
if (lastNodePtr->lexeme == OPEN_PAREN) {
msg = Tcl_NewStringObj("unbalanced open paren", -1);
} else if (lastNodePtr->lexeme == COMMA) {
- msg = Tcl_NewObj();
- TclObjPrintf(NULL, msg,
+ msg = TclObjPrintf(NULL,
"missing function argument at %s", mark);
scanned = 0;
insertMark = 1;
@@ -496,16 +490,14 @@ Tcl_ParseExpr(
} else if ((nodePtr->lexeme == COMMA)
&& (lastNodePtr->lexeme == OPEN_PAREN)
&& (lastNodePtr[-1].lexeme == FUNCTION)) {
- msg = Tcl_NewObj();
- TclObjPrintf(NULL, msg,
+ msg = TclObjPrintf(NULL,
"missing function argument at %s", mark);
scanned = 0;
insertMark = 1;
}
}
if (msg == NULL) {
- msg = Tcl_NewObj();
- TclObjPrintf(NULL, msg, "missing operand at %s", mark);
+ msg = TclObjPrintf(NULL, "missing operand at %s", mark);
scanned = 0;
insertMark = 1;
}
@@ -551,8 +543,7 @@ Tcl_ParseExpr(
}
if ((otherPtr->lexeme == QUESTION)
&& (lastOrphanPtr->lexeme != COLON)) {
- msg = Tcl_NewObj();
- TclObjPrintf(NULL, msg,
+ msg = TclObjPrintf(NULL,
"missing operator \":\" at %s", mark);
scanned = 0;
insertMark = 1;
@@ -657,7 +648,7 @@ Tcl_ParseExpr(
if (msg == NULL) {
msg = Tcl_GetObjResult(interp);
}
- TclObjPrintf(NULL, msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"",
+ TclAppendPrintfToObj(NULL, msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"",
((start - limit) < scratch.string) ? "" : "...",
((start - limit) < scratch.string)
? (start - scratch.string) : limit - 3,
@@ -678,10 +669,10 @@ Tcl_ParseExpr(
}
Tcl_SetObjResult(interp, msg);
numBytes = scratch.end - scratch.string;
- TclFormatToErrorInfo(interp,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
"\n (parsing expression \"%.*s%s\")",
(numBytes < limit) ? numBytes : limit - 3,
- scratch.string, (numBytes < limit) ? "" : "...");
+ scratch.string, (numBytes < limit) ? "" : "..."));
}
}
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index ea10e18..e0f6615 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.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: tclPkg.c,v 1.21 2006/10/16 17:43:20 dgp Exp $
+ * RCS: @(#) $Id: tclPkg.c,v 1.22 2006/10/31 20:19:45 dgp Exp $
*
* TIP #268.
* Heavily rewritten to handle the extend version numbers, and extended
@@ -508,9 +508,9 @@ Tcl_PkgRequireProc(
}
if (code == TCL_ERROR) {
- TclFormatToErrorInfo(interp,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
"\n (\"package ifneeded %s %s\" script)",
- name, versionToProvide);
+ name, versionToProvide));
}
Tcl_Release((ClientData) versionToProvide);
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 1dfe606..90e6970 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.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: tclProc.c,v 1.102 2006/10/31 13:46:32 dkf Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.103 2006/10/31 20:19:45 dgp Exp $
*/
#include "tclInt.h"
@@ -369,12 +369,10 @@ TclCreateProc(
if (precompiled) {
if (numArgs > procPtr->numArgs) {
- Tcl_Obj *objPtr = Tcl_NewObj();
- TclObjPrintf(NULL, objPtr,
+ Tcl_SetObjResult(interp, TclObjPrintf(NULL,
"procedure \"%s\": arg list contains %d entries, "
"precompiled header expects %d", procName, numArgs,
- procPtr->numArgs);
- Tcl_SetObjResult(interp, objPtr);
+ procPtr->numArgs));
goto procError;
}
localPtr = procPtr->firstLocalPtr;
@@ -460,11 +458,9 @@ TclCreateProc(
!= (VAR_SCALAR | VAR_ARGUMENT))
|| (localPtr->defValuePtr == NULL && fieldCount == 2)
|| (localPtr->defValuePtr != NULL && fieldCount != 2)) {
- Tcl_Obj *objPtr = Tcl_NewObj();
- TclObjPrintf(NULL, objPtr,
+ Tcl_SetObjResult(interp, TclObjPrintf(NULL,
"procedure \"%s\": formal parameter %d is "
- "inconsistent with precompiled body", procName, i);
- Tcl_SetObjResult(interp, objPtr);
+ "inconsistent with precompiled body", procName, i));
ckfree((char *) fieldValues);
goto procError;
}
@@ -479,13 +475,10 @@ TclCreateProc(
&tmpLength);
if ((valueLength != tmpLength) ||
strncmp(fieldValues[1], tmpPtr, (size_t) tmpLength)) {
- Tcl_Obj *objPtr = Tcl_NewObj();
-
- TclObjPrintf(NULL, objPtr,
+ Tcl_SetObjResult(interp, TclObjPrintf(NULL,
"procedure \"%s\": formal parameter \"%s\" has "
"default value inconsistent with precompiled body",
- procName, fieldValues[0]);
- Tcl_SetObjResult(interp, objPtr);
+ procName, fieldValues[0]));
ckfree((char *) fieldValues);
goto procError;
}
@@ -846,8 +839,8 @@ Tcl_UplevelObjCmd(
result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
}
if (result == TCL_ERROR) {
- TclFormatToErrorInfo(interp, "\n (\"uplevel\" body line %d)",
- interp->errorLine);
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ "\n (\"uplevel\" body line %d)", interp->errorLine));
}
/*
@@ -1699,10 +1692,10 @@ ProcCompileProc(
int limit = 50;
int overflow = (length > limit);
- TclFormatToErrorInfo(interp,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
"\n (compiling %s \"%.*s%s\", line %d)",
description, (overflow ? limit : length), procName,
- (overflow ? "..." : ""), interp->errorLine);
+ (overflow ? "..." : ""), interp->errorLine));
}
return result;
}
@@ -1746,9 +1739,10 @@ MakeProcError(
const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen);
overflow = (nameLen > limit);
- TclFormatToErrorInfo(interp, "\n (procedure \"%.*s%s\" line %d)",
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ "\n (procedure \"%.*s%s\" line %d)",
(overflow ? limit : nameLen), procName,
- (overflow ? "..." : ""), interp->errorLine);
+ (overflow ? "..." : ""), interp->errorLine));
}
/*
@@ -2083,8 +2077,8 @@ SetLambdaFromAny(
if (TclCreateProc(interp, /*ignored nsPtr*/ NULL, name, argsPtr,
bodyPtr, &procPtr) != TCL_OK) {
- TclFormatToErrorInfo(interp,
- "\n (parsing lambda expression \"%s\")", name, NULL);
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ "\n (parsing lambda expression \"%s\")", name));
return TCL_ERROR;
}
@@ -2273,9 +2267,10 @@ MakeLambdaError(
const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen);
overflow = (nameLen > limit);
- TclFormatToErrorInfo(interp, "\n (lambda term \"%.*s%s\" line %d)",
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ "\n (lambda term \"%.*s%s\" line %d)",
(overflow ? limit : nameLen), procName,
- (overflow ? "..." : ""), interp->errorLine);
+ (overflow ? "..." : ""), interp->errorLine));
}
/*
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index af94b6d..c3ba0f0 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.58 2006/09/24 20:46:40 msofer Exp $ */
+ * RCS: @(#) $Id: tclStringObj.c,v 1.59 2006/10/31 20:19:45 dgp Exp $ */
#include "tclInt.h"
#include "tommath.h"
@@ -51,9 +51,9 @@ static void AppendUtfToUnicodeRep(Tcl_Obj *objPtr,
static void AppendUtfToUtfRep(Tcl_Obj *objPtr,
CONST char *bytes, int numBytes);
static void FillUnicodeRep(Tcl_Obj *objPtr);
-static int FormatObjVA(Tcl_Interp *interp, Tcl_Obj *objPtr,
+static int AppendFormatToObjVA(Tcl_Interp *interp, Tcl_Obj *objPtr,
CONST char *format, va_list argList);
-static int ObjPrintfVA(Tcl_Interp *interp, Tcl_Obj *objPtr,
+static int AppendPrintfToObjVA(Tcl_Interp *interp, Tcl_Obj *objPtr,
CONST char *format, va_list argList);
static void FreeStringInternalRep(Tcl_Obj *objPtr);
static void DupStringInternalRep(Tcl_Obj *objPtr,
@@ -2293,7 +2293,7 @@ TclAppendFormattedObjs(
/*
*---------------------------------------------------------------------------
*
- * FormatObjVA --
+ * AppendFormatToObjVA --
*
* Populate the Unicode internal rep with the Unicode form of its string
* rep. The object must alread have a "String" internal rep.
@@ -2308,7 +2308,7 @@ TclAppendFormattedObjs(
*/
static int
-FormatObjVA(
+AppendFormatToObjVA(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
CONST char *format,
@@ -2339,7 +2339,7 @@ FormatObjVA(
/*
*---------------------------------------------------------------------------
*
- * TclFormatObj --
+ * TclAppendFormatToObj --
*
* Results:
* A standard Tcl result.
@@ -2351,7 +2351,7 @@ FormatObjVA(
*/
int
-TclFormatObj(
+TclAppendFormatToObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
CONST char *format,
@@ -2361,7 +2361,7 @@ TclFormatObj(
int result;
va_start(argList, format);
- result = FormatObjVA(interp, objPtr, format, argList);
+ result = AppendFormatToObjVA(interp, objPtr, format, argList);
va_end(argList);
return result;
}
@@ -2369,7 +2369,41 @@ TclFormatObj(
/*
*---------------------------------------------------------------------------
*
- * ObjPrintfVA --
+ * TclObjFormat--
+ *
+ * Results:
+ * A refcount zero Tcl_Obj.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclObjFormat(
+ Tcl_Interp *interp,
+ CONST char *format,
+ ...)
+{
+ va_list argList;
+ int result;
+ Tcl_Obj *objPtr = Tcl_NewObj();
+
+ va_start(argList, format);
+ result = AppendFormatToObjVA(interp, objPtr, format, argList);
+ va_end(argList);
+ if (result != TCL_OK) {
+ Tcl_DecrRefCount(objPtr);
+ return NULL;
+ }
+ return objPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * AppendPrintfToObjVA --
*
* Results:
*
@@ -2379,7 +2413,7 @@ TclFormatObj(
*/
static int
-ObjPrintfVA(
+AppendPrintfToObjVA(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
CONST char *format,
@@ -2510,7 +2544,7 @@ ObjPrintfVA(
/*
*---------------------------------------------------------------------------
*
- * TclObjPrintf --
+ * TclAppendPrintfToObj --
*
* Results:
* A standard Tcl result.
@@ -2522,7 +2556,7 @@ ObjPrintfVA(
*/
int
-TclObjPrintf(
+TclAppendPrintfToObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
CONST char *format,
@@ -2532,42 +2566,43 @@ TclObjPrintf(
int result;
va_start(argList, format);
- result = ObjPrintfVA(interp, objPtr, format, argList);
+ result = AppendPrintfToObjVA(interp, objPtr, format, argList);
va_end(argList);
return result;
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * TclFormatToErrorInfo --
+ * TclObjPrintf --
*
* Results:
+ * A refcount zero Tcl_Obj.
*
* Side effects:
+ * None.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
-int
-TclFormatToErrorInfo(
+Tcl_Obj *
+TclObjPrintf(
Tcl_Interp *interp,
CONST char *format,
...)
{
- int code;
va_list argList;
+ int result;
Tcl_Obj *objPtr = Tcl_NewObj();
va_start(argList, format);
- code = ObjPrintfVA(interp, objPtr, format, argList);
+ result = AppendPrintfToObjVA(interp, objPtr, format, argList);
va_end(argList);
- if (code != TCL_OK) {
- return code;
+ if (result != TCL_OK) {
+ Tcl_DecrRefCount(objPtr);
+ return NULL;
}
- TclAppendObjToErrorInfo(interp, objPtr);
- Tcl_DecrRefCount(objPtr);
- return TCL_OK;
+ return objPtr;
}
/*
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index 49e0e6e..6f7a20e 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.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: tclTimer.c,v 1.23 2006/09/26 00:05:03 patthoyts Exp $
+ * RCS: @(#) $Id: tclTimer.c,v 1.24 2006/10/31 20:19:46 dgp Exp $
*/
#include "tclInt.h"
@@ -870,9 +870,7 @@ Tcl_AfterObjCmd(
(ClientData) afterPtr);
afterPtr->nextPtr = assocPtr->firstAfterPtr;
assocPtr->firstAfterPtr = afterPtr;
- objPtr = Tcl_NewObj();
- TclObjPrintf(NULL, objPtr, "after#%d", afterPtr->id);
- Tcl_SetObjResult(interp, objPtr);
+ Tcl_SetObjResult(interp, TclObjPrintf(NULL, "after#%d", afterPtr->id));
return TCL_OK;
}
case AFTER_CANCEL: {
@@ -935,9 +933,7 @@ Tcl_AfterObjCmd(
afterPtr->nextPtr = assocPtr->firstAfterPtr;
assocPtr->firstAfterPtr = afterPtr;
Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr);
- objPtr = Tcl_NewObj();
- TclObjPrintf(NULL, objPtr, "after#%d", afterPtr->id);
- Tcl_SetObjResult(interp, objPtr);
+ Tcl_SetObjResult(interp, TclObjPrintf(NULL, "after#%d", afterPtr->id));
break;
case AFTER_INFO: {
Tcl_Obj *resultListPtr;
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index ab6c0c8..febe94c 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.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: tclUtil.c,v 1.71 2006/09/30 19:15:21 msofer Exp $
+ * RCS: @(#) $Id: tclUtil.c,v 1.72 2006/10/31 20:19:46 dgp Exp $
*/
#include "tclInt.h"
@@ -215,17 +215,15 @@ TclFindElement(
*/
if (interp != NULL) {
- Tcl_Obj *objPtr = Tcl_NewObj();
p2 = p;
while ((p2 < limit)
&& (!isspace(UCHAR(*p2))) /* INTL: ISO space. */
&& (p2 < p+20)) {
p2++;
}
- TclObjPrintf(NULL, objPtr,
+ Tcl_SetObjResult(interp, TclObjPrintf(NULL,
"list element in braces followed by \"%.*s\" "
- "instead of space", (int) (p2-p), p);
- Tcl_SetObjResult(interp, objPtr);
+ "instead of space", (int) (p2-p), p));
}
return TCL_ERROR;
}
@@ -276,17 +274,15 @@ TclFindElement(
*/
if (interp != NULL) {
- Tcl_Obj *objPtr = Tcl_NewObj();
p2 = p;
while ((p2 < limit)
&& (!isspace(UCHAR(*p2))) /* INTL: ISO space */
&& (p2 < p+20)) {
p2++;
}
- TclObjPrintf(NULL, objPtr,
+ Tcl_SetObjResult(interp, TclObjPrintf(NULL,
"list element in quotes followed by \"%.*s\" "
- "instead of space", (int) (p2-p), p);
- Tcl_SetObjResult(interp, objPtr);
+ "instead of space", (int) (p2-p), p));
}
return TCL_ERROR;
}
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index 9cd2e1e..187cab4 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.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: tclUnixFCmd.c,v 1.56 2006/09/07 09:17:33 vasiljevic Exp $
+ * RCS: @(#) $Id: tclUnixFCmd.c,v 1.57 2006/10/31 20:19:46 dgp Exp $
*
* Portions of this code were derived from NetBSD source code which has the
* following copyright notice:
@@ -1413,10 +1413,8 @@ GetPermissionsAttribute(
return TCL_ERROR;
}
- *attributePtrPtr = Tcl_NewObj();
- TclObjPrintf(NULL, *attributePtrPtr, "%0#5lo",
- (long) (statBuf.st_mode & 0x00007FFF));
-
+ *attributePtrPtr = TclObjPrintf(NULL,
+ "%0#5lo", (long) (statBuf.st_mode & 0x00007FFF));
return TCL_OK;
}
generated by cgit v0.12 at 2024-11-17 13:00:15 (GMT)