summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclIO.c12
-rw-r--r--generic/tclIOCmd.c26
-rw-r--r--generic/tclNamesp.c116
-rw-r--r--generic/tclObj.c28
-rw-r--r--generic/tclPkg.c8
-rw-r--r--generic/tclResult.c7
-rw-r--r--generic/tclScan.c11
-rw-r--r--generic/tclTimer.c4
-rw-r--r--generic/tclTrace.c8
-rw-r--r--generic/tclUtil.c25
-rw-r--r--generic/tclVar.c44
11 files changed, 130 insertions, 159 deletions
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 13630ac..ca1c868 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.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: tclIO.c,v 1.78 2004/09/10 20:04:10 dkf Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.79 2004/10/06 15:59:23 dgp Exp $
*/
#include "tclInt.h"
@@ -7567,12 +7567,12 @@ TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
outStatePtr = outPtr->state;
if (inStatePtr->csPtr) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
+ Tcl_AppendResult(interp, "channel \"",
Tcl_GetChannelName(inChan), "\" is busy", NULL);
return TCL_ERROR;
}
if (outStatePtr->csPtr) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
+ Tcl_AppendResult(interp, "channel \"",
Tcl_GetChannelName(outChan), "\" is busy", NULL);
return TCL_ERROR;
}
@@ -7904,7 +7904,7 @@ CopyData(csPtr, mask)
result = TCL_ERROR;
} else {
Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), total);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(total));
}
}
return result;
@@ -8721,7 +8721,7 @@ Tcl_GetChannelNamesEx(interp, pattern)
* for this interpreter.
*/
hTblPtr = GetChannelTable(interp);
- resultPtr = Tcl_GetObjResult(interp);
+ resultPtr = Tcl_NewObj();
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
hPtr != (Tcl_HashEntry *) NULL;
@@ -8745,9 +8745,11 @@ Tcl_GetChannelNamesEx(interp, pattern)
if (((pattern == NULL) || Tcl_StringMatch(name, pattern)) &&
(Tcl_ListObjAppendElement(interp, resultPtr,
Tcl_NewStringObj(name, -1)) != TCL_OK)) {
+ Tcl_DecrRefCount(resultPtr);
return TCL_ERROR;
}
}
+ Tcl_SetObjResult(interp, resultPtr);
return TCL_OK;
}
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 1c6c8ae..73af20a 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.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: tclIOCmd.c,v 1.20 2004/07/16 22:37:28 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.21 2004/10/06 15:59:24 dgp Exp $
*/
#include "tclInt.h"
@@ -263,8 +263,7 @@ Tcl_GetsObjCmd(dummy, interp, objc, objv)
Tcl_DecrRefCount(linePtr);
return TCL_ERROR;
}
- resultPtr = Tcl_GetObjResult(interp);
- Tcl_SetIntObj(resultPtr, lineLen);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
return TCL_OK;
} else {
Tcl_SetObjResult(interp, linePtr);
@@ -497,7 +496,7 @@ Tcl_TellObjCmd(clientData, interp, objc, objv)
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
- Tcl_SetWideIntObj(Tcl_GetObjResult(interp), Tcl_Tell(chan));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_Tell(chan)));
return TCL_OK;
}
@@ -557,6 +556,10 @@ Tcl_CloseObjCmd(clientData, interp, objc, objv)
int len;
resultPtr = Tcl_GetObjResult(interp);
+ if (Tcl_IsShared(resultPtr)) {
+ resultPtr = Tcl_DuplicateObj(resultPtr);
+ Tcl_SetObjResult(interp, resultPtr);
+ }
string = Tcl_GetStringFromObj(resultPtr, &len);
if ((len > 0) && (string[len - 1] == '\n')) {
Tcl_SetObjLength(resultPtr, len - 1);
@@ -679,7 +682,7 @@ Tcl_EofObjCmd(unused, interp, objc, objv)
return TCL_ERROR;
}
- Tcl_SetBooleanObj(Tcl_GetObjResult(interp), Tcl_Eof(chan));
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_Eof(chan)));
return TCL_OK;
}
@@ -831,8 +834,7 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
*/
result = Tcl_Close(interp, chan);
- string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
- Tcl_AppendToObj(resultPtr, string, length);
+ Tcl_AppendObjToObj(resultPtr, Tcl_GetObjResult(interp));
/*
* If the last character of the result is a newline, then remove
@@ -891,12 +893,12 @@ Tcl_FblockedObjCmd(unused, interp, objc, objv)
return TCL_ERROR;
}
if ((mode & TCL_READABLE) == 0) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
+ Tcl_AppendResult(interp, "channel \"",
arg, "\" wasn't opened for reading", (char *) NULL);
return TCL_ERROR;
}
- Tcl_SetBooleanObj(Tcl_GetObjResult(interp), Tcl_InputBlocked(chan));
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_InputBlocked(chan)));
return TCL_OK;
}
@@ -1497,8 +1499,7 @@ Tcl_FcopyObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
if ((mode & TCL_READABLE) == 0) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
- arg,
+ Tcl_AppendResult(interp, "channel \"", arg,
"\" wasn't opened for reading", (char *) NULL);
return TCL_ERROR;
}
@@ -1508,8 +1509,7 @@ Tcl_FcopyObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
if ((mode & TCL_WRITABLE) == 0) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
- arg,
+ Tcl_AppendResult(interp, "channel \"", arg,
"\" wasn't opened for writing", (char *) NULL);
return TCL_ERROR;
}
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 3a86859..4c7a420 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -21,7 +21,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.60 2004/10/05 18:14:28 dgp Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.61 2004/10/06 15:59:24 dgp Exp $
*/
#include "tclInt.h"
@@ -628,8 +628,8 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
parentPtr = NULL;
simpleName = "";
} else if (*name == '\0') {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "can't create namespace \"\": only global namespace can have empty name", (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't create namespace \"\": only global namespace can have empty name", -1));
return NULL;
} else {
/*
@@ -657,8 +657,7 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
*/
if (Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "can't create namespace \"", name,
+ Tcl_AppendResult(interp, "can't create namespace \"", name,
"\": already exists", (char *) NULL);
return NULL;
}
@@ -1129,10 +1128,8 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
&exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "invalid export pattern \"", pattern,
- "\": pattern can't specify a namespace",
- (char *) NULL);
+ Tcl_AppendResult(interp, "invalid export pattern \"", pattern,
+ "\": pattern can't specify a namespace", (char *) NULL);
return TCL_ERROR;
}
@@ -1358,8 +1355,7 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
*/
if (strlen(pattern) == 0) {
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
- "empty import pattern", -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern", -1));
return TCL_ERROR;
}
TclGetNamespaceForQualName(interp, pattern, nsPtr,
@@ -1367,19 +1363,17 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
&importNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
if (importNsPtr == NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "unknown namespace in import pattern \"",
+ Tcl_AppendResult(interp, "unknown namespace in import pattern \"",
pattern, "\"", (char *) NULL);
return TCL_ERROR;
}
if (importNsPtr == nsPtr) {
if (pattern == simplePattern) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ Tcl_AppendResult(interp,
"no namespace specified in import pattern \"", pattern,
"\"", (char *) NULL);
} else {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "import pattern \"", pattern,
+ Tcl_AppendResult(interp, "import pattern \"", pattern,
"\" tries to import from namespace \"",
importNsPtr->name, "\" into itself", (char *) NULL);
}
@@ -1457,8 +1451,8 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
dataPtr = (ImportedCmdData *) link->objClientData;
link = dataPtr->realCmdPtr;
if (overwrite == link) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "import pattern \"", pattern,
+ Tcl_AppendResult(interp, "import pattern \"",
+ pattern,
"\" would create a loop containing ",
"command \"", Tcl_DStringValue(&ds),
"\"", (char *) NULL);
@@ -1489,8 +1483,7 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
refPtr->nextPtr = cmdPtr->importRefPtr;
cmdPtr->importRefPtr = refPtr;
} else {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "can't import command \"", cmdName,
+ Tcl_AppendResult(interp, "can't import command \"", cmdName,
"\": already exists", (char *) NULL);
return TCL_ERROR;
}
@@ -1562,7 +1555,7 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
&sourceNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
if (sourceNsPtr == NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ Tcl_AppendResult(interp,
"unknown namespace in namespace forget pattern \"",
pattern, "\"", (char *) NULL);
return TCL_ERROR;
@@ -2128,8 +2121,8 @@ Tcl_FindNamespace(interp, name, contextNsPtr, flags)
return (Tcl_Namespace *) nsPtr;
} else if (flags & TCL_LEAVE_ERR_MSG) {
Tcl_ResetResult(interp);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "unknown namespace \"", name, "\"", (char *) NULL);
+ Tcl_AppendResult(interp, "unknown namespace \"", name,
+ "\"", (char *) NULL);
}
return NULL;
}
@@ -2254,8 +2247,8 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags)
return (Tcl_Command) cmdPtr;
} else if (flags & TCL_LEAVE_ERR_MSG) {
Tcl_ResetResult(interp);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "unknown command \"", name, "\"", (char *) NULL);
+ Tcl_AppendResult(interp, "unknown command \"", name,
+ "\"", (char *) NULL);
}
return (Tcl_Command) NULL;
@@ -2381,8 +2374,8 @@ Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags)
return (Tcl_Var) varPtr;
} else if (flags & TCL_LEAVE_ERR_MSG) {
Tcl_ResetResult(interp);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "unknown variable \"", name, "\"", (char *) NULL);
+ Tcl_AppendResult(interp, "unknown variable \"", name,
+ "\"", (char *) NULL);
}
return (Tcl_Var) NULL;
}
@@ -2826,8 +2819,8 @@ NamespaceChildrenCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
if (namespacePtr == NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "unknown namespace \"", TclGetString(objv[2]),
+ Tcl_AppendResult(interp, "unknown namespace \"",
+ TclGetString(objv[2]),
"\" in namespace children command", (char *) NULL);
return TCL_ERROR;
}
@@ -3017,9 +3010,9 @@ NamespaceCurrentCmd(dummy, interp, objc, objv)
currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
if (currNsPtr == (Namespace *) Tcl_GetGlobalNamespace(interp)) {
- Tcl_AppendToObj(Tcl_GetObjResult(interp), "::", -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("::", 2));
} else {
- Tcl_AppendToObj(Tcl_GetObjResult(interp), currNsPtr->fullName, -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(currNsPtr->fullName, -1));
}
return TCL_OK;
}
@@ -3083,8 +3076,8 @@ NamespaceDeleteCmd(dummy, interp, objc, objv)
namespacePtr = Tcl_FindNamespace(interp, name,
(Tcl_Namespace *) NULL, /*flags*/ 0);
if (namespacePtr == NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "unknown namespace \"", TclGetString(objv[i]),
+ Tcl_AppendResult(interp, "unknown namespace \"",
+ TclGetString(objv[i]),
"\" in namespace delete command", (char *) NULL);
return TCL_ERROR;
}
@@ -3265,7 +3258,7 @@ NamespaceExistsCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- Tcl_SetBooleanObj(Tcl_GetObjResult(interp), (namespacePtr != NULL));
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(namespacePtr != NULL));
return TCL_OK;
}
@@ -3573,8 +3566,7 @@ NamespaceInscopeCmd(dummy, interp, objc, objv)
return result;
}
if (namespacePtr == NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "unknown namespace \"", TclGetString(objv[2]),
+ Tcl_AppendResult(interp, "unknown namespace \"", TclGetString(objv[2]),
"\" in inscope namespace command", (char *) NULL);
return TCL_ERROR;
}
@@ -3671,6 +3663,7 @@ NamespaceOriginCmd(dummy, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Tcl_Command command, origCommand;
+ Tcl_Obj *resultPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "name");
@@ -3679,12 +3672,12 @@ NamespaceOriginCmd(dummy, interp, objc, objv)
command = Tcl_GetCommandFromObj(interp, objv[2]);
if (command == (Tcl_Command) NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "invalid command name \"", TclGetString(objv[2]),
- "\"", (char *) NULL);
+ Tcl_AppendResult(interp, "invalid command name \"",
+ TclGetString(objv[2]), "\"", (char *) NULL);
return TCL_ERROR;
}
origCommand = TclGetOriginalCommand(command);
+ resultPtr = Tcl_NewObj();
if (origCommand == (Tcl_Command) NULL) {
/*
* The specified command isn't an imported command. Return the
@@ -3692,10 +3685,11 @@ NamespaceOriginCmd(dummy, interp, objc, objv)
* was defined in.
*/
- Tcl_GetCommandFullName(interp, command, Tcl_GetObjResult(interp));
+ Tcl_GetCommandFullName(interp, command, resultPtr);
} else {
- Tcl_GetCommandFullName(interp, origCommand, Tcl_GetObjResult(interp));
+ Tcl_GetCommandFullName(interp, origCommand, resultPtr);
}
+ Tcl_SetObjResult(interp, resultPtr);
return TCL_OK;
}
@@ -3738,8 +3732,8 @@ NamespaceParentCmd(dummy, interp, objc, objv)
return result;
}
if (nsPtr == NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "unknown namespace \"", TclGetString(objv[2]),
+ Tcl_AppendResult(interp, "unknown namespace \"",
+ TclGetString(objv[2]),
"\" in namespace parent command", (char *) NULL);
return TCL_ERROR;
}
@@ -3753,8 +3747,8 @@ NamespaceParentCmd(dummy, interp, objc, objv)
*/
if (nsPtr->parentPtr != NULL) {
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
- nsPtr->parentPtr->fullName, -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ nsPtr->parentPtr->fullName, -1));
}
return TCL_OK;
}
@@ -3821,7 +3815,7 @@ NamespaceQualifiersCmd(dummy, interp, objc, objv)
if (p >= name) {
length = p-name+1;
- Tcl_AppendToObj(Tcl_GetObjResult(interp), name, length);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(name, length));
}
return TCL_OK;
}
@@ -3883,7 +3877,7 @@ NamespaceTailCmd(dummy, interp, objc, objv)
}
if (p >= name) {
- Tcl_AppendToObj(Tcl_GetObjResult(interp), p, -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(p, -1));
}
return TCL_OK;
}
@@ -3921,6 +3915,7 @@ NamespaceWhichCmd(dummy, interp, objc, objv)
"-command", "-variable", NULL
};
int lookupType = 0;
+ Tcl_Obj *resultPtr;
if (objc < 3 || objc > 4) {
badArgs:
@@ -3941,24 +3936,25 @@ NamespaceWhichCmd(dummy, interp, objc, objv)
}
}
+ resultPtr = Tcl_NewObj();
switch (lookupType) {
case 0: { /* -command */
Tcl_Command cmd = Tcl_GetCommandFromObj(interp, objv[objc-1]);
- if (cmd == (Tcl_Command) NULL) {
- return TCL_OK; /* cmd not found, just return (no error) */
+ if (cmd != (Tcl_Command) NULL) {
+ Tcl_GetCommandFullName(interp, cmd, resultPtr);
}
- Tcl_GetCommandFullName(interp, cmd, Tcl_GetObjResult(interp));
break;
}
case 1: { /* -variable */
Tcl_Var var = Tcl_FindNamespaceVar(interp,
TclGetString(objv[objc-1]), NULL, /*flags*/ 0);
if (var != (Tcl_Var) NULL) {
- Tcl_GetVariableFullName(interp, var, Tcl_GetObjResult(interp));
+ Tcl_GetVariableFullName(interp, var, resultPtr);
}
break;
}
}
+ Tcl_SetObjResult(interp, resultPtr);
return TCL_OK;
}
@@ -4470,8 +4466,8 @@ NamespaceEnsembleCmd(dummy, interp, objc, objv)
Tcl_WrongNumArgs(interp, 3, objv, "cmdname");
return TCL_ERROR;
}
- Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
- FindEnsemble(interp, objv[3], 0) != NULL);
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+ FindEnsemble(interp, objv[3], 0) != NULL));
return TCL_OK;
case ENS_CONFIG:
@@ -5106,26 +5102,24 @@ NsEnsembleImplementationCmd(clientData, interp, objc, objv)
Tcl_ResetResult(interp);
if (ensemblePtr->subcommandTable.numEntries == 0) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "unknown subcommand \"", TclGetString(objv[1]),
+ Tcl_AppendResult(interp, "unknown subcommand \"", TclGetString(objv[1]),
"\": namespace ", ensemblePtr->nsPtr->fullName,
" does not export any commands", NULL);
return TCL_ERROR;
}
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "unknown ",
+ Tcl_AppendResult(interp, "unknown ",
(ensemblePtr->flags & ENS_PREFIX ? "or ambiguous " : ""),
"subcommand \"", TclGetString(objv[1]), "\": must be ", NULL);
if (ensemblePtr->subcommandTable.numEntries == 1) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- ensemblePtr->subcommandArrayPtr[0], NULL);
+ Tcl_AppendResult(interp, ensemblePtr->subcommandArrayPtr[0], NULL);
} else {
int i;
for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ Tcl_AppendResult(interp,
ensemblePtr->subcommandArrayPtr[i], ", ", NULL);
}
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "or ", ensemblePtr->subcommandArrayPtr[i], NULL);
+ Tcl_AppendResult(interp, "or ",
+ ensemblePtr->subcommandArrayPtr[i], NULL);
}
return TCL_ERROR;
}
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 9154690..d7dd7b1 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.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: tclObj.c,v 1.71 2004/10/01 12:45:20 dkf Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.72 2004/10/06 15:59:25 dgp Exp $
*/
#include "tclInt.h"
@@ -1936,9 +1936,9 @@ Tcl_GetIntFromObj(interp, objPtr, intPtr)
tooBig:
#endif
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "integer value too large to represent as non-long integer", -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "integer value too large to represent as non-long integer",
+ -1));
}
return TCL_ERROR;
}
@@ -1972,9 +1972,8 @@ SetIntFromAny(interp, objPtr)
}
if (objPtr->typePtr != &tclIntType) {
if (interp != NULL) {
- char *s = "integer value too large to represent";
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
+ CONST char *s = "integer value too large to represent";
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
}
return TCL_ERROR;
@@ -2056,9 +2055,8 @@ SetIntOrWideFromAny(interp, objPtr)
}
if (errno == ERANGE) {
if (interp != NULL) {
- char *s = "integer value too large to represent";
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
+ CONST char *s = "integer value too large to represent";
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
}
return TCL_ERROR;
@@ -2357,9 +2355,8 @@ Tcl_GetLongFromObj(interp, objPtr, longPtr)
return TCL_OK;
} else {
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "integer value too large to represent", -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "integer value too large to represent", -1));
}
return TCL_ERROR;
}
@@ -2444,9 +2441,8 @@ SetWideIntFromAny(interp, objPtr)
}
if (errno == ERANGE) {
if (interp != NULL) {
- char *s = "integer value too large to represent";
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
+ CONST char *s = "integer value too large to represent";
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *) NULL);
}
return TCL_ERROR;
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 913b5ad..a58feb4 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.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: tclPkg.c,v 1.10 2003/12/24 04:18:20 davygrvy Exp $
+ * RCS: @(#) $Id: tclPkg.c,v 1.11 2004/10/06 15:59:25 dgp Exp $
*/
#include "tclInt.h"
@@ -758,8 +758,8 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
|| (CheckVersion(interp, argv3) != TCL_OK)) {
return TCL_ERROR;
}
- Tcl_SetIntObj(Tcl_GetObjResult(interp),
- ComparePkgVersions(argv2, argv3, (int *) NULL));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ ComparePkgVersions(argv2, argv3, (int *) NULL)));
break;
}
case PKG_VERSIONS: {
@@ -790,7 +790,7 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
ComparePkgVersions(argv2, argv3, &satisfies);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), satisfies);
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(satisfies));
break;
}
default: {
diff --git a/generic/tclResult.c b/generic/tclResult.c
index e15efce..9870501 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.13 2004/10/05 23:21:26 dkf Exp $
+ * RCS: @(#) $Id: tclResult.c,v 1.14 2004/10/06 15:59:25 dgp Exp $
*/
#include "tclInt.h"
@@ -540,10 +540,7 @@ Tcl_AppendElement(interp, stringPtr)
* string result, then reset the object result.
*/
- if (*(iPtr->result) == 0) {
- Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
- TCL_VOLATILE);
- }
+ (void) Tcl_GetStringResult(interp);
/*
* See how much space is needed, and grow the append buffer if
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 69e4170..624910c 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.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: tclScan.c,v 1.15 2004/08/19 20:59:00 dkf Exp $
+ * RCS: @(#) $Id: tclScan.c,v 1.16 2004/10/06 15:59:25 dgp Exp $
*/
#include "tclInt.h"
@@ -396,7 +396,7 @@ ValidateFormat(interp, format, numVars, totalSubs)
if (flags & SCAN_LONGER) {
invalidLonger:
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ Tcl_AppendResult(interp,
"'l' modifier may not be specified in %", buf,
" conversion", NULL);
goto error;
@@ -452,8 +452,8 @@ ValidateFormat(interp, format, numVars, totalSubs)
char buf[TCL_UTF_MAX+1];
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "bad scan conversion character \"", buf, "\"", NULL);
+ Tcl_AppendResult(interp, "bad scan conversion character \"",
+ buf, "\"", NULL);
goto error;
}
}
@@ -1167,8 +1167,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv)
result++;
if (Tcl_ObjSetVar2(interp, objv[i+3], NULL,
objs[i], 0) == NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "couldn't set variable \"",
+ Tcl_AppendResult(interp, "couldn't set variable \"",
Tcl_GetString(objv[i+3]), "\"", (char *) NULL);
code = TCL_ERROR;
}
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index 3093ac6..8c5a210 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTimer.c,v 1.11 2004/09/07 18:24:48 kennykb Exp $
+ * RCS: @(#) $Id: tclTimer.c,v 1.12 2004/10/06 15:59:25 dgp Exp $
*/
#include "tclInt.h"
@@ -917,7 +917,7 @@ processInteger:
"\" doesn't exist", (char *) NULL);
return TCL_ERROR;
}
- resultListPtr = Tcl_GetObjResult(interp);
+ resultListPtr = Tcl_NewObj();
Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr);
Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
(afterPtr->token == NULL) ? "idle" : "timer", -1));
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index dc8cbd3..2b0f10f 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.14 2004/10/05 18:14:28 dgp Exp $
+ * RCS: @(#) $Id: tclTrace.c,v 1.15 2004/10/06 15:59:25 dgp Exp $
*/
#include "tclInt.h"
@@ -356,7 +356,7 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
Tcl_WrongNumArgs(interp, 2, objv, "name");
return TCL_ERROR;
}
- resultListPtr = Tcl_GetObjResult(interp);
+ resultListPtr = Tcl_NewObj();
clientData = 0;
name = Tcl_GetString(objv[2]);
while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
@@ -978,7 +978,7 @@ TclTraceVariableObjCmd(interp, optionIndex, objc, objv)
return TCL_ERROR;
}
- resultListPtr = Tcl_GetObjResult(interp);
+ resultListPtr = Tcl_NewObj();
clientData = 0;
name = Tcl_GetString(objv[3]);
while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
@@ -1995,7 +1995,7 @@ TraceVarProc(clientData, interp, name1, name2, flags)
code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
Tcl_DStringLength(&cmd), 0);
if (code != TCL_OK) { /* copy error msg to result */
- register Tcl_Obj *errMsgObj = Tcl_GetObjResult(interp);
+ Tcl_Obj *errMsgObj = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(errMsgObj);
result = (char *) errMsgObj;
}
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 819f3b5..1a4b841 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUtil.c,v 1.46 2004/09/29 22:17:29 dkf Exp $
+ * RCS: @(#) $Id: tclUtil.c,v 1.47 2004/10/06 15:59:25 dgp Exp $
*/
#include "tclInt.h"
@@ -1764,10 +1764,7 @@ Tcl_DStringGetResult(interp, dsPtr)
* string result, then reset the object result.
*/
- if (*(iPtr->result) == 0) {
- Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
- TCL_VOLATILE);
- }
+ (void) Tcl_GetStringResult(interp);
dsPtr->length = strlen(iPtr->result);
if (iPtr->freeProc != NULL) {
@@ -2331,10 +2328,8 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr)
* because this is an error-generation path anyway.
*/
Tcl_ResetResult(interp);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "bad index \"", bytes,
- "\": must be integer or end?-integer?",
- (char *) NULL);
+ Tcl_AppendResult(interp, "bad index \"", bytes,
+ "\": must be integer or end?-integer?", (char *) NULL);
if (!strncmp(bytes, "end-", 3)) {
bytes += 3;
}
@@ -2426,10 +2421,8 @@ SetEndOffsetFromAny(interp, objPtr)
(size_t)((length > 3) ? 3 : length)) != 0)) {
if (interp != NULL) {
Tcl_ResetResult(interp);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "bad index \"", bytes,
- "\": must be end?-integer?",
- (char*) NULL);
+ Tcl_AppendResult(interp, "bad index \"", bytes,
+ "\": must be end?-integer?", (char*) NULL);
}
return TCL_ERROR;
}
@@ -2453,10 +2446,8 @@ SetEndOffsetFromAny(interp, objPtr)
*/
if (interp != NULL) {
Tcl_ResetResult(interp);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "bad index \"", bytes,
- "\": must be integer or end?-integer?",
- (char *) NULL);
+ Tcl_AppendResult(interp, "bad index \"", bytes,
+ "\": must be integer or end?-integer?", (char *) NULL);
}
return TCL_ERROR;
}
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 9f9985f..a51d7dd 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.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: tclVar.c,v 1.94 2004/10/06 09:48:40 dkf Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.95 2004/10/06 15:59:26 dgp Exp $
*/
#ifdef STDC_HEADERS
@@ -2676,7 +2676,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
Interp *iPtr = (Interp *) interp;
Var *varPtr, *arrayPtr;
Tcl_HashEntry *hPtr;
- Tcl_Obj *resultPtr, *varNamePtr;
+ Tcl_Obj *varNamePtr;
int notArray;
char *varName;
int index, result;
@@ -2727,13 +2727,6 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
notArray = 1;
}
- /*
- * We have to wait to get the resultPtr until here because
- * TclCallVarTraces can affect the result.
- */
-
- resultPtr = Tcl_GetObjResult(interp);
-
switch (index) {
case ARRAY_ANYMORE: {
ArraySearch *searchPtr;
@@ -2761,11 +2754,11 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
}
searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search);
if (searchPtr->nextEntry == NULL) {
- Tcl_SetIntObj(resultPtr, 0);
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
return TCL_OK;
}
}
- Tcl_SetIntObj(resultPtr, 1);
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
break;
}
case ARRAY_DONESEARCH: {
@@ -2802,7 +2795,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
return TCL_ERROR;
}
- Tcl_SetIntObj(resultPtr, !notArray);
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(!notArray));
break;
}
case ARRAY_GET: {
@@ -2914,7 +2907,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
Var *varPtr2;
char *pattern = NULL;
char *name;
- Tcl_Obj *namePtr;
+ Tcl_Obj *namePtr, *resultPtr;
int mode, matched = 0;
static CONST char *options[] = {
"-exact", "-glob", "-regexp", (char *) NULL
@@ -2940,6 +2933,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
}
+ resultPtr = Tcl_NewObj();
for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
@@ -2959,6 +2953,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
matched = Tcl_RegExpMatch(interp, name,
pattern);
if (matched < 0) {
+ Tcl_DecrRefCount(resultPtr);
return TCL_ERROR;
}
break;
@@ -2974,6 +2969,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
Tcl_DecrRefCount(namePtr); /* free unneeded name obj */
return result;
}
+ Tcl_SetObjResult(interp, resultPtr);
}
break;
}
@@ -3010,8 +3006,8 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
break;
}
}
- Tcl_SetStringObj(resultPtr,
- Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), -1));
break;
}
case ARRAY_SET: {
@@ -3042,7 +3038,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
size++;
}
}
- Tcl_SetIntObj(resultPtr, size);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(size));
break;
}
case ARRAY_STARTSEARCH: {
@@ -3058,15 +3054,13 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
searchPtr = (ArraySearch *) ckalloc(sizeof(ArraySearch));
if (varPtr->searchPtr == NULL) {
searchPtr->id = 1;
- Tcl_AppendStringsToObj(resultPtr, "s-1-", varName,
- (char *) NULL);
+ Tcl_AppendResult(interp, "s-1-", varName, NULL);
} else {
char string[TCL_INTEGER_SPACE];
searchPtr->id = varPtr->searchPtr->id + 1;
TclFormatInt(string, searchPtr->id);
- Tcl_AppendStringsToObj(resultPtr, "s-", string, "-", varName,
- (char *) NULL);
+ Tcl_AppendResult(interp, "s-", string, "-", varName, NULL);
}
searchPtr->varPtr = varPtr;
searchPtr->nextEntry = Tcl_FirstHashEntry(varPtr->value.tablePtr,
@@ -3085,7 +3079,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
stats = Tcl_HashStats(varPtr->value.tablePtr);
if (stats != NULL) {
- Tcl_SetStringObj(Tcl_GetObjResult(interp), stats, -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1));
ckfree((void *)stats);
} else {
Tcl_SetResult(interp, "error reading array statistics",
@@ -3139,8 +3133,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
return TCL_OK;
error:
- Tcl_AppendStringsToObj(resultPtr, "\"", varName, "\" isn't an array",
- (char *) NULL);
+ Tcl_AppendResult(interp, "\"", varName, "\" isn't an array", NULL);
return TCL_ERROR;
}
@@ -3253,9 +3246,8 @@ TclArraySet(interp, arrayNameObj, arrayElemObj)
return result;
}
if (elemLen & 1) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "list must have an even number of elements", -1);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "list must have an even number of elements", -1));
return TCL_ERROR;
}
if (elemLen == 0) {
generated by cgit v0.12 at 2024-11-05 09:34:40 (GMT)