summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c7
-rw-r--r--generic/tclCkalloc.c7
-rw-r--r--generic/tclCmdMZ.c6
-rw-r--r--generic/tclExecute.c5
-rw-r--r--generic/tclIORChan.c10
-rw-r--r--generic/tclMain.c17
-rw-r--r--generic/tclProc.c39
-rw-r--r--generic/tclTimer.c13
-rw-r--r--generic/tclUtil.c24
9 files changed, 70 insertions, 58 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index a58c781..0198a4e 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.173 2005/09/14 21:32:17 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.174 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
@@ -4156,8 +4156,9 @@ ProcessUnexpectedResult(interp, returnCode)
Tcl_AppendResult(interp,
"invoked \"continue\" outside of a loop", (char *) NULL);
} else {
- TclObjPrintf(NULL, Tcl_GetObjResult(interp),
- "command returned bad code: %d", returnCode);
+ Tcl_Obj *objPtr = Tcl_NewObj();
+ TclObjPrintf(NULL, objPtr, "command returned bad code: %d", returnCode);
+ Tcl_SetObjResult(interp, objPtr);
}
}
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index 43e0862..e3eea4e 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.24 2005/09/14 21:32:17 dgp Exp $
+ * RCS: @(#) $Id: tclCkalloc.c,v 1.25 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
@@ -843,13 +843,14 @@ MemoryCmd(clientData, interp, argc, argv)
return TCL_OK;
}
if (strcmp(argv[1],"info") == 0) {
- TclObjPrintf(NULL, Tcl_GetObjResult(interp),
- "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n",
+ 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",
"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);
return TCL_OK;
}
if (strcmp(argv[1],"init") == 0) {
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index ebc27f6..b4a7d5a 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.130 2005/09/14 21:32:17 dgp Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.131 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
@@ -2158,9 +2158,11 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
length2 = length1 * count;
if ((length2 / count) != length1) {
- TclObjPrintf(NULL, Tcl_GetObjResult(interp),
+ resultPtr = Tcl_NewObj();
+ TclObjPrintf(NULL, resultPtr,
"string size overflow, must be less than %d",
INT_MAX);
+ Tcl_SetObjResult(interp, resultPtr);
return TCL_ERROR;
}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 52556fd..c7502f0 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.200 2005/09/14 21:32:17 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.201 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
@@ -6094,11 +6094,12 @@ TclExprFloatError(interp, value)
Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *) NULL);
}
} else {
- Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
+ Tcl_Obj *objPtr = Tcl_NewObj();
TclObjPrintf(NULL, objPtr,
"unknown floating-point error, errno = %d", errno);
Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN",
Tcl_GetString(objPtr), (char *) NULL);
+ Tcl_SetObjResult(interp, objPtr);
}
}
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 13b8028..0a57eb3 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.4 2005/09/14 21:32:17 dgp Exp $
+ * RCS: @(#) $Id: tclIORChan.c,v 1.5 2005/09/15 16:40:02 dgp Exp $
*/
#include <tclInt.h>
@@ -1723,10 +1723,12 @@ RcGetOption (clientData, interp, optionName, dsPtr)
if ((listc % 2) == 1) {
/* Odd number of elements is wrong.
*/
+ Tcl_Obj *objPtr = Tcl_NewObj();
Tcl_ResetResult(interp);
- TclObjPrintf(NULL, Tcl_GetObjResult(interp),
- "Expected list with even number of elements, got %d element%s instead",
- listc, (listc == 1 ? "" : "s"));
+ TclObjPrintf(NULL, objPtr, "Expected list with even number of "
+ "elements, got %d element%s instead", listc,
+ (listc == 1 ? "" : "s"));
+ Tcl_SetObjResult(interp, objPtr);
Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
return TCL_ERROR;
}
diff --git a/generic/tclMain.c b/generic/tclMain.c
index f2954b6..75fa70b 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.31 2005/07/21 14:38:49 dkf Exp $
+ * RCS: @(#) $Id: tclMain.c,v 1.32 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
@@ -655,20 +655,21 @@ Tcl_Main(argc, argv, appInitProc)
/*
* Rather than calling exit, invoke the "exit" command so that users can
* replace "exit" with some other command to do additional cleanup on
- * exit. The Tcl_Eval call should never return.
+ * exit. The Tcl_EvalObjEx call should never return.
*/
if (!Tcl_InterpDeleted(interp)) {
if (!Tcl_LimitExceeded(interp)) {
- char buffer[TCL_INTEGER_SPACE + 5];
-
- sprintf(buffer, "exit %d", exitCode);
- Tcl_Eval(interp, buffer);
+ Tcl_Obj *cmd = Tcl_NewObj();
+ TclObjPrintf(NULL, cmd, "exit %d", exitCode);
+ Tcl_IncrRefCount(cmd);
+ Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(cmd);
}
/*
- * If Tcl_Eval returns, trying to eval [exit], something unusual is
- * happening. Maybe interp has been deleted; maybe [exit] was
+ * If Tcl_EvalObjEx returns, trying to eval [exit], something unusual
+ * is happening. Maybe interp has been deleted; maybe [exit] was
* redefined, maybe we've blown up because of an exceeded limit. We
* still want to cleanup and exit.
*/
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 3a962d2..b184c8a 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.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: tclProc.c,v 1.79 2005/09/14 18:35:56 dgp Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.80 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
@@ -337,11 +337,12 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
if (precompiled) {
if (numArgs > procPtr->numArgs) {
- char buf[40 + TCL_INTEGER_SPACE + TCL_INTEGER_SPACE];
- sprintf(buf, "%d entries, precompiled header expects %d",
- numArgs, procPtr->numArgs);
- Tcl_AppendResult(interp, "procedure \"", procName,
- "\": arg list contains ", buf, NULL);
+ Tcl_Obj *objPtr = Tcl_NewObj();
+ TclObjPrintf(NULL, objPtr,
+ "procedure \"%s\": arg list contains %d entries, "
+ "precompiled header expects %d", procName, numArgs,
+ procPtr->numArgs);
+ Tcl_SetObjResult(interp, objPtr);
goto procError;
}
localPtr = procPtr->firstLocalPtr;
@@ -428,12 +429,12 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
!= (VAR_SCALAR | VAR_ARGUMENT))
|| (localPtr->defValuePtr == NULL && fieldCount == 2)
|| (localPtr->defValuePtr != NULL && fieldCount != 2)) {
- char buf[40 + TCL_INTEGER_SPACE];
-
+ Tcl_Obj *objPtr = Tcl_NewObj();
+ TclObjPrintf(NULL, objPtr,
+ "procedure \"%s\": formal parameter %d is "
+ "inconsistent with precompiled body", procName, i);
+ Tcl_SetObjResult(interp, objPtr);
ckfree((char *) fieldValues);
- sprintf(buf, "%d is inconsistent with precompiled body", i);
- Tcl_AppendResult(interp, "procedure \"", procName,
- "\": formal parameter ", buf, (char *) NULL);
goto procError;
}
@@ -447,10 +448,13 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
&tmpLength);
if ((valueLength != tmpLength) ||
strncmp(fieldValues[1], tmpPtr, (size_t) tmpLength)) {
- Tcl_AppendResult(interp, "procedure \"", procName,
- "\": formal parameter \"", fieldValues[0],
- "\" has default value inconsistent with ",
- "precompiled body", (char *) NULL);
+ Tcl_Obj *objPtr = Tcl_NewObj();
+
+ TclObjPrintf(NULL, objPtr,
+ "procedure \"%s\": formal parameter \"%s\" has "
+ "default value inconsistent with precompiled body",
+ procName, fieldValues[0]);
+ Tcl_SetObjResult(interp, objPtr);
ckfree((char *) fieldValues);
goto procError;
}
@@ -810,9 +814,8 @@ Tcl_UplevelObjCmd(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 (\"uplevel\" body line %d)", interp->errorLine);
- Tcl_AddObjErrorInfo(interp, msg, -1);
+ TclFormatToErrorInfo(interp, "\n (\"uplevel\" body line %d)",
+ interp->errorLine);
}
/*
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index ce07825..e441867 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.17 2005/07/24 22:56:44 dkf Exp $
+ * RCS: @(#) $Id: tclTimer.c,v 1.18 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
@@ -781,6 +781,7 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
static CONST char *afterSubCmds[] = {
"cancel", "idle", "info", (char *) NULL
};
+ Tcl_Obj *objPtr;
enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
ThreadSpecificData *tsdPtr = InitTimer();
@@ -848,8 +849,9 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
(ClientData) afterPtr);
afterPtr->nextPtr = assocPtr->firstAfterPtr;
assocPtr->firstAfterPtr = afterPtr;
- sprintf(buf, "after#%d", afterPtr->id);
- Tcl_AppendResult(interp, buf, (char *) NULL);
+ objPtr = Tcl_NewObj();
+ TclObjPrintf(NULL, objPtr, "after#%d", afterPtr->id);
+ Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
}
@@ -926,8 +928,9 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
afterPtr->nextPtr = assocPtr->firstAfterPtr;
assocPtr->firstAfterPtr = afterPtr;
Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr);
- sprintf(buf, "after#%d", afterPtr->id);
- Tcl_AppendResult(interp, buf, (char *) NULL);
+ objPtr = Tcl_NewObj();
+ TclObjPrintf(NULL, objPtr, "after#%d", afterPtr->id);
+ Tcl_SetObjResult(interp, objPtr);
break;
case AFTER_INFO: {
Tcl_Obj *resultListPtr;
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 0654f65..1dd6fcb 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.64 2005/09/06 14:40:11 dkf Exp $
+ * RCS: @(#) $Id: tclUtil.c,v 1.65 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
@@ -235,18 +235,17 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
*/
if (interp != NULL) {
- char buf[100];
-
+ Tcl_Obj *objPtr = Tcl_NewObj();
p2 = p;
while ((p2 < limit)
&& (!isspace(UCHAR(*p2))) /* INTL: ISO space. */
&& (p2 < p+20)) {
p2++;
}
- sprintf(buf,
- "list element in braces followed by \"%.*s\" instead of space",
- (int) (p2-p), p);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ TclObjPrintf(NULL, objPtr,
+ "list element in braces followed by \"%.*s\" "
+ "instead of space", (int) (p2-p), p);
+ Tcl_SetObjResult(interp, objPtr);
}
return TCL_ERROR;
}
@@ -297,18 +296,17 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
*/
if (interp != NULL) {
- char buf[100];
-
+ Tcl_Obj *objPtr = Tcl_NewObj();
p2 = p;
while ((p2 < limit)
&& (!isspace(UCHAR(*p2))) /* INTL: ISO space */
&& (p2 < p+20)) {
p2++;
}
- sprintf(buf,
- "list element in quotes followed by \"%.*s\" %s",
- (int) (p2-p), p, "instead of space");
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ TclObjPrintf(NULL, objPtr,
+ "list element in quotes followed by \"%.*s\" "
+ "instead of space", (int) (p2-p), p);
+ Tcl_SetObjResult(interp, objPtr);
}
return TCL_ERROR;
}
generated by cgit v0.12 at 2024-11-19 01:25:45 (GMT)