diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2007-04-10 14:47:06 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2007-04-10 14:47:06 (GMT) |
commit | 0379fe02395721d2ea1419c61ca69ec818561082 (patch) | |
tree | e12acd4bb445070087067812722f564f29218f8d /generic | |
parent | f7f181d5456b19b4726f71223362bf82d761d8ff (diff) | |
download | tcl-0379fe02395721d2ea1419c61ca69ec818561082.zip tcl-0379fe02395721d2ea1419c61ca69ec818561082.tar.gz tcl-0379fe02395721d2ea1419c61ca69ec818561082.tar.bz2 |
Handle creation of Tcl_Objs from constant strings better (easier to use, more
efficient). After [Patch 1529526] (afredd)
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclBasic.c | 15 | ||||
-rw-r--r-- | generic/tclClock.c | 7 | ||||
-rw-r--r-- | generic/tclCmdAH.c | 85 | ||||
-rw-r--r-- | generic/tclCmdIL.c | 76 | ||||
-rw-r--r-- | generic/tclCmdMZ.c | 8 | ||||
-rw-r--r-- | generic/tclCompExpr.c | 79 | ||||
-rw-r--r-- | generic/tclCompile.c | 7 | ||||
-rw-r--r-- | generic/tclConfig.c | 10 | ||||
-rw-r--r-- | generic/tclDictObj.c | 18 | ||||
-rw-r--r-- | generic/tclEncoding.c | 7 | ||||
-rw-r--r-- | generic/tclEnv.c | 4 | ||||
-rw-r--r-- | generic/tclEvent.c | 12 | ||||
-rw-r--r-- | generic/tclExecute.c | 6 | ||||
-rw-r--r-- | generic/tclFCmd.c | 6 | ||||
-rw-r--r-- | generic/tclFileName.c | 13 | ||||
-rw-r--r-- | generic/tclHistory.c | 6 | ||||
-rw-r--r-- | generic/tclIORChan.c | 17 | ||||
-rw-r--r-- | generic/tclIOUtil.c | 12 | ||||
-rw-r--r-- | generic/tclInt.h | 18 | ||||
-rw-r--r-- | generic/tclInterp.c | 7 | ||||
-rw-r--r-- | generic/tclLink.c | 9 | ||||
-rw-r--r-- | generic/tclMain.c | 6 | ||||
-rw-r--r-- | generic/tclNamesp.c | 8 | ||||
-rw-r--r-- | generic/tclObj.c | 20 | ||||
-rw-r--r-- | generic/tclPathObj.c | 4 | ||||
-rw-r--r-- | generic/tclProc.c | 19 | ||||
-rw-r--r-- | generic/tclResult.c | 14 | ||||
-rwxr-xr-x | generic/tclStrToD.c | 6 | ||||
-rw-r--r-- | generic/tclTrace.c | 6 |
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); |