From 4152a1cc08547b251509c18405d318433f5ece2e Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 3 Aug 2012 10:56:28 +0000 Subject: converting to using Tcl_Obj API for error message generation; part done --- generic/tclBasic.c | 129 ++++++++++++------------ generic/tclClock.c | 4 +- generic/tclCmdAH.c | 5 +- generic/tclCmdIL.c | 251 ++++++++++++++++++++++++---------------------- generic/tclConfig.c | 8 +- generic/tclDictObj.c | 39 ++++--- generic/tclEnsemble.c | 167 +++++++++++++++++++----------- generic/tclExecute.c | 38 +++---- generic/tclFileName.c | 39 +++---- generic/tclIORChan.c | 3 +- generic/tclIOUtil.c | 5 +- generic/tclLoad.c | 10 +- generic/tclLoadNone.c | 4 +- generic/tclOO.c | 48 +++++---- generic/tclOOBasic.c | 100 ++++++++++-------- generic/tclOODefineCmds.c | 140 +++++++++++++++----------- generic/tclOOInfo.c | 64 ++++++------ generic/tclOOMethod.c | 8 +- generic/tclOOStubLib.c | 11 +- generic/tclParse.c | 29 +++--- generic/tclPipe.c | 8 +- generic/tclPkg.c | 9 +- generic/tclScan.c | 55 +++++----- generic/tclTrace.c | 19 ++-- generic/tclUtil.c | 40 +++----- generic/tclVar.c | 73 +++++++------- generic/tclZlib.c | 25 ++--- win/tclWinDde.c | 6 +- 28 files changed, 742 insertions(+), 595 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 537750e..db365e3 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -1708,9 +1708,9 @@ Tcl_HideCommand( */ if (strstr(hiddenCmdToken, "::") != NULL) { - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot use namespace qualifiers in hidden command" - " token (rename)", NULL); + " token (rename)", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", NULL); return TCL_ERROR; } @@ -1733,8 +1733,9 @@ Tcl_HideCommand( */ if (cmdPtr->nsPtr != iPtr->globalNsPtr) { - Tcl_AppendResult(interp, "can only hide global namespace commands" - " (use rename then hide)", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only hide global namespace commands (use rename then hide)", + -1)); Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", NULL); return TCL_ERROR; } @@ -1758,8 +1759,9 @@ Tcl_HideCommand( hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew); if (!isNew) { - Tcl_AppendResult(interp, "hidden command named \"", hiddenCmdToken, - "\" already exists", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "hidden command named \"%s\" already exists", + hiddenCmdToken)); Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", NULL); return TCL_ERROR; } @@ -1861,8 +1863,9 @@ Tcl_ExposeCommand( */ if (strstr(cmdName, "::") != NULL) { - Tcl_AppendResult(interp, "cannot expose to a namespace " - "(use expose to toplevel, then rename)", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "cannot expose to a namespace (use expose to toplevel, then rename)", + -1)); Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", NULL); return TCL_ERROR; } @@ -1877,8 +1880,8 @@ Tcl_ExposeCommand( hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken); } if (hPtr == NULL) { - Tcl_AppendResult(interp, "unknown hidden command \"", hiddenCmdToken, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown hidden command \"%s\"", hiddenCmdToken)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", hiddenCmdToken, NULL); return TCL_ERROR; @@ -1897,9 +1900,9 @@ Tcl_ExposeCommand( * than 'nicely' erroring out ? */ - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "trying to expose a non-global command namespace command", - NULL); + -1)); return TCL_ERROR; } @@ -1916,8 +1919,8 @@ Tcl_ExposeCommand( hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew); if (!isNew) { - Tcl_AppendResult(interp, "exposed command \"", cmdName, - "\" already exists", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "exposed command \"%s\" already exists", cmdName)); Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", NULL); return TCL_ERROR; } @@ -2497,9 +2500,10 @@ TclRenameCommand( cmd = Tcl_FindCommand(interp, oldName, NULL, /*flags*/ 0); cmdPtr = (Command *) cmd; if (cmdPtr == NULL) { - Tcl_AppendResult(interp, "can't ", + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't %s \"%s\": command doesn't exist", ((newName == NULL)||(*newName == '\0'))? "delete":"rename", - " \"", oldName, "\": command doesn't exist", NULL); + oldName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, NULL); return TCL_ERROR; } @@ -2529,15 +2533,15 @@ TclRenameCommand( TCL_CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail); if ((newNsPtr == NULL) || (newTail == NULL)) { - Tcl_AppendResult(interp, "can't rename to \"", newName, - "\": bad command name", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't rename to \"%s\": bad command name", newName)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL); result = TCL_ERROR; goto done; } if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) { - Tcl_AppendResult(interp, "can't rename to \"", newName, - "\": command already exists", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't rename to \"%s\": command already exists", newName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME", "TARGET_EXISTS", NULL); result = TCL_ERROR; @@ -3538,9 +3542,9 @@ OldMathFuncProc( * We have a non-numeric argument. */ - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "argument to math function didn't have numeric value", - TCL_STATIC); + -1)); TclCheckBadOctal(interp, Tcl_GetString(valuePtr)); ckfree(args); return TCL_ERROR; @@ -3827,9 +3831,8 @@ TclInterpReady( */ if (iPtr->flags & DELETED) { - /* JJM - Superfluous Tcl_ResetResult call removed. */ - Tcl_AppendResult(interp, - "attempt to call eval in deleted interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to call eval in deleted interpreter", -1)); Tcl_SetErrorCode(interp, "TCL", "IDELETE", "attempt to call eval in deleted interpreter", NULL); return TCL_ERROR; @@ -3857,8 +3860,8 @@ TclInterpReady( return TCL_OK; } - Tcl_AppendResult(interp, - "too many nested evaluations (infinite loop?)", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "too many nested evaluations (infinite loop?)", -1)); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL); return TCL_ERROR; } @@ -3992,8 +3995,7 @@ Tcl_Canceled( } } - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, message, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1)); Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, NULL); } @@ -4616,8 +4618,8 @@ TEOV_NotFound( cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr); if (cmdPtr == NULL) { - Tcl_AppendResult(interp, "invalid command name \"", - TclGetString(objv[0]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid command name \"%s\"", TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", TclGetString(objv[0]), NULL); @@ -6285,11 +6287,11 @@ ProcessUnexpectedResult( Tcl_ResetResult(interp); if (returnCode == TCL_BREAK) { - Tcl_AppendResult(interp, - "invoked \"break\" outside of a loop", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invoked \"break\" outside of a loop", -1)); } else if (returnCode == TCL_CONTINUE) { - Tcl_AppendResult(interp, - "invoked \"continue\" outside of a loop", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "invoked \"continue\" outside of a loop", -1)); } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "command returned bad code: %d", returnCode)); @@ -6624,7 +6626,8 @@ TclObjInvoke( } if ((objc < 1) || (objv == NULL)) { - Tcl_AppendResult(interp, "illegal argument vector", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "illegal argument vector", -1)); return TCL_ERROR; } @@ -6642,8 +6645,8 @@ TclObjInvoke( hPtr = Tcl_FindHashEntry(hTblPtr, cmdName); } if (hPtr == NULL) { - Tcl_AppendResult(interp, "invalid hidden command name \"", - cmdName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid hidden command name \"%s\"", cmdName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName, NULL); return TCL_ERROR; @@ -7269,7 +7272,8 @@ ExprIsqrtFunc( return TCL_OK; negarg: - Tcl_SetResult(interp, "square root of negative argument", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "square root of negative argument", -1)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", NULL); return TCL_ERROR; @@ -8319,9 +8323,8 @@ TclNRTailcallObjCmd( } if (!iPtr->varFramePtr->isProcCallFrame) { /* or is upleveled */ - Tcl_SetResult(interp, - "tailcall can only be called from a proc or lambda", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "tailcall can only be called from a proc or lambda", -1)); Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL); return TCL_ERROR; } @@ -8480,8 +8483,8 @@ TclNRYieldObjCmd( } if (!corPtr) { - Tcl_SetResult(interp, "yield can only be called in a coroutine", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "yield can only be called in a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL); return TCL_ERROR; } @@ -8514,8 +8517,8 @@ TclNRYieldToObjCmd( } if (!corPtr) { - Tcl_SetResult(interp, "yieldto can only be called in a coroutine", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "yieldto can only be called in a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL); return TCL_ERROR; } @@ -8763,8 +8766,8 @@ NRCoroutineActivateCallback( */ if (corPtr->stackLevel != stackLevel) { - Tcl_SetResult(interp, "cannot yield: C stack busy", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "cannot yield: C stack busy", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", NULL); return TCL_ERROR; @@ -8823,8 +8826,8 @@ NRCoroInjectObjCmd( cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { - Tcl_AppendResult(interp, "can only inject a command into a coroutine", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only inject a command into a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", TclGetString(objv[1]), NULL); return TCL_ERROR; @@ -8832,8 +8835,8 @@ NRCoroInjectObjCmd( corPtr = cmdPtr->objClientData; if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_AppendResult(interp, - "can only inject a command into a suspended coroutine", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only inject a command into a suspended coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL); return TCL_ERROR; } @@ -8860,9 +8863,9 @@ TclNRInterpCoroutine( CoroutineData *corPtr = clientData; if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "coroutine \"", Tcl_GetString(objv[0]), - "\" is already running", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "coroutine \"%s\" is already running", + Tcl_GetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", NULL); return TCL_ERROR; } @@ -8943,22 +8946,24 @@ TclNRCoroutineObjCmd( &nsPtr, &altNsPtr, &cxtNsPtr, &procName); if (nsPtr == NULL) { - Tcl_AppendResult(interp, "can't create procedure \"", fullName, - "\": unknown namespace", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't create procedure \"%s\": unknown namespace", + fullName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", NULL); return TCL_ERROR; } if (procName == NULL) { - Tcl_AppendResult(interp, "can't create procedure \"", fullName, - "\": bad procedure name", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't create procedure \"%s\": bad procedure name", + fullName)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", fullName, NULL); return TCL_ERROR; } if ((nsPtr != iPtr->globalNsPtr) && (procName != NULL) && (procName[0] == ':')) { - Tcl_AppendResult(interp, "can't create procedure \"", procName, - "\" in non-global namespace with name starting with \":\"", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't create procedure \"%s\" in non-global namespace with" + " name starting with \":\"", procName)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, NULL); return TCL_ERROR; } diff --git a/generic/tclClock.c b/generic/tclClock.c index 7fa4017..e46ac69 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -878,8 +878,8 @@ ConvertLocalToUTCUsingC( if (localErrno != 0 || (fields->seconds == -1 && timeVal.tm_yday == -1)) { - Tcl_SetResult(interp, "time value too large/small to represent", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "time value too large/small to represent", -1)); return TCL_ERROR; } return TCL_OK; diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index f09ee70..4bb993e 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -1842,7 +1842,7 @@ PathFilesystemCmd( } fsInfo = Tcl_FSFileSystemInfo(objv[1]); if (fsInfo == NULL) { - Tcl_SetResult(interp, "unrecognised path", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("unrecognised path", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM", Tcl_GetString(objv[1]), NULL); return TCL_ERROR; @@ -2092,7 +2092,8 @@ FilesystemSeparatorCmd( Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[1]); if (separatorObj == NULL) { - Tcl_SetResult(interp, "unrecognised path", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unrecognised path", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM", Tcl_GetString(objv[1]), NULL); return TCL_ERROR; diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index b312026..14e0092 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -27,15 +27,15 @@ */ typedef struct SortElement { - union { /* The value that we sorting by. */ + union { /* The value that we sorting by. */ const char *strValuePtr; long intValue; double doubleValue; Tcl_Obj *objValuePtr; } collationKey; - union { /* Object being sorted, or its index. */ - Tcl_Obj *objPtr; - int index; + union { /* Object being sorted, or its index. */ + Tcl_Obj *objPtr; + int index; } payload; struct SortElement *nextPtr;/* Next element in the list, or NULL for end * of list. */ @@ -229,8 +229,9 @@ TclNRIfObjCmd( Tcl_Obj *boolObj; if (objc <= 1) { - Tcl_AppendResult(interp, "wrong # args: no expression after \"", - TclGetString(objv[0]), "\" argument", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: no expression after \"%s\" argument", + TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } @@ -319,8 +320,9 @@ IfConditionCallback( */ if (i >= objc) { - Tcl_AppendResult(interp, "wrong # args: ", - "no expression after \"", clause, "\" argument", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: no expression after \"%s\" argument", + clause)); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } @@ -345,8 +347,9 @@ IfConditionCallback( } } if (i < objc - 1) { - Tcl_AppendResult(interp, "wrong # args: ", - "extra words after \"else\" clause in \"if\" command", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "wrong # args: extra words after \"else\" clause in \"if\" command", + -1)); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } @@ -361,9 +364,9 @@ IfConditionCallback( return TclNREvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i); missingScript: - clause = TclGetString(objv[i-1]); - Tcl_AppendResult(interp, "wrong # args: no script following \"", clause, - "\" argument", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: no script following \"%s\" argument", + TclGetString(objv[i-1]))); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } @@ -491,7 +494,8 @@ InfoArgsCmd( name = TclGetString(objv[1]); procPtr = TclFindProc(iPtr, name); if (procPtr == NULL) { - Tcl_AppendResult(interp, "\"", name, "\" isn't a procedure", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" isn't a procedure", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL); return TCL_ERROR; } @@ -552,7 +556,8 @@ InfoBodyCmd( name = TclGetString(objv[1]); procPtr = TclFindProc(iPtr, name); if (procPtr == NULL) { - Tcl_AppendResult(interp, "\"", name, "\" isn't a procedure", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" isn't a procedure", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL); return TCL_ERROR; } @@ -981,7 +986,8 @@ InfoDefaultCmd( procPtr = TclFindProc(iPtr, procName); if (procPtr == NULL) { - Tcl_AppendResult(interp, "\"", procName, "\" isn't a procedure",NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" isn't a procedure", procName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", procName, NULL); return TCL_ERROR; @@ -1012,8 +1018,9 @@ InfoDefaultCmd( } } - Tcl_AppendResult(interp, "procedure \"", procName, - "\" doesn't have an argument \"", argName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "procedure \"%s\" doesn't have an argument \"%s\"", + procName, argName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARGUMENT", argName, NULL); return TCL_ERROR; } @@ -1055,10 +1062,10 @@ InfoErrorStackCmd( target = interp; if (objc == 2) { - target = Tcl_GetSlave(interp, Tcl_GetString(objv[1])); - if (target == NULL) { - return TCL_ERROR; - } + target = Tcl_GetSlave(interp, Tcl_GetString(objv[1])); + if (target == NULL) { + return TCL_ERROR; + } } iPtr = (Interp *) target; @@ -1158,12 +1165,13 @@ InfoFrameCmd( * A coroutine: must fix the level computations AND the cmdFrame chain, * which is interrupted at the base. */ + CmdFrame *lastPtr = NULL; - runPtr = iPtr->cmdFramePtr; + runPtr = iPtr->cmdFramePtr; /* TODO - deal with overflow */ - topLevel += corPtr->caller.cmdFramePtr->level; + topLevel += corPtr->caller.cmdFramePtr->level; while (runPtr) { runPtr->level += corPtr->caller.cmdFramePtr->level; lastPtr = runPtr; @@ -1196,8 +1204,8 @@ InfoFrameCmd( if ((level > topLevel) || (level <= - topLevel)) { levelError: - Tcl_AppendResult(interp, "bad level \"", TclGetString(objv[1]), "\"", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad level \"%s\"", TclGetString(objv[1]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_FRAME", TclGetString(objv[1]), NULL); code = TCL_ERROR; @@ -1401,15 +1409,15 @@ TclInfoFrame( Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr; if (namePtr) { - Tcl_Obj *procNameObj; + Tcl_Obj *procNameObj; /* * This is a regular command. */ - TclNewObj(procNameObj); - Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr, - procNameObj); + TclNewObj(procNameObj); + Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr, + procNameObj); ADD_PAIR("proc", procNameObj); } else if (procPtr->cmdPtr->clientData) { ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData; @@ -1538,7 +1546,9 @@ InfoHostnameCmd( Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1)); return TCL_OK; } - Tcl_SetResult(interp, "unable to determine name of host", TCL_STATIC); + + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unable to determine name of host", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "HOSTNAME", "UNKNOWN", NULL); return TCL_ERROR; } @@ -1609,8 +1619,8 @@ InfoLevelCmd( return TCL_ERROR; levelError: - Tcl_AppendResult(interp, "bad level \"", TclGetString(objv[1]), "\"", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad level \"%s\"", TclGetString(objv[1]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL", TclGetString(objv[1]), NULL); return TCL_ERROR; @@ -1656,7 +1666,9 @@ InfoLibraryCmd( Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1)); return TCL_OK; } - Tcl_SetResult(interp, "no library has been specified for Tcl",TCL_STATIC); + + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no library has been specified for Tcl", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", "tcl_library",NULL); return TCL_ERROR; } @@ -2590,9 +2602,10 @@ Tcl_LrepeatObjCmd( return TCL_ERROR; } if (elementCount < 0) { - Tcl_SetObjResult(interp, Tcl_Format(NULL, - "bad count \"%d\": must be integer >= 0", 1, objv+1)); - Tcl_SetErrorCode(interp, "TCL","OPERATION","LREPEAT","NEGARG", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad count \"%d\": must be integer >= 0", elementCount)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG", + NULL); return TCL_ERROR; } @@ -2608,7 +2621,7 @@ Tcl_LrepeatObjCmd( if (elementCount && objc > LIST_MAX/elementCount) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "max length of a Tcl list (%d elements) exceeded", LIST_MAX)); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } totalElems = objc * elementCount; @@ -2723,9 +2736,10 @@ Tcl_LreplaceObjCmd( */ if ((first >= listLen) && (listLen > 0)) { - Tcl_AppendResult(interp, "list doesn't contain element ", - TclGetString(objv[2]), NULL); - Tcl_SetErrorCode(interp, "TCL","OPERATION","LREPLACE","BADIDX", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "list doesn't contain element %s", TclGetString(objv[2]))); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX", + NULL); return TCL_ERROR; } if (last >= listLen) { @@ -2996,8 +3010,9 @@ Tcl_LsearchObjCmd( Tcl_DecrRefCount(startPtr); } if (i > objc-4) { - Tcl_AppendResult(interp, "missing starting index", NULL); - Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing starting index", -1)); + Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); result = TCL_ERROR; goto done; } @@ -3027,10 +3042,10 @@ Tcl_LsearchObjCmd( if (startPtr != NULL) { Tcl_DecrRefCount(startPtr); } - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-index\" option must be followed by list index", - NULL); - Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); + -1)); + Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); return TCL_ERROR; } @@ -3088,18 +3103,18 @@ Tcl_LsearchObjCmd( if (startPtr != NULL) { Tcl_DecrRefCount(startPtr); } - Tcl_AppendResult(interp, - "-subindices cannot be used without -index option", NULL); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", - "BAD_OPTION_MIX", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "-subindices cannot be used without -index option", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", + "BAD_OPTION_MIX", NULL); return TCL_ERROR; } if (bisect && (allMatches || negatedMatch)) { - Tcl_AppendResult(interp, - "-bisect is not compatible with -all or -not", NULL); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", - "BAD_OPTION_MIX", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "-bisect is not compatible with -all or -not", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", + "BAD_OPTION_MIX", NULL); return TCL_ERROR; } @@ -3531,7 +3546,7 @@ Tcl_LsetObjCmd( if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, - "listVar ?index? ?index ...? value"); + "listVar ?index? ?index ...? value"); return TCL_ERROR; } @@ -3664,10 +3679,10 @@ Tcl_LsortObjCmd( break; case LSORT_COMMAND: if (i == objc-2) { - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-command\" option must be followed " - "by comparison command", NULL); - Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); + "by comparison command", -1)); + Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); sortInfo.resultCode = TCL_ERROR; goto done2; } @@ -3685,29 +3700,30 @@ Tcl_LsortObjCmd( sortInfo.isIncreasing = 1; break; case LSORT_INDEX: { - int indexc, dummy; + int indexc, dummy; Tcl_Obj **indexv; if (i == objc-2) { - Tcl_AppendResult(interp, "\"-index\" option must be " - "followed by list index", NULL); - Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); - sortInfo.resultCode = TCL_ERROR; - goto done2; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "\"-index\" option must be followed by list index", + -1)); + Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); + sortInfo.resultCode = TCL_ERROR; + goto done2; } if (TclListObjGetElements(interp, objv[i+1], &indexc, &indexv) != TCL_OK) { - sortInfo.resultCode = TCL_ERROR; - goto done2; + sortInfo.resultCode = TCL_ERROR; + goto done2; } - /* - * Check each of the indices for syntactic correctness. Note that - * we do not store the converted values here because we do not - * know if this is the only -index option yet and so we can't - * allocate any space; that happens after the scan through all the - * options is done. - */ + /* + * Check each of the indices for syntactic correctness. Note that + * we do not store the converted values here because we do not + * know if this is the only -index option yet and so we can't + * allocate any space; that happens after the scan through all the + * options is done. + */ for (j=0 ; j= groupSize) { - Tcl_AppendResult(interp, "when used with \"-stride\", the " - "leading \"-index\" value must be within the group", - NULL); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", - "BADINDEX", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "when used with \"-stride\", the leading \"-index\"" + " value must be within the group", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", + "BADINDEX", NULL); sortInfo.resultCode = TCL_ERROR; goto done; } @@ -4255,11 +4272,10 @@ SortCompare( if (TclGetIntFromObj(infoPtr->interp, Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) { - Tcl_ResetResult(infoPtr->interp); - Tcl_AppendResult(infoPtr->interp, - "-compare command returned non-integer result", NULL); - Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT", - "COMPARISONFAILED", NULL); + Tcl_SetObjResult(infoPtr->interp, Tcl_NewStringObj( + "-compare command returned non-integer result", -1)); + Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT", + "COMPARISONFAILED", NULL); infoPtr->resultCode = TCL_ERROR; return 0; } @@ -4470,11 +4486,11 @@ SelectObjFromSublist( return NULL; } if (currentObj == NULL) { - Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf( - "element %d missing from sublist \"%s\"", - index, TclGetString(objPtr))); - Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT", - "INDEXFAILED", NULL); + Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf( + "element %d missing from sublist \"%s\"", + index, TclGetString(objPtr))); + Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT", + "INDEXFAILED", NULL); infoPtr->resultCode = TCL_ERROR; return NULL; } @@ -4489,6 +4505,5 @@ SelectObjFromSublist( * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 - * indent-tabs-mode: nil * End: */ diff --git a/generic/tclConfig.c b/generic/tclConfig.c index dea487a..a4ba71a 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -236,7 +236,7 @@ QueryConfigObjCmd( * present. */ - Tcl_SetResult(interp, "package not known", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1)); Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE", Tcl_GetString(pkgName), NULL); return TCL_ERROR; @@ -251,7 +251,7 @@ QueryConfigObjCmd( if (Tcl_DictObjGet(interp, pkgDict, objv[2], &val) != TCL_OK || val == NULL) { - Tcl_SetResult(interp, "key not known", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG", Tcl_GetString(objv[2]), NULL); return TCL_ERROR; @@ -270,8 +270,8 @@ QueryConfigObjCmd( listPtr = Tcl_NewListObj(n, NULL); if (!listPtr) { - Tcl_SetResult(interp, "insufficient memory to create list", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "insufficient memory to create list", -1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index ac2cb62..691fab9 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -700,7 +700,8 @@ SetDictFromAny( missingValue: if (interp != NULL) { - Tcl_SetResult(interp, "missing value to go with key", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing value to go with key", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL); } result = TCL_ERROR; @@ -779,9 +780,9 @@ TclTraceDictPath( } if ((flags & DICT_PATH_CREATE) != DICT_PATH_CREATE) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "key \"", TclGetString(keyv[i]), - "\" not known in dictionary", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "key \"%s\" not known in dictionary", + TclGetString(keyv[i]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT", TclGetString(keyv[i]), NULL); } @@ -1571,9 +1572,9 @@ DictGetCmd( return result; } if (valuePtr == NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "key \"", TclGetString(objv[objc-1]), - "\" not known in dictionary", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "key \"%s\" not known in dictionary", + TclGetString(objv[objc-1]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT", TclGetString(objv[objc-1]), NULL); return TCL_ERROR; @@ -2027,6 +2028,7 @@ DictInfoCmd( { Tcl_Obj *dictPtr; Dict *dict; + char *statsStr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "dictionary"); @@ -2042,7 +2044,9 @@ DictInfoCmd( } dict = dictPtr->internalRep.otherValuePtr; - Tcl_SetResult(interp, Tcl_HashStats(&dict->table), TCL_DYNAMIC); + statsStr = Tcl_HashStats(&dict->table); + Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1)); + ckfree(statsStr); return TCL_OK; } @@ -2371,8 +2375,8 @@ DictForNRCmd( return TCL_ERROR; } if (varc != 2) { - Tcl_SetResult(interp, "must have exactly two variable names", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "must have exactly two variable names", -1)); return TCL_ERROR; } searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch)); @@ -2787,8 +2791,8 @@ DictFilterCmd( return TCL_ERROR; } if (varc != 2) { - Tcl_SetResult(interp, "must have exactly two variable names", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "must have exactly two variable names", -1)); return TCL_ERROR; } keyVarObj = varv[0]; @@ -2828,16 +2832,19 @@ DictFilterCmd( if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't set key variable: \"", - TclGetString(keyVarObj), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't set key variable: \"%s\"", + TclGetString(keyVarObj))); result = TCL_ERROR; goto abnormalResult; } if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't set value variable: \"", - TclGetString(valueVarObj), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't set value variable: \"%s\"", + TclGetString(valueVarObj))); + result = TCL_ERROR; goto abnormalResult; } diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 754e480..b76c603 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -17,6 +17,7 @@ * Declarations for functions local to this file: */ +static inline Tcl_Obj * NewNsObj(Tcl_Namespace *namespacePtr); static inline int EnsembleUnknownCallback(Tcl_Interp *interp, EnsembleConfig *ensemblePtr, int objc, Tcl_Obj *const objv[], Tcl_Obj **prefixObjPtr); @@ -78,6 +79,19 @@ const Tcl_ObjType tclEnsembleCmdType = { NULL /* setFromAnyProc */ }; +static inline Tcl_Obj * +NewNsObj( + Tcl_Namespace *namespacePtr) +{ + register Namespace *nsPtr = (Namespace *) namespacePtr; + + if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) { + return Tcl_NewStringObj("::", 2); + } else { + return Tcl_NewStringObj(nsPtr->fullName, -1); + } +} + /* *---------------------------------------------------------------------- * @@ -116,9 +130,10 @@ TclNamespaceEnsembleCmd( if (nsPtr == NULL || nsPtr->flags & NS_DYING) { if (!Tcl_InterpDeleted(interp)) { - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "tried to manipulate ensemble of deleted namespace", - NULL); + -1)); + Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", NULL); } return TCL_ERROR; } @@ -235,9 +250,11 @@ TclNamespaceEnsembleCmd( return TCL_ERROR; } if (len < 1) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "ensemble subcommand implementations " - "must be non-empty lists", TCL_STATIC); + "must be non-empty lists", -1)); + Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", + "EMPTY_TARGET", NULL); Tcl_DictObjDone(&search); if (patchedDict) { Tcl_DecrRefCount(patchedDict); @@ -250,7 +267,7 @@ TclNamespaceEnsembleCmd( cmd = TclGetString(listv[0]); if (!(cmd[0] == ':' && cmd[1] == ':')) { Tcl_Obj *newList = Tcl_NewListObj(len, listv); - Tcl_Obj *newCmd = Tcl_NewStringObj(nsPtr->fullName,-1); + Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace *) nsPtr); if (nsPtr->parentPtr) { Tcl_AppendStringsToObj(newCmd, "::", NULL); @@ -370,8 +387,7 @@ TclNamespaceEnsembleCmd( case CONF_NAMESPACE: namespacePtr = NULL; /* silence gcc 4 warning */ Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr); - Tcl_SetResult(interp, ((Namespace *) namespacePtr)->fullName, - TCL_VOLATILE); + Tcl_SetObjResult(interp, NewNsObj(namespacePtr)); break; case CONF_PREFIX: { int flags = 0; /* silence gcc 4 warning */ @@ -411,9 +427,7 @@ TclNamespaceEnsembleCmd( -1)); namespacePtr = NULL; /* silence gcc 4 warning */ Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr); - Tcl_ListObjAppendElement(NULL, resultObj, - Tcl_NewStringObj(((Namespace *) namespacePtr)->fullName, - -1)); + Tcl_ListObjAppendElement(NULL, resultObj, NewNsObj(namespacePtr)); /* -parameters option */ Tcl_ListObjAppendElement(NULL, resultObj, @@ -515,9 +529,11 @@ TclNamespaceEnsembleCmd( goto freeMapAndError; } if (len < 1) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "ensemble subcommand implementations " - "must be non-empty lists", TCL_STATIC); + "must be non-empty lists", -1)); + Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", + "EMPTY_TARGET", NULL); Tcl_DictObjDone(&search); if (patchedDict) { Tcl_DecrRefCount(patchedDict); @@ -527,8 +543,7 @@ TclNamespaceEnsembleCmd( cmd = TclGetString(listv[0]); if (!(cmd[0] == ':' && cmd[1] == ':')) { Tcl_Obj *newList = Tcl_DuplicateObj(listObj); - Tcl_Obj *newCmd = - Tcl_NewStringObj(nsPtr->fullName, -1); + Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace*)nsPtr); if (nsPtr->parentPtr) { Tcl_AppendStringsToObj(newCmd, "::", NULL); @@ -554,7 +569,9 @@ TclNamespaceEnsembleCmd( continue; } case CONF_NAMESPACE: - Tcl_AppendResult(interp, "option -namespace is read-only", + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "option -namespace is read-only", -1)); + Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "READ_ONLY", NULL); goto freeMapAndError; case CONF_PREFIX: @@ -629,7 +646,7 @@ Tcl_CreateEnsemble( */ if (!(name[0] == ':' && name[1] == ':')) { - nameObj = Tcl_NewStringObj(nsPtr->fullName, -1); + nameObj = NewNsObj((Tcl_Namespace *) nsPtr); if (nsPtr->parentPtr == NULL) { Tcl_AppendStringsToObj(nameObj, name, NULL); } else { @@ -702,7 +719,9 @@ Tcl_SetEnsembleSubcommandList( Tcl_Obj *oldList; if (cmdPtr->objProc != NsEnsembleImplementationCmd) { - Tcl_AppendResult(interp, "command is not an ensemble", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "command is not an ensemble", -1)); + Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); return TCL_ERROR; } if (subcmdList != NULL) { @@ -776,7 +795,9 @@ Tcl_SetEnsembleParameterList( int length; if (cmdPtr->objProc != NsEnsembleImplementationCmd) { - Tcl_AppendResult(interp, "command is not an ensemble", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "command is not an ensemble", -1)); + Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); return TCL_ERROR; } if (paramList == NULL) { @@ -850,7 +871,9 @@ Tcl_SetEnsembleMappingDict( Tcl_Obj *oldDict; if (cmdPtr->objProc != NsEnsembleImplementationCmd) { - Tcl_AppendResult(interp, "command is not an ensemble", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "command is not an ensemble", -1)); + Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); return TCL_ERROR; } if (mapDict != NULL) { @@ -873,9 +896,11 @@ Tcl_SetEnsembleMappingDict( } bytes = TclGetString(cmdObjPtr); if (bytes[0] != ':' || bytes[1] != ':') { - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "ensemble target is not a fully-qualified command", - NULL); + -1)); + Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", + "UNQUALIFIED_TARGET", NULL); Tcl_DictObjDone(&search); return TCL_ERROR; } @@ -945,7 +970,9 @@ Tcl_SetEnsembleUnknownHandler( Tcl_Obj *oldList; if (cmdPtr->objProc != NsEnsembleImplementationCmd) { - Tcl_AppendResult(interp, "command is not an ensemble", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "command is not an ensemble", -1)); + Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); return TCL_ERROR; } if (unknownList != NULL) { @@ -1009,7 +1036,9 @@ Tcl_SetEnsembleFlags( int wasCompiled; if (cmdPtr->objProc != NsEnsembleImplementationCmd) { - Tcl_AppendResult(interp, "command is not an ensemble", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "command is not an ensemble", -1)); + Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); return TCL_ERROR; } @@ -1084,7 +1113,9 @@ Tcl_GetEnsembleSubcommandList( if (cmdPtr->objProc != NsEnsembleImplementationCmd) { if (interp != NULL) { - Tcl_AppendResult(interp, "command is not an ensemble", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "command is not an ensemble", -1)); + Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; } @@ -1124,7 +1155,9 @@ Tcl_GetEnsembleParameterList( if (cmdPtr->objProc != NsEnsembleImplementationCmd) { if (interp != NULL) { - Tcl_AppendResult(interp, "command is not an ensemble", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "command is not an ensemble", -1)); + Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; } @@ -1164,7 +1197,9 @@ Tcl_GetEnsembleMappingDict( if (cmdPtr->objProc != NsEnsembleImplementationCmd) { if (interp != NULL) { - Tcl_AppendResult(interp, "command is not an ensemble", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "command is not an ensemble", -1)); + Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; } @@ -1203,7 +1238,9 @@ Tcl_GetEnsembleUnknownHandler( if (cmdPtr->objProc != NsEnsembleImplementationCmd) { if (interp != NULL) { - Tcl_AppendResult(interp, "command is not an ensemble", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "command is not an ensemble", -1)); + Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; } @@ -1242,7 +1279,9 @@ Tcl_GetEnsembleFlags( if (cmdPtr->objProc != NsEnsembleImplementationCmd) { if (interp != NULL) { - Tcl_AppendResult(interp, "command is not an ensemble", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "command is not an ensemble", -1)); + Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; } @@ -1281,7 +1320,9 @@ Tcl_GetEnsembleNamespace( if (cmdPtr->objProc != NsEnsembleImplementationCmd) { if (interp != NULL) { - Tcl_AppendResult(interp, "command is not an ensemble", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "command is not an ensemble", -1)); + Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; } @@ -1337,8 +1378,9 @@ Tcl_FindEnsemble( if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd){ if (flags & TCL_LEAVE_ERR_MSG) { - Tcl_AppendResult(interp, "\"", TclGetString(cmdNameObj), - "\" is not an ensemble command", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" is not an ensemble command", + TclGetString(cmdNameObj))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE", TclGetString(cmdNameObj), NULL); } @@ -1591,6 +1633,7 @@ NsEnsembleImplementationCmdNR( * specified but not yet cached command * names. */ int reparseCount = 0; /* Number of reparses. */ + Tcl_Obj *errorObj; /* Used for building error messages. */ /* * Must recheck objc, since numParameters might have changed. Cf. test @@ -1631,8 +1674,9 @@ NsEnsembleImplementationCmdNR( */ if (!Tcl_InterpDeleted(interp)) { - Tcl_AppendResult(interp, - "ensemble activated for deleted namespace", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "ensemble activated for deleted namespace", -1)); + Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", NULL); } return TCL_ERROR; } @@ -1880,35 +1924,34 @@ NsEnsembleImplementationCmdNR( */ Tcl_ResetResult(interp); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE", + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND", TclGetString(objv[1+ensemblePtr->numParameters]), NULL); if (ensemblePtr->subcommandTable.numEntries == 0) { - Tcl_AppendResult(interp, "unknown subcommand \"", + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown subcommand \"%s\": namespace %s does not" + " export any commands", TclGetString(objv[1+ensemblePtr->numParameters]), - "\": namespace ", ensemblePtr->nsPtr->fullName, - " does not export any commands", NULL); + ensemblePtr->nsPtr->fullName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND", TclGetString(objv[1+ensemblePtr->numParameters]), NULL); return TCL_ERROR; } - Tcl_AppendResult(interp, "unknown ", - (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? "or ambiguous " : ""), - "subcommand \"", TclGetString(objv[1+ensemblePtr->numParameters]), - "\": must be ", NULL); + errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ", + (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""), + TclGetString(objv[1+ensemblePtr->numParameters])); if (ensemblePtr->subcommandTable.numEntries == 1) { - Tcl_AppendResult(interp, ensemblePtr->subcommandArrayPtr[0], NULL); + Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1); } else { int i; for (i=0 ; isubcommandTable.numEntries-1 ; i++) { - Tcl_AppendResult(interp, - ensemblePtr->subcommandArrayPtr[i], ", ", NULL); + Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], -1); + Tcl_AppendToObj(errorObj, ", ", 2); } - Tcl_AppendResult(interp, "or ", - ensemblePtr->subcommandArrayPtr[i], NULL); + Tcl_AppendPrintfToObj(errorObj, "or %s", + ensemblePtr->subcommandArrayPtr[i]); } - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND", - TclGetString(objv[1+ensemblePtr->numParameters]), NULL); + Tcl_SetObjResult(interp, errorObj); return TCL_ERROR; } @@ -2034,7 +2077,6 @@ EnsembleUnknownCallback( { int paramc, i, result, prefixObjc; Tcl_Obj **paramv, *unknownCmd, *ensObj; - char buf[TCL_INTEGER_SPACE]; /* * Create the unknown command callback to determine what to do. @@ -2061,9 +2103,12 @@ EnsembleUnknownCallback( ((Interp *) interp)->evalFlags |= TCL_EVAL_REDIRECT; result = Tcl_EvalObjv(interp, paramc, paramv, 0); if ((result == TCL_OK) && (ensemblePtr->flags & ENSEMBLE_DEAD)) { - Tcl_SetResult(interp, - "unknown subcommand handler deleted its ensemble", - TCL_STATIC); + if (!Tcl_InterpDeleted(interp)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unknown subcommand handler deleted its ensemble", -1)); + Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_DELETED", + NULL); + } result = TCL_ERROR; } Tcl_Release(ensemblePtr); @@ -2112,26 +2157,26 @@ EnsembleUnknownCallback( if (!Tcl_InterpDeleted(interp)) { if (result != TCL_ERROR) { Tcl_ResetResult(interp); - Tcl_SetResult(interp, - "unknown subcommand handler returned bad code: ", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unknown subcommand handler returned bad code: ", -1)); switch (result) { case TCL_RETURN: - Tcl_AppendResult(interp, "return", NULL); + Tcl_AppendToObj(Tcl_GetObjResult(interp), "return", -1); break; case TCL_BREAK: - Tcl_AppendResult(interp, "break", NULL); + Tcl_AppendToObj(Tcl_GetObjResult(interp), "break", -1); break; case TCL_CONTINUE: - Tcl_AppendResult(interp, "continue", NULL); + Tcl_AppendToObj(Tcl_GetObjResult(interp), "continue", -1); break; default: - sprintf(buf, "%d", result); - Tcl_AppendResult(interp, buf, NULL); + Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp), "%d", result); } Tcl_AddErrorInfo(interp, "\n result of " "ensemble unknown subcommand handler: "); Tcl_AddErrorInfo(interp, TclGetString(unknownCmd)); + Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_RESULT", + NULL); } else { Tcl_AddErrorInfo(interp, "\n (ensemble unknown subcommand handler)"); @@ -2392,7 +2437,7 @@ BuildEnsembleConfig( * the programmer's responsibility (or [::unknown] of course). */ - cmdObj = Tcl_NewStringObj(ensemblePtr->nsPtr->fullName, -1); + cmdObj = NewNsObj((Tcl_Namespace *) ensemblePtr->nsPtr); if (ensemblePtr->nsPtr->parentPtr != NULL) { Tcl_AppendStringsToObj(cmdObj, "::", name, NULL); } else { diff --git a/generic/tclExecute.c b/generic/tclExecute.c index e402634..3c0b472 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -4896,8 +4896,8 @@ TEBCresume( case INST_RSHIFT: if (l2 < 0) { - Tcl_SetResult(interp, "negative shift argument", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "negative shift argument", -1)); #if 0 DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", @@ -4944,8 +4944,8 @@ TEBCresume( case INST_LSHIFT: if (l2 < 0) { - Tcl_SetResult(interp, "negative shift argument", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "negative shift argument", -1)); #if 0 DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", @@ -4967,9 +4967,8 @@ TEBCresume( * good place to draw the line. */ - Tcl_SetResult(interp, - "integer value too large to represent", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "integer value too large to represent", -1)); #if 0 DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", @@ -5671,9 +5670,9 @@ TEBCresume( NEXT_INST_V(5, opnd+1, 1); } DECACHE_STACK_INFO(); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "key \"", TclGetString(OBJ_AT_TOS), - "\" not known in dictionary", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "key \"%s\" not known in dictionary", + TclGetString(OBJ_AT_TOS))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT", TclGetString(OBJ_AT_TOS), NULL); CACHE_STACK_INFO(); @@ -6304,7 +6303,7 @@ TEBCresume( divideByZero: DECACHE_STACK_INFO(); - Tcl_SetResult(interp, "divide by zero", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1)); Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL); CACHE_STACK_INFO(); goto gotError; @@ -6316,8 +6315,8 @@ TEBCresume( exponOfZero: DECACHE_STACK_INFO(); - Tcl_SetResult(interp, "exponentiation of zero by negative power", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "exponentiation of zero by negative power", -1)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "exponentiation of zero by negative power", NULL); CACHE_STACK_INFO(); @@ -6693,7 +6692,8 @@ ExecuteExtendedBinaryMathOp( invalid = 0; } if (invalid) { - Tcl_SetResult(interp, "negative shift argument", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "negative shift argument", -1)); return GENERAL_ARITHMETIC_ERROR; } @@ -6723,8 +6723,8 @@ ExecuteExtendedBinaryMathOp( * place to draw the line. */ - Tcl_SetResult(interp, "integer value too large to represent", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "integer value too large to represent", -1)); return GENERAL_ARITHMETIC_ERROR; } shift = (int)(*((const long *)ptr2)); @@ -7125,7 +7125,8 @@ ExecuteExtendedBinaryMathOp( */ if (type2 != TCL_NUMBER_LONG) { - Tcl_SetResult(interp, "exponent too large", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "exponent too large", -1)); return GENERAL_ARITHMETIC_ERROR; } @@ -7363,7 +7364,8 @@ ExecuteExtendedBinaryMathOp( Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); if (big2.used > 1) { mp_clear(&big2); - Tcl_SetResult(interp, "exponent too large", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "exponent too large", -1)); return GENERAL_ARITHMETIC_ERROR; } Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); diff --git a/generic/tclFileName.c b/generic/tclFileName.c index edb6581..5d90351 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -1174,9 +1174,10 @@ DoTildeSubst( dir = TclGetEnv("HOME", &dirString); if (dir == NULL) { if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't find HOME environment " - "variable to expand path", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't find HOME environment " + "variable to expand path", -1)); + Tcl_SetErrorCode(interp, "TCL", "FILENAME", "NO_HOME", NULL); } return NULL; } @@ -1185,8 +1186,9 @@ DoTildeSubst( } else if (TclpGetUserHome(user, resultPtr) == NULL) { if (interp) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "user \"%s\" doesn't exist", user)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "USER", user, NULL); } return NULL; } @@ -1329,9 +1331,9 @@ Tcl_GlobObjCmd( endOfForLoop: if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) { - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-tails\" must be used with either " - "\"-directory\" or \"-path\"", NULL); + "\"-directory\" or \"-path\"", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BADOPTIONCOMBINATION", NULL); return TCL_ERROR; @@ -1625,20 +1627,23 @@ Tcl_GlobObjCmd( } if (length == 0) { - Tcl_AppendResult(interp, "no files matched glob pattern", - (join || (objc == 1)) ? " \"" : "s \"", NULL); + Tcl_Obj *errorMsg = + Tcl_ObjPrintf("no files matched glob pattern%s \"", + (join || (objc == 1)) ? "" : "s"); + if (join) { - Tcl_AppendResult(interp, Tcl_DStringValue(&prefix), NULL); + Tcl_AppendToObj(errorMsg, Tcl_DStringValue(&prefix), -1); } else { const char *sep = ""; for (i = 0; i < objc; i++) { - string = Tcl_GetString(objv[i]); - Tcl_AppendResult(interp, sep, string, NULL); + Tcl_AppendPrintfToObj(errorMsg, "%s%s", + sep, Tcl_GetString(objv[i])); sep = " "; } } - Tcl_AppendResult(interp, "\"", NULL); + Tcl_AppendToObj(errorMsg, "\"", -1); + Tcl_SetObjResult(interp, errorMsg); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH", NULL); result = TCL_ERROR; @@ -2206,15 +2211,15 @@ DoGlob( closeBrace = p; break; } - Tcl_SetResult(interp, "unmatched open-brace in file name", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unmatched open-brace in file name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE", NULL); return TCL_ERROR; } else if (*p == '}') { - Tcl_SetResult(interp, "unmatched close-brace in file name", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unmatched close-brace in file name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE", NULL); return TCL_ERROR; diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 6fec40a..eeb11f9 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -739,7 +739,8 @@ TclChanCreateObjCmd( * Return handle as result of command. */ - Tcl_SetResult(interp, (char *)chanPtr->state->channelName, TCL_VOLATILE); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(chanPtr->state->channelName, -1)); return TCL_OK; error: diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 41a5aac..ebf34dc 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -1094,8 +1094,9 @@ Tcl_FSMatchInDirectory( cwd = Tcl_FSGetCwd(NULL); if (cwd == NULL) { if (interp != NULL) { - Tcl_SetResult(interp, "glob couldn't determine " - "the current working directory", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "glob couldn't determine the current working directory", + -1)); } return TCL_ERROR; } diff --git a/generic/tclLoad.c b/generic/tclLoad.c index ce4d6a4..f14cec0 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -157,9 +157,8 @@ Tcl_LoadObjCmd( } } if ((fullFileName[0] == 0) && (packageName == NULL)) { - Tcl_SetResult(interp, - "must specify either file name or package name", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "must specify either file name or package name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOLIBRARY", NULL); code = TCL_ERROR; @@ -581,9 +580,8 @@ Tcl_UnloadObjCmd( } } if ((fullFileName[0] == 0) && (packageName == NULL)) { - Tcl_SetResult(interp, - "must specify either file name or package name", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "must specify either file name or package name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NOLIBRARY", NULL); code = TCL_ERROR; diff --git a/generic/tclLoadNone.c b/generic/tclLoadNone.c index ac094e6..6b48aee 100644 --- a/generic/tclLoadNone.c +++ b/generic/tclLoadNone.c @@ -44,9 +44,9 @@ TclpDlopen( * function which should be used for this * file. */ { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "dynamic loading is not currently available on this system", - TCL_STATIC); + -1)); return TCL_ERROR; } diff --git a/generic/tclOO.c b/generic/tclOO.c index df7d49d..d9f5d60 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -1582,8 +1582,9 @@ Tcl_NewObjectInstance( if (nameStr && Tcl_FindCommand(interp, nameStr, NULL, TCL_NAMESPACE_ONLY)) { - Tcl_AppendResult(interp, "can't create object \"", nameStr, - "\": command already exists with that name", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't create object \"%s\": command already exists with" + " that name", nameStr)); Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL); return NULL; } @@ -1649,8 +1650,8 @@ Tcl_NewObjectInstance( */ if (result != TCL_ERROR && Deleted(oPtr)) { - Tcl_SetResult(interp, "object deleted in constructor", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "object deleted in constructor", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL); result = TCL_ERROR; } @@ -1705,8 +1706,9 @@ TclNRNewObjectInstance( if (nameStr && Tcl_FindCommand(interp, nameStr, NULL, TCL_NAMESPACE_ONLY)) { - Tcl_AppendResult(interp, "can't create object \"", nameStr, - "\": command already exists with that name", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't create object \"%s\": command already exists with" + " that name", nameStr)); Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL); return TCL_ERROR; } @@ -1794,7 +1796,8 @@ FinalizeAlloc( */ if (result != TCL_ERROR && Deleted(oPtr)) { - Tcl_SetResult(interp, "object deleted in constructor", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "object deleted in constructor", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL); result = TCL_ERROR; } @@ -1851,7 +1854,8 @@ Tcl_CopyObjectInstance( */ if (IsRootClass(oPtr)) { - Tcl_AppendResult(interp, "may not clone the class of classes", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "may not clone the class of classes", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "CLONING_CLASS", NULL); return NULL; } @@ -2514,9 +2518,9 @@ TclOOObjectCmdCore( flags | (oPtr->flags & FILTER_HANDLING), methodNamePtr); TclDecrRefCount(mappedMethodName); if (contextPtr == NULL) { - Tcl_AppendResult(interp, "impossible to invoke method \"", - TclGetString(methodNamePtr), - "\": no defined method or unknown method", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "impossible to invoke method \"%s\": no defined method or" + " unknown method", TclGetString(methodNamePtr))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD_MAPPED", TclGetString(methodNamePtr), NULL); return TCL_ERROR; @@ -2530,9 +2534,9 @@ TclOOObjectCmdCore( contextPtr = TclOOGetCallContext(oPtr, methodNamePtr, flags | (oPtr->flags & FILTER_HANDLING), NULL); if (contextPtr == NULL) { - Tcl_AppendResult(interp, "impossible to invoke method \"", - TclGetString(methodNamePtr), - "\": no defined method or unknown method", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "impossible to invoke method \"%s\": no defined method or" + " unknown method", TclGetString(methodNamePtr))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(methodNamePtr), NULL); return TCL_ERROR; @@ -2558,8 +2562,8 @@ TclOOObjectCmdCore( } } if (contextPtr->index >= contextPtr->callPtr->numChain) { - Tcl_SetResult(interp, "no valid method implementation", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no valid method implementation", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(methodNamePtr), NULL); TclOODeleteContext(contextPtr); @@ -2640,8 +2644,8 @@ Tcl_ObjectContextInvokeNext( methodType = "method"; } - Tcl_AppendResult(interp, "no next ", methodType, " implementation", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no next %s implementation", methodType)); Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL); return TCL_ERROR; } @@ -2709,8 +2713,8 @@ TclNRObjectContextInvokeNext( methodType = "method"; } - Tcl_AppendResult(interp, "no next ", methodType, " implementation", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no next %s implementation", methodType)); Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL); return TCL_ERROR; } @@ -2787,8 +2791,8 @@ Tcl_GetObjectFromObj( return cmdPtr->objClientData; notAnObject: - Tcl_AppendResult(interp, TclGetString(objPtr), - " does not refer to an object", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s does not refer to an object", TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "OBJECT", TclGetString(objPtr), NULL); return NULL; diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 35ad1eb..3637ede 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -168,8 +168,8 @@ TclOO_Class_Create( if (oPtr->classPtr == NULL) { Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr); - Tcl_AppendResult(interp, "object \"", TclGetString(cmdnameObj), - "\" is not a class", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "object \"%s\" is not a class", TclGetString(cmdnameObj))); Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL); return TCL_ERROR; } @@ -186,7 +186,8 @@ TclOO_Class_Create( objName = Tcl_GetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)], &len); if (len == 0) { - Tcl_AppendResult(interp, "object name must not be empty", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "object name must not be empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL); return TCL_ERROR; } @@ -232,8 +233,8 @@ TclOO_Class_CreateNs( if (oPtr->classPtr == NULL) { Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr); - Tcl_AppendResult(interp, "object \"", TclGetString(cmdnameObj), - "\" is not a class", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "object \"%s\" is not a class", TclGetString(cmdnameObj))); Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL); return TCL_ERROR; } @@ -250,14 +251,16 @@ TclOO_Class_CreateNs( objName = Tcl_GetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)], &len); if (len == 0) { - Tcl_AppendResult(interp, "object name must not be empty", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "object name must not be empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL); return TCL_ERROR; } nsName = Tcl_GetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)+1], &len); if (len == 0) { - Tcl_AppendResult(interp, "namespace name must not be empty", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "namespace name must not be empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL); return TCL_ERROR; } @@ -301,8 +304,8 @@ TclOO_Class_New( if (oPtr->classPtr == NULL) { Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr); - Tcl_AppendResult(interp, "object \"", TclGetString(cmdnameObj), - "\" is not a class", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "object \"%s\" is not a class", TclGetString(cmdnameObj))); Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL); return TCL_ERROR; } @@ -504,6 +507,7 @@ TclOO_Object_Unknown( Object *oPtr = contextPtr->oPtr; const char **methodNames; int numMethodNames, i, skip = Tcl_ObjectContextSkippedArgs(context); + Tcl_Obj *errorMsg; /* * If no method name, generate an error asking for a method name. (Only by @@ -529,31 +533,34 @@ TclOO_Object_Unknown( if (numMethodNames == 0) { Tcl_Obj *tmpBuf = TclOOObjectName(interp, oPtr); + const char *piece; - Tcl_AppendResult(interp, "object \"", TclGetString(tmpBuf), NULL); if (contextPtr->callPtr->flags & PUBLIC_METHOD) { - Tcl_AppendResult(interp, "\" has no visible methods", NULL); + piece = "visible methods"; } else { - Tcl_AppendResult(interp, "\" has no methods", NULL); + piece = "methods"; } + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "object \"%s\" has no %s", TclGetString(tmpBuf), piece)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[skip]), NULL); return TCL_ERROR; } - Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[skip]), - "\": must be ", NULL); + errorMsg = Tcl_ObjPrintf("unknown method \"%s\": must be ", + TclGetString(objv[skip])); for (i=0 ; iisProcCallFrame & FRAME_IS_METHOD)) { - Tcl_AppendResult(interp, TclGetString(objv[0]), - " may only be called from inside a method", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s may only be called from inside a method", + TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); return TCL_ERROR; } @@ -822,8 +831,9 @@ TclOONextToObjCmd( */ if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { - Tcl_AppendResult(interp, TclGetString(objv[0]), - " may only be called from inside a method", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s may only be called from inside a method", + TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); return TCL_ERROR; } @@ -843,8 +853,9 @@ TclOONextToObjCmd( } classPtr = ((Object *)object)->classPtr; if (classPtr == NULL) { - Tcl_AppendResult(interp, "\"", TclGetString(objv[1]), - "\" is not a class", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" is not a class", TclGetString(objv[1]))); + Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", NULL); return TCL_ERROR; } @@ -881,14 +892,15 @@ TclOONextToObjCmd( struct MInvoke *miPtr = contextPtr->callPtr->chain + i; if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) { - Tcl_AppendResult(interp, "method implementation by \"", - TclGetString(objv[1]), "\" not reachable from here", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "method implementation by \"%s\" not reachable from here", + TclGetString(objv[1]))); return TCL_ERROR; } } - Tcl_AppendResult(interp, "method has no non-filter implementation by \"", - TclGetString(objv[1]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "method has no non-filter implementation by \"%s\"", + TclGetString(objv[1]))); return TCL_ERROR; } @@ -948,8 +960,9 @@ TclOOSelfObjCmd( */ if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { - Tcl_AppendResult(interp, TclGetString(objv[0]), - " may only be called from inside a method", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s may only be called from inside a method", + TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); return TCL_ERROR; } @@ -983,7 +996,8 @@ TclOOSelfObjCmd( Class *clsPtr = CurrentlyInvoked(contextPtr).mPtr->declaringClassPtr; if (clsPtr == NULL) { - Tcl_AppendResult(interp, "method not defined by a class", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "method not defined by a class", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL); return TCL_ERROR; } @@ -1003,7 +1017,8 @@ TclOOSelfObjCmd( return TCL_OK; case SELF_FILTER: if (!CurrentlyInvoked(contextPtr).isFilter) { - Tcl_AppendResult(interp, "not inside a filtering context", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "not inside a filtering context", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL); return TCL_ERROR; } else { @@ -1028,7 +1043,8 @@ TclOOSelfObjCmd( case SELF_CALLER: if ((framePtr->callerVarPtr == NULL) || !(framePtr->callerVarPtr->isProcCallFrame & FRAME_IS_METHOD)){ - Tcl_AppendResult(interp, "caller is not an object", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "caller is not an object", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); return TCL_ERROR; } else { @@ -1045,7 +1061,8 @@ TclOOSelfObjCmd( * This should be unreachable code. */ - Tcl_AppendResult(interp, "method without declarer!", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "method without declarer!", -1)); return TCL_ERROR; } @@ -1076,7 +1093,8 @@ TclOOSelfObjCmd( * This should be unreachable code. */ - Tcl_AppendResult(interp, "method without declarer!", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "method without declarer!", -1)); return TCL_ERROR; } @@ -1093,7 +1111,8 @@ TclOOSelfObjCmd( return TCL_OK; case SELF_TARGET: if (!CurrentlyInvoked(contextPtr).isFilter) { - Tcl_AppendResult(interp, "not inside a filtering context", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "not inside a filtering context", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL); return TCL_ERROR; } else { @@ -1119,7 +1138,8 @@ TclOOSelfObjCmd( * This should be unreachable code. */ - Tcl_AppendResult(interp, "method without declarer!", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "method without declarer!", -1)); return TCL_ERROR; } result[0] = TclOOObjectName(interp, declarerPtr); diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index 69cffb0..c022e6b 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -423,8 +423,8 @@ RenameDeleteMethod( if (!useClass) { if (!oPtr->methodsPtr) { noSuchMethod: - Tcl_AppendResult(interp, "method ", TclGetString(fromPtr), - " does not exist", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "method %s does not exist", TclGetString(fromPtr))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(fromPtr), NULL); return TCL_ERROR; @@ -438,14 +438,15 @@ RenameDeleteMethod( &isNew); if (hPtr == newHPtr) { renameToSelf: - Tcl_AppendResult(interp, "cannot rename method to itself", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "cannot rename method to itself", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_TO_SELF", NULL); return TCL_ERROR; } else if (!isNew) { renameToExisting: - Tcl_AppendResult(interp, "method called ", - TclGetString(toPtr), " already exists", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "method called %s already exists", + TclGetString(toPtr))); Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_OVER", NULL); return TCL_ERROR; } @@ -513,7 +514,8 @@ TclOOUnknownDefinition( const char *soughtStr, *matchedStr = NULL; if (objc < 2) { - Tcl_AppendResult(interp, "bad call of unknown handler", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "bad call of unknown handler", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", NULL); return TCL_ERROR; } @@ -558,7 +560,8 @@ TclOOUnknownDefinition( } noMatch: - Tcl_AppendResult(interp, "invalid command name \"",soughtStr,"\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid command name \"%s\"", soughtStr)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", soughtStr, NULL); return TCL_ERROR; } @@ -646,9 +649,9 @@ InitDefineContext( int result; if (namespacePtr == NULL) { - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot process definitions; support namespace deleted", - NULL); + -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -686,16 +689,17 @@ TclOOGetDefineCmdContext( if ((iPtr->varFramePtr == NULL) || (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE)) { - Tcl_AppendResult(interp, "this command may only be called from within" - " the context of an ::oo::define or ::oo::objdefine command", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "this command may only be called from within the context of" + " an ::oo::define or ::oo::objdefine command", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return NULL; } object = iPtr->varFramePtr->clientData; if (Tcl_ObjectDeleted(object)) { - Tcl_AppendResult(interp, "this command cannot be called when the " - "object has been deleted", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "this command cannot be called when the object has been" + " deleted", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return NULL; } @@ -736,7 +740,7 @@ GetClassInOuterContext( return NULL; } if (oPtr->classPtr == NULL) { - Tcl_AppendResult(interp, errMsg, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", TclGetString(className), NULL); return NULL; @@ -816,8 +820,8 @@ TclOODefineObjCmd( return TCL_ERROR; } if (oPtr->classPtr == NULL) { - Tcl_AppendResult(interp, TclGetString(objv[1]), - " does not refer to a class", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s does not refer to a class",TclGetString(objv[1]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", TclGetString(objv[1]), NULL); return TCL_ERROR; @@ -1161,14 +1165,14 @@ TclOODefineClassObjCmd( return TCL_ERROR; } if (oPtr->flags & ROOT_OBJECT) { - Tcl_AppendResult(interp, - "may not modify the class of the root object class", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "may not modify the class of the root object class", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } if (oPtr->flags & ROOT_CLASS) { - Tcl_AppendResult(interp, - "may not modify the class of the class of classes", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "may not modify the class of the class of classes", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1194,9 +1198,10 @@ TclOODefineClassObjCmd( */ if ((oPtr->classPtr==NULL) == TclOOIsReachable(fPtr->classCls, clsPtr)) { - Tcl_AppendResult(interp, "may not change a ", - (oPtr->classPtr==NULL ? "non-" : ""), "class object into a ", - (oPtr->classPtr==NULL ? "" : "non-"), "class object", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "may not change a %sclass object into a %sclass object", + (oPtr->classPtr==NULL ? "non-" : ""), + (oPtr->classPtr==NULL ? "" : "non-"))); Tcl_SetErrorCode(interp, "TCL", "OO", "TRANSMUTATION", NULL); return TCL_ERROR; } @@ -1317,7 +1322,8 @@ TclOODefineDeleteMethodObjCmd( return TCL_ERROR; } if (!isInstanceDeleteMethod && !oPtr->classPtr) { - Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1440,7 +1446,8 @@ TclOODefineExportObjCmd( } clsPtr = oPtr->classPtr; if (!isInstanceExport && !clsPtr) { - Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1531,7 +1538,8 @@ TclOODefineForwardObjCmd( return TCL_ERROR; } if (!isInstanceForward && !oPtr->classPtr) { - Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1588,7 +1596,8 @@ TclOODefineMethodObjCmd( return TCL_ERROR; } if (!isInstanceMethod && !oPtr->classPtr) { - Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1639,7 +1648,8 @@ TclOODefineMixinObjCmd( return TCL_ERROR; } if (!isInstanceMixin && !oPtr->classPtr) { - Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1653,7 +1663,8 @@ TclOODefineMixinObjCmd( goto freeAndError; } if (!isInstanceMixin && TclOOIsReachable(oPtr->classPtr, clsPtr)) { - Tcl_AppendResult(interp, "may not mix a class into itself", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "may not mix a class into itself", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL); goto freeAndError; } @@ -1704,7 +1715,8 @@ TclOODefineRenameMethodObjCmd( return TCL_ERROR; } if (!isInstanceRenameMethod && !oPtr->classPtr) { - Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1764,7 +1776,8 @@ TclOODefineUnexportObjCmd( } clsPtr = oPtr->classPtr; if (!isInstanceUnexport && !clsPtr) { - Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1949,7 +1962,8 @@ ClassFilterGet( if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { - Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1984,7 +1998,8 @@ ClassFilterSet( if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { - Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } else if (Tcl_ListObjGetElements(interp, objv[0], &filterc, @@ -2027,7 +2042,8 @@ ClassMixinGet( if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { - Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -2065,7 +2081,8 @@ ClassMixinSet( if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { - Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } else if (Tcl_ListObjGetElements(interp, objv[0], &mixinc, @@ -2082,7 +2099,8 @@ ClassMixinSet( goto freeAndError; } if (TclOOIsReachable(oPtr->classPtr, mixins[i])) { - Tcl_AppendResult(interp, "may not mix a class into itself", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "may not mix a class into itself", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL); goto freeAndError; } @@ -2128,7 +2146,8 @@ ClassSuperGet( if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { - Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -2165,12 +2184,13 @@ ClassSuperSet( if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { - Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } else if (oPtr == oPtr->fPtr->objectCls->thisPtr) { - Tcl_AppendResult(interp, - "may not modify the superclass of the root object", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "may not modify the superclass of the root object", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } else if (Tcl_ListObjGetElements(interp, objv[0], &superc, @@ -2196,15 +2216,15 @@ ClassSuperSet( } for (j=0 ; jclassPtr, superclasses[i])) { - Tcl_AppendResult(interp, - "attempt to form circular dependency graph", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to form circular dependency graph", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL); failedAfterAlloc: ckfree((char *) superclasses); @@ -2265,7 +2285,8 @@ ClassVarsGet( if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { - Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -2301,7 +2322,8 @@ ClassVarsSet( if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { - Tcl_AppendResult(interp, "attempt to misuse API", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } else if (Tcl_ListObjGetElements(interp, objv[0], &varc, @@ -2313,15 +2335,16 @@ ClassVarsSet( const char *varName = Tcl_GetString(varv[i]); if (strstr(varName, "::") != NULL) { - Tcl_AppendResult(interp, "invalid declared variable name \"", - varName, "\": must not contain namespace separators", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid declared variable name \"%s\": must not %s", + varName, "contain namespace separators")); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL); return TCL_ERROR; } if (Tcl_StringMatch(varName, "*(*)")) { - Tcl_AppendResult(interp, "invalid declared variable name \"", - varName, "\": must not refer to an array element", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid declared variable name \"%s\": must not %s", + varName, "refer to an array element")); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL); return TCL_ERROR; } @@ -2591,15 +2614,16 @@ ObjVarsSet( const char *varName = Tcl_GetString(varv[i]); if (strstr(varName, "::") != NULL) { - Tcl_AppendResult(interp, "invalid declared variable name \"", - varName, "\": must not contain namespace separators", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid declared variable name \"%s\": must not %s", + varName, "contain namespace separators")); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL); return TCL_ERROR; } if (Tcl_StringMatch(varName, "*(*)")) { - Tcl_AppendResult(interp, "invalid declared variable name \"", - varName, "\": must not refer to an array element", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid declared variable name \"%s\": must not %s", + varName, "refer to an array element")); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL); return TCL_ERROR; } diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index f298320..796442b 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -177,8 +177,8 @@ GetClassFromObj( return NULL; } if (oPtr->classPtr == NULL) { - Tcl_AppendResult(interp, "\"", TclGetString(objPtr), - "\" is not a class", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" is not a class", TclGetString(objPtr))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", TclGetString(objPtr), NULL); return NULL; @@ -279,16 +279,16 @@ InfoObjectDefnCmd( hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]); if (hPtr == NULL) { unknownMethod: - Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]), - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown method \"%s\"", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; } procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr)); if (procPtr == NULL) { - Tcl_AppendResult(interp, - "definition not available for this kind of method", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "definition not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; @@ -390,17 +390,17 @@ InfoObjectForwardCmd( hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]); if (hPtr == NULL) { unknownMethod: - Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]), - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown method \"%s\"", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; } prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr)); if (prefixObj == NULL) { - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "prefix argument list not available for this kind of method", - NULL); + -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; @@ -491,7 +491,8 @@ InfoObjectIsACmd( return TCL_ERROR; } if (o2Ptr->classPtr == NULL) { - Tcl_AppendResult(interp, "non-classes cannot be mixins", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "non-classes cannot be mixins", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "NONCLASS", NULL); return TCL_ERROR; } else { @@ -516,7 +517,8 @@ InfoObjectIsACmd( return TCL_ERROR; } if (o2Ptr->classPtr == NULL) { - Tcl_AppendResult(interp, "non-classes cannot be types", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "non-classes cannot be types", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "NONCLASS", NULL); return TCL_ERROR; } @@ -651,8 +653,8 @@ InfoObjectMethodTypeCmd( hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]); if (hPtr == NULL) { unknownMethod: - Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]), - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown method \"%s\"", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; @@ -878,8 +880,8 @@ InfoClassConstrCmd( } procPtr = TclOOGetProcFromMethod(clsPtr->constructorPtr); if (procPtr == NULL) { - Tcl_AppendResult(interp, - "definition not available for this kind of method", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "definition not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "METHOD_TYPE", NULL); return TCL_ERROR; } @@ -937,16 +939,16 @@ InfoClassDefnCmd( } hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]); if (hPtr == NULL) { - Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]), - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown method \"%s\"", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; } procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr)); if (procPtr == NULL) { - Tcl_AppendResult(interp, - "definition not available for this kind of method", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "definition not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; @@ -1006,8 +1008,8 @@ InfoClassDestrCmd( } procPtr = TclOOGetProcFromMethod(clsPtr->destructorPtr); if (procPtr == NULL) { - Tcl_AppendResult(interp, - "definition not available for this kind of method", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "definition not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "METHOD_TYPE", NULL); return TCL_ERROR; } @@ -1085,17 +1087,17 @@ InfoClassForwardCmd( } hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]); if (hPtr == NULL) { - Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]), - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown method \"%s\"", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; } prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr)); if (prefixObj == NULL) { - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "prefix argument list not available for this kind of method", - NULL); + -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; @@ -1269,8 +1271,8 @@ InfoClassMethodTypeCmd( hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]); if (hPtr == NULL) { unknownMethod: - Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]), - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown method \"%s\"", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; @@ -1494,7 +1496,8 @@ InfoObjectCallCmd( contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL); if (contextPtr == NULL) { - Tcl_AppendResult(interp, "cannot construct any call chain", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "cannot construct any call chain", -1)); return TCL_ERROR; } Tcl_SetObjResult(interp, @@ -1538,7 +1541,8 @@ InfoClassCallCmd( callPtr = TclOOGetStereotypeCallChain(clsPtr, objv[2], PUBLIC_METHOD); if (callPtr == NULL) { - Tcl_AppendResult(interp, "cannot construct any call chain", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "cannot construct any call chain", -1)); return TCL_ERROR; } Tcl_SetObjResult(interp, TclOORenderCallChain(interp, callPtr)); diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 877c3db..60eaa6e 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -1329,8 +1329,8 @@ TclOONewForwardInstanceMethod( return NULL; } if (prefixLen < 1) { - Tcl_AppendResult(interp, "method forward prefix must be non-empty", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "method forward prefix must be non-empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL); return NULL; } @@ -1371,8 +1371,8 @@ TclOONewForwardMethod( return NULL; } if (prefixLen < 1) { - Tcl_AppendResult(interp, "method forward prefix must be non-empty", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "method forward prefix must be non-empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL); return NULL; } diff --git a/generic/tclOOStubLib.c b/generic/tclOOStubLib.c index 3b6ce37..55f2378 100644 --- a/generic/tclOOStubLib.c +++ b/generic/tclOOStubLib.c @@ -53,8 +53,9 @@ TclOOInitializeStubs( if (clientData == NULL) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Error loading ", packageName, " package; ", - "package not present or incomplete", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error loading %s package; package not present or incomplete", + packageName)); return NULL; } else { const TclOOStubs * const stubsPtr = clientData; @@ -76,9 +77,9 @@ TclOOInitializeStubs( error: Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Error loading ", packageName, " package", - " (requested version '", version, "', loaded version '", - actualVersion, "'): ", errMsg, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error loading %s package" + " (requested version '%s', loaded version '%s'): %s", + packageName, version, actualVersion, errMsg)); return NULL; } } diff --git a/generic/tclParse.c b/generic/tclParse.c index f0050c6..aab2fac 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -258,7 +258,8 @@ Tcl_ParseCommand( if ((start == NULL) && (numBytes != 0)) { if (interp != NULL) { - Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't parse a NULL pointer", -1)); } return TCL_ERROR; } @@ -568,14 +569,14 @@ Tcl_ParseCommand( } if (src[-1] == '"') { if (interp != NULL) { - Tcl_SetResult(interp, "extra characters after close-quote", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra characters after close-quote", -1)); } parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA; } else { if (interp != NULL) { - Tcl_SetResult(interp, "extra characters after close-brace", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "extra characters after close-brace", -1)); } parsePtr->errorType = TCL_PARSE_BRACE_EXTRA; } @@ -1175,8 +1176,8 @@ ParseTokens( } if (numBytes == 0) { if (parsePtr->interp != NULL) { - Tcl_SetResult(parsePtr->interp, - "missing close-bracket", TCL_STATIC); + Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( + "missing close-bracket", -1)); } parsePtr->errorType = TCL_PARSE_MISSING_BRACKET; parsePtr->term = tokenPtr->start; @@ -1411,8 +1412,8 @@ Tcl_ParseVarName( } if (numBytes == 0) { if (parsePtr->interp != NULL) { - Tcl_SetResult(parsePtr->interp, - "missing close-brace for variable name", TCL_STATIC); + Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( + "missing close-brace for variable name", -1)); } parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE; parsePtr->term = tokenPtr->start-1; @@ -1479,8 +1480,8 @@ Tcl_ParseVarName( } if ((parsePtr->term == src+numBytes) || (*parsePtr->term != ')')){ if (parsePtr->interp != NULL) { - Tcl_SetResult(parsePtr->interp, "missing )", - TCL_STATIC); + Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( + "missing )", -1)); } parsePtr->errorType = TCL_PARSE_MISSING_PAREN; parsePtr->term = src; @@ -1755,7 +1756,8 @@ Tcl_ParseBraces( goto error; } - Tcl_SetResult(parsePtr->interp, "missing close-brace", TCL_STATIC); + Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( + "missing close-brace", -1)); /* * Guess if the problem is due to comments by searching the source string @@ -1857,7 +1859,8 @@ Tcl_ParseQuotedString( } if (*parsePtr->term != '"') { if (parsePtr->interp != NULL) { - Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC); + Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( + "missing \"", -1)); } parsePtr->errorType = TCL_PARSE_MISSING_QUOTE; parsePtr->term = start; diff --git a/generic/tclPipe.c b/generic/tclPipe.c index d0b136d..56a1846 100644 --- a/generic/tclPipe.c +++ b/generic/tclPipe.c @@ -542,8 +542,8 @@ TclCreatePipeline( } if (*p == '\0') { if ((i == (lastBar + 1)) || (i == (argc - 1))) { - Tcl_SetResult(interp, "illegal use of | or |& in command", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "illegal use of | or |& in command", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX", NULL); goto error; @@ -722,8 +722,8 @@ TclCreatePipeline( * We had a bar followed only by redirections. */ - Tcl_SetResult(interp, "illegal use of | or |& in command", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "illegal use of | or |& in command", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX", NULL); goto error; diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 382ffe3..730efec 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -850,7 +850,8 @@ Tcl_PackageObjCmd( if (res == 0){ if (objc == 4) { ckfree(argv3i); - Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(availPtr->script, -1)); return TCL_OK; } Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); @@ -955,7 +956,8 @@ Tcl_PackageObjCmd( if (hPtr != NULL) { pkgPtr = Tcl_GetHashValue(hPtr); if (pkgPtr->version != NULL) { - Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(pkgPtr->version, -1)); } } return TCL_OK; @@ -1017,7 +1019,8 @@ Tcl_PackageObjCmd( if (objc == 2) { if (iPtr->packageUnknown != NULL) { - Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE); + Tcl_SetObjResult(interp, + Tcl_NewStringObj(iPtr->packageUnknown, -1)); } } else if (objc == 3) { if (iPtr->packageUnknown != NULL) { diff --git a/generic/tclScan.c b/generic/tclScan.c index d21bfaf..ef7eedf 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -261,6 +261,10 @@ ValidateFormat( int objIndex, xpgSize, nspace = numVars; int *nassign = TclStackAlloc(interp, nspace * sizeof(int)); char buf[TCL_UTF_MAX+1]; + Tcl_Obj *errorMsg; /* Place to build an error messages. Note that + * these are messy operations because we do + * not want to use the formatting engine; + * we're inside there! */ /* * Initialize an array that records the number of times a variable is @@ -328,9 +332,9 @@ ValidateFormat( gotSequential = 1; if (gotXpg) { mixedXPG: - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot mix \"%\" and \"%n$\" conversion specifiers", - TCL_STATIC); + -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "MIXEDSPECTYPES", NULL); goto error; } @@ -375,9 +379,9 @@ ValidateFormat( switch (ch) { case 'c': if (flags & SCAN_WIDTH) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "field width may not be specified in %c conversion", - TCL_STATIC); + -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADWIDTH", NULL); goto error; } @@ -389,9 +393,11 @@ ValidateFormat( if (flags & (SCAN_LONGER|SCAN_BIG)) { invalidFieldSize: buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; - Tcl_AppendResult(interp, - "field size modifier may not be specified in %", buf, - " conversion", NULL); + errorMsg = Tcl_NewStringObj( + "field size modifier may not be specified in %", -1); + Tcl_AppendToObj(errorMsg, buf, -1); + Tcl_AppendToObj(errorMsg, " conversion", -1); + Tcl_SetObjResult(interp, errorMsg); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADSIZE", NULL); goto error; } @@ -409,8 +415,8 @@ ValidateFormat( break; case 'u': if (flags & SCAN_BIG) { - Tcl_SetResult(interp, - "unsigned bignum scans are invalid", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unsigned bignum scans are invalid", -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL); goto error; } @@ -446,15 +452,18 @@ ValidateFormat( } break; badSet: - Tcl_SetResult(interp, "unmatched [ in format string", - TCL_STATIC); - Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BRACKET", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unmatched [ in format string", -1)); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BRACKET", NULL); goto error; default: buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; - Tcl_AppendResult(interp, "bad scan conversion character \"", buf, - "\"", NULL); - Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL); + errorMsg = Tcl_NewStringObj( + "bad scan conversion character \"", -1); + Tcl_AppendToObj(errorMsg, buf, -1); + Tcl_AppendToObj(errorMsg, "\"", -1); + Tcl_SetObjResult(interp, errorMsg); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL); goto error; } if (!(flags & SCAN_SUPPRESS)) { @@ -498,9 +507,9 @@ ValidateFormat( } for (i = 0; i < numVars; i++) { if (nassign[i] > 1) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "variable is assigned by multiple \"%n$\" conversion specifiers", - TCL_STATIC); + -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "POLYASSIGNED", NULL); goto error; } else if (!xpgSize && (nassign[i] == 0)) { @@ -509,9 +518,9 @@ ValidateFormat( * and/or numVars != 0), then too many vars were given */ - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "variable is not assigned by any conversion specifiers", - TCL_STATIC); + -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "UNASSIGNED", NULL); goto error; } @@ -522,13 +531,13 @@ ValidateFormat( badIndex: if (gotXpg) { - Tcl_SetResult(interp, "\"%n$\" argument index out of range", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "\"%n$\" argument index out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "INDEXRANGE", NULL); } else { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "different numbers of variable names and field specifiers", - TCL_STATIC); + -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "FIELDVARMISMATCH", NULL); } diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 529c38a..3888549 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -434,9 +434,9 @@ TraceExecutionObjCmd( return result; } if (listLen == 0) { - Tcl_SetResult(interp, "bad operation list \"\": must be " - "one or more of enter, leave, enterstep, or leavestep", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "bad operation list \"\": must be one or more of" + " enter, leave, enterstep, or leavestep", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS", NULL); return TCL_ERROR; @@ -677,8 +677,9 @@ TraceCommandObjCmd( return result; } if (listLen == 0) { - Tcl_SetResult(interp, "bad operation list \"\": must be " - "one or more of delete or rename", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "bad operation list \"\": must be one or more of" + " delete or rename", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS", NULL); return TCL_ERROR; @@ -875,8 +876,9 @@ TraceVariableObjCmd( return result; } if (listLen == 0) { - Tcl_SetResult(interp, "bad operation list \"\": must be " - "one or more of array, read, unset, or write", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "bad operation list \"\": must be one or more of" + " array, read, unset, or write", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS", NULL); return TCL_ERROR; @@ -2715,7 +2717,8 @@ TclCallVarTraces( if (disposeFlags & TCL_TRACE_RESULT_OBJECT) { Tcl_SetObjResult((Tcl_Interp *)iPtr, (Tcl_Obj *) result); } else { - Tcl_SetResult((Tcl_Interp *)iPtr, result, TCL_STATIC); + Tcl_SetObjResult((Tcl_Interp *)iPtr, + Tcl_NewStringObj(result, -1)); } Tcl_AddErrorInfo((Tcl_Interp *)iPtr, ""); diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 63c9fb2..6d42080 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -655,16 +655,16 @@ TclFindElement( if (p == limit) { if (openBraces != 0) { if (interp != NULL) { - Tcl_SetResult(interp, "unmatched open brace in list", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unmatched open brace in list", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "BRACE", NULL); } return TCL_ERROR; } else if (inQuotes) { if (interp != NULL) { - Tcl_SetResult(interp, "unmatched open quote in list", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unmatched open quote in list", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "QUOTE", NULL); } @@ -810,8 +810,8 @@ Tcl_SplitList( if (i >= size) { ckfree(argv); if (interp != NULL) { - Tcl_SetResult(interp, "internal error in Tcl_SplitList", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "internal error in Tcl_SplitList", -1)); Tcl_SetErrorCode(interp, "TCL", "INTERNAL", "Tcl_SplitList", NULL); } @@ -3382,16 +3382,10 @@ TclGetIntForIndex( parseError: if (interp != NULL) { - /* - * The result might not be empty; this resets it which should be both - * a cheap operation, and of little problem because this is an - * error-generation path anyway. - */ - bytes = Tcl_GetString(objPtr); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad index \"", bytes, - "\": must be integer?[+-]integer? or end?[+-]integer?", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad index \"%s\": must be integer?[+-]integer? or" + " end?[+-]integer?", bytes)); if (!strncmp(bytes, "end-", 4)) { bytes += 4; } @@ -3483,9 +3477,8 @@ SetEndOffsetFromAny( if ((*bytes != 'e') || (strncmp(bytes, "end", (size_t)((length > 3) ? 3 : length)) != 0)) { if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad index \"", bytes, - "\": must be end?[+-]integer?", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad index \"%s\": must be end?[+-]integer?", bytes)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL); } return TCL_ERROR; @@ -3519,9 +3512,8 @@ SetEndOffsetFromAny( badIndexFormat: if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad index \"", bytes, - "\": must be end?[+-]integer?", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad index \"%s\": must be end?[+-]integer?", bytes)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL); } return TCL_ERROR; @@ -3597,8 +3589,8 @@ TclCheckBadOctal( * be added to an existing error message as extra info. */ - Tcl_AppendResult(interp, " (looks like invalid octal number)", - NULL); + Tcl_AppendToObj(Tcl_GetObjResult(interp), + " (looks like invalid octal number)", -1); } return 1; } @@ -4214,7 +4206,7 @@ TclReToGlob( invalidGlob: if (interp != NULL) { - Tcl_AppendResult(interp, msg, NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, NULL); } Tcl_DStringFree(dsPtr); diff --git a/generic/tclVar.c b/generic/tclVar.c index e92dc5f..e31e9cf 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -3065,7 +3065,8 @@ ArrayStartSearchCmd( if ((varPtr == NULL) || !TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr)) { - Tcl_AppendResult(interp, "\"", varName, "\" isn't an array", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" isn't an array", varName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", varName, NULL); return TCL_ERROR; } @@ -3160,8 +3161,8 @@ ArrayAnyMoreCmd( if ((varPtr == NULL) || !TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr)) { - Tcl_AppendResult(interp, "\"", TclGetString(varNameObj), - "\" isn't an array", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" isn't an array", TclGetString(varNameObj))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", TclGetString(varNameObj), NULL); return TCL_ERROR; @@ -3266,8 +3267,8 @@ ArrayNextElementCmd( if ((varPtr == NULL) || !TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr)) { - Tcl_AppendResult(interp, "\"", TclGetString(varNameObj), - "\" isn't an array", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" isn't an array", TclGetString(varNameObj))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", TclGetString(varNameObj), NULL); return TCL_ERROR; @@ -3376,8 +3377,8 @@ ArrayDoneSearchCmd( if ((varPtr == NULL) || !TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr)) { - Tcl_AppendResult(interp, "\"", TclGetString(varNameObj), - "\" isn't an array", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" isn't an array", TclGetString(varNameObj))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", TclGetString(varNameObj), NULL); return TCL_ERROR; @@ -4019,8 +4020,8 @@ ArrayStatsCmd( if ((varPtr == NULL) || !TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr)) { - Tcl_AppendResult(interp, "\"", TclGetString(varNameObj), - "\" isn't an array", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" isn't an array", TclGetString(varNameObj))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", TclGetString(varNameObj), NULL); return TCL_ERROR; @@ -4028,7 +4029,8 @@ ArrayStatsCmd( stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr); if (stats == NULL) { - Tcl_SetResult(interp, "error reading array statistics", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error reading array statistics", -1)); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1)); @@ -4317,10 +4319,10 @@ ObjMakeUpvar( || (varFramePtr == NULL) || !HasLocalVars(varFramePtr) || (strstr(TclGetString(myNamePtr), "::") != NULL))) { - Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"", - TclGetString(myNamePtr), "\": upvar won't create " + Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf( + "bad variable name \"%s\": upvar won't create " "namespace variable that refers to procedure variable", - NULL); + TclGetString(myNamePtr))); Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", NULL); return TCL_ERROR; } @@ -4418,9 +4420,10 @@ TclPtrObjMakeUpvar( * myName looks like an array reference. */ - Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"", - myName, "\": upvar won't create a scalar variable " - "that looks like an array element", NULL); + Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf( + "bad variable name \"%s\": upvar won't create a" + " scalar variable that looks like an array element", + myName)); Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", NULL); return TCL_ERROR; @@ -4447,15 +4450,15 @@ TclPtrObjMakeUpvar( } if (varPtr == otherPtr) { - Tcl_SetResult((Tcl_Interp *) iPtr, - "can't upvar from variable to itself", TCL_STATIC); + Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_NewStringObj( + "can't upvar from variable to itself", -1)); Tcl_SetErrorCode(interp, "TCL", "UPVAR", "SELF", NULL); return TCL_ERROR; } if (TclIsVarTraced(varPtr)) { - Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName, - "\" has traces: can't use for upvar", NULL); + Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf( + "variable \"%s\" has traces: can't use for upvar", myName)); Tcl_SetErrorCode(interp, "TCL", "UPVAR", "TRACED", NULL); return TCL_ERROR; } else if (!TclIsVarUndefined(varPtr)) { @@ -4469,8 +4472,8 @@ TclPtrObjMakeUpvar( */ if (!TclIsVarLink(varPtr)) { - Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName, - "\" already exists", NULL); + Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf( + "variable \"%s\" already exists", myName)); Tcl_SetErrorCode(interp, "TCL", "UPVAR", "EXISTS", NULL); return TCL_ERROR; } @@ -4968,8 +4971,8 @@ Tcl_UpvarObjCmd( * for this particular case. */ - Tcl_AppendResult(interp, "bad level \"", TclGetString(levelObj), "\"", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad level \"%s\"", TclGetString(levelObj))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "LEVEL", NULL); return TCL_ERROR; } @@ -4978,8 +4981,8 @@ Tcl_UpvarObjCmd( * We've now finished with parsing levels; skip to the variable names. */ - objc -= hasLevel+1; - objv += hasLevel+1; + objc -= hasLevel + 1; + objv += hasLevel + 1; /* * Iterate over each (other variable, local variable) pair. Divide the @@ -5060,8 +5063,8 @@ SetArraySearchObj( return TCL_OK; syntax: - Tcl_AppendResult(interp, "illegal search identifier \"", string, "\"", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "illegal search identifier \"%s\"", string)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL); return TCL_ERROR; } @@ -5126,10 +5129,9 @@ ParseSearchId( */ if (strcmp(string+offset, varName) != 0) { - Tcl_AppendResult(interp, "search identifier \"", string, - "\" isn't for variable \"", varName, "\"", NULL); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "search identifier \"%s\" isn't for variable \"%s\"", + string, varName)); goto badLookup; } @@ -5153,7 +5155,8 @@ ParseSearchId( } } } - Tcl_AppendResult(interp, "couldn't find search \"", string, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't find search \"%s\"", string)); badLookup: Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL); return NULL; @@ -5894,8 +5897,8 @@ ObjFindNamespaceVar( Tcl_DecrRefCount(simpleNamePtr); } if ((varPtr == NULL) && (flags & TCL_LEAVE_ERR_MSG)) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "unknown variable \"", name, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown variable \"%s\"", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", name, NULL); } return (Tcl_Var) varPtr; diff --git a/generic/tclZlib.c b/generic/tclZlib.c index a799639..8a57a91 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -577,8 +577,8 @@ Tcl_ZlibStreamInit( TclDStringAppendObj(&cmdname, Tcl_GetObjResult(interp)); if (Tcl_GetCommandInfo(interp, Tcl_DStringValue(&cmdname), &cmdinfo) == 1) { - Tcl_SetResult(interp, - "BUG: Stream command name already exists", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "BUG: Stream command name already exists", -1)); Tcl_SetErrorCode(interp, "TCL", "BUG", "EXISTING_CMD", NULL); Tcl_DStringFree(&cmdname); goto error; @@ -900,8 +900,8 @@ Tcl_ZlibStreamPut( if (zshPtr->streamEnd) { if (zshPtr->interp) { - Tcl_SetResult(zshPtr->interp, - "already past compressed stream end", TCL_STATIC); + Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj( + "already past compressed stream end", -1)); Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", NULL); } return TCL_ERROR; @@ -1085,9 +1085,9 @@ Tcl_ZlibStreamGet( if (zshPtr->stream.avail_in > 0) { if (zshPtr->interp) { - Tcl_SetResult(zshPtr->interp, - "Unexpected zlib internal state during decompression", - TCL_STATIC); + Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj( + "unexpected zlib internal state during" + " decompression", -1)); Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "STATE", NULL); } @@ -2581,8 +2581,9 @@ ZlibTransformSetOption( /* not used */ } else if (value[0] == 's' && strcmp(value, "sync") == 0) { flushType = Z_SYNC_FLUSH; } else { - Tcl_AppendResult(interp, "unknown -flush type \"", value, - "\": must be full or sync", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown -flush type \"%s\": must be full or sync", + value)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "FLUSH", NULL); return TCL_ERROR; } @@ -3152,7 +3153,7 @@ Tcl_ZlibStreamInit( Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle) { - Tcl_SetResult(interp, "unimplemented", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL); return TCL_ERROR; } @@ -3218,7 +3219,7 @@ Tcl_ZlibDeflate( int level, Tcl_Obj *gzipHeaderDictObj) { - Tcl_SetResult(interp, "unimplemented", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL); return TCL_ERROR; } @@ -3231,7 +3232,7 @@ Tcl_ZlibInflate( int bufferSize, Tcl_Obj *gzipHeaderDictObj) { - Tcl_SetResult(interp, "unimplemented", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL); return TCL_ERROR; } diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 1cd6c46..4d6e31b 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -1648,9 +1648,9 @@ DdeObjCmd( */ if (Tcl_IsSafe(riPtr->interp) && riPtr->handlerPtr == NULL) { - Tcl_SetResult(riPtr->interp, "permission denied: " - "a handler procedure must be defined for use in " - "a safe interp", TCL_STATIC); + Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj( + "permission denied: a handler procedure must be" + " defined for use in a safe interp", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK", NULL); result = TCL_ERROR; -- cgit v0.12