summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c15
-rw-r--r--generic/tclClock.c7
-rw-r--r--generic/tclCmdAH.c85
-rw-r--r--generic/tclCmdIL.c76
-rw-r--r--generic/tclCmdMZ.c8
-rw-r--r--generic/tclCompExpr.c79
-rw-r--r--generic/tclCompile.c7
-rw-r--r--generic/tclConfig.c10
-rw-r--r--generic/tclDictObj.c18
-rw-r--r--generic/tclEncoding.c7
-rw-r--r--generic/tclEnv.c4
-rw-r--r--generic/tclEvent.c12
-rw-r--r--generic/tclExecute.c6
-rw-r--r--generic/tclFCmd.c6
-rw-r--r--generic/tclFileName.c13
-rw-r--r--generic/tclHistory.c6
-rw-r--r--generic/tclIORChan.c17
-rw-r--r--generic/tclIOUtil.c12
-rw-r--r--generic/tclInt.h18
-rw-r--r--generic/tclInterp.c7
-rw-r--r--generic/tclLink.c9
-rw-r--r--generic/tclMain.c6
-rw-r--r--generic/tclNamesp.c8
-rw-r--r--generic/tclObj.c20
-rw-r--r--generic/tclPathObj.c4
-rw-r--r--generic/tclProc.c19
-rw-r--r--generic/tclResult.c14
-rwxr-xr-xgeneric/tclStrToD.c6
-rw-r--r--generic/tclTrace.c6
29 files changed, 258 insertions, 247 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 66ab08d..3d58522 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.242 2007/04/04 13:29:57 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.243 2007/04/10 14:47:08 dkf Exp $
*/
#include "tclInt.h"
@@ -395,10 +395,10 @@ Tcl_CreateInterp(void)
iPtr->returnOpts = NULL;
iPtr->errorInfo = NULL;
- iPtr->eiVar = Tcl_NewStringObj("errorInfo", -1);
+ TclNewLiteralStringObj(iPtr->eiVar, "errorInfo");
Tcl_IncrRefCount(iPtr->eiVar);
iPtr->errorCode = NULL;
- iPtr->ecVar = Tcl_NewStringObj("errorCode", -1);
+ TclNewLiteralStringObj(iPtr->ecVar, "errorCode");
Tcl_IncrRefCount(iPtr->ecVar);
iPtr->returnLevel = 1;
iPtr->returnCode = TCL_OK;
@@ -3210,7 +3210,7 @@ Tcl_GetMathFuncInfo(
* Get the command that implements the math function.
*/
- cmdNameObj = Tcl_NewStringObj("tcl::mathfunc::", -1);
+ TclNewLiteralStringObj(cmdNameObj, "tcl::mathfunc::");
Tcl_AppendToObj(cmdNameObj, name, -1);
Tcl_IncrRefCount(cmdNameObj);
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdNameObj);
@@ -3223,7 +3223,7 @@ Tcl_GetMathFuncInfo(
if (cmdPtr == NULL) {
Tcl_Obj *message;
- message = Tcl_NewStringObj("unknown math function \"", -1);
+ TclNewLiteralStringObj(message, "unknown math function \"");
Tcl_AppendToObj(message, name, -1);
Tcl_AppendToObj(message, "\"", 1);
Tcl_SetObjResult(interp, message);
@@ -3497,7 +3497,7 @@ TclEvalObjvInternal(
*/
if (currNsPtr->unknownHandlerPtr == NULL) {
- currNsPtr->unknownHandlerPtr = Tcl_NewStringObj("::unknown", -1);
+ TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
}
@@ -3990,6 +3990,7 @@ TclEvalEx(
*/
Tcl_Obj *norm = Tcl_FSGetNormalizedPath(interp, iPtr->scriptFile);
+
if (!norm) {
/*
* Error message in the interp result.
@@ -3999,7 +4000,7 @@ TclEvalEx(
eeFrame.data.eval.path = norm;
Tcl_IncrRefCount(eeFrame.data.eval.path);
} else {
- eeFrame.data.eval.path = Tcl_NewStringObj("", -1);
+ TclNewLiteralStringObj(eeFrame.data.eval.path, "");
}
} else {
/*
diff --git a/generic/tclClock.c b/generic/tclClock.c
index a92dc67..223577b 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.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: tclClock.c,v 1.59 2006/08/28 08:48:07 das Exp $
+ * RCS: @(#) $Id: tclClock.c,v 1.60 2007/04/10 14:47:09 dkf Exp $
*/
#include "tclInt.h"
@@ -845,9 +845,8 @@ ConvertLocalToUTCUsingC(
if (localErrno != 0
|| (fields->seconds == -1 && timeVal.tm_yday == -1)) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("time value too large/small to represent",
- -1));
+ Tcl_SetResult(interp, "time value too large/small to represent",
+ TCL_STATIC);
return TCL_ERROR;
}
return TCL_OK;
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 66d95d5..452bdce 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.87 2007/03/23 03:07:58 dgp Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.88 2007/04/10 14:47:09 dkf Exp $
*/
#include "tclInt.h"
@@ -323,7 +323,7 @@ Tcl_CdObjCmd(
if (objc == 2) {
dir = objv[1];
} else {
- dir = Tcl_NewStringObj("~",1);
+ TclNewLiteralStringObj(dir, "~");
Tcl_IncrRefCount(dir);
}
if (Tcl_FSConvertToPathType(interp, dir) != TCL_OK) {
@@ -595,24 +595,24 @@ Tcl_ErrorObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *CONST objv[]) /* Argument objects. */
{
- Tcl_Obj *options;
+ Tcl_Obj *options, *optName;
if ((objc < 2) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "message ?errorInfo? ?errorCode?");
return TCL_ERROR;
}
- options = Tcl_NewStringObj("-code error -level 0", -1);
+ TclNewLiteralStringObj(options, "-code error -level 0");
if (objc >= 3) { /* Process the optional info argument */
- Tcl_ListObjAppendElement(NULL, options,
- Tcl_NewStringObj("-errorinfo", -1));
+ TclNewLiteralStringObj(optName, "-errorinfo");
+ Tcl_ListObjAppendElement(NULL, options, optName);
Tcl_ListObjAppendElement(NULL, options, objv[2]);
}
- if (objc == 4) { /* Process the optional code argument */
- Tcl_ListObjAppendElement(NULL, options,
- Tcl_NewStringObj("-errorcode", -1));
+ if (objc >= 4) { /* Process the optional code argument */
+ TclNewLiteralStringObj(optName, "-errorcode");
+ Tcl_ListObjAppendElement(NULL, options, optName);
Tcl_ListObjAppendElement(NULL, options, objv[3]);
}
@@ -1207,22 +1207,29 @@ Tcl_FileObjCmd(
Tcl_SetObjResult(interp, fileName);
return TCL_OK;
}
- case FCMD_PATHTYPE:
+ case FCMD_PATHTYPE: {
+ Tcl_Obj *typeName;
+
if (objc != 3) {
goto only3Args;
}
+
switch (Tcl_FSGetPathType(objv[2])) {
case TCL_PATH_ABSOLUTE:
- Tcl_SetObjResult(interp, Tcl_NewStringObj("absolute", -1));
+ TclNewLiteralStringObj(typeName, "absolute");
break;
case TCL_PATH_RELATIVE:
- Tcl_SetObjResult(interp, Tcl_NewStringObj("relative", -1));
+ TclNewLiteralStringObj(typeName, "relative");
break;
case TCL_PATH_VOLUME_RELATIVE:
- Tcl_SetObjResult(interp, Tcl_NewStringObj("volumerelative", -1));
+ TclNewLiteralStringObj(typeName, "volumerelative");
break;
+ default:
+ return TCL_OK;
}
+ Tcl_SetObjResult(interp, typeName);
return TCL_OK;
+ }
case FCMD_READABLE:
if (objc != 3) {
goto only3Args;
@@ -1284,16 +1291,15 @@ Tcl_FileObjCmd(
separator = "\\";
break;
}
- Tcl_SetObjResult(interp, Tcl_NewStringObj(separator,1));
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(separator, 1));
} else {
Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[2]);
- if (separatorObj != NULL) {
- Tcl_SetObjResult(interp, separatorObj);
- } else {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("Unrecognised path",-1));
+
+ if (separatorObj == NULL) {
+ Tcl_SetResult(interp, "Unrecognised path", TCL_STATIC);
return TCL_ERROR;
}
+ Tcl_SetObjResult(interp, separatorObj);
}
return TCL_OK;
case FCMD_SPLIT: {
@@ -1304,16 +1310,16 @@ Tcl_FileObjCmd(
}
res = Tcl_FSSplitPath(objv[2], NULL);
if (res == NULL) {
+ /* How can the interp be NULL here?! DKF */
if (interp != NULL) {
Tcl_AppendResult(interp, "could not read \"",
TclGetString(objv[2]),
"\": no such file or directory", NULL);
}
return TCL_ERROR;
- } else {
- Tcl_SetObjResult(interp, res);
- return TCL_OK;
}
+ Tcl_SetObjResult(interp, res);
+ return TCL_OK;
}
case FCMD_SYSTEM: {
Tcl_Obj *fsInfo;
@@ -1322,13 +1328,12 @@ Tcl_FileObjCmd(
goto only3Args;
}
fsInfo = Tcl_FSFileSystemInfo(objv[2]);
- if (fsInfo != NULL) {
- Tcl_SetObjResult(interp, fsInfo);
- return TCL_OK;
- } else {
- Tcl_SetObjResult(interp, Tcl_NewStringObj("Unrecognised path",-1));
+ if (fsInfo == NULL) {
+ Tcl_SetResult(interp, "Unrecognised path", TCL_STATIC);
return TCL_ERROR;
}
+ Tcl_SetObjResult(interp, fsInfo);
+ return TCL_OK;
}
case FCMD_TAIL: {
Tcl_Obj *dirPtr;
@@ -1339,11 +1344,10 @@ Tcl_FileObjCmd(
dirPtr = TclPathPart(interp, objv[2], TCL_PATH_TAIL);
if (dirPtr == NULL) {
return TCL_ERROR;
- } else {
- Tcl_SetObjResult(interp, dirPtr);
- Tcl_DecrRefCount(dirPtr);
- return TCL_OK;
}
+ Tcl_SetObjResult(interp, dirPtr);
+ Tcl_DecrRefCount(dirPtr);
+ return TCL_OK;
}
case FCMD_VOLUMES:
if (objc != 2) {
@@ -1477,26 +1481,26 @@ StoreStatData(
Tcl_StatBuf *statPtr) /* Pointer to buffer containing stat data to
* store in varName. */
{
- Tcl_Obj *field = Tcl_NewObj();
- Tcl_Obj *value;
+ Tcl_Obj *field, *value;
register unsigned short mode;
/*
* Assume Tcl_ObjSetVar2() does not keep a copy of the field name!
*
- * Might be a better idea to call Tcl_SetVar2Ex() instead so we don't have
- * to make assumptions that might go wrong later.
+ * Might be a better idea to call Tcl_SetVar2Ex() instead, except we want
+ * to have an object (i.e. possibly cached) array variable name but a
+ * string element name, so no API exists. Messy.
*/
#define STORE_ARY(fieldName, object) \
- Tcl_SetStringObj(field, (fieldName), -1); \
+ TclNewLiteralStringObj(field, fieldName); \
+ Tcl_IncrRefCount(field); \
value = (object); \
if (Tcl_ObjSetVar2(interp,varName,field,value,TCL_LEAVE_ERR_MSG)==NULL) { \
- Tcl_DecrRefCount(field); \
+ TclDecrRefCount(field); \
return TCL_ERROR; \
- }
-
- Tcl_IncrRefCount(field);
+ } \
+ TclDecrRefCount(field);
/*
* Watch out porters; the inode is meant to be an *unsigned* value, so the
@@ -1520,7 +1524,6 @@ StoreStatData(
STORE_ARY("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef STORE_ARY
- Tcl_DecrRefCount(field);
return TCL_OK;
}
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 99c8316..3484b49 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.112 2007/03/12 16:26:27 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.113 2007/04/10 14:47:09 dkf Exp $
*/
#include "tclInt.h"
@@ -1117,6 +1117,7 @@ InfoFrameCmd(
static CONST char *typeString[TCL_LOCATION_LAST] = {
"eval", "eval", "eval", "precompiled", "source", "proc"
};
+ Tcl_Obj *tmpObj;
if (objc == 2) {
/*
@@ -1175,6 +1176,11 @@ InfoFrameCmd(
* Regarding use of the CmdFrame fields see tclInt.h, and its definition.
*/
+#define ADD_PAIR(name, value) \
+ TclNewLiteralStringObj(tmpObj, name); \
+ lv[lc++] = tmpObj; \
+ lv[lc++] = (value)
+
switch (framePtr->type) {
case TCL_LOCATION_EVAL:
/*
@@ -1182,13 +1188,10 @@ InfoFrameCmd(
* str.
*/
- lv[lc++] = Tcl_NewStringObj("type", -1);
- lv[lc++] = Tcl_NewStringObj(typeString[framePtr->type], -1);
- lv[lc++] = Tcl_NewStringObj("line", -1);
- lv[lc++] = Tcl_NewIntObj(framePtr->line[0]);
- lv[lc++] = Tcl_NewStringObj("cmd", -1);
- lv[lc++] = Tcl_NewStringObj(framePtr->cmd.str.cmd,
- framePtr->cmd.str.len);
+ ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
+ ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
+ ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd,
+ framePtr->cmd.str.len));
break;
case TCL_LOCATION_EVAL_LIST:
@@ -1197,10 +1200,8 @@ InfoFrameCmd(
* listPtr, possibly a frame.
*/
- lv[lc++] = Tcl_NewStringObj("type", -1);
- lv[lc++] = Tcl_NewStringObj(typeString[framePtr->type], -1);
- lv[lc++] = Tcl_NewStringObj("line", -1);
- lv[lc++] = Tcl_NewIntObj(framePtr->line[0]);
+ ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
+ ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
/*
* We put a duplicate of the command list obj into the result to
@@ -1209,8 +1210,7 @@ InfoFrameCmd(
* optimization path in Tcl_EvalObjEx.
*/
- lv[lc++] = Tcl_NewStringObj("cmd", -1);
- lv[lc++] = Tcl_DuplicateObj(framePtr->cmd.listPtr);
+ ADD_PAIR("cmd", Tcl_DuplicateObj(framePtr->cmd.listPtr));
break;
case TCL_LOCATION_PREBC:
@@ -1218,8 +1218,7 @@ InfoFrameCmd(
* Precompiled. Result contains the type as signal, nothing else.
*/
- lv[lc++] = Tcl_NewStringObj("type", -1);
- lv[lc++] = Tcl_NewStringObj(typeString[framePtr->type], -1);
+ ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
break;
case TCL_LOCATION_BC: {
@@ -1243,14 +1242,11 @@ InfoFrameCmd(
* Possibly modified: type, path!
*/
- lv[lc++] = Tcl_NewStringObj("type", -1);
- lv[lc++] = Tcl_NewStringObj(typeString[f.type], -1);
- lv[lc++] = Tcl_NewStringObj("line", -1);
- lv[lc++] = Tcl_NewIntObj(f.line[0]);
+ ADD_PAIR("type", Tcl_NewStringObj(typeString[f.type], -1));
+ ADD_PAIR("line", Tcl_NewIntObj(f.line[0]));
if (f.type == TCL_LOCATION_SOURCE) {
- lv[lc++] = Tcl_NewStringObj("file", -1);
- lv[lc++] = f.data.eval.path;
+ ADD_PAIR("file", f.data.eval.path);
/*
* Death of reference by TclGetSrcInfoForPc.
@@ -1259,8 +1255,7 @@ InfoFrameCmd(
Tcl_DecrRefCount(f.data.eval.path);
}
- lv[lc++] = Tcl_NewStringObj("cmd", -1);
- lv[lc++] = Tcl_NewStringObj(f.cmd.str.cmd, f.cmd.str.len);
+ ADD_PAIR("cmd", Tcl_NewStringObj(f.cmd.str.cmd, f.cmd.str.len));
if (procPtr != NULL) {
Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr;
@@ -1273,8 +1268,7 @@ InfoFrameCmd(
char *procName = Tcl_GetHashKey(namePtr->tablePtr, namePtr);
char *nsName = procPtr->cmdPtr->nsPtr->fullName;
- lv[lc++] = Tcl_NewStringObj("proc", -1);
- lv[lc++] = Tcl_NewStringObj(nsName, -1);
+ ADD_PAIR("proc", Tcl_NewStringObj(nsName, -1));
if (strcmp(nsName, "::") != 0) {
Tcl_AppendToObj(lv[lc-1], "::", -1);
@@ -1288,8 +1282,7 @@ InfoFrameCmd(
* consider, if any is used it is part of the lambda term.
*/
- lv[lc++] = Tcl_NewStringObj("lambda", -1);
- lv[lc++] = ((Tcl_Obj *) procPtr->cmdPtr->clientData);
+ ADD_PAIR("lambda", (Tcl_Obj *) procPtr->cmdPtr->clientData);
}
}
break;
@@ -1300,21 +1293,17 @@ InfoFrameCmd(
* Evaluation of a script file.
*/
- lv[lc++] = Tcl_NewStringObj("type", -1);
- lv[lc++] = Tcl_NewStringObj(typeString[framePtr->type], -1);
- lv[lc++] = Tcl_NewStringObj("line", -1);
- lv[lc++] = Tcl_NewIntObj(framePtr->line[0]);
- lv[lc++] = Tcl_NewStringObj("file", -1);
- lv[lc++] = framePtr->data.eval.path;
+ ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
+ ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
+ ADD_PAIR("file", framePtr->data.eval.path);
/*
* Refcount framePtr->data.eval.path goes up when lv is converted into
* the result list object.
*/
- lv[lc++] = Tcl_NewStringObj("cmd", -1);
- lv[lc++] = Tcl_NewStringObj(framePtr->cmd.str.cmd,
- framePtr->cmd.str.len);
+ ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd,
+ framePtr->cmd.str.len));
break;
case TCL_LOCATION_PROC:
@@ -1337,8 +1326,7 @@ InfoFrameCmd(
int c = framePtr->framePtr->level;
int t = iPtr->varFramePtr->level;
- lv[lc++] = Tcl_NewStringObj("level", -1);
- lv[lc++] = Tcl_NewIntObj(t - c);
+ ADD_PAIR("level", Tcl_NewIntObj(t - c));
break;
}
}
@@ -1507,6 +1495,7 @@ InfoHostnameCmd(
Tcl_Obj *CONST objv[]) /* Argument objects. */
{
CONST char *name;
+
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
@@ -1516,11 +1505,9 @@ InfoHostnameCmd(
if (name) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1));
return TCL_OK;
- } else {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "unable to determine name of host", -1));
- return TCL_ERROR;
}
+ Tcl_SetResult(interp, "unable to determine name of host", TCL_STATIC);
+ return TCL_ERROR;
}
/*
@@ -1634,8 +1621,7 @@ InfoLibraryCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1));
return TCL_OK;
}
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "no library has been specified for Tcl", -1));
+ Tcl_SetResult(interp, "no library has been specified for Tcl",TCL_STATIC);
return TCL_ERROR;
}
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 67659c1..640f43f 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.147 2007/03/30 15:54:17 dgp Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.148 2007/04/10 14:47:09 dkf Exp $
*/
#include "tclInt.h"
@@ -3109,9 +3109,9 @@ Tcl_TimeObjCmd(
* as such (extracting the first element, typically).
*/
- objs[1] = Tcl_NewStringObj("microseconds", -1);
- objs[2] = Tcl_NewStringObj("per", -1);
- objs[3] = Tcl_NewStringObj("iteration", -1);
+ TclNewLiteralStringObj(objs[1], "microseconds");
+ TclNewLiteralStringObj(objs[2], "per");
+ TclNewLiteralStringObj(objs[3], "iteration");
Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs));
return TCL_OK;
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index b48aa56..0043b65 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.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: tclCompExpr.c,v 1.48 2007/03/30 17:39:23 dgp Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.49 2007/04/10 14:47:10 dkf Exp $
*/
#include "tclInt.h"
@@ -228,8 +228,7 @@ ParseExpr(
nodes = (OpNode *) attemptckalloc(nodesAvailable * sizeof(OpNode));
if (nodes == NULL) {
- msg = Tcl_NewStringObj(
- "not enough memory to parse expression", -1);
+ TclNewLiteralStringObj(msg, "not enough memory to parse expression");
code = TCL_ERROR;
} else {
/*
@@ -264,8 +263,8 @@ ParseExpr(
} while ((newPtr == NULL)
&& ((size -= (size - nodesUsed) / 2) > nodesUsed));
if (newPtr == NULL) {
- msg = Tcl_NewStringObj(
- "not enough memory to parse expression", -1);
+ TclNewLiteralStringObj(msg,
+ "not enough memory to parse expression");
code = TCL_ERROR;
continue;
}
@@ -355,8 +354,8 @@ ParseExpr(
Tcl_Obj *copy = Tcl_NewStringObj(lastStart,
start + scanned - lastStart);
if (TclCheckBadOctal(NULL, Tcl_GetString(copy))) {
- post = Tcl_NewStringObj(
- "looks like invalid octal number", -1);
+ TclNewLiteralStringObj(post,
+ "looks like invalid octal number");
}
Tcl_DecrRefCount(copy);
}
@@ -422,7 +421,7 @@ ParseExpr(
}
tokenPtr = parsePtr->tokenPtr + wordIndex + 1;
if (tokenPtr->type != TCL_TOKEN_VARIABLE) {
- msg = Tcl_NewStringObj("invalid character \"$\"", -1);
+ TclNewLiteralStringObj(msg, "invalid character \"$\"");
code = TCL_ERROR;
continue;
}
@@ -455,7 +454,7 @@ ParseExpr(
}
if (start == end) {
- msg = Tcl_NewStringObj("missing close-bracket", -1);
+ TclNewLiteralStringObj(msg, "missing close-bracket");
parsePtr->term = tokenPtr->start;
parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
parsePtr->incomplete = 1;
@@ -540,18 +539,18 @@ ParseExpr(
if (prec[nodePtr[-1].lexeme] > precedence) {
if (nodePtr[-1].lexeme == OPEN_PAREN) {
- msg = Tcl_NewStringObj("unbalanced open paren", -1);
+ TclNewLiteralStringObj(msg, "unbalanced open paren");
} else if (nodePtr[-1].lexeme == COMMA) {
msg = Tcl_ObjPrintf(
"missing function argument at %s", mark);
scanned = 0;
insertMark = 1;
} else if (nodePtr[-1].lexeme == START) {
- msg = Tcl_NewStringObj("empty expression", -1);
+ TclNewLiteralStringObj(msg, "empty expression");
}
} else {
if (lexeme == CLOSE_PAREN) {
- msg = Tcl_NewStringObj("unbalanced close paren", -1);
+ TclNewLiteralStringObj(msg, "unbalanced close paren");
} else if ((lexeme == COMMA)
&& (nodePtr[-1].lexeme == OPEN_PAREN)
&& (nodePtr[-2].lexeme == FUNCTION)) {
@@ -617,7 +616,7 @@ ParseExpr(
if ((otherPtr->lexeme == OPEN_PAREN)
&& (lexeme != CLOSE_PAREN)) {
- msg = Tcl_NewStringObj("unbalanced open paren", -1);
+ TclNewLiteralStringObj(msg, "unbalanced open paren");
code = TCL_ERROR;
break;
}
@@ -632,9 +631,8 @@ ParseExpr(
}
if ((lastWas >= 0) && (nodes[lastWas].lexeme == COLON)
&& (otherPtr->lexeme != QUESTION)) {
- msg = Tcl_NewStringObj(
- "unexpected operator \":\" without preceding \"?\"",
- -1);
+ TclNewLiteralStringObj(msg,
+ "unexpected operator \":\" without preceding \"?\"");
code = TCL_ERROR;
break;
}
@@ -671,7 +669,7 @@ ParseExpr(
if (lexeme == CLOSE_PAREN) {
if (otherPtr->lexeme == START) {
- msg = Tcl_NewStringObj("unbalanced close paren", -1);
+ TclNewLiteralStringObj(msg, "unbalanced close paren");
code = TCL_ERROR;
continue;
}
@@ -688,18 +686,16 @@ ParseExpr(
if (lexeme == COMMA) {
if ((otherPtr->lexeme != OPEN_PAREN)
|| (otherPtr[-1].lexeme != FUNCTION)) {
- msg = Tcl_NewStringObj(
- "unexpected \",\" outside function argument list",
- -1);
+ TclNewLiteralStringObj(msg,
+ "unexpected \",\" outside function argument list");
code = TCL_ERROR;
continue;
}
otherPtr->left++;
}
if ((lastWas >= 0) && (nodes[lastWas].lexeme == COLON)) {
- msg = Tcl_NewStringObj(
- "unexpected operator \":\" without preceding \"?\"",
- -1);
+ TclNewLiteralStringObj(msg,
+ "unexpected operator \":\" without preceding \"?\"");
code = TCL_ERROR;
continue;
}
@@ -1217,8 +1213,8 @@ Tcl_ParseExpr(
} while ((newPtr == NULL)
&& ((size -= (size - nodesUsed) / 2) > nodesUsed));
if (newPtr == NULL) {
- msg = Tcl_NewStringObj(
- "not enough memory to parse expression", -1);
+ TclNewLiteralStringObj(msg,
+ "not enough memory to parse expression");
code = TCL_ERROR;
continue;
}
@@ -1265,6 +1261,7 @@ Tcl_ParseExpr(
nodePtr->lexeme = FUNCTION;
} else {
Tcl_Obj *objPtr = Tcl_NewStringObj(start, scanned);
+
Tcl_IncrRefCount(objPtr);
code = Tcl_ConvertToType(NULL, objPtr, &tclBooleanType);
Tcl_DecrRefCount(objPtr);
@@ -1316,8 +1313,8 @@ Tcl_ParseExpr(
Tcl_Obj *copy = Tcl_NewStringObj(operand,
start + scanned - operand);
if (TclCheckBadOctal(NULL, Tcl_GetString(copy))) {
- post = Tcl_NewStringObj(
- "looks like invalid octal number", -1);
+ TclNewLiteralStringObj(post,
+ "looks like invalid octal number");
}
Tcl_DecrRefCount(copy);
}
@@ -1377,7 +1374,7 @@ Tcl_ParseExpr(
}
tokenPtr = scratch.tokenPtr + nodePtr->token + 1;
if (tokenPtr->type != TCL_TOKEN_VARIABLE) {
- msg = Tcl_NewStringObj("invalid character \"$\"", -1);
+ TclNewLiteralStringObj(msg, "invalid character \"$\"");
code = TCL_ERROR;
continue;
}
@@ -1410,7 +1407,7 @@ Tcl_ParseExpr(
}
if (start == end) {
- msg = Tcl_NewStringObj("missing close-bracket", -1);
+ TclNewLiteralStringObj(msg, "missing close-bracket");
parsePtr->term = tokenPtr->start;
parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
parsePtr->incomplete = 1;
@@ -1505,17 +1502,17 @@ Tcl_ParseExpr(
if ((NODE_TYPE & lastNodePtr->lexeme) != LEAF) {
if (prec[lastNodePtr->lexeme] > precedence) {
if (lastNodePtr->lexeme == OPEN_PAREN) {
- msg = Tcl_NewStringObj("unbalanced open paren", -1);
+ TclNewLiteralStringObj(msg, "unbalanced open paren");
} else if (lastNodePtr->lexeme == COMMA) {
msg = Tcl_ObjPrintf(
"missing function argument at %s", mark);
scanned = 0;
insertMark = 1;
} else if (lastNodePtr->lexeme == START) {
- msg = Tcl_NewStringObj("empty expression", -1);
+ TclNewLiteralStringObj(msg, "empty expression");
}
} else if (nodePtr->lexeme == CLOSE_PAREN) {
- msg = Tcl_NewStringObj("unbalanced close paren", -1);
+ TclNewLiteralStringObj(msg, "unbalanced close paren");
} else if ((nodePtr->lexeme == COMMA)
&& (lastNodePtr->lexeme == OPEN_PAREN)
&& (lastNodePtr[-1].lexeme == FUNCTION)) {
@@ -1578,7 +1575,7 @@ Tcl_ParseExpr(
if ((otherPtr->lexeme == OPEN_PAREN)
&& (nodePtr->lexeme != CLOSE_PAREN)) {
lastOrphanPtr = otherPtr;
- msg = Tcl_NewStringObj("unbalanced open paren", -1);
+ TclNewLiteralStringObj(msg, "unbalanced open paren");
code = TCL_ERROR;
break;
}
@@ -1593,9 +1590,8 @@ Tcl_ParseExpr(
}
if ((lastOrphanPtr->lexeme == COLON)
&& (otherPtr->lexeme != QUESTION)) {
- msg = Tcl_NewStringObj(
- "unexpected operator \":\" without preceding \"?\"",
- -1);
+ TclNewLiteralStringObj(msg,
+ "unexpected operator \":\" without preceding \"?\"");
code = TCL_ERROR;
break;
}
@@ -1631,7 +1627,7 @@ Tcl_ParseExpr(
if (nodePtr->lexeme == CLOSE_PAREN) {
if (otherPtr->lexeme == START) {
- msg = Tcl_NewStringObj("unbalanced close paren", -1);
+ TclNewLiteralStringObj(msg, "unbalanced close paren");
code = TCL_ERROR;
continue;
}
@@ -1645,16 +1641,15 @@ Tcl_ParseExpr(
if ((nodePtr->lexeme == COMMA) && ((otherPtr->lexeme != OPEN_PAREN)
|| (otherPtr[-1].lexeme != FUNCTION))) {
- msg = Tcl_NewStringObj(
- "unexpected \",\" outside function argument list", -1);
+ TclNewLiteralStringObj(msg,
+ "unexpected \",\" outside function argument list");
code = TCL_ERROR;
continue;
}
if (lastOrphanPtr->lexeme == COLON) {
- msg = Tcl_NewStringObj(
- "unexpected operator \":\" without preceding \"?\"",
- -1);
+ TclNewLiteralStringObj(msg,
+ "unexpected operator \":\" without preceding \"?\"");
code = TCL_ERROR;
continue;
}
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 11cff19..5a3633d 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.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: tclCompile.c,v 1.114 2007/04/08 02:19:31 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.115 2007/04/10 14:47:10 dkf Exp $
*/
#include "tclInt.h"
@@ -1176,8 +1176,7 @@ TclCompileScript(
* Compile bytecodes to report the parse error at runtime.
*/
- Tcl_Obj *returnCmd = Tcl_NewStringObj(
- "return -code 1 -level 0 -errorinfo", -1);
+ Tcl_Obj *returnCmd;
Tcl_Obj *errMsg = Tcl_GetObjResult(interp);
Tcl_Obj *errInfo = Tcl_DuplicateObj(errMsg);
char *cmdString;
@@ -1185,6 +1184,8 @@ TclCompileScript(
Tcl_Parse subParse;
int errorLine = 1;
+ TclNewLiteralStringObj(returnCmd,
+ "return -code 1 -level 0 -errorinfo");
Tcl_IncrRefCount(returnCmd);
Tcl_IncrRefCount(errInfo);
Tcl_AppendToObj(errInfo, "\n while executing\n\"", -1);
diff --git a/generic/tclConfig.c b/generic/tclConfig.c
index 85975f9..1199e81 100644
--- a/generic/tclConfig.c
+++ b/generic/tclConfig.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: tclConfig.c,v 1.13 2007/04/01 00:10:23 dkf Exp $
+ * RCS: @(#) $Id: tclConfig.c,v 1.14 2007/04/10 14:47:10 dkf Exp $
*/
#include "tclInt.h"
@@ -217,7 +217,7 @@ QueryConfigObjCmd(
* present.
*/
- Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1));
+ Tcl_SetResult(interp, "package not known", TCL_STATIC);
return TCL_ERROR;
}
@@ -230,7 +230,7 @@ QueryConfigObjCmd(
if (Tcl_DictObjGet(interp, pkgDict, objv [2], &val) != TCL_OK
|| val == NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1));
+ Tcl_SetResult(interp, "key not known", TCL_STATIC);
return TCL_ERROR;
}
@@ -247,8 +247,8 @@ QueryConfigObjCmd(
listPtr = Tcl_NewListObj(n, NULL);
if (!listPtr) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("insufficient memory to create list",-1));
+ Tcl_SetResult(interp, "insufficient memory to create list",
+ TCL_STATIC);
return TCL_ERROR;
}
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 3a55669..66fdc41 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.46 2006/11/28 22:20:28 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.47 2007/04/10 14:47:10 dkf Exp $
*/
#include "tclInt.h"
@@ -393,8 +393,8 @@ SetDictFromAny(
}
if (objc & 1) {
if (interp != NULL) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("missing value to go with key", -1));
+ Tcl_SetResult(interp, "missing value to go with key",
+ TCL_STATIC);
}
return TCL_ERROR;
}
@@ -541,11 +541,11 @@ SetDictFromAny(
missingKey:
if (interp != NULL) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("missing value to go with key", -1));
+ Tcl_SetResult(interp, "missing value to go with key", TCL_STATIC);
}
TclDecrRefCount(keyPtr);
result = TCL_ERROR;
+
errorExit:
for (hPtr=Tcl_FirstHashEntry(&dict->table,&search);
hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) {
@@ -2175,8 +2175,8 @@ DictForCmd(
return TCL_ERROR;
}
if (varc != 2) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "must have exactly two variable names", -1));
+ Tcl_SetResult(interp, "must have exactly two variable names",
+ TCL_STATIC);
return TCL_ERROR;
}
keyVarObj = varv[0];
@@ -2494,8 +2494,8 @@ DictFilterCmd(
return TCL_ERROR;
}
if (varc != 2) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "must have exactly two variable names", -1));
+ Tcl_SetResult(interp, "must have exactly two variable names",
+ TCL_STATIC);
return TCL_ERROR;
}
keyVarObj = varv[0];
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 11c838a..910c5a9 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclEncoding.c,v 1.52 2006/12/27 01:25:35 mdejong Exp $
+ * RCS: @(#) $Id: tclEncoding.c,v 1.53 2007/04/10 14:47:13 dkf Exp $
*/
#include "tclInt.h"
@@ -3264,9 +3264,10 @@ InitializeEncodingSearchPath(
{
char *bytes;
int i, numDirs, numBytes;
- Tcl_Obj *libPath, *encodingObj = Tcl_NewStringObj("encoding", -1);
- Tcl_Obj *searchPath = Tcl_NewObj();
+ Tcl_Obj *libPath, *encodingObj, *searchPath;
+ TclNewLiteralStringObj(encodingObj, "encoding");
+ TclNewObj(searchPath);
Tcl_IncrRefCount(encodingObj);
Tcl_IncrRefCount(searchPath);
libPath = TclGetLibraryPath();
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index e55d59e..596e68b 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.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: tclEnv.c,v 1.31 2007/03/21 14:16:08 dkf Exp $
+ * RCS: @(#) $Id: tclEnv.c,v 1.32 2007/04/10 14:47:13 dkf Exp $
*/
#include "tclInt.h"
@@ -118,7 +118,7 @@ TclSetupEnv(
if (environ[0] == NULL) {
Tcl_Obj *varNamePtr;
- varNamePtr = Tcl_NewStringObj("env", -1);
+ TclNewLiteralStringObj(varNamePtr, "env");
Tcl_IncrRefCount(varNamePtr);
TclArraySet(interp, varNamePtr, NULL);
Tcl_DecrRefCount(varNamePtr);
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index ff92252..d171110 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.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: tclEvent.c,v 1.71 2007/03/19 16:59:08 dgp Exp $
+ * RCS: @(#) $Id: tclEvent.c,v 1.72 2007/04/10 14:47:13 dkf Exp $
*/
#include "tclInt.h"
@@ -246,9 +246,9 @@ HandleBgErrors(
if (errChannel != (Tcl_Channel) NULL) {
Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
- Tcl_Obj *keyPtr = Tcl_NewStringObj("-errorinfo", -1);
- Tcl_Obj *valuePtr;
+ Tcl_Obj *keyPtr, *valuePtr;
+ TclNewLiteralStringObj(keyPtr, "-errorinfo");
Tcl_IncrRefCount(keyPtr);
Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
@@ -313,7 +313,7 @@ TclDefaultBgErrorHandlerObjCmd(
* interp fields.
*/
- keyPtr = Tcl_NewStringObj("-errorcode", -1);
+ TclNewLiteralStringObj(keyPtr, "-errorcode");
Tcl_IncrRefCount(keyPtr);
Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
@@ -321,7 +321,7 @@ TclDefaultBgErrorHandlerObjCmd(
Tcl_SetVar2Ex(interp, "errorCode", NULL, valuePtr, TCL_GLOBAL_ONLY);
}
- keyPtr = Tcl_NewStringObj("-errorinfo", -1);
+ TclNewLiteralStringObj(keyPtr, "-errorinfo");
Tcl_IncrRefCount(keyPtr);
Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
@@ -333,7 +333,7 @@ TclDefaultBgErrorHandlerObjCmd(
* Create and invoke the bgerror command.
*/
- tempObjv[0] = Tcl_NewStringObj("bgerror", -1);
+ TclNewLiteralStringObj(tempObjv[0], "bgerror");
Tcl_IncrRefCount(tempObjv[0]);
tempObjv[1] = objv[1];
Tcl_AllowExceptions(interp);
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 62f4f88..13844c1 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.271 2007/04/07 05:34:30 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.272 2007/04/10 14:47:14 dkf Exp $
*/
#include "tclInt.h"
@@ -6697,7 +6697,9 @@ ValidatePcAndStackTop(
fprintf(stderr, "\nBad stack top %d at pc %u in TclExecuteByteCode (min %i, max %i)",
stackTop, relativePc, stackLowerBound, stackUpperBound);
if (cmd != NULL) {
- Tcl_Obj *message = Tcl_NewStringObj("\n executing ", -1);
+ Tcl_Obj *message;
+
+ TclNewLiteralStringObj(message, "\n executing ");
Tcl_IncrRefCount(message);
Tcl_AppendLimitedToObj(message, cmd, numChars, 100, NULL);
fprintf(stderr,"%s\n", Tcl_GetString(message));
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index a7f5478..8de33fa 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.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: tclFCmd.c,v 1.37 2007/04/02 18:48:03 dgp Exp $
+ * RCS: @(#) $Id: tclFCmd.c,v 1.38 2007/04/10 14:47:14 dkf Exp $
*/
#include "tclInt.h"
@@ -568,8 +568,10 @@ CopyRenameOneFile(
*/
{
- Tcl_Obj* perm = Tcl_NewStringObj("u+w",-1);
+ Tcl_Obj *perm;
int index;
+
+ TclNewLiteralStringObj(perm, "u+w");
Tcl_IncrRefCount(perm);
if (TclFSFileAttrIndex(target, "-permissions", &index) == TCL_OK) {
Tcl_FSFileAttrsSet(NULL, index, target, perm);
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 131a8d5..b9417d6 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.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: tclFileName.c,v 1.79 2007/04/02 18:48:03 dgp Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.80 2007/04/10 14:47:15 dkf Exp $
*/
#include "tclInt.h"
@@ -663,7 +663,7 @@ SplitUnixPath(
if (length > 0) {
Tcl_Obj *nextElt;
if ((elementStart[0] == '~') && (elementStart != path)) {
- nextElt = Tcl_NewStringObj("./",2);
+ TclNewLiteralStringObj(nextElt, "./");
Tcl_AppendToObj(nextElt, elementStart, length);
} else {
nextElt = Tcl_NewStringObj(elementStart, length);
@@ -731,11 +731,10 @@ SplitWinPath(
length = p - elementStart;
if (length > 0) {
Tcl_Obj *nextElt;
- if ((elementStart != path)
- && ((elementStart[0] == '~')
+ if ((elementStart != path) && ((elementStart[0] == '~')
|| (isalpha(UCHAR(elementStart[0]))
&& elementStart[1] == ':'))) {
- nextElt = Tcl_NewStringObj("./",2);
+ TclNewLiteralStringObj(nextElt, "./");
Tcl_AppendToObj(nextElt, elementStart, length);
} else {
nextElt = Tcl_NewStringObj(elementStart, length);
@@ -1972,9 +1971,9 @@ TclGlob(
if (len == prefixLen) {
if ((pattern[0] == '\0')
|| (strchr(separators, pattern[0]) == NULL)) {
- elems[0] = Tcl_NewStringObj(".", 1);
+ TclNewLiteralStringObj(elems[0], ".");
} else {
- elems[0] = Tcl_NewStringObj("/", 1);
+ TclNewLiteralStringObj(elems[0], "/");
}
} else {
elems[0] = Tcl_NewStringObj(oldStr+prefixLen, len-prefixLen);
diff --git a/generic/tclHistory.c b/generic/tclHistory.c
index e77b230..87e6c52 100644
--- a/generic/tclHistory.c
+++ b/generic/tclHistory.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: tclHistory.c,v 1.9 2006/09/30 17:56:47 msofer Exp $
+ * RCS: @(#) $Id: tclHistory.c,v 1.10 2007/04/10 14:47:15 dkf Exp $
*/
#include "tclInt.h"
@@ -134,8 +134,8 @@ Tcl_RecordAndEvalObj(
* Do recording by eval'ing a tcl history command: history add $cmd.
*/
- list[0] = Tcl_NewStringObj("history", -1);
- list[1] = Tcl_NewStringObj("add", -1);
+ TclNewLiteralStringObj(list[0], "history");
+ TclNewLiteralStringObj(list[1], "add");
list[2] = cmdPtr;
objPtr = Tcl_NewListObj(3, list);
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 2ea4870..93683a7 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.20 2007/02/26 23:27:49 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclIORChan.c,v 1.21 2007/04/10 14:47:15 dkf Exp $
*/
#include <tclInt.h>
@@ -551,8 +551,7 @@ TclChanCreateObjCmd(
*/
if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
-
- err = Tcl_NewStringObj("chan handler \"", -1);
+ TclNewLiteralStringObj(err, "chan handler \"");
Tcl_AppendObjToObj(err, cmdObj);
Tcl_AppendToObj(err, " initialize\" returned non-list: ", -1);
Tcl_AppendObjToObj(err, resObj);
@@ -564,7 +563,7 @@ TclChanCreateObjCmd(
while (listc > 0) {
if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames,
"method", TCL_EXACT, &methIndex) != TCL_OK) {
- err = Tcl_NewStringObj("chan handler \"", -1);
+ TclNewLiteralStringObj(err, "chan handler \"");
Tcl_AppendObjToObj(err, cmdObj);
Tcl_AppendToObj(err, " initialize\" returned ", -1);
Tcl_AppendObjToObj(err, Tcl_GetObjResult(interp));
@@ -577,7 +576,7 @@ TclChanCreateObjCmd(
}
if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
- err = Tcl_NewStringObj("chan handler \"", -1);
+ TclNewLiteralStringObj(err, "chan handler \"");
Tcl_AppendObjToObj(err, cmdObj);
Tcl_AppendToObj(err, "\" does not support all required methods", -1);
Tcl_SetObjResult(interp, err);
@@ -585,7 +584,7 @@ TclChanCreateObjCmd(
}
if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) {
- err = Tcl_NewStringObj("chan handler \"", -1);
+ TclNewLiteralStringObj(err, "chan handler \"");
Tcl_AppendObjToObj(err, cmdObj);
Tcl_AppendToObj(err, "\" lacks a \"read\" method", -1);
Tcl_SetObjResult(interp, err);
@@ -593,7 +592,7 @@ TclChanCreateObjCmd(
}
if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) {
- err = Tcl_NewStringObj("chan handler \"", -1);
+ TclNewLiteralStringObj(err, "chan handler \"");
Tcl_AppendObjToObj(err, cmdObj);
Tcl_AppendToObj(err, "\" lacks a \"write\" method", -1);
Tcl_SetObjResult(interp, err);
@@ -601,7 +600,7 @@ TclChanCreateObjCmd(
}
if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) {
- err = Tcl_NewStringObj("chan handler \"", -1);
+ TclNewLiteralStringObj(err, "chan handler \"");
Tcl_AppendObjToObj(err, cmdObj);
Tcl_AppendToObj(err, "\" supports \"cget\" but not \"cgetall\"", -1);
Tcl_SetObjResult(interp, err);
@@ -609,7 +608,7 @@ TclChanCreateObjCmd(
}
if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) {
- err = Tcl_NewStringObj("chan handler \"", -1);
+ TclNewLiteralStringObj(err, "chan handler \"");
Tcl_AppendObjToObj(err, cmdObj);
Tcl_AppendToObj(err, "\" supports \"cgetall\" but not \"cget\"", -1);
Tcl_SetObjResult(interp, err);
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index b275b77..8e3a3f2 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.142 2007/03/16 02:05:31 das Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.143 2007/04/10 14:47:15 dkf Exp $
*/
#include "tclInt.h"
@@ -3272,8 +3272,9 @@ TclLoadFile(
{
int index;
- Tcl_Obj* perm = Tcl_NewStringObj("0700",-1);
+ Tcl_Obj *perm;
+ TclNewLiteralStringObj(perm, "0700");
Tcl_IncrRefCount(perm);
if (TclFSFileAttrIndex(copyToPtr, "-permissions", &index) == TCL_OK) {
Tcl_FSFileAttrsSet(NULL, index, copyToPtr, perm);
@@ -3784,7 +3785,7 @@ Tcl_FSSplitPath(
if (length > 0) {
Tcl_Obj *nextElt;
if (elementStart[0] == '~') {
- nextElt = Tcl_NewStringObj("./",2);
+ TclNewLiteralStringObj(nextElt, "./");
Tcl_AppendToObj(nextElt, elementStart, length);
} else {
nextElt = Tcl_NewStringObj(elementStart, length);
@@ -4572,12 +4573,15 @@ Tcl_FSPathSeparator(
if (fsPtr->filesystemSeparatorProc != NULL) {
return (*fsPtr->filesystemSeparatorProc)(pathPtr);
} else {
+ Tcl_Obj *resultObj;
+
/*
* Allow filesystems not to provide a filesystemSeparatorProc if they
* wish to use the standard forward slash.
*/
- return Tcl_NewStringObj("/", 1);
+ TclNewLiteralStringObj(resultObj, "/");
+ return resultObj;
}
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 2e3b47f..140a67c 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.304 2007/04/03 15:08:24 msofer Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.305 2007/04/10 14:47:15 dkf Exp $
*/
#ifndef _TCLINT
@@ -2951,9 +2951,11 @@ MODULE_SCOPE void TclInvalidateNsPath(Namespace *nsPtr);
(objPtr)->length = 0; \
(objPtr)->typePtr = NULL
-/* Invalidate the string rep first so we can use the bytes value \
- * for our pointer chain, and signal an obj deletion (as opposed \
- * to shimmering) with 'length == -1' */ \
+/*
+ * Invalidate the string rep first so we can use the bytes value for our
+ * pointer chain, and signal an obj deletion (as opposed to shimmering) with
+ * 'length == -1'
+ */
# define TclDecrRefCount(objPtr) \
if (--(objPtr)->refCount <= 0) { \
@@ -3290,6 +3292,7 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum,
* MODULE_SCOPE void TclNewWideObj(Tcl_Obj *objPtr, Tcl_WideInt w);
* MODULE_SCOPE void TclNewDoubleObj(Tcl_Obj *objPtr, double d);
* MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, char *s, int len);
+ * MODULE_SCOPE void TclNewLiteralStringObj(Tcl_Obj*objPtr, char*sLiteral);
*
*----------------------------------------------------------------
*/
@@ -3343,6 +3346,13 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum,
#endif /* TCL_MEM_DEBUG */
/*
+ * The sLiteral argument *must* be a string literal; the incantation with
+ * sizeof(sLiteral "") will fail to compile otherwise.
+ */
+#define TclNewLiteralStringObj(objPtr, sLiteral) \
+ TclNewStringObj((objPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1))
+
+/*
*----------------------------------------------------------------
* Macros used by the Tcl core to test for some special double values.
* The ANSI C "prototypes" for these macros are:
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 6e9c041..b9f445a 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.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: tclInterp.c,v 1.71 2007/04/02 18:48:03 dgp Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.72 2007/04/10 14:47:16 dkf Exp $
*/
#include "tclInt.h"
@@ -1495,7 +1495,7 @@ AliasCreate(
* on the precise definition of these tokens.
*/
- newToken = Tcl_NewStringObj("::",-1);
+ TclNewLiteralStringObj(newToken, "::");
Tcl_AppendObjToObj(newToken, aliasPtr->token);
Tcl_DecrRefCount(aliasPtr->token);
aliasPtr->token = newToken;
@@ -2191,9 +2191,10 @@ SlaveCreate(
*/
if (safe) {
- Tcl_Obj* clockObj = Tcl_NewStringObj("clock", -1);
+ Tcl_Obj *clockObj;
int status;
+ TclNewLiteralStringObj(clockObj, "clock");
Tcl_IncrRefCount(clockObj);
status = AliasCreate(interp, slaveInterp, masterInterp, clockObj,
clockObj, 0, (Tcl_Obj *CONST *) NULL);
diff --git a/generic/tclLink.c b/generic/tclLink.c
index bdfa4db..8d3bc1a 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.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: tclLink.c,v 1.20 2007/03/20 21:20:12 dgp Exp $
+ * RCS: @(#) $Id: tclLink.c,v 1.21 2007/04/10 14:47:16 dkf Exp $
*/
#include "tclInt.h"
@@ -552,6 +552,7 @@ ObjValue(
Link *linkPtr) /* Structure describing linked variable. */
{
char *p;
+ Tcl_Obj *resultObj;
switch (linkPtr->type) {
case TCL_LINK_INT:
@@ -599,7 +600,8 @@ ObjValue(
case TCL_LINK_STRING:
p = LinkedVar(char *);
if (p == NULL) {
- return Tcl_NewStringObj("NULL", 4);
+ TclNewLiteralStringObj(resultObj, "NULL");
+ return resultObj;
}
return Tcl_NewStringObj(p, -1);
@@ -609,7 +611,8 @@ ObjValue(
*/
default:
- return Tcl_NewStringObj("??", 2);
+ TclNewLiteralStringObj(resultObj, "??");
+ return resultObj;
}
}
diff --git a/generic/tclMain.c b/generic/tclMain.c
index aa907ac..21e37e8 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.40 2006/11/23 03:18:01 das Exp $
+ * RCS: @(#) $Id: tclMain.c,v 1.41 2007/04/10 14:47:16 dkf Exp $
*/
#include "tclInt.h"
@@ -443,9 +443,9 @@ Tcl_Main(
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel) {
Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
- Tcl_Obj *keyPtr = Tcl_NewStringObj("-errorinfo", -1);
- Tcl_Obj *valuePtr;
+ Tcl_Obj *keyPtr, *valuePtr;
+ TclNewLiteralStringObj(keyPtr, "-errorinfo");
Tcl_IncrRefCount(keyPtr);
Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index d8b60e8..676f164 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.130 2007/04/06 22:36:49 msofer Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.131 2007/04/10 14:47:16 dkf Exp $
*/
#include "tclInt.h"
@@ -1479,7 +1479,7 @@ Tcl_Import(
Tcl_Obj *objv[2];
int result;
- objv[0] = Tcl_NewStringObj("auto_import", -1);
+ TclNewLiteralStringObj(objv[0], "auto_import");
objv[1] = Tcl_NewStringObj(pattern, -1);
Tcl_IncrRefCount(objv[0]);
@@ -3228,7 +3228,7 @@ NamespaceCodeCmd(
currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
if (currNsPtr == (Namespace *) Tcl_GetGlobalNamespace(interp)) {
- objPtr = Tcl_NewStringObj("::", 2);
+ TclNewLiteralStringObj(objPtr, "::");
} else {
objPtr = Tcl_NewStringObj(currNsPtr->fullName, -1);
}
@@ -4468,7 +4468,7 @@ Tcl_GetNamespaceUnknownHandler(
* handler).
*/
- currNsPtr->unknownHandlerPtr = Tcl_NewStringObj("::unknown", -1);
+ TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
}
return currNsPtr->unknownHandlerPtr;
diff --git a/generic/tclObj.c b/generic/tclObj.c
index b069896..5ea3d7a 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.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: tclObj.c,v 1.118 2007/03/19 16:59:08 dgp Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.119 2007/04/10 14:47:17 dkf Exp $
*/
#include "tclInt.h"
@@ -1401,8 +1401,9 @@ SetBooleanFromAny(
if (interp != NULL) {
int length;
char *str = Tcl_GetStringFromObj(objPtr, &length);
- Tcl_Obj *msg =
- Tcl_NewStringObj("expected boolean value but got \"", -1);
+ Tcl_Obj *msg;
+
+ TclNewLiteralStringObj(msg, "expected boolean value but got \"");
Tcl_AppendLimitedToObj(msg, str, length, 50, "");
Tcl_AppendToObj(msg, "\"", -1);
Tcl_SetObjResult(interp, msg);
@@ -2177,9 +2178,9 @@ Tcl_GetLongFromObj(
#endif
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_Obj *msg =
- Tcl_NewStringObj("expected integer but got \"", -1);
+ Tcl_Obj *msg;
+ TclNewLiteralStringObj(msg, "expected integer but got \"");
Tcl_AppendObjToObj(msg, objPtr);
Tcl_AppendToObj(msg, "\"", -1);
Tcl_SetObjResult(interp, msg);
@@ -2479,8 +2480,9 @@ Tcl_GetWideIntFromObj(
}
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_Obj *msg =
- Tcl_NewStringObj("expected integer but got \"", -1);
+ Tcl_Obj *msg;
+
+ TclNewLiteralStringObj(msg, "expected integer but got \"");
Tcl_AppendObjToObj(msg, objPtr);
Tcl_AppendToObj(msg, "\"", -1);
Tcl_SetObjResult(interp, msg);
@@ -2780,9 +2782,9 @@ GetBignumFromObj(
#endif
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_Obj *msg =
- Tcl_NewStringObj("expected integer but got \"", -1);
+ Tcl_Obj *msg;
+ TclNewLiteralStringObj(msg, "expected integer but got \"");
Tcl_AppendObjToObj(msg, objPtr);
Tcl_AppendToObj(msg, "\"", -1);
Tcl_SetObjResult(interp, msg);
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index a3dce53..e49141f 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.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: tclPathObj.c,v 1.58 2007/02/20 23:24:02 nijtmans Exp $
+ * RCS: @(#) $Id: tclPathObj.c,v 1.59 2007/04/10 14:47:17 dkf Exp $
*/
#include "tclInt.h"
@@ -731,7 +731,7 @@ TclPathPart(
resultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1);
} else if (splitElements == 0 ||
(Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE)) {
- resultPtr = Tcl_NewStringObj(".", 1);
+ TclNewLiteralStringObj(resultPtr, ".");
} else {
Tcl_ListObjIndex(NULL, splitPtr, 0, &resultPtr);
}
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 64c875c..218582b 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.110 2007/04/06 22:36:49 msofer Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.111 2007/04/10 14:47:17 dkf Exp $
*/
#include "tclInt.h"
@@ -1681,8 +1681,9 @@ ProcCompileProc(
* to compile.
*/
- Tcl_Obj *message = Tcl_NewStringObj("Compiling ", -1);
+ Tcl_Obj *message;
+ TclNewLiteralStringObj(message, "Compiling ");
Tcl_IncrRefCount(message);
Tcl_AppendStringsToObj(message, description, " \"", NULL);
Tcl_AppendLimitedToObj(message, procName, -1, 50, NULL);
@@ -2024,7 +2025,7 @@ TclGetObjInterpProc(void)
* reference count is 0.
*
* Results:
- * Returns a pointer to a newly allocated Tcl_Obj, 0 on error.
+ * Returns a pointer to a newly allocated Tcl_Obj, NULL on error.
*
* Side effects:
* The reference count in the ByteCode attached to the Proc is bumped up
@@ -2044,8 +2045,7 @@ TclNewProcBodyObj(
return NULL;
}
- objPtr = Tcl_NewStringObj("", 0);
-
+ TclNewObj(objPtr);
if (objPtr) {
objPtr->typePtr = &tclProcBodyType;
objPtr->internalRep.otherValuePtr = procPtr;
@@ -2180,7 +2180,7 @@ SetLambdaFromAny(
result = Tcl_ListObjGetElements(interp, objPtr, &objc, &objv);
if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
- errPtr = Tcl_NewStringObj("can't interpret \"",-1);
+ TclNewLiteralStringObj(errPtr, "can't interpret \"");
Tcl_AppendObjToObj(errPtr, objPtr);
Tcl_AppendToObj(errPtr, "\" as a lambda expression", -1);
Tcl_SetObjResult(interp, errPtr);
@@ -2289,11 +2289,12 @@ SetLambdaFromAny(
*/
if (objc == 2) {
- nsObjPtr = Tcl_NewStringObj("::", 2);
+ TclNewLiteralStringObj(nsObjPtr, "::");
} else {
char *nsName = Tcl_GetString(objv[2]);
+
if ((*nsName != ':') || (*(nsName+1) != ':')) {
- nsObjPtr = Tcl_NewStringObj("::", 2);
+ TclNewLiteralStringObj(nsObjPtr, "::");
Tcl_AppendObjToObj(nsObjPtr, objv[2]);
} else {
nsObjPtr = objv[2];
@@ -2415,7 +2416,7 @@ Tcl_ApplyObjCmd(
}
if (nsPtr == NULL) {
- errPtr = Tcl_NewStringObj("cannot find namespace \"",-1);
+ TclNewLiteralStringObj(errPtr, "cannot find namespace \"");
Tcl_AppendObjToObj(errPtr, nsObjPtr);
Tcl_AppendToObj(errPtr, "\"", -1);
Tcl_SetObjResult(interp, errPtr);
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 1d56e6f..c159fce 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclResult.c,v 1.33 2007/01/29 18:55:50 dgp Exp $
+ * RCS: @(#) $Id: tclResult.c,v 1.34 2007/04/10 14:47:17 dkf Exp $
*/
#include "tclInt.h"
@@ -1112,12 +1112,12 @@ GetKeys(void)
int i;
- keys[KEY_CODE] = Tcl_NewStringObj("-code", -1);
- keys[KEY_ERRORCODE] = Tcl_NewStringObj("-errorcode", -1);
- keys[KEY_ERRORINFO] = Tcl_NewStringObj("-errorinfo", -1);
- keys[KEY_ERRORLINE] = Tcl_NewStringObj("-errorline", -1);
- keys[KEY_LEVEL] = Tcl_NewStringObj("-level", -1);
- keys[KEY_OPTIONS] = Tcl_NewStringObj("-options", -1);
+ TclNewLiteralStringObj(keys[KEY_CODE], "-code");
+ TclNewLiteralStringObj(keys[KEY_ERRORCODE], "-errorcode");
+ TclNewLiteralStringObj(keys[KEY_ERRORINFO], "-errorinfo");
+ TclNewLiteralStringObj(keys[KEY_ERRORLINE], "-errorline");
+ TclNewLiteralStringObj(keys[KEY_LEVEL], "-level");
+ TclNewLiteralStringObj(keys[KEY_OPTIONS], "-options");
for (i = KEY_CODE; i < KEY_LAST; i++) {
Tcl_IncrRefCount(keys[i]);
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 9fd152c..4a8ae60 100755
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclStrToD.c,v 1.27 2007/02/20 23:24:03 nijtmans Exp $
+ * RCS: @(#) $Id: tclStrToD.c,v 1.28 2007/04/10 14:47:17 dkf Exp $
*
*----------------------------------------------------------------------
*/
@@ -1125,7 +1125,9 @@ TclParseNumber(
if (status != TCL_OK) {
if (interp != NULL) {
- Tcl_Obj *msg = Tcl_NewStringObj("expected ", -1);
+ Tcl_Obj *msg;
+
+ TclNewLiteralStringObj(msg, "expected ");
Tcl_AppendToObj(msg, expected, -1);
Tcl_AppendToObj(msg, " but got \"", -1);
Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, "");
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 4301c8b..56a165d 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.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: tclTrace.c,v 1.35 2007/04/02 18:48:04 dgp Exp $
+ * RCS: @(#) $Id: tclTrace.c,v 1.36 2007/04/10 14:47:17 dkf Exp $
*/
#include "tclInt.h"
@@ -2612,9 +2612,9 @@ TclCallVarTraces(
if (leaveErrMsg) {
CONST char *type = "";
Tcl_Obj *options = Tcl_GetReturnOptions((Tcl_Interp *)iPtr, code);
- Tcl_Obj *errorInfoKey = Tcl_NewStringObj("-errorinfo", -1);
- Tcl_Obj *errorInfo;
+ Tcl_Obj *errorInfoKey, *errorInfo;
+ TclNewLiteralStringObj(errorInfoKey, "-errorinfo");
Tcl_IncrRefCount(errorInfoKey);
Tcl_DictObjGet(NULL, options, errorInfoKey, &errorInfo);
Tcl_IncrRefCount(errorInfo);
generated by cgit v0.12 at 2024-11-06 17:40:34 (GMT)