From b0e29724338467351f10a4b11e317a5866ac658f Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 6 Oct 2004 15:59:22 +0000 Subject: * generic/tclBasic.c: * generic/tclBinary.c: * generic/tclCmdAH.c: * generic/tclCmdIL.c: * generic/tclCmdMZ.c: * generic/tclCompExpr.c: * generic/tclDictObj.c: * generic/tclEncoding.c: * generic/tclExecute.c: * generic/tclFCmd.c: * generic/tclHistory.c: * generic/tclIndexObj.c: * generic/tclInterp.c: * generic/tclIO.c: * generic/tclIOCmd.c: * generic/tclNamesp.c: * generic/tclObj.c: * generic/tclPkg.c: * generic/tclResult.c: * generic/tclScan.c: * generic/tclTimer.c: * generic/tclTrace.c: * generic/tclUtil.c: * generic/tclVar.c: It is a poor practice to directly set or append to the value of the objResult of an interp, because that value might be shared, and in that circumstance a Tcl_Panic() will be the result. Searched for example of this practice and replaced with safer alternatives, often using the Tcl_AppendResult() routine that dkf just rehabilitated. --- ChangeLog | 11 +++++ generic/tclIO.c | 12 +++--- generic/tclIOCmd.c | 26 ++++++------ generic/tclNamesp.c | 116 +++++++++++++++++++++++++--------------------------- generic/tclObj.c | 28 ++++++------- generic/tclPkg.c | 8 ++-- generic/tclResult.c | 7 +--- generic/tclScan.c | 11 +++-- generic/tclTimer.c | 4 +- generic/tclTrace.c | 8 ++-- generic/tclUtil.c | 25 ++++------- generic/tclVar.c | 44 ++++++++------------ 12 files changed, 141 insertions(+), 159 deletions(-) diff --git a/ChangeLog b/ChangeLog index 0e1ff18..4ad351b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -23,6 +23,17 @@ * generic/tclHistory.c: * generic/tclIndexObj.c: * generic/tclInterp.c: + * generic/tclIO.c: + * generic/tclIOCmd.c: + * generic/tclNamesp.c: + * generic/tclObj.c: + * generic/tclPkg.c: + * generic/tclResult.c: + * generic/tclScan.c: + * generic/tclTimer.c: + * generic/tclTrace.c: + * generic/tclUtil.c: + * generic/tclVar.c: It is a poor practice to directly set or append to the value of the objResult of an interp, because that value might be shared, and in that circumstance a Tcl_Panic() will be the 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 ; isubcommandTable.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) { -- cgit v0.12