From 604e737b0d1ae40d2f45da85bb5dd7cbf096cad7 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 6 Oct 2004 14:59:00 +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: 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 | 6 ++++ generic/tclEncoding.c | 11 ++----- generic/tclExecute.c | 74 ++++++++++++++++++++--------------------------- generic/tclFCmd.c | 7 ++--- generic/tclHistory.c | 5 ++-- generic/tclIndexObj.c | 6 ++-- generic/tclInterp.c | 80 ++++++++++++++++++++++++--------------------------- 7 files changed, 85 insertions(+), 104 deletions(-) diff --git a/ChangeLog b/ChangeLog index 91c6a87..0e1ff18 100644 --- a/ChangeLog +++ b/ChangeLog @@ -17,6 +17,12 @@ * 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: 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/tclEncoding.c b/generic/tclEncoding.c index 558487e..58d898b 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.23 2004/06/18 20:38:01 dgp Exp $ + * RCS: @(#) $Id: tclEncoding.c,v 1.24 2004/10/06 14:59:00 dgp Exp $ */ #include "tclInt.h" @@ -629,13 +629,7 @@ Tcl_GetEncodingNames(interp) Tcl_DecrRefCount(encodingObj); } - /* - * Clear any values placed in the result by globbing. - */ - - Tcl_ResetResult(interp); - resultPtr = Tcl_GetObjResult(interp); - + resultPtr = Tcl_NewObj(); hPtr = Tcl_FirstHashEntry(&table, &search); while (hPtr != NULL) { Tcl_Obj *strPtr; @@ -645,6 +639,7 @@ Tcl_GetEncodingNames(interp) hPtr = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&table); + Tcl_SetObjResult(interp, resultPtr); } /* diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 138d25e..7d92376 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.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: tclExecute.c,v 1.153 2004/09/24 01:14:42 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.154 2004/10/06 14:59:01 dgp Exp $ */ #ifdef STDC_HEADERS @@ -4691,8 +4691,7 @@ TclExecuteByteCode(interp, codePtr) divideByZero: DECACHE_STACK_INFO(); - Tcl_ResetResult(interp); - Tcl_AppendToObj(Tcl_GetObjResult(interp), "divide by zero", -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1)); Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", (char *) NULL); CACHE_STACK_INFO(); @@ -4707,9 +4706,8 @@ TclExecuteByteCode(interp, codePtr) exponOfZero: DECACHE_STACK_INFO(); - Tcl_ResetResult(interp); - Tcl_AppendToObj(Tcl_GetObjResult(interp), - "exponentiation of zero by negative power", -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "exponentiation of zero by negative power", -1)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "exponentiation of zero by negative power", (char *) NULL); CACHE_STACK_INFO(); @@ -5109,9 +5107,8 @@ IllegalExprOperandType(interp, pc, opndPtr) Tcl_ResetResult(interp); if ((opndPtr->bytes == NULL) || (opndPtr->length == 0)) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "can't use empty string as operand of \"", operator, "\"", - (char *) NULL); + Tcl_AppendResult(interp, "can't use empty string as operand of \"", + operator, "\"", (char *) NULL); } else { char *msg = "non-numeric string"; char *s, *p; @@ -5209,8 +5206,8 @@ IllegalExprOperandType(interp, pc, opndPtr) } } makeErrorMessage: - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't use ", - msg, " as operand of \"", operator, "\"", (char *) NULL); + Tcl_AppendResult(interp, "can't use ", msg, " as operand of \"", + operator, "\"", (char *) NULL); } } @@ -5477,15 +5474,14 @@ VerifyExprObjType(interp, objPtr) result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, objPtr, &d); } if ((result != TCL_OK) && (interp != NULL)) { - Tcl_ResetResult(interp); if (TclCheckBadOctal((Tcl_Interp *) NULL, s)) { - Tcl_AppendToObj(Tcl_GetObjResult(interp), + Tcl_SetObjResult(interp, Tcl_NewStringObj( "argument to math function was an invalid octal number", - -1); + -1)); } else { - Tcl_AppendToObj(Tcl_GetObjResult(interp), + Tcl_SetObjResult(interp, Tcl_NewStringObj( "argument to math function didn't have numeric value", - -1); + -1)); } } return result; @@ -5632,9 +5628,8 @@ ExprAbsFunc(interp, tosPtr, clientData) if (i < 0) { iResult = -i; if (iResult < 0) { - 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)); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", "integer value too large to represent", (char *) NULL); return TCL_ERROR; @@ -5649,9 +5644,8 @@ ExprAbsFunc(interp, tosPtr, clientData) if (w < W0) { wResult = -w; if (wResult < 0) { - 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)); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", "integer value too large to represent", (char *) NULL); return TCL_ERROR; @@ -5740,9 +5734,8 @@ ExprIntFunc(interp, tosPtr, clientData) if (d < 0.0) { if (d < (double) (long) LONG_MIN) { tooLarge: - 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)); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", "integer value too large to represent", (char *) NULL); return TCL_ERROR; @@ -5798,9 +5791,8 @@ ExprWideFunc(interp, tosPtr, clientData) if (d < 0.0) { if (d < Tcl_WideAsDouble(LLONG_MIN)) { tooLarge: - 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)); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", "integer value too large to represent", (char *) NULL); return TCL_ERROR; @@ -5969,9 +5961,8 @@ ExprRoundFunc(interp, tosPtr, clientData) */ tooLarge: - 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)); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", "integer value too large to represent", (char *) NULL); @@ -6008,10 +5999,8 @@ ExprSrandFunc(interp, tosPtr, clientData) /* * At this point, the only other possible type is double */ - Tcl_ResetResult(interp); - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "can't use floating-point value as argument to srand", - (char *) NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't use floating-point value as argument to srand", -1)); return TCL_ERROR; } @@ -6088,8 +6077,8 @@ ExprCallMathFunc(interp, objc, objv) funcName = TclGetString(objv[0]); hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName); if (hPtr == NULL) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "unknown math function \"", funcName, "\"", (char *) NULL); + Tcl_AppendResult(interp, "unknown math function \"", funcName, + "\"", (char *) NULL); return TCL_ERROR; } mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr); @@ -6221,28 +6210,27 @@ TclExprFloatError(interp, value) double value; /* Value returned after error; used to * distinguish underflows from overflows. */ { - char *s; + CONST char *s; - Tcl_ResetResult(interp); if ((errno == EDOM) || IS_NAN(value)) { s = "domain error: argument not in valid range"; - Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, (char *) NULL); } else if ((errno == ERANGE) || IS_INF(value)) { if (value == 0.0) { s = "floating-point value too small to represent"; - Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, (char *) NULL); } else { s = "floating-point value too large to represent"; - Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *) NULL); } } else { char msg[64 + TCL_INTEGER_SPACE]; sprintf(msg, "unknown floating-point error, errno = %d", errno); - Tcl_AppendToObj(Tcl_GetObjResult(interp), msg, -1); + Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", msg, (char *) NULL); } } diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index 3d0bb95..17959fc 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.27 2004/10/06 13:09:43 dkf Exp $ + * RCS: @(#) $Id: tclFCmd.c,v 1.28 2004/10/06 14:59:02 dgp Exp $ */ #include "tclInt.h" @@ -936,9 +936,8 @@ TclFileAttrsCmd(interp, objc, objv) * There was an error, probably that the filePtr is * not accepted by any filesystem */ - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "could not read \"", Tcl_GetString(filePtr), - "\": ", Tcl_PosixError(interp), + Tcl_AppendResult(interp, "could not read \"", + Tcl_GetString(filePtr), "\": ", Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } diff --git a/generic/tclHistory.c b/generic/tclHistory.c index 4598a6a..784a31d 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.6 2004/05/13 12:59:22 dkf Exp $ + * RCS: @(#) $Id: tclHistory.c,v 1.7 2004/10/06 14:59:02 dgp Exp $ */ #include "tclInt.h" @@ -65,8 +65,7 @@ Tcl_RecordAndEval(interp, cmd, flags) * then reset the object result. */ - Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), - TCL_VOLATILE); + (void) Tcl_GetStringResult(interp); /* * Discard the Tcl object created to hold the command. diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index f752a91..22397af 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.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: tclIndexObj.c,v 1.19 2004/09/29 22:17:31 dkf Exp $ + * RCS: @(#) $Id: tclIndexObj.c,v 1.20 2004/10/06 14:59:02 dgp Exp $ */ #include "tclInt.h" @@ -314,9 +314,9 @@ SetIndexFromAny(interp, objPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr; /* The object to convert. */ { - Tcl_AppendToObj(Tcl_GetObjResult(interp), + Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't convert value to index except via Tcl_GetIndexFromObj API", - -1); + -1)); return TCL_ERROR; } diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 969b546..5ba48ab 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.45 2004/09/14 17:45:36 msofer Exp $ + * RCS: @(#) $Id: tclInterp.c,v 1.46 2004/10/06 14:59:02 dgp Exp $ */ #include "tclInt.h" @@ -694,10 +694,8 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv) if (slaveInterp == NULL) { return TCL_ERROR; } else if (slaveInterp == interp) { - Tcl_ResetResult(interp); - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "cannot delete the current interpreter", - (char *) NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "cannot delete the current interpreter", -1)); return TCL_ERROR; } iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo; @@ -732,7 +730,7 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv) Tcl_ResetResult(interp); exists = 0; } - Tcl_SetIntObj(Tcl_GetObjResult(interp), exists); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(exists)); return TCL_OK; } case OPT_EXPOSE: { @@ -779,7 +777,8 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv) if (slaveInterp == NULL) { return TCL_ERROR; } - Tcl_SetIntObj(Tcl_GetObjResult(interp), Tcl_IsSafe(slaveInterp)); + Tcl_SetObjResult(interp, + Tcl_NewBooleanObj(Tcl_IsSafe(slaveInterp))); return TCL_OK; } case OPT_INVOKEHID: { @@ -897,13 +896,14 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv) return TCL_ERROR; } iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo; - resultPtr = Tcl_GetObjResult(interp); + resultPtr = Tcl_NewObj(); hPtr = Tcl_FirstHashEntry(&iiPtr->master.slaveTable, &hashSearch); for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) { string = Tcl_GetHashKey(&iiPtr->master.slaveTable, hPtr); Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewStringObj(string, -1)); } + Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } case OPT_SHARE: { @@ -954,18 +954,16 @@ Tcl_InterpObjCmd(clientData, interp, objc, objv) iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo; hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName); if (hPtr == NULL) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "alias \"", aliasName, "\" in path \"", - Tcl_GetString(objv[2]), "\" not found", - (char *) NULL); + Tcl_AppendResult(interp, "alias \"", aliasName, + "\" in path \"", Tcl_GetString(objv[2]), + "\" not found", (char *) NULL); return TCL_ERROR; } aliasPtr = (Alias *) Tcl_GetHashValue(hPtr); if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) { Tcl_ResetResult(interp); - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "target interpreter for alias \"", aliasName, - "\" in path \"", Tcl_GetString(objv[2]), + Tcl_AppendResult(interp, "target interpreter for alias \"", + aliasName, "\" in path \"", Tcl_GetString(objv[2]), "\" is not my descendant", (char *) NULL); return TCL_ERROR; } @@ -1175,8 +1173,8 @@ Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr, iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo; hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName); if (hPtr == NULL) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "alias \"", aliasName, "\" not found", (char *) NULL); + Tcl_AppendResult(interp, "alias \"", aliasName, + "\" not found", (char *) NULL); return TCL_ERROR; } aliasPtr = (Alias *) Tcl_GetHashValue(hPtr); @@ -1237,8 +1235,8 @@ Tcl_GetAliasObj(interp, aliasName, targetInterpPtr, targetNamePtr, objcPtr, iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo; hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName); if (hPtr == (Tcl_HashEntry *) NULL) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "alias \"", aliasName, "\" not found", (char *) NULL); + Tcl_AppendResult(interp, "alias \"", aliasName, + "\" not found", (char *) NULL); return TCL_ERROR; } aliasPtr = (Alias *) Tcl_GetHashValue(hPtr); @@ -1326,8 +1324,7 @@ TclPreventAliasLoop(interp, cmdInterp, cmd) * [Bug #641195] */ - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "cannot define or rename alias \"", + Tcl_AppendResult(interp, "cannot define or rename alias \"", Tcl_GetCommandName(cmdInterp, cmd), "\": interpreter deleted", (char *) NULL); return TCL_ERROR; @@ -1342,8 +1339,7 @@ TclPreventAliasLoop(interp, cmdInterp, cmd) } aliasCmdPtr = (Command *) aliasCmd; if (aliasCmdPtr == cmdPtr) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "cannot define or rename alias \"", + Tcl_AppendResult(interp, "cannot define or rename alias \"", Tcl_GetCommandName(cmdInterp, cmd), "\": would create a loop", (char *) NULL); return TCL_ERROR; @@ -1564,7 +1560,7 @@ AliasDelete(interp, slaveInterp, namePtr) slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave; hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, Tcl_GetString(namePtr)); if (hPtr == NULL) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "alias \"", + Tcl_AppendResult(interp, "alias \"", Tcl_GetString(namePtr), "\" not found", NULL); return TCL_ERROR; } @@ -1643,18 +1639,18 @@ AliasList(interp, slaveInterp) { Tcl_HashEntry *entryPtr; Tcl_HashSearch hashSearch; - Tcl_Obj *resultPtr; + Tcl_Obj *resultPtr = Tcl_NewObj(); Alias *aliasPtr; Slave *slavePtr; slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave; - resultPtr = Tcl_GetObjResult(interp); entryPtr = Tcl_FirstHashEntry(&slavePtr->aliasTable, &hashSearch); for ( ; entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&hashSearch)) { aliasPtr = (Alias *) Tcl_GetHashValue(entryPtr); Tcl_ListObjAppendElement(NULL, resultPtr, aliasPtr->token); } + Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } @@ -1982,8 +1978,7 @@ GetInterp(interp, pathPtr) } } if (searchInterp == NULL) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "could not find interpreter \"", + Tcl_AppendResult(interp, "could not find interpreter \"", Tcl_GetString(pathPtr), "\"", (char *) NULL); } return searchInterp; @@ -2048,8 +2043,7 @@ SlaveCreate(interp, pathPtr, safe) masterInfoPtr = (InterpInfo *) ((Interp *) masterInterp)->interpInfo; hPtr = Tcl_CreateHashEntry(&masterInfoPtr->master.slaveTable, path, &new); if (new == 0) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "interpreter named \"", path, + Tcl_AppendResult(interp, "interpreter named \"", path, "\" already exists, cannot create", (char *) NULL); return NULL; } @@ -2223,7 +2217,8 @@ SlaveObjCmd(clientData, interp, objc, objv) Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL); return TCL_ERROR; } - Tcl_SetIntObj(Tcl_GetObjResult(interp), Tcl_IsSafe(slaveInterp)); + Tcl_SetObjResult(interp, + Tcl_NewBooleanObj(Tcl_IsSafe(slaveInterp))); return TCL_OK; } case OPT_INVOKEHIDDEN: { @@ -2430,9 +2425,9 @@ SlaveExpose(interp, slaveInterp, objc, objv) char *name; if (Tcl_IsSafe(interp)) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + Tcl_SetObjResult(interp, Tcl_NewStringObj( "permission denied: safe interpreter cannot expose commands", - (char *) NULL); + -1)); return TCL_ERROR; } @@ -2474,8 +2469,7 @@ SlaveRecursionLimit(interp, slaveInterp, objc, objv) if (objc) { if (Tcl_IsSafe(interp)) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "permission denied: ", + Tcl_AppendResult(interp, "permission denied: ", "safe interpreters cannot change recursion limit", (char *) NULL); return TCL_ERROR; @@ -2531,9 +2525,9 @@ SlaveHide(interp, slaveInterp, objc, objv) char *name; if (Tcl_IsSafe(interp)) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + Tcl_SetObjResult(interp, Tcl_NewStringObj( "permission denied: safe interpreter cannot hide commands", - (char *) NULL); + -1)); return TCL_ERROR; } @@ -2568,12 +2562,11 @@ SlaveHidden(interp, slaveInterp) Tcl_Interp *interp; /* Interp for data return. */ Tcl_Interp *slaveInterp; /* Interp whose hidden commands to query. */ { - Tcl_Obj *listObjPtr; /* Local object pointer. */ + Tcl_Obj *listObjPtr = Tcl_NewObj(); /* Local object pointer. */ Tcl_HashTable *hTblPtr; /* For local searches. */ Tcl_HashEntry *hPtr; /* For local searches. */ Tcl_HashSearch hSearch; /* For local searches. */ - listObjPtr = Tcl_GetObjResult(interp); hTblPtr = ((Interp *) slaveInterp)->hiddenCmdTablePtr; if (hTblPtr != (Tcl_HashTable *) NULL) { for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); @@ -2584,6 +2577,7 @@ SlaveHidden(interp, slaveInterp) Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1)); } } + Tcl_SetObjResult(interp, listObjPtr); return TCL_OK; } @@ -2615,9 +2609,9 @@ SlaveInvokeHidden(interp, slaveInterp, namespaceName, objc, objv) int result; if (Tcl_IsSafe(interp)) { - Tcl_SetStringObj(Tcl_GetObjResult(interp), + Tcl_SetObjResult(interp, Tcl_NewStringObj( "not allowed to invoke hidden commands from safe interpreter", - -1); + -1)); return TCL_ERROR; } @@ -2670,9 +2664,9 @@ SlaveMarkTrusted(interp, slaveInterp) * marked trusted. */ { if (Tcl_IsSafe(interp)) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + Tcl_SetObjResult(interp, Tcl_NewStringObj( "permission denied: safe interpreter cannot mark trusted", - (char *) NULL); + -1)); return TCL_ERROR; } ((Interp *) slaveInterp)->flags &= ~SAFE_INTERP; -- cgit v0.12