summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c8
-rw-r--r--generic/tclCkalloc.c4
-rw-r--r--generic/tclCmdAH.c15
-rw-r--r--generic/tclCmdIL.c6
-rw-r--r--generic/tclCmdMZ.c8
-rw-r--r--generic/tclDictObj.c6
-rw-r--r--generic/tclExecute.c6
-rw-r--r--generic/tclIORChan.c10
-rw-r--r--generic/tclIOUtil.c4
-rw-r--r--generic/tclInt.h9
-rw-r--r--generic/tclMain.c4
-rw-r--r--generic/tclNamesp.c8
-rw-r--r--generic/tclParseExpr.c30
-rw-r--r--generic/tclPkg.c4
-rw-r--r--generic/tclProc.c18
-rw-r--r--generic/tclStringObj.c29
-rw-r--r--generic/tclTimer.c6
-rw-r--r--generic/tclUtil.c6
18 files changed, 86 insertions, 95 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index ded0bcc..964c477 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.212 2006/11/02 13:24:19 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.213 2006/11/02 15:58:04 dgp Exp $
*/
#include "tclInt.h"
@@ -3812,7 +3812,7 @@ Tcl_EvalEx(
* Attempt to expand a non-list.
*/
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (expanding word %d)", objectsUsed));
Tcl_DecrRefCount(objv[objectsUsed]);
goto error;
@@ -4203,7 +4203,7 @@ ProcessUnexpectedResult(
Tcl_AppendResult(interp,
"invoked \"continue\" outside of a loop", NULL);
} else {
- Tcl_SetObjResult(interp, TclObjPrintf(NULL,
+ Tcl_SetObjResult(interp, TclObjPrintf(
"command returned bad code: %d", returnCode));
}
}
@@ -5832,7 +5832,7 @@ MathFuncWrongNumArgs(
break;
}
}
- Tcl_SetObjResult(interp, TclObjPrintf(NULL,
+ Tcl_SetObjResult(interp, TclObjPrintf(
"too %s arguments for math function \"%s\"",
(found < expected ? "few" : "many"), name));
}
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index ee7419c..e72ad97 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.27 2006/10/31 20:19:44 dgp Exp $
+ * RCS: @(#) $Id: tclCkalloc.c,v 1.28 2006/11/02 15:58:04 dgp Exp $
*/
#include "tclInt.h"
@@ -842,7 +842,7 @@ MemoryCmd(
return TCL_OK;
}
if (strcmp(argv[1],"info") == 0) {
- Tcl_SetObjResult(interp, TclObjPrintf(NULL,
+ Tcl_SetObjResult(interp, TclObjPrintf(
"%-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,
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index a00f32e..1ed975f 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.77 2006/11/02 14:04:41 dkf Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.78 2006/11/02 15:58:04 dgp Exp $
*/
#include "tclInt.h"
@@ -188,7 +188,7 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv)
armPtr = caseObjv[body - 1];
result = Tcl_EvalObjEx(interp, caseObjv[body], 0);
if (result == TCL_ERROR) {
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (\"%.50s\" arm line %d)",
TclGetString(armPtr), interp->errorLine));
}
@@ -251,7 +251,7 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv)
*/
if (Tcl_LimitExceeded(interp)) {
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (\"catch\" body line %d)", interp->errorLine));
return TCL_ERROR;
}
@@ -660,7 +660,7 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv)
result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
}
if (result == TCL_ERROR) {
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (\"eval\" body line %d)", interp->errorLine));
}
return result;
@@ -1611,7 +1611,7 @@ Tcl_ForObjCmd(dummy, interp, objc, objv)
result = Tcl_EvalObjEx(interp, objv[4], 0);
if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
if (result == TCL_ERROR) {
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (\"for\" body line %d)", interp->errorLine));
}
break;
@@ -1821,9 +1821,8 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
result = TCL_OK;
break;
} else if (result == TCL_ERROR) {
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
- "\n (\"foreach\" body line %d)",
- interp->errorLine));
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
+ "\n (\"foreach\" body line %d)", interp->errorLine));
break;
} else {
break;
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index ba10ca0..fdbc293 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.91 2006/10/31 20:19:44 dgp Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.92 2006/11/02 15:58:05 dgp Exp $
*/
#include "tclInt.h"
@@ -3362,7 +3362,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
if (sortInfo.indexc > 1) {
ckfree((char *) sortInfo.indexv);
}
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (-index option item number %d)", j));
return TCL_ERROR;
}
@@ -4000,7 +4000,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
if (sortInfo.indexc > 1) {
ckfree((char *) sortInfo.indexv);
}
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (-index option item number %d)", j));
return TCL_ERROR;
}
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 578e977..d9084cf 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.136 2006/10/31 20:19:45 dgp Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.137 2006/11/02 15:58:07 dgp Exp $
*/
#include "tclInt.h"
@@ -2128,7 +2128,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
length2 = length1 * count;
if ((length2 / count) != length1) {
- Tcl_SetObjResult(interp, TclObjPrintf(NULL,
+ Tcl_SetObjResult(interp, TclObjPrintf(
"string size overflow, must be less than %d",
INT_MAX));
return TCL_ERROR;
@@ -2882,7 +2882,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
if (result == TCL_ERROR) {
int limit = 50;
int overflow = (patternLength > limit);
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (\"%.*s%s\" arm line %d)",
(overflow ? limit : patternLength), pattern,
(overflow ? "..." : ""), interp->errorLine));
@@ -3030,7 +3030,7 @@ Tcl_WhileObjCmd(dummy, interp, objc, objv)
result = Tcl_EvalObjEx(interp, objv[2], 0);
if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
if (result == TCL_ERROR) {
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (\"while\" body line %d)", interp->errorLine));
}
break;
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 8efc7aa..de469f9 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.42 2006/10/31 20:19:45 dgp Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.43 2006/11/02 15:58:08 dgp Exp $
*/
#include "tclInt.h"
@@ -2229,7 +2229,7 @@ DictForCmd(
if (result == TCL_BREAK) {
result = TCL_OK;
} else if (result == TCL_ERROR) {
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (\"dict for\" body line %d)",
interp->errorLine));
}
@@ -2575,7 +2575,7 @@ DictFilterCmd(
result = TCL_OK;
break;
case TCL_ERROR:
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (\"dict filter\" script line %d)",
interp->errorLine));
default:
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index d77ef69..11a0354 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.248 2006/10/31 20:19:45 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.249 2006/11/02 15:58:08 dgp Exp $
*/
#include "tclInt.h"
@@ -6374,7 +6374,7 @@ IllegalExprOperandType(
description = "(big) integer";
}
- Tcl_SetObjResult(interp, TclObjPrintf(NULL,
+ Tcl_SetObjResult(interp, TclObjPrintf(
"can't use %s as operand of \"%s\"", description, operator));
}
@@ -6638,7 +6638,7 @@ TclExprFloatError(
Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *) NULL);
}
} else {
- Tcl_Obj *objPtr = TclObjPrintf(NULL,
+ Tcl_Obj *objPtr = TclObjPrintf(
"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 d944287..34d9556 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.16 2006/10/31 20:19:45 dgp Exp $
+ * RCS: @(#) $Id: tclIORChan.c,v 1.17 2006/11/02 15:58:08 dgp Exp $
*/
#include <tclInt.h>
@@ -1652,7 +1652,7 @@ ReflectGetOption(
*/
Tcl_ResetResult(interp);
- Tcl_SetObjResult(interp, TclObjPrintf(NULL,
+ Tcl_SetObjResult(interp, TclObjPrintf(
"Expected list with even number of "
"elements, got %d element%s instead", listc,
(listc == 1 ? "" : "s")));
@@ -1909,7 +1909,7 @@ NextHandle(void)
Tcl_Obj *resObj;
Tcl_MutexLock(&rcCounterMutex);
- resObj = TclObjPrintf(NULL, "rc%lu", rcCounter);
+ resObj = TclObjPrintf("rc%lu", rcCounter);
rcCounter++;
Tcl_MutexUnlock(&rcCounterMutex);
@@ -2043,13 +2043,13 @@ InvokeTclMethod(
Tcl_IncrRefCount(cmd);
Tcl_ResetResult(rcPtr->interp);
- Tcl_SetObjResult(rcPtr->interp, TclObjPrintf(NULL,
+ Tcl_SetObjResult(rcPtr->interp, TclObjPrintf(
"chan handler returned bad code: %d", result));
Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString, cmdLen);
Tcl_DecrRefCount(cmd);
result = TCL_ERROR;
}
- TclAppendObjToErrorInfo(rcPtr->interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(rcPtr->interp, TclObjPrintf(
"\n (chan handler subcommand \"%s\")", method));
resObj = MarshallError(rcPtr->interp);
}
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index fb4f71b..ef913c5 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.135 2006/10/31 20:19:45 dgp Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.136 2006/11/02 15:58:08 dgp Exp $
*/
#include "tclInt.h"
@@ -1830,7 +1830,7 @@ Tcl_FSEvalFileEx(
int limit = 150;
int overflow = (length > limit);
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (file \"%.*s%s\" line %d)",
(overflow ? limit : length), pathString,
(overflow ? "..." : ""), interp->errorLine));
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 2faf993..540858e 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.290 2006/10/31 20:19:45 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.291 2006/11/02 15:58:08 dgp Exp $
*/
#ifndef _TCLINT
@@ -2043,8 +2043,8 @@ MODULE_SCOPE int TclAppendFormatToObj(Tcl_Interp *interp,
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 TclAppendPrintfToObj(Tcl_Obj *objPtr,
+ CONST char *format, ...);
MODULE_SCOPE void TclAppendObjToErrorInfo(Tcl_Interp *interp,
Tcl_Obj *objPtr);
MODULE_SCOPE int TclArraySet(Tcl_Interp *interp,
@@ -2152,8 +2152,7 @@ MODULE_SCOPE Tcl_Obj * TclObjFormat(Tcl_Interp *interp,
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 Tcl_Obj * TclObjPrintf(CONST char *format, ...);
MODULE_SCOPE int TclPtrMakeUpvar (Tcl_Interp *interp,
Var *otherP1Ptr, CONST char *myName,
int myFlags, int index);
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 841d6bd..c9ee3db 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.37 2006/10/31 20:19:45 dgp Exp $
+ * RCS: @(#) $Id: tclMain.c,v 1.38 2006/11/02 15:58:08 dgp Exp $
*/
#include "tclInt.h"
@@ -652,7 +652,7 @@ Tcl_Main(
if (!Tcl_InterpDeleted(interp)) {
if (!Tcl_LimitExceeded(interp)) {
- Tcl_Obj *cmd = TclObjPrintf(NULL, "exit %d", exitCode);
+ Tcl_Obj *cmd = TclObjPrintf("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 f2c0636..93a87ed 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.115 2006/11/02 13:44:15 dkf Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.116 2006/11/02 15:58:08 dgp Exp $
*/
#include "tclInt.h"
@@ -3458,7 +3458,7 @@ NamespaceEvalCmd(
int limit = 200;
int overflow = (length > limit);
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (in namespace eval \"%.*s%s\" script line %d)",
(overflow ? limit : length), namespacePtr->fullName,
(overflow ? "..." : ""), interp->errorLine));
@@ -3876,7 +3876,7 @@ NamespaceInscopeCmd(
int limit = 200;
int overflow = (length > limit);
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (in namespace inscope \"%.*s%s\" script line %d)",
(overflow ? limit : length), namespacePtr->fullName,
(overflow ? "..." : ""), interp->errorLine));
@@ -6997,7 +6997,7 @@ Tcl_LogCommandInfo(
}
overflow = (length > limit);
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL)
? "while executing" : "invoked from within"),
(overflow ? limit : length), command, (overflow ? "..." : "")));
diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c
index f3d9d45..d1044fd 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.45 2006/10/31 20:19:45 dgp Exp $
+ * RCS: @(#) $Id: tclParseExpr.c,v 1.46 2006/11/02 15:58:08 dgp Exp $
*/
#include "tclInt.h"
@@ -225,12 +225,12 @@ Tcl_ParseExpr(
if ((NODE_TYPE & nodePtr->lexeme) == 0) {
switch (nodePtr->lexeme) {
case INVALID:
- msg = TclObjPrintf(NULL,
+ msg = TclObjPrintf(
"invalid character \"%.*s\"", scanned, start);
code = TCL_ERROR;
continue;
case INCOMPLETE:
- msg = TclObjPrintf(NULL,
+ msg = TclObjPrintf(
"incomplete operator \"%.*s\"", scanned, start);
code = TCL_ERROR;
continue;
@@ -246,17 +246,17 @@ Tcl_ParseExpr(
if (code == TCL_OK) {
nodePtr->lexeme = BOOLEAN;
} else {
- msg = TclObjPrintf(NULL,
+ msg = TclObjPrintf(
"invalid bareword \"%.*s%s\"",
(scanned < limit) ? scanned : limit - 3, start,
(scanned < limit) ? "" : "...");
- post = TclObjPrintf(NULL,
+ post = TclObjPrintf(
"should be \"$%.*s%s\" or \"{%.*s%s}\"",
(scanned < limit) ? scanned : limit - 3,
start, (scanned < limit) ? "" : "...",
(scanned < limit) ? scanned : limit - 3,
start, (scanned < limit) ? "" : "...");
- TclAppendPrintfToObj(NULL, post,
+ TclAppendPrintfToObj(post,
" or \"%.*s%s(...)\" or ...",
(scanned < limit) ? scanned : limit - 3,
start, (scanned < limit) ? "" : "...");
@@ -284,7 +284,7 @@ Tcl_ParseExpr(
CONST char *operand =
scratch.tokenPtr[lastNodePtr->token].start;
- msg = TclObjPrintf(NULL, "missing operator at %s", mark);
+ msg = TclObjPrintf("missing operator at %s", mark);
if (operand[0] == '0') {
Tcl_Obj *copy = Tcl_NewStringObj(operand,
start + scanned - operand);
@@ -418,7 +418,7 @@ Tcl_ParseExpr(
case UNARY:
if ((NODE_TYPE & lastNodePtr->lexeme) == LEAF) {
- msg = TclObjPrintf(NULL, "missing operator at %s", mark);
+ msg = TclObjPrintf("missing operator at %s", mark);
scanned = 0;
insertMark = 1;
code = TCL_ERROR;
@@ -464,7 +464,7 @@ Tcl_ParseExpr(
break;
}
- msg = TclObjPrintf(NULL, "empty subexpression at %s", mark);
+ msg = TclObjPrintf("empty subexpression at %s", mark);
scanned = 0;
insertMark = 1;
code = TCL_ERROR;
@@ -477,7 +477,7 @@ Tcl_ParseExpr(
if (lastNodePtr->lexeme == OPEN_PAREN) {
msg = Tcl_NewStringObj("unbalanced open paren", -1);
} else if (lastNodePtr->lexeme == COMMA) {
- msg = TclObjPrintf(NULL,
+ msg = TclObjPrintf(
"missing function argument at %s", mark);
scanned = 0;
insertMark = 1;
@@ -490,14 +490,14 @@ Tcl_ParseExpr(
} else if ((nodePtr->lexeme == COMMA)
&& (lastNodePtr->lexeme == OPEN_PAREN)
&& (lastNodePtr[-1].lexeme == FUNCTION)) {
- msg = TclObjPrintf(NULL,
+ msg = TclObjPrintf(
"missing function argument at %s", mark);
scanned = 0;
insertMark = 1;
}
}
if (msg == NULL) {
- msg = TclObjPrintf(NULL, "missing operand at %s", mark);
+ msg = TclObjPrintf("missing operand at %s", mark);
scanned = 0;
insertMark = 1;
}
@@ -543,7 +543,7 @@ Tcl_ParseExpr(
}
if ((otherPtr->lexeme == QUESTION)
&& (lastOrphanPtr->lexeme != COLON)) {
- msg = TclObjPrintf(NULL,
+ msg = TclObjPrintf(
"missing operator \":\" at %s", mark);
scanned = 0;
insertMark = 1;
@@ -648,7 +648,7 @@ Tcl_ParseExpr(
if (msg == NULL) {
msg = Tcl_GetObjResult(interp);
}
- TclAppendPrintfToObj(NULL, msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"",
+ TclAppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"",
((start - limit) < scratch.string) ? "" : "...",
((start - limit) < scratch.string)
? (start - scratch.string) : limit - 3,
@@ -669,7 +669,7 @@ Tcl_ParseExpr(
}
Tcl_SetObjResult(interp, msg);
numBytes = scratch.end - scratch.string;
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (parsing expression \"%.*s%s\")",
(numBytes < limit) ? numBytes : limit - 3,
scratch.string, (numBytes < limit) ? "" : "..."));
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index e0f6615..0814677 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.22 2006/10/31 20:19:45 dgp Exp $
+ * RCS: @(#) $Id: tclPkg.c,v 1.23 2006/11/02 15:58:08 dgp Exp $
*
* TIP #268.
* Heavily rewritten to handle the extend version numbers, and extended
@@ -508,7 +508,7 @@ Tcl_PkgRequireProc(
}
if (code == TCL_ERROR) {
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (\"package ifneeded %s %s\" script)",
name, versionToProvide));
}
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 90e6970..ffdd121 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.103 2006/10/31 20:19:45 dgp Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.104 2006/11/02 15:58:08 dgp Exp $
*/
#include "tclInt.h"
@@ -369,7 +369,7 @@ TclCreateProc(
if (precompiled) {
if (numArgs > procPtr->numArgs) {
- Tcl_SetObjResult(interp, TclObjPrintf(NULL,
+ Tcl_SetObjResult(interp, TclObjPrintf(
"procedure \"%s\": arg list contains %d entries, "
"precompiled header expects %d", procName, numArgs,
procPtr->numArgs));
@@ -458,7 +458,7 @@ TclCreateProc(
!= (VAR_SCALAR | VAR_ARGUMENT))
|| (localPtr->defValuePtr == NULL && fieldCount == 2)
|| (localPtr->defValuePtr != NULL && fieldCount != 2)) {
- Tcl_SetObjResult(interp, TclObjPrintf(NULL,
+ Tcl_SetObjResult(interp, TclObjPrintf(
"procedure \"%s\": formal parameter %d is "
"inconsistent with precompiled body", procName, i));
ckfree((char *) fieldValues);
@@ -475,7 +475,7 @@ TclCreateProc(
&tmpLength);
if ((valueLength != tmpLength) ||
strncmp(fieldValues[1], tmpPtr, (size_t) tmpLength)) {
- Tcl_SetObjResult(interp, TclObjPrintf(NULL,
+ Tcl_SetObjResult(interp, TclObjPrintf(
"procedure \"%s\": formal parameter \"%s\" has "
"default value inconsistent with precompiled body",
procName, fieldValues[0]));
@@ -839,7 +839,7 @@ Tcl_UplevelObjCmd(
result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
}
if (result == TCL_ERROR) {
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (\"uplevel\" body line %d)", interp->errorLine));
}
@@ -1692,7 +1692,7 @@ ProcCompileProc(
int limit = 50;
int overflow = (length > limit);
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (compiling %s \"%.*s%s\", line %d)",
description, (overflow ? limit : length), procName,
(overflow ? "..." : ""), interp->errorLine));
@@ -1739,7 +1739,7 @@ MakeProcError(
const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen);
overflow = (nameLen > limit);
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (procedure \"%.*s%s\" line %d)",
(overflow ? limit : nameLen), procName,
(overflow ? "..." : ""), interp->errorLine));
@@ -2077,7 +2077,7 @@ SetLambdaFromAny(
if (TclCreateProc(interp, /*ignored nsPtr*/ NULL, name, argsPtr,
bodyPtr, &procPtr) != TCL_OK) {
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (parsing lambda expression \"%s\")", name));
return TCL_ERROR;
}
@@ -2267,7 +2267,7 @@ MakeLambdaError(
const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen);
overflow = (nameLen > limit);
- TclAppendObjToErrorInfo(interp, TclObjPrintf(NULL,
+ TclAppendObjToErrorInfo(interp, TclObjPrintf(
"\n (lambda term \"%.*s%s\" line %d)",
(overflow ? limit : nameLen), procName,
(overflow ? "..." : ""), interp->errorLine));
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index c3ba0f0..9b06eb2 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.59 2006/10/31 20:19:45 dgp Exp $ */
+ * RCS: @(#) $Id: tclStringObj.c,v 1.60 2006/11/02 15:58:09 dgp Exp $ */
#include "tclInt.h"
#include "tommath.h"
@@ -53,7 +53,7 @@ static void AppendUtfToUtfRep(Tcl_Obj *objPtr,
static void FillUnicodeRep(Tcl_Obj *objPtr);
static int AppendFormatToObjVA(Tcl_Interp *interp, Tcl_Obj *objPtr,
CONST char *format, va_list argList);
-static int AppendPrintfToObjVA(Tcl_Interp *interp, Tcl_Obj *objPtr,
+static void AppendPrintfToObjVA(Tcl_Obj *objPtr,
CONST char *format, va_list argList);
static void FreeStringInternalRep(Tcl_Obj *objPtr);
static void DupStringInternalRep(Tcl_Obj *objPtr,
@@ -2412,9 +2412,8 @@ TclObjFormat(
*---------------------------------------------------------------------------
*/
-static int
+static void
AppendPrintfToObjVA(
- Tcl_Interp *interp,
Tcl_Obj *objPtr,
CONST char *format,
va_list argList)
@@ -2536,9 +2535,12 @@ AppendPrintfToObjVA(
} while (seekingConversion);
}
Tcl_ListObjGetElements(NULL, list, &objc, &objv);
- code = TclAppendFormattedObjs(interp, objPtr, format, objc, objv);
+ code = TclAppendFormattedObjs(NULL, objPtr, format, objc, objv);
+ if (code != TCL_OK) {
+ Tcl_Panic("Unable to format \"%s\" with supplied arguments: %s",
+ format, Tcl_GetString(list));
+ }
Tcl_DecrRefCount(list);
- return code;
}
/*
@@ -2555,20 +2557,17 @@ AppendPrintfToObjVA(
*---------------------------------------------------------------------------
*/
-int
+void
TclAppendPrintfToObj(
- Tcl_Interp *interp,
Tcl_Obj *objPtr,
CONST char *format,
...)
{
va_list argList;
- int result;
va_start(argList, format);
- result = AppendPrintfToObjVA(interp, objPtr, format, argList);
+ AppendPrintfToObjVA(objPtr, format, argList);
va_end(argList);
- return result;
}
/*
@@ -2587,21 +2586,15 @@ TclAppendPrintfToObj(
Tcl_Obj *
TclObjPrintf(
- Tcl_Interp *interp,
CONST char *format,
...)
{
va_list argList;
- int result;
Tcl_Obj *objPtr = Tcl_NewObj();
va_start(argList, format);
- result = AppendPrintfToObjVA(interp, objPtr, format, argList);
+ AppendPrintfToObjVA(objPtr, format, argList);
va_end(argList);
- if (result != TCL_OK) {
- Tcl_DecrRefCount(objPtr);
- return NULL;
- }
return objPtr;
}
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index 3acb18f..2e7ca49 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.25 2006/10/31 22:41:38 das Exp $
+ * RCS: @(#) $Id: tclTimer.c,v 1.26 2006/11/02 15:58:09 dgp Exp $
*/
#include "tclInt.h"
@@ -869,7 +869,7 @@ Tcl_AfterObjCmd(
(ClientData) afterPtr);
afterPtr->nextPtr = assocPtr->firstAfterPtr;
assocPtr->firstAfterPtr = afterPtr;
- Tcl_SetObjResult(interp, TclObjPrintf(NULL, "after#%d", afterPtr->id));
+ Tcl_SetObjResult(interp, TclObjPrintf("after#%d", afterPtr->id));
return TCL_OK;
}
case AFTER_CANCEL: {
@@ -932,7 +932,7 @@ Tcl_AfterObjCmd(
afterPtr->nextPtr = assocPtr->firstAfterPtr;
assocPtr->firstAfterPtr = afterPtr;
Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr);
- Tcl_SetObjResult(interp, TclObjPrintf(NULL, "after#%d", afterPtr->id));
+ Tcl_SetObjResult(interp, TclObjPrintf("after#%d", afterPtr->id));
break;
case AFTER_INFO: {
Tcl_Obj *resultListPtr;
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 5ef30da..7357a91 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.73 2006/11/02 10:03:01 dkf Exp $
+ * RCS: @(#) $Id: tclUtil.c,v 1.74 2006/11/02 15:58:09 dgp Exp $
*/
#include "tclInt.h"
@@ -221,7 +221,7 @@ TclFindElement(
&& (p2 < p+20)) {
p2++;
}
- Tcl_SetObjResult(interp, TclObjPrintf(NULL,
+ Tcl_SetObjResult(interp, TclObjPrintf(
"list element in braces followed by \"%.*s\" "
"instead of space", (int) (p2-p), p));
}
@@ -280,7 +280,7 @@ TclFindElement(
&& (p2 < p+20)) {
p2++;
}
- Tcl_SetObjResult(interp, TclObjPrintf(NULL,
+ Tcl_SetObjResult(interp, TclObjPrintf(
"list element in quotes followed by \"%.*s\" "
"instead of space", (int) (p2-p), p));
}
generated by cgit v0.12 at 2024-11-05 11:40:53 (GMT)