Index: generic/tclArithSeries.c ================================================================== --- generic/tclArithSeries.c +++ generic/tclArithSeries.c @@ -636,12 +636,11 @@ dend = end; } } if (len > TCL_SIZE_MAX) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "max length of a Tcl list exceeded", TCL_AUTO_LENGTH)); + TclSetResult(interp, "max length of a Tcl list exceeded"); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (void *)NULL); return TCL_ERROR; } if (arithSeriesObj) { @@ -960,13 +959,12 @@ } else { /* Construct the elements array */ objv = (Tcl_Obj **) Tcl_Alloc(sizeof(Tcl_Obj*) * objc); if (objv == NULL) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "max length of a Tcl list exceeded", - TCL_AUTO_LENGTH)); + TclSetResult(interp, + "max length of a Tcl list exceeded"); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (void *)NULL); } return TCL_ERROR; } arithSeriesRepPtr->elements = objv; @@ -986,12 +984,11 @@ } *objvPtr = objv; *objcPtr = objc; } else { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "value is not an arithseries", TCL_AUTO_LENGTH)); + TclSetResult(interp, "value is not an arithseries"); Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", (void *)NULL); } return TCL_ERROR; } return TCL_OK; Index: generic/tclAssembly.c ================================================================== --- generic/tclAssembly.c +++ generic/tclAssembly.c @@ -1380,12 +1380,11 @@ } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } if (opnd < 0 || opnd > 3) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("operand must be [0..3]", -1)); + TclSetResult(interp, "operand must be [0..3]"); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND<0,>3", (void *)NULL); goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, opnd); break; @@ -1621,12 +1620,11 @@ if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } if (opnd < 2) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("operand must be >=2", -1)); + TclSetResult(interp, "operand must be >=2"); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND>=2", (void *)NULL); } goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd); @@ -1986,13 +1984,12 @@ if (TclListObjLength(interp, jumps, &objc) != TCL_OK) { return TCL_ERROR; } if (objc % 2 != 0) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "jump table must have an even number of list elements", - -1)); + TclSetResult(interp, + "jump table must have an even number of list elements"); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADJUMPTABLE", (void *)NULL); } return TCL_ERROR; } if (TclListObjGetElements(interp, jumps, &objc, &objv) != TCL_OK) { @@ -2017,13 +2014,13 @@ TclGetString(objv[i+1])); hashEntry = Tcl_CreateHashEntry(jtHashPtr, TclGetString(objv[i]), &isNew); if (!isNew) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "duplicate entry in jump table for \"%s\"", - TclGetString(objv[i]))); + TclGetString(objv[i])); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY", (void *)NULL); DeleteMirrorJumpTable(jtPtr); return TCL_ERROR; } } @@ -2103,12 +2100,11 @@ TclNewObj(operandObj); if (!TclWordKnownAtCompileTime(*tokenPtrPtr, operandObj)) { Tcl_DecrRefCount(operandObj); if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "assembly code may not contain substitutions", -1)); + TclSetResult(interp, "assembly code may not contain substitutions"); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOSUBST", (void *)NULL); } return TCL_ERROR; } *tokenPtrPtr = TokenAfter(*tokenPtrPtr); @@ -2325,13 +2321,13 @@ } localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr); Tcl_DecrRefCount(varNameObj); if (localVar < 0) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "cannot use this instruction to create a variable" - " in a non-proc context", -1)); + " in a non-proc context"); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", (void *)NULL); } return TCL_INDEX_NONE; } *tokenPtrPtr = TokenAfter(tokenPtr); @@ -2361,12 +2357,11 @@ { const char* p; for (p = name; p+2 < name+nameLen; p++) { if ((*p == ':') && (p[1] == ':')) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "variable \"%s\" is not local", name)); + TclPrintfResult(interp, "variable \"%s\" is not local", name); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONLOCAL", name, (void *)NULL); return TCL_ERROR; } } return TCL_OK; @@ -2394,15 +2389,12 @@ static int CheckOneByte( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ int value) /* Value to check */ { - Tcl_Obj* result; /* Error message */ - if (value < 0 || value > 0xFF) { - result = Tcl_NewStringObj("operand does not fit in one byte", -1); - Tcl_SetObjResult(interp, result); + TclSetResult(interp, "operand does not fit in one byte"); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", (void *)NULL); return TCL_ERROR; } return TCL_OK; } @@ -2429,15 +2421,12 @@ static int CheckSignedOneByte( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ int value) /* Value to check */ { - Tcl_Obj* result; /* Error message */ - if (value > 0x7F || value < -0x80) { - result = Tcl_NewStringObj("operand does not fit in one byte", -1); - Tcl_SetObjResult(interp, result); + TclSetResult(interp, "operand does not fit in one byte"); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", (void *)NULL); return TCL_ERROR; } return TCL_OK; } @@ -2462,15 +2451,12 @@ static int CheckNonNegative( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ int value) /* Value to check */ { - Tcl_Obj* result; /* Error message */ - if (value < 0) { - result = Tcl_NewStringObj("operand must be nonnegative", -1); - Tcl_SetObjResult(interp, result); + TclSetResult(interp, "operand must be nonnegative"); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONNEGATIVE", (void *)NULL); return TCL_ERROR; } return TCL_OK; } @@ -2495,15 +2481,12 @@ static int CheckStrictlyPositive( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ int value) /* Value to check */ { - Tcl_Obj* result; /* Error message */ - if (value <= 0) { - result = Tcl_NewStringObj("operand must be positive", -1); - Tcl_SetObjResult(interp, result); + TclSetResult(interp, "operand must be positive"); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "POSITIVE", (void *)NULL); return TCL_ERROR; } return TCL_OK; } @@ -2549,12 +2532,12 @@ /* * This is a duplicate label. */ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "duplicate definition of label \"%s\"", labelName)); + TclPrintfResult(interp, + "duplicate definition of label \"%s\"", labelName); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPLABEL", labelName, (void *)NULL); } return TCL_ERROR; } @@ -2950,12 +2933,12 @@ /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "undefined label \"%s\"", TclGetString(jumpTarget))); + TclPrintfResult(interp, + "undefined label \"%s\"", TclGetString(jumpTarget)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL", TclGetString(jumpTarget), (void *)NULL); Tcl_SetErrorLine(interp, bbPtr->jumpLine); } } @@ -3233,15 +3216,15 @@ /* * Report an error for a throw in the wrong context. */ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "\"%s\" instruction may not appear in " "a context where an exception has been " "caught and not disposed of.", - tclInstructionTable[opcode].name)); + tclInstructionTable[opcode].name); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADTHROW", (void *)NULL); AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr); } return TCL_ERROR; } @@ -3410,12 +3393,12 @@ if (blockPtr->initialStackDepth == initialStackDepth) { return TCL_OK; } if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "inconsistent stack depths on two execution paths", -1)); + TclSetResult(interp, + "inconsistent stack depths on two execution paths"); /* * TODO - add execution trace of both paths */ @@ -3440,11 +3423,11 @@ * underflows the stack. */ if (initialStackDepth + blockPtr->minStackDepth < 0) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("stack underflow", -1)); + TclSetResult(interp, "stack underflow"); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", (void *)NULL); AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr); Tcl_SetErrorLine(interp, blockPtr->startLine); } return TCL_ERROR; @@ -3458,12 +3441,12 @@ if (blockPtr->enclosingCatch != 0 && initialStackDepth + blockPtr->minStackDepth < (blockPtr->enclosingCatch->initialStackDepth + blockPtr->enclosingCatch->finalStackDepth)) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "code pops stack below level of enclosing catch", -1)); + TclSetResult(interp, + "code pops stack below level of enclosing catch"); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACKINCATCH", (void *)NULL); AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr); Tcl_SetErrorLine(interp, blockPtr->startLine); } return TCL_ERROR; @@ -3585,13 +3568,13 @@ * Exit with unbalanced stack. */ if (depth != 1) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "stack is unbalanced on exit from the code (depth=%d)", - depth)); + depth); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", (void *)NULL); } return TCL_ERROR; } @@ -3729,13 +3712,13 @@ if (bbPtr->catchState == BBCS_UNKNOWN) { bbPtr->enclosingCatch = enclosing; } else if (bbPtr->enclosingCatch != enclosing) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "execution reaches an instruction in inconsistent " - "exception contexts", -1)); + "exception contexts"); Tcl_SetErrorLine(interp, bbPtr->startLine); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADCATCH", (void *)NULL); } return TCL_ERROR; } @@ -3789,12 +3772,12 @@ * the state was on entry to the catch. */ if (enclosing == NULL) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "endCatch without a corresponding beginCatch", -1)); + TclSetResult(interp, + "endCatch without a corresponding beginCatch"); Tcl_SetErrorLine(interp, bbPtr->startLine); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADENDCATCH", (void *)NULL); } return TCL_ERROR; } @@ -3859,17 +3842,17 @@ CheckForUnclosedCatches( AssemblyEnv* assemEnvPtr) /* Assembly environment */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ - Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; - /* Tcl interpreter */ if (assemEnvPtr->curr_bb->catchState >= BBCS_INCATCH) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "catch still active on exit from assembly code", -1)); + Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; + /* Tcl interpreter */ + TclSetResult(interp, + "catch still active on exit from assembly code"); Tcl_SetErrorLine(interp, assemEnvPtr->curr_bb->enclosingCatch->startLine); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "UNCLOSEDCATCH", (void *)NULL); } return TCL_ERROR; Index: generic/tclBasic.c ================================================================== --- generic/tclBasic.c +++ generic/tclBasic.c @@ -658,89 +658,101 @@ void *clientData, Tcl_Interp *interp, /* Current interpreter. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { + const char *buildData = (const char *) clientData; + char buf[80]; + const char *arg, *p, *q; + Tcl_Size len; + int idx; + static const char *identifiers[] = { + "commit", "compiler", "patchlevel", "version", NULL + }; + enum Identifiers { + ID_COMMIT, ID_COMPILER, ID_PATCHLEVEL, ID_VERSION, ID_OTHER + }; + if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?option?"); return TCL_ERROR; - } - if (objc == 2) { - Tcl_Size len; - const char *arg = TclGetStringFromObj(objv[1], &len); - if (len == 7 && !strcmp(arg, "version")) { - char buf[80]; - const char *p = strchr((char *)clientData, '.'); - if (p) { - const char *q = strchr(p + 1, '.'); - const char *r = strchr(p + 1, '+'); - p = (q < r) ? q : r; - } - if (p) { - memcpy(buf, (char *)clientData, p - (char *)clientData); - buf[p - (char *)clientData] = '\0'; - Tcl_AppendResult(interp, buf, (char *)NULL); - } - return TCL_OK; - } else if (len == 10 && !strcmp(arg, "patchlevel")) { - char buf[80]; - const char *p = strchr((char *)clientData, '+'); - if (p) { - memcpy(buf, (char *)clientData, p - (char *)clientData); - buf[p - (char *)clientData] = '\0'; - Tcl_AppendResult(interp, buf, (char *)NULL); - } - return TCL_OK; - } else if (len == 6 && !strcmp(arg, "commit")) { - const char *q, *p = strchr((char *)clientData, '+'); - if (p) { - if ((q = strchr(p, '.'))) { - char buf[80]; - memcpy(buf, p + 1, q - p - 1); - buf[q - p - 1] = '\0'; - Tcl_AppendResult(interp, buf, (char *)NULL); - } else { - Tcl_AppendResult(interp, p + 1, (char *)NULL); - } - } - return TCL_OK; - } else if (len == 8 && !strcmp(arg, "compiler")) { - const char *p = strchr((char *)clientData, '.'); - while (p) { - if (!strncmp(p + 1, "clang-", 6) - || !strncmp(p + 1, "gcc-", 4) - || !strncmp(p + 1, "icc-", 4) - || !strncmp(p + 1, "msvc-", 5)) { - const char *q = strchr(p + 1, '.'); - if (q) { - char buf[16]; - memcpy(buf, p + 1, q - p - 1); - buf[q - p - 1] = '\0'; - Tcl_AppendResult(interp, buf, (char *)NULL); - } else { - Tcl_AppendResult(interp, p + 1, (char *)NULL); - } - return TCL_OK; - } - p = strchr(p + 1, '.'); - } - Tcl_AppendResult(interp, "0", (char *)NULL); - return TCL_OK; - } - const char *p = strchr((char *)clientData, '.'); - while (p) { - if (!strncmp(p + 1, arg, len) - && ((p[len + 1] == '.') || (p[len + 1] == '\0'))) { - Tcl_AppendResult(interp, "1", (char *)NULL); - return TCL_OK; - } - p = strchr(p + 1, '.'); - } - Tcl_AppendResult(interp, "0", (char *)NULL); - return TCL_OK; - } - Tcl_AppendResult(interp, (char *)clientData, (char *)NULL); + } else if (objc < 2) { + TclSetResult(interp, buildData); + return TCL_OK; + } + + /* + * Query for a specific piece of build info + */ + + if (Tcl_GetIndexFromObj(NULL, objv[1], identifiers, NULL, TCL_EXACT, + &idx) != TCL_OK) { + idx = ID_OTHER; + } + + switch (idx) { + case ID_PATCHLEVEL: + if ((p = strchr(buildData, '+')) != NULL) { + memcpy(buf, buildData, p - buildData); + buf[p - buildData] = '\0'; + TclSetResult(interp, buf); + } + return TCL_OK; + case ID_VERSION: + if ((p = strchr(buildData, '.')) != NULL) { + const char *r = strchr(p++, '+'); + q = strchr(p, '.'); + p = (q < r) ? q : r; + } + if (p != NULL) { + memcpy(buf, buildData, p - buildData); + buf[p - buildData] = '\0'; + TclSetResult(interp, buf); + } + return TCL_OK; + case ID_COMMIT: + if ((p = strchr(buildData, '+')) != NULL) { + if ((q = strchr(p++, '.')) != NULL) { + memcpy(buf, p, q - p); + buf[q - p] = '\0'; + TclSetResult(interp, buf); + } else { + TclSetResult(interp, p); + } + } + return TCL_OK; + case ID_COMPILER: + for (p = strchr(buildData, '.'); p++; p = strchr(p, '.')) { + /* + * Does the word begin with one of the standard prefixes? + */ + if (!strncmp(p, "clang-", 6) + || !strncmp(p, "gcc-", 4) + || !strncmp(p, "icc-", 4) + || !strncmp(p, "msvc-", 5)) { + if ((q = strchr(p, '.')) != NULL) { + memcpy(buf, p, q - p); + buf[q - p] = '\0'; + TclSetResult(interp, buf); + } else { + TclSetResult(interp, p); + } + return TCL_OK; + } + } + break; + default: /* Boolean test for other identifiers' presence */ + arg = TclGetStringFromObj(objv[1], &len); + for (p = strchr(buildData, '.'); p++; p = strchr(p, '.')) { + if (!strncmp(p, arg, len) + && ((p[len] == '.') || (p[len] == '\0'))) { + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); + return TCL_OK; + } + } + } + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); return TCL_OK; } static int buildInfoObjCmd( @@ -749,11 +761,11 @@ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return buildInfoObjCmd2(clientData, interp, objc, objv); } - + /* *---------------------------------------------------------------------- * * Tcl_CreateInterp -- * @@ -1497,13 +1509,13 @@ TCL_UNUSED(int) /*objc*/, TCL_UNUSED(Tcl_Obj *const *) /* objv */) { const UnsafeEnsembleInfo *infoPtr = (const UnsafeEnsembleInfo *)clientData; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "not allowed to invoke subcommand %s of %s", - infoPtr->commandName, infoPtr->ensembleNsName)); + infoPtr->commandName, infoPtr->ensembleNsName); Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", (char *)NULL); return TCL_ERROR; } /* @@ -2193,13 +2205,13 @@ * the source, in order to avoid potential confusion, lets prevent "::" in * the token too. - dl */ if (strstr(hiddenCmdToken, "::") != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "cannot use namespace qualifiers in hidden command" - " token (rename)", -1)); + " token (rename)"); Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", (char *)NULL); return TCL_ERROR; } /* @@ -2218,13 +2230,12 @@ /* * Check that the command is really in global namespace */ if (cmdPtr->nsPtr != iPtr->globalNsPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only hide global namespace commands (use rename then hide)", - -1)); + TclSetResult(interp, + "can only hide global namespace commands (use rename then hide)"); Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", (char *)NULL); return TCL_ERROR; } /* @@ -2244,13 +2255,13 @@ * exists. */ hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew); if (!isNew) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "hidden command named \"%s\" already exists", - hiddenCmdToken)); + hiddenCmdToken); Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", (char *)NULL); return TCL_ERROR; } /* @@ -2348,13 +2359,12 @@ * trying to do an expose and a rename (to another namespace) at the same * time). */ if (strstr(cmdName, "::") != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot expose to a namespace (use expose to toplevel, then rename)", - -1)); + TclSetResult(interp, + "cannot expose to a namespace (use expose to toplevel, then rename)"); Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", (char *)NULL); return TCL_ERROR; } /* @@ -2365,12 +2375,12 @@ hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr; if (hiddenCmdTablePtr != NULL) { hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken); } if (hPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown hidden command \"%s\"", hiddenCmdToken)); + TclPrintfResult(interp, + "unknown hidden command \"%s\"", hiddenCmdToken); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", hiddenCmdToken, (char *)NULL); return TCL_ERROR; } cmdPtr = (Command *) Tcl_GetHashValue(hPtr); @@ -2385,13 +2395,13 @@ /* * This case is theoretically impossible, we might rather Tcl_Panic * than 'nicely' erroring out ? */ - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "trying to expose a non-global command namespace command", - -1)); + TclSetResult(interp, + "trying to expose a non-global command namespace command"); + Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", (char *)NULL); return TCL_ERROR; } /* * This is the global table. @@ -2404,12 +2414,12 @@ * exposing a previously hidden command. */ hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew); if (!isNew) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "exposed command \"%s\" already exists", cmdName)); + TclPrintfResult(interp, + "exposed command \"%s\" already exists", cmdName); Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", (char *)NULL); return TCL_ERROR; } /* @@ -3054,14 +3064,14 @@ */ cmd = Tcl_FindCommand(interp, oldName, NULL, /*flags*/ 0); cmdPtr = (Command *) cmd; if (cmdPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "can't %s \"%s\": command doesn't exist", ((newName == NULL) || (*newName == '\0')) ? "delete" : "rename", - oldName)); + oldName); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, (char *)NULL); return TCL_ERROR; } /* @@ -3087,19 +3097,19 @@ TclGetNamespaceForQualName(interp, newName, NULL, TCL_CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail); if ((newNsPtr == NULL) || (newTail == NULL)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't rename to \"%s\": bad command name", newName)); + TclPrintfResult(interp, + "can't rename to \"%s\": bad command name", newName); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL); result = TCL_ERROR; goto done; } if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't rename to \"%s\": command already exists", newName)); + TclPrintfResult(interp, + "can't rename to \"%s\": command already exists", newName); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME", "TARGET_EXISTS", (char *)NULL); result = TCL_ERROR; goto done; } @@ -4047,14 +4057,12 @@ /* * If the interpreter has been deleted, return an error. */ if (iPtr->flags & DELETED) { - 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", (char *)NULL); + TclSetResult(interp, "attempt to call eval in deleted interpreter"); + Tcl_SetErrorCode(interp, "TCL", "IDELETE", (char *)NULL); return TCL_ERROR; } if (iPtr->execEnvPtr->rewind) { return TCL_ERROR; @@ -4076,12 +4084,11 @@ if ((iPtr->numLevels <= iPtr->maxNestingDepth)) { return TCL_OK; } - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "too many nested evaluations (infinite loop?)", -1)); + TclSetResult(interp, "too many nested evaluations (infinite loop?)"); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", (char *)NULL); return TCL_ERROR; } /* @@ -4211,11 +4218,11 @@ if (length == 0) { message = "eval canceled"; } } - Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1)); + TclSetResult(interp, message); Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, (char *)NULL); } /* * Return TCL_ERROR to the caller (not necessarily just the Tcl core @@ -4501,12 +4508,11 @@ /* * When it's been deleted, and we're told not to attempt resolving * it ourselves, all we can do is raise an error. */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "attempt to invoke a deleted command")); + TclSetResult(interp, "attempt to invoke a deleted command"); Tcl_SetErrorCode(interp, "TCL", "EVAL", "DELETEDCOMMAND", (char *)NULL); return TCL_ERROR; } } if (cmdPtr == NULL) { @@ -4875,12 +4881,12 @@ * "blocking" interface. */ cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr); if (cmdPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid command name \"%s\"", TclGetString(objv[0]))); + TclPrintfResult(interp, + "invalid command name \"%s\"", TclGetString(objv[0])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", TclGetString(objv[0]), (char *)NULL); /* * Release any resources we locked and allocated during the handler @@ -6366,18 +6372,16 @@ { char buf[TCL_INTEGER_SPACE]; Tcl_ResetResult(interp); if (returnCode == TCL_BREAK) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "invoked \"break\" outside of a loop", -1)); + TclSetResult(interp, "invoked \"break\" outside of a loop"); } else if (returnCode == TCL_CONTINUE) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "invoked \"continue\" outside of a loop", -1)); + TclSetResult(interp, "invoked \"continue\" outside of a loop"); } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "command returned bad code: %d", returnCode)); + TclPrintfResult(interp, + "command returned bad code: %d", returnCode); } snprintf(buf, sizeof(buf), "%d", returnCode); Tcl_SetErrorCode(interp, "TCL", "UNEXPECTED_RESULT_CODE", buf, (char *)NULL); } @@ -6678,12 +6682,11 @@ { if (interp == NULL) { return TCL_ERROR; } if ((objc < 1) || (objv == NULL)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "illegal argument vector", -1)); + TclSetResult(interp, "illegal argument vector"); return TCL_ERROR; } if ((flags & TCL_INVOKE_HIDDEN) == 0) { Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN"); } @@ -6707,12 +6710,12 @@ hTblPtr = iPtr->hiddenCmdTablePtr; if (hTblPtr != NULL) { hPtr = Tcl_FindHashEntry(hTblPtr, cmdName); } if (hPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid hidden command name \"%s\"", cmdName)); + TclPrintfResult(interp, + "invalid hidden command name \"%s\"", cmdName); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName, (char *)NULL); return TCL_ERROR; } cmdPtr = (Command *) Tcl_GetHashValue(hPtr); @@ -7197,12 +7200,11 @@ Tcl_SetObjResult(interp, Tcl_NewBignumObj(&root)); } return TCL_OK; negarg: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "square root of negative argument", -1)); + TclSetResult(interp, "square root of negative argument"); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", (char *)NULL); return TCL_ERROR; } @@ -8266,12 +8268,11 @@ break; case FP_ZERO: TclNewLiteralStringObj(objPtr, "zero"); break; default: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unable to classify number: %f", d)); + TclPrintfResult(interp, "unable to classify number: %f", d); return TCL_ERROR; } Tcl_SetObjResult(interp, objPtr); return TCL_OK; } @@ -8308,13 +8309,13 @@ if (*tail == ':' && tail[-1] == ':') { name = tail + 1; break; } } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "%s arguments for math function \"%s\"", - (found < expected ? "not enough" : "too many"), name)); + (found < expected ? "not enough" : "too many"), name); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL); } #ifdef USE_DTRACE /* @@ -8819,12 +8820,12 @@ Tcl_WrongNumArgs(interp, 1, objv, "?command? ?arg ...?"); return TCL_ERROR; } if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "tailcall can only be called from a proc, lambda or method", -1)); + TclSetResult(interp, + "tailcall can only be called from a proc, lambda or method"); Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", (char *)NULL); return TCL_ERROR; } /* @@ -8981,12 +8982,11 @@ Tcl_WrongNumArgs(interp, 1, objv, "?returnValue?"); return TCL_ERROR; } if (!corPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yield can only be called in a coroutine", -1)); + TclSetResult(interp, "yield can only be called in a coroutine"); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (char *)NULL); return TCL_ERROR; } if (objc == 2) { @@ -9014,19 +9014,17 @@ Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?"); return TCL_ERROR; } if (!corPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yieldto can only be called in a coroutine", -1)); + TclSetResult(interp, "yieldto can only be called in a coroutine"); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (char *)NULL); return TCL_ERROR; } if (((Namespace *) nsPtr)->flags & NS_DYING) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yieldto called in deleted namespace", -1)); + TclSetResult(interp, "yieldto called in deleted namespace"); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", (char *)NULL); return TCL_ERROR; } @@ -9256,12 +9254,11 @@ } } } iPtr->execEnvPtr = corPtr->eePtr; - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot yield: C stack busy", -1)); + TclSetResult(interp, "cannot yield: C stack busy"); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", (char *)NULL); return TCL_ERROR; } @@ -9345,12 +9342,11 @@ * Look up the coroutine. */ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only get coroutine type of a coroutine", -1)); + TclSetResult(interp, "can only get coroutine type of a coroutine"); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", TclGetString(objv[1]), (char *)NULL); return TCL_ERROR; } @@ -9359,11 +9355,11 @@ * future. */ corPtr = (CoroutineData *) cmdPtr->objClientData; if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1)); + TclSetResult(interp, "active"); return TCL_OK; } /* * Inactive coroutines are classified by the (effective) command used to @@ -9370,18 +9366,17 @@ * suspend them, which matters when you're injecting a probe. */ switch (corPtr->nargs) { case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL: - Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", -1)); + TclSetResult(interp, "yield"); return TCL_OK; case COROUTINE_ARGUMENTS_ARBITRARY: - Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", -1)); + TclSetResult(interp, "yieldto"); return TCL_OK; default: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unknown coroutine type", -1)); + TclSetResult(interp, "unknown coroutine type"); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", (char *)NULL); return TCL_ERROR; } } @@ -9406,11 +9401,11 @@ */ Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); + TclSetResult(interp, errMsg); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", TclGetString(objPtr), (char *) NULL); return NULL; } return (CoroutineData *) cmdPtr->objClientData; @@ -9439,12 +9434,12 @@ "can only inject a command into a coroutine"); if (!corPtr) { return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a command into a suspended coroutine", -1)); + TclSetResult(interp, + "can only inject a command into a suspended coroutine"); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); return TCL_ERROR; } /* @@ -9484,13 +9479,12 @@ "can only inject a probe command into a coroutine"); if (!corPtr) { return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a probe command into a suspended coroutine", - -1)); + TclSetResult(interp, + "can only inject a probe command into a suspended coroutine"); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); return TCL_ERROR; } /* @@ -9676,12 +9670,12 @@ "can only inject a command into a coroutine"); if (!corPtr) { return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a command into a suspended coroutine", -1)); + TclSetResult(interp, + "can only inject a command into a suspended coroutine"); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); return TCL_ERROR; } /* @@ -9705,13 +9699,13 @@ Tcl_Obj *const objv[]) /* Argument objects. */ { CoroutineData *corPtr = (CoroutineData *) clientData; if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "coroutine \"%s\" is already running", - TclGetString(objv[0]))); + TclGetString(objv[0])); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", (char *)NULL); return TCL_ERROR; } /* @@ -9729,13 +9723,12 @@ return TCL_ERROR; } break; default: if (corPtr->nargs + 1 != objc) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("wrong coro nargs; how did we get here? " - "not implemented!", -1)); + TclSetResult(interp, + "wrong coro nargs; how did we get here? not implemented!"); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL); return TCL_ERROR; } /* fallthrough */ case COROUTINE_ARGUMENTS_ARBITRARY: @@ -9783,20 +9776,20 @@ procName = TclGetString(objv[1]); TclGetNamespaceForQualName(interp, procName, inNsPtr, 0, &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName); if (nsPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "can't create procedure \"%s\": unknown namespace", - procName)); + procName); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", (char *)NULL); return TCL_ERROR; } if (simpleName == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "can't create procedure \"%s\": bad procedure name", - procName)); + procName); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, (char *)NULL); return TCL_ERROR; } /* Index: generic/tclBinary.c ================================================================== --- generic/tclBinary.c +++ generic/tclBinary.c @@ -399,12 +399,12 @@ if (numBytes > INT_MAX) { /* Caller asked for numBytes to be written to an int, but the * value is outside the int range. */ if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "byte sequence length exceeds INT_MAX", -1)); + TclSetResult(interp, + "byte sequence length exceeds INT_MAX"); Tcl_SetErrorCode(interp, "TCL", "API", "OUTDATED", (void *)NULL); } return NULL; } else { *(int *)numBytesPtr = (int) numBytes; @@ -516,14 +516,14 @@ if (ch > 255) { proper = 0; if (demandProper) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "expected byte sequence but character %" TCL_Z_MODIFIER "u was '%1s' (U+%06X)", - dst - byteArrayPtr->bytes, src, ch)); + dst - byteArrayPtr->bytes, src, ch); Tcl_SetErrorCode(interp, "TCL", "VALUE", "BYTES", (void *)NULL); } Tcl_Free(byteArrayPtr); *byteArrayPtrPtr = NULL; return proper; @@ -965,13 +965,12 @@ } if (count == BINARY_ALL) { count = listc; } else if (count > listc) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "number of elements in list does not match count", - -1)); + TclSetResult(interp, + "number of elements in list does not match count"); return TCL_ERROR; } if (TclListObjGetElements(interp, objv[arg], &listc, &listv) != TCL_OK) { return TCL_ERROR; @@ -981,12 +980,12 @@ offset += count*size; break; case 'x': if (count == BINARY_ALL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot use \"*\" in format string with \"x\"", -1)); + TclSetResult(interp, + "cannot use \"*\" in format string with \"x\""); return TCL_ERROR; } else if (count == BINARY_NOCOUNT) { count = 1; } offset += count; @@ -1296,13 +1295,13 @@ Tcl_SetObjResult(interp, resultPtr); return TCL_OK; badValue: Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "expected %s string but got \"%s\" instead", - errorString, errorValue)); + errorString, errorValue); return TCL_ERROR; badCount: errorString = "missing count for \"@\" field specifier"; goto error; @@ -1316,17 +1315,16 @@ Tcl_UniChar ch = 0; char buf[5] = ""; TclUtfToUniChar(errorString, &ch); buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad field specifier \"%s\"", buf)); + TclPrintfResult(interp, "bad field specifier \"%s\"", buf); return TCL_ERROR; } error: - Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1)); + TclSetResult(interp, errorString); return TCL_ERROR; } /* *---------------------------------------------------------------------- @@ -1697,17 +1695,16 @@ Tcl_UniChar ch = 0; char buf[5] = ""; TclUtfToUniChar(errorString, &ch); buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad field specifier \"%s\"", buf)); + TclPrintfResult(interp, "bad field specifier \"%s\"", buf); return TCL_ERROR; } error: - Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1)); + TclSetResult(interp, errorString); return TCL_ERROR; } /* *---------------------------------------------------------------------- @@ -2563,13 +2560,13 @@ ucs4 = c; } else { TclUtfToUniChar((const char *)(data - 1), &ucs4); } TclDecrRefCount(resultObj); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "invalid hexadecimal digit \"%c\" (U+%06X) at position %" - TCL_Z_MODIFIER "u", ucs4, ucs4, data - datastart - 1)); + TCL_Z_MODIFIER "u", ucs4, ucs4, data - datastart - 1); Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", (void *)NULL); return TCL_ERROR; } /* @@ -2632,12 +2629,11 @@ case OPT_MAXLEN: if (TclGetWideIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) { return TCL_ERROR; } if (maxlen < 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "line length out of range", -1)); + TclSetResult(interp, "line length out of range"); Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE", "LINE_LENGTH", (void *)NULL); return TCL_ERROR; } break; @@ -2760,12 +2756,11 @@ if (Tcl_GetIntFromObj(interp, objv[i + 1], &lineLength) != TCL_OK) { return TCL_ERROR; } if (lineLength < 5 || lineLength > 85) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "line length out of range", -1)); + TclSetResult(interp, "line length out of range"); Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE", "LINE_LENGTH", (void *)NULL); return TCL_ERROR; } lineLength = ((lineLength - 1) & -4) + 1; /* 5, 9, 13 ... */ @@ -2781,27 +2776,27 @@ switch (*p) { case '\t': case '\v': case '\f': case '\r': - p++; numBytes--; + p++; + numBytes--; continue; case '\n': numBytes--; break; default: - badwrap: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "invalid wrapchar; will defeat decoding", - -1)); - Tcl_SetErrorCode(interp, "TCL", "BINARY", - "ENCODE", "WRAPCHAR", (void *)NULL); - return TCL_ERROR; + goto badwrap; } } if (numBytes) { - goto badwrap; + badwrap: + TclSetResult(interp, + "invalid wrapchar; will defeat decoding"); + Tcl_SetErrorCode(interp, "TCL", "BINARY", + "ENCODE", "WRAPCHAR", (void *)NULL); + return TCL_ERROR; } } break; } } @@ -3016,11 +3011,11 @@ Tcl_SetByteArrayLength(resultObj, cursor - begin); Tcl_SetObjResult(interp, resultObj); return TCL_OK; shortUu: - Tcl_SetObjResult(interp, Tcl_ObjPrintf("short uuencode data")); + TclSetResult(interp, "short uuencode data"); Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "SHORT", (void *)NULL); TclDecrRefCount(resultObj); return TCL_ERROR; badUu: @@ -3027,13 +3022,13 @@ if (pure) { ucs4 = c; } else { TclUtfToUniChar((const char *)(data - 1), &ucs4); } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "invalid uuencode character \"%c\" (U+%06X) at position %" - TCL_Z_MODIFIER "u", ucs4, ucs4, data - datastart - 1)); + TCL_Z_MODIFIER "u", ucs4, ucs4, data - datastart - 1); Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", (void *)NULL); TclDecrRefCount(resultObj); return TCL_ERROR; } @@ -3203,13 +3198,13 @@ /* Safe because we know data is NUL-terminated */ TclUtfToUniChar((const char *)(data - 1), &ucs4); } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "invalid base64 character \"%c\" (U+%06X) at position %" - TCL_Z_MODIFIER "u", ucs4, ucs4, data - datastart - 1)); + TCL_Z_MODIFIER "u", ucs4, ucs4, data - datastart - 1); Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", (void *)NULL); TclDecrRefCount(resultObj); return TCL_ERROR; } Index: generic/tclCkalloc.c ================================================================== --- generic/tclCkalloc.c +++ generic/tclCkalloc.c @@ -823,12 +823,12 @@ return TCL_ERROR; } result = Tcl_DumpActiveMemory(fileName); Tcl_DStringFree(&buffer); if (result != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s", - TclGetString(objv[2]), Tcl_PosixError(interp))); + TclPrintfResult(interp, "error accessing %s: %s", + TclGetString(objv[2]), Tcl_PosixError(interp)); return TCL_ERROR; } return TCL_OK; } if (strcmp(TclGetString(objv[1]),"break_on_malloc") == 0) { @@ -841,17 +841,17 @@ } break_on_malloc = value; return TCL_OK; } if (strcmp(TclGetString(objv[1]),"info") == 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n%-25s %10" TCL_Z_MODIFIER "u\n", "total mallocs", total_mallocs, "total frees", total_frees, "current packets allocated", current_malloc_packets, "current bytes allocated", current_bytes_malloced, "maximum packets allocated", maximum_malloc_packets, - "maximum bytes allocated", maximum_bytes_malloced)); + "maximum bytes allocated", maximum_bytes_malloced); return TCL_OK; } if (strcmp(TclGetString(objv[1]), "init") == 0) { if (objc != 3) { goto bad_suboption; @@ -868,13 +868,13 @@ if (fileName == NULL) { return TCL_ERROR; } fileP = fopen(fileName, "w"); if (fileP == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "cannot open output file: %s", - Tcl_PosixError(interp))); + TclPrintfResult(interp, + "cannot open output file: %s", + Tcl_PosixError(interp))); return TCL_ERROR; } TclDbDumpActiveObjects(fileP); fclose(fileP); Tcl_DStringFree(&buffer); @@ -933,14 +933,14 @@ } validate_memory = (strcmp(TclGetString(objv[2]),"on") == 0); return TCL_OK; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad option \"%s\": should be active, break_on_malloc, info, " - "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate", - TclGetString(objv[1]))); + TclPrintfResult(interp, + "bad option \"%s\": should be active, break_on_malloc, info, " + "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate", + TclGetString(objv[1]))); return TCL_ERROR; argError: Tcl_WrongNumArgs(interp, 2, objv, "count"); return TCL_ERROR; Index: generic/tclClock.c ================================================================== --- generic/tclClock.c +++ generic/tclClock.c @@ -709,13 +709,12 @@ if (!(opts->flags & CLF_LOCALE_USED)) { opts->localeObj = NormLocaleObj(dataPtr, opts->interp, opts->localeObj, &opts->mcDictObj); if (opts->localeObj == NULL) { - Tcl_SetObjResult(opts->interp, Tcl_NewStringObj( - "locale not specified and no default locale set", - TCL_AUTO_LENGTH)); + TclSetResult(opts->interp, + "locale not specified and no default locale set"); Tcl_SetErrorCode(opts->interp, "CLOCK", "badOption", (char *)NULL); return NULL; } opts->flags |= CLF_LOCALE_USED; @@ -1436,12 +1435,11 @@ if (Tcl_DictObjGet(interp, dict, dataPtr->literals[LIT_LOCALSECONDS], &secondsObj)!= TCL_OK) { return TCL_ERROR; } if (secondsObj == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("key \"localseconds\" not " - "found in dictionary", TCL_AUTO_LENGTH)); + TclSetResult(interp, "key \"localseconds\" not found in dictionary"); return TCL_ERROR; } if ((TclGetWideIntFromObj(interp, secondsObj, &fields.localSeconds) != TCL_OK) || (TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) || ConvertLocalToUTC(dataPtr, interp, &fields, objv[2], changeover)) { @@ -1663,12 +1661,11 @@ if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) { return TCL_ERROR; } if (value == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "expected key(s) not found in dictionary", TCL_AUTO_LENGTH)); + TclSetResult(interp, "expected key(s) not found in dictionary"); return TCL_ERROR; } return Tcl_GetIndexFromObj(interp, value, eras, "era", TCL_EXACT, storePtr); } @@ -1683,12 +1680,11 @@ if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) { return TCL_ERROR; } if (value == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "expected key(s) not found in dictionary", TCL_AUTO_LENGTH)); + TclSetResult(interp, "expected key(s) not found in dictionary"); return TCL_ERROR; } return TclGetIntFromObj(interp, value, storePtr); } @@ -2127,12 +2123,11 @@ * If conversion fails, report an error. */ if (localErrno != 0 || (fields->seconds == -1 && timeVal.tm_yday == -1)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "time value too large/small to represent", TCL_AUTO_LENGTH)); + TclSetResult(interp, "time value too large/small to represent"); return TCL_ERROR; } return TCL_OK; } @@ -2349,21 +2344,20 @@ * Use 'localtime' to determine local year, month, day, time of day. */ tock = (time_t) fields->seconds; if ((Tcl_WideInt) tock != fields->seconds) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "number too large to represent as a Posix time", TCL_AUTO_LENGTH)); + TclSetResult(interp, "number too large to represent as a Posix time"); Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", (char *)NULL); return TCL_ERROR; } TzsetIfNecessary(); timeVal = ThreadSafeLocalTime(&tock); if (timeVal == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "localtime failed (clock value may be too " - "large/small to represent)", TCL_AUTO_LENGTH)); + "large/small to represent)"); Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", (char *)NULL); return TCL_ERROR; } /* @@ -3052,12 +3046,11 @@ } #else varName = TclGetString(objv[1]); varValue = getenv(varName); if (varValue != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - varValue, TCL_AUTO_LENGTH)); + TclSetResult(interp, varValue); } #endif return TCL_OK; } @@ -3337,13 +3330,13 @@ /* if already specified */ if (saw & (1 << optionIndex)) { if (operation != CLC_OP_SCN && optionIndex == CLC_ARGS_BASE) { goto badOptionMsg; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "bad option \"%s\": doubly present", - TclGetString(objv[i]))); + TclGetString(objv[i])); goto badOption; } switch (optionIndex) { case CLC_ARGS_FORMAT: if (operation == CLC_OP_ADD) { @@ -3389,12 +3382,11 @@ * Check options. */ if ((saw & (1 << CLC_ARGS_GMT)) && (saw & (1 << CLC_ARGS_TIMEZONE))) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot use -gmt and -timezone in same call", TCL_AUTO_LENGTH)); + TclSetResult(interp, "cannot use -gmt and -timezone in same call"); Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", (char *)NULL); return TCL_ERROR; } if (gmtFlag) { opts->timezoneObj = dataPtr->literals[LIT_GMT]; @@ -3490,13 +3482,13 @@ } return TCL_OK; badOptionMsg: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "bad option \"%s\": must be %s", - TclGetString(objv[i]), syntax)); + TclGetString(objv[i]), syntax); badOption: Tcl_SetErrorCode(interp, "CLOCK", "badOption", (i < objc) ? TclGetString(objv[i]) : (char *)NULL, (char *)NULL); return TCL_ERROR; @@ -3637,12 +3629,12 @@ /* Use compiled version of FreeScan - */ /* [SB] TODO: Perhaps someday we'll localize the legacy code. Right now, * it's not localized. */ if (opts.localeObj != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "legacy [clock scan] does not support -locale", TCL_AUTO_LENGTH)); + TclSetResult(interp, + "legacy [clock scan] does not support -locale"); Tcl_SetErrorCode(interp, "CLOCK", "flagWithLegacyFormat", (char *)NULL); ret = TCL_ERROR; goto done; } ret = ClockFreeScan(&yy, objv[1], &opts); @@ -3731,12 +3723,12 @@ /* some overflow checks */ if (info->flags & CLF_JULIANDAY) { double curJDN = (double)yydate.julianDay + ((double)yySecondOfDay - SECONDS_PER_DAY/2) / SECONDS_PER_DAY; if (curJDN > opts->dataPtr->maxJDN) { - Tcl_SetObjResult(opts->interp, Tcl_NewStringObj( - "requested date too large to represent", TCL_AUTO_LENGTH)); + TclSetResult(opts->interp, + "requested date too large to represent"); Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", (char *)NULL); return TCL_ERROR; } } @@ -3940,12 +3932,12 @@ } return TCL_OK; error: - Tcl_SetObjResult(opts->interp, Tcl_ObjPrintf( - "unable to convert input string: %s", errMsg)); + TclPrintfResult(opts->interp, + "unable to convert input string: %s", errMsg); Tcl_SetErrorCode(opts->interp, "CLOCK", "invInpStr", errCode, (char *)NULL); return TCL_ERROR; } /*---------------------------------------------------------------------- @@ -3984,13 +3976,13 @@ * yyMonth -> info->date.month (same as yydate.month) */ yyInput = TclGetString(strObj); if (TclClockFreeScan(interp, info) != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "unable to convert date-time string \"%s\": %s", - TclGetString(strObj), Tcl_GetString(Tcl_GetObjResult(interp)))); + TclGetString(strObj), Tcl_GetString(Tcl_GetObjResult(interp))); goto done; } /* * If the caller supplied a date in the string, update the date with Index: generic/tclClockFmt.c ================================================================== --- generic/tclClockFmt.c +++ generic/tclClockFmt.c @@ -855,12 +855,12 @@ } Tcl_MutexUnlock(&ClockFmtMutex); if (fss == NULL && interp != NULL) { - Tcl_AppendResult(interp, "retrieve clock format failed \"", - strFmt ? strFmt : "", "\"", NULL); + TclPrintfResult(interp, "retrieve clock format failed \"%s\"", + strFmt ? strFmt : ""); Tcl_SetErrorCode(interp, "TCL", "EINVAL", (char *)NULL); } return fss; } @@ -1598,12 +1598,11 @@ if (val == 0) { val = 7; } if (val > 7) { - Tcl_SetObjResult(opts->interp, Tcl_NewStringObj( - "day of week is greater than 7", TCL_AUTO_LENGTH)); + TclSetResult(opts->interp, "day of week is greater than 7"); Tcl_SetErrorCode(opts->interp, "CLOCK", "badDayOfWeek", (char *)NULL); return TCL_ERROR; } info->date.dayOfWeek = val; yyInput++; @@ -2693,27 +2692,25 @@ return ret; /* Error case reporting. */ overflow: - Tcl_SetObjResult(opts->interp, Tcl_NewStringObj( - "integer value too large to represent", TCL_AUTO_LENGTH)); + TclSetResult(opts->interp, "integer value too large to represent"); Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", (char *)NULL); goto done; not_match: #if 1 - Tcl_SetObjResult(opts->interp, Tcl_NewStringObj( - "input string does not match supplied format", TCL_AUTO_LENGTH)); + TclSetResult(opts->interp, "input string does not match supplied format"); #else /* to debug where exactly scan breaks */ - Tcl_SetObjResult(opts->interp, Tcl_ObjPrintf( + TclPrintfResult(opts->interp, "input string \"%s\" does not match supplied format \"%s\"," " locale \"%s\" - token \"%s\"", info->dateStart, HashEntry4FmtScn(fss)->key.string, TclGetString(opts->localeObj), - tok && tok->tokWord.start ? tok->tokWord.start : "NULL")); + tok && tok->tokWord.start ? tok->tokWord.start : "NULL"); #endif Tcl_SetErrorCode(opts->interp, "CLOCK", "badInputString", (char *)NULL); goto done; } Index: generic/tclCmdAH.c ================================================================== --- generic/tclCmdAH.c +++ generic/tclCmdAH.c @@ -288,13 +288,13 @@ Tcl_DStringFree(&ds); if (result == TCL_OK) { result = Tcl_FSChdir(dir); } if (result != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't change working directory to \"%s\": %s", - TclGetString(dir), Tcl_PosixError(interp))); + TclGetString(dir), Tcl_PosixError(interp)); result = TCL_ERROR; } } if (objc != 2) { Tcl_DecrRefCount(dir); @@ -723,13 +723,13 @@ return TCL_OK; } dirListObj = objv[1]; if (Tcl_SetEncodingSearchPath(dirListObj) == TCL_ERROR) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "expected directory list but got \"%s\"", - TclGetString(dirListObj))); + TclGetString(dirListObj)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "ENCODING", "BADPATH", (void *)NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, dirListObj); @@ -818,12 +818,11 @@ if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?encoding?"); return TCL_ERROR; } if (objc == 1) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj(Tcl_GetEncodingName(NULL), -1)); + TclSetResult(interp, Tcl_GetEncodingName(NULL)); } else { return Tcl_SetSystemEncoding(interp, TclGetString(objv[1])); } return TCL_OK; } @@ -1189,13 +1188,13 @@ return TCL_ERROR; } #if defined(_WIN32) /* We use a value of 0 to indicate the access time not available */ if (Tcl_GetAccessTimeFromStat(&buf) == 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not get access time for file \"%s\"", - TclGetString(objv[1]))); + TclGetString(objv[1])); return TCL_ERROR; } #endif if (objc == 3) { @@ -1212,13 +1211,13 @@ tval.actime = newTime; tval.modtime = Tcl_GetModificationTimeFromStat(&buf); if (Tcl_FSUtime(objv[1], &tval) != 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not set access time for file \"%s\": %s", - TclGetString(objv[1]), Tcl_PosixError(interp))); + TclGetString(objv[1]), Tcl_PosixError(interp)); return TCL_ERROR; } /* * Do another stat to ensure that the we return the new recognized @@ -1271,13 +1270,13 @@ return TCL_ERROR; } #if defined(_WIN32) /* We use a value of 0 to indicate the modification time not available */ if (Tcl_GetModificationTimeFromStat(&buf) == 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not get modification time for file \"%s\"", - TclGetString(objv[1]))); + TclGetString(objv[1])); return TCL_ERROR; } #endif if (objc == 3) { /* @@ -1293,13 +1292,13 @@ tval.actime = Tcl_GetAccessTimeFromStat(&buf); tval.modtime = newTime; if (Tcl_FSUtime(objv[1], &tval) != 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not set modification time for file \"%s\": %s", - TclGetString(objv[1]), Tcl_PosixError(interp))); + TclGetString(objv[1]), Tcl_PosixError(interp)); return TCL_ERROR; } /* * Do another stat to ensure that the we return the new recognized @@ -1426,12 +1425,11 @@ return TCL_ERROR; } if (GetStatBuf(interp, objv[1], Tcl_FSLstat, &buf) != TCL_OK) { return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewStringObj( - GetTypeFromMode((unsigned short) buf.st_mode), -1)); + TclSetResult(interp, GetTypeFromMode((unsigned short) buf.st_mode)); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -1918,11 +1916,11 @@ Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } fsInfo = Tcl_FSFileSystemInfo(objv[1]); if (fsInfo == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unrecognised path", -1)); + TclSetResult(interp, "unrecognised path"); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM", TclGetString(objv[1]), (void *)NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, fsInfo); @@ -2066,13 +2064,13 @@ Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } res = Tcl_FSSplitPath(objv[1], (Tcl_Size *)NULL); if (res == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not read \"%s\": no such file or directory", - TclGetString(objv[1]))); + TclGetString(objv[1])); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PATHSPLIT", "NONESUCH", (void *)NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, res); @@ -2164,17 +2162,16 @@ break; case TCL_PLATFORM_WINDOWS: separator = "\\"; break; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(separator, 1)); + TclSetResult(interp, separator); } else { Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[1]); if (separatorObj == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unrecognised path", -1)); + TclSetResult(interp, "unrecognised path"); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM", TclGetString(objv[1]), (void *)NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, separatorObj); @@ -2302,13 +2299,13 @@ } Tcl_DStringFree(&ds); if (status < 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not read \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp)); } return TCL_ERROR; } return TCL_OK; } @@ -2817,16 +2814,16 @@ if (result != TCL_OK) { result = TCL_ERROR; goto done; } if (statePtr->varcList[i] < 1) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "%s varlist is empty", - (statePtr->resultList != NULL ? "lmap" : "foreach"))); + TclPrintfResult(interp, + "%s varlist is empty", + (statePtr->resultList != NULL ? "lmap" : "foreach")); Tcl_SetErrorCode(interp, "TCL", "OPERATION", - (statePtr->resultList != NULL ? "LMAP" : "FOREACH"), - "NEEDVARS", (void *)NULL); + (statePtr->resultList != NULL ? "LMAP" : "FOREACH"), + "NEEDVARS", (void *)NULL); result = TCL_ERROR; goto done; } TclListObjGetElements(NULL, statePtr->vCopyList[i], &statePtr->varcList[i], &statePtr->varvList[i]); Index: generic/tclCmdIL.c ================================================================== --- generic/tclCmdIL.c +++ generic/tclCmdIL.c @@ -223,13 +223,13 @@ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *boolObj; if (objc <= 1) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "wrong # args: no expression after \"%s\" argument", - TclGetString(objv[0]))); + TclGetString(objv[0])); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL); return TCL_ERROR; } /* @@ -314,13 +314,13 @@ * "elseif". The arguments after the expression must be "then" * (optional) and a script to execute if the expression is true. */ if (i >= objc) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "wrong # args: no expression after \"%s\" argument", - clause)); + clause); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL); return TCL_ERROR; } if (!thenScriptIndex) { TclNewObj(boolObj); @@ -341,13 +341,12 @@ if (i >= objc) { goto missingScript; } } if (i < objc - 1) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "wrong # args: extra words after \"else\" clause in \"if\" command", - -1)); + TclSetResult(interp, + "wrong # args: extra words after \"else\" clause in \"if\" command"); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL); return TCL_ERROR; } if (thenScriptIndex) { /* @@ -358,13 +357,13 @@ iPtr->cmdFramePtr, thenScriptIndex); } return TclNREvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i); missingScript: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "wrong # args: no script following \"%s\" argument", - TclGetString(objv[i-1]))); + TclGetString(objv[i-1])); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL); return TCL_ERROR; } /* @@ -488,12 +487,11 @@ } name = TclGetString(objv[1]); procPtr = TclFindProc(iPtr, name); if (procPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "\"%s\" isn't a procedure", name)); + TclPrintfResult(interp, "\"%s\" isn't a procedure", name); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, (char *)NULL); return TCL_ERROR; } /* @@ -550,12 +548,11 @@ } name = TclGetString(objv[1]); procPtr = TclFindProc(iPtr, name); if (procPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "\"%s\" isn't a procedure", name)); + TclPrintfResult(interp, "\"%s\" isn't a procedure", name); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, (char *)NULL); return TCL_ERROR; } /* @@ -970,12 +967,11 @@ procName = TclGetString(objv[1]); argName = TclGetString(objv[2]); procPtr = TclFindProc(iPtr, procName); if (procPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "\"%s\" isn't a procedure", procName)); + TclPrintfResult(interp, "\"%s\" isn't a procedure", procName); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", procName, (char *)NULL); return TCL_ERROR; } @@ -1003,13 +999,13 @@ } return TCL_OK; } } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "procedure \"%s\" doesn't have an argument \"%s\"", - procName, argName)); + procName, argName); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARGUMENT", argName, (char *)NULL); return TCL_ERROR; } /* @@ -1055,11 +1051,10 @@ } } iPtr = (Interp *) target; Tcl_SetObjResult(interp, iPtr->errorStack); - return TCL_OK; } /* *---------------------------------------------------------------------- @@ -1186,12 +1181,11 @@ goto done; } if ((level > topLevel) || (level <= - topLevel)) { levelError: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad level \"%s\"", TclGetString(objv[1]))); + TclPrintfResult(interp, "bad level \"%s\"", TclGetString(objv[1])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", TclGetString(objv[1]), (char *)NULL); code = TCL_ERROR; goto done; } @@ -1545,16 +1539,15 @@ return TCL_ERROR; } name = Tcl_GetHostName(); if (name) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1)); + TclSetResult(interp, name); return TCL_OK; } - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unable to determine name of host", -1)); + TclSetResult(interp, "unable to determine name of host"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "HOSTNAME", "UNKNOWN", (char *)NULL); return TCL_ERROR; } /* @@ -1621,12 +1614,11 @@ Tcl_WrongNumArgs(interp, 1, objv, "?number?"); return TCL_ERROR; levelError: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad level \"%s\"", TclGetString(objv[1]))); + TclPrintfResult(interp, "bad level \"%s\"", TclGetString(objv[1])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", TclGetString(objv[1]), (char *)NULL); return TCL_ERROR; } @@ -1665,16 +1657,15 @@ return TCL_ERROR; } libDirName = Tcl_GetVar2(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY); if (libDirName != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1)); + TclSetResult(interp, libDirName); return TCL_OK; } - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "no library has been specified for Tcl", -1)); + TclSetResult(interp, "no library has been specified for Tcl"); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", "tcl_library", (char *)NULL); return TCL_ERROR; } /* @@ -1797,11 +1788,11 @@ } patchlevel = Tcl_GetVar2(interp, "tcl_patchLevel", NULL, (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)); if (patchlevel != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(patchlevel, -1)); + TclSetResult(interp, patchlevel); return TCL_OK; } return TCL_ERROR; } @@ -2029,11 +2020,11 @@ Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } #ifdef TCL_SHLIB_EXT - Tcl_SetObjResult(interp, Tcl_NewStringObj(TCL_SHLIB_EXT, -1)); + TclSetResult(interp, TCL_SHLIB_EXT); #endif return TCL_OK; } /* @@ -2123,14 +2114,13 @@ * aliases as they're part of the security mechanisms. */ if (Tcl_IsSafe(interp) && (((Command *) command)->objProc == TclAliasObjCmd)) { - Tcl_AppendResult(interp, "native", (char *)NULL); + TclSetResult(interp, "native"); } else { - Tcl_SetObjResult(interp, - Tcl_NewStringObj(TclGetCommandTypeName(command), -1)); + TclSetResult(interp, TclGetCommandTypeName(command)); } return TCL_OK; } /* @@ -2634,14 +2624,13 @@ */ if (objc == 2) { if (!listLen) { /* empty list, throw the same error as with index "end" */ - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "index \"end\" out of range", -1)); + TclSetResult(interp, "index \"end\" out of range"); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" - "OUTOFRANGE", (char *)NULL); + "OUTOFRANGE", (char *)NULL); return TCL_ERROR; } result = Tcl_ListObjIndex(interp, listPtr, (listLen-1), &elemPtr); if (result != TCL_OK) { @@ -2956,12 +2945,13 @@ } if (TCL_OK != TclGetWideIntFromObj(interp, objv[1], &elementCount)) { return TCL_ERROR; } if (elementCount < 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad count \"%" TCL_LL_MODIFIER "d\": must be integer >= 0", elementCount)); + TclPrintfResult(interp, + "bad count \"%" TCL_LL_MODIFIER "d\": must be integer >= 0", + elementCount); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG", (char *)NULL); return TCL_ERROR; } @@ -2973,12 +2963,13 @@ objv += 2; /* Final sanity check. Do not exceed limits on max list length. */ if (elementCount && objc > LIST_MAX/elementCount) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "max length of a Tcl list (%" TCL_SIZE_MODIFIER "d elements) exceeded", LIST_MAX)); + TclPrintfResult(interp, + "max length of a Tcl list (%" TCL_SIZE_MODIFIER "d elements) exceeded", + LIST_MAX); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL); return TCL_ERROR; } totalElems = objc * elementCount; @@ -3391,12 +3382,11 @@ if (startPtr != NULL) { Tcl_DecrRefCount(startPtr); startPtr = NULL; } if (i > objc-4) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "missing starting index", -1)); + TclSetResult(interp, "missing starting index"); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (char *)NULL); result = TCL_ERROR; goto done; } i++; @@ -3414,24 +3404,22 @@ } Tcl_IncrRefCount(startPtr); break; case LSEARCH_STRIDE: /* -stride */ if (i > objc-4) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "\"-stride\" option must be " - "followed by stride length", -1)); + TclSetResult(interp, + "\"-stride\" option must be followed by stride length"); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (char *)NULL); result = TCL_ERROR; goto done; } if (TclGetWideIntFromObj(interp, objv[i+1], &wide) != TCL_OK) { result = TCL_ERROR; goto done; } if (wide < 1) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "stride length must be at least 1", -1)); + TclSetResult(interp, "stride length must be at least 1"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BADSTRIDE", (char *)NULL); result = TCL_ERROR; goto done; } @@ -3445,13 +3433,12 @@ if (allocatedIndexVector) { TclStackFree(interp, sortInfo.indexv); allocatedIndexVector = 0; } if (i > objc-4) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "\"-index\" option must be followed by list index", - -1)); + TclSetResult(interp, + "\"-index\" option must be followed by list index"); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (char *)NULL); result = TCL_ERROR; goto done; } @@ -3492,13 +3479,13 @@ if (TclIndexEncode(interp, indices[j], TCL_INDEX_NONE, TCL_INDEX_NONE, &encoded) != TCL_OK) { result = TCL_ERROR; } if (encoded == (int)TCL_INDEX_NONE) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "index \"%s\" out of range", - TclGetString(indices[j]))); + TclGetString(indices[j])); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" "OUTOFRANGE", (char *)NULL); result = TCL_ERROR; } if (result == TCL_ERROR) { @@ -3516,21 +3503,19 @@ /* * Subindices only make sense if asked for with -index option set. */ if (returnSubindices && sortInfo.indexc==0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "-subindices cannot be used without -index option", -1)); + TclSetResult(interp, "-subindices cannot be used without -index option"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BAD_OPTION_MIX", (char *)NULL); result = TCL_ERROR; goto done; } if (bisect && (allMatches || negatedMatch)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "-bisect is not compatible with -all or -not", -1)); + TclSetResult(interp, "-bisect is not compatible with -all or -not"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BAD_OPTION_MIX", (char *)NULL); result = TCL_ERROR; goto done; } @@ -3578,13 +3563,12 @@ * because of the -stride option. [TIP #351] */ if (groupSize > 1) { if (listc % groupSize) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "list size must be a multiple of the stride length", - -1)); + TclSetResult(interp, + "list size must be a multiple of the stride length"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BADSTRIDE", (char *)NULL); result = TCL_ERROR; goto done; } @@ -3594,13 +3578,13 @@ * offset of the element within each group by which to sort. */ groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1); if (groupOffset < 0 || groupOffset >= groupSize) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "when used with \"-stride\", the leading \"-index\"" - " value must be within the group", -1)); + " value must be within the group"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BADINDEX", (char *)NULL); result = TCL_ERROR; goto done; } @@ -4348,39 +4332,36 @@ } break; /* Error cases: incomplete arguments */ case 12: - opmode = (SequenceOperators)values[1]; goto KeywordError; break; + opmode = (SequenceOperators)values[1]; goto KeywordError; break; case 112: - opmode = (SequenceOperators)values[2]; goto KeywordError; break; + opmode = (SequenceOperators)values[2]; goto KeywordError; break; case 1212: - opmode = (SequenceOperators)values[3]; goto KeywordError; break; + opmode = (SequenceOperators)values[3]; goto KeywordError; break; KeywordError: - switch (opmode) { - case LSEQ_DOTS: - case LSEQ_TO: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "missing \"to\" value.")); - break; - case LSEQ_COUNT: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "missing \"count\" value.")); - break; - case LSEQ_BY: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "missing \"by\" value.")); - break; - } - goto done; - break; + switch (opmode) { + case LSEQ_DOTS: + case LSEQ_TO: + TclSetResult(interp, "missing \"to\" value."); + break; + case LSEQ_COUNT: + TclSetResult(interp, "missing \"count\" value."); + break; + case LSEQ_BY: + TclSetResult(interp, "missing \"by\" value."); + break; + } + goto done; + break; /* All other argument errors */ default: - Tcl_WrongNumArgs(interp, 1, objv, "n ??op? n ??by? n??"); - goto done; - break; + Tcl_WrongNumArgs(interp, 1, objv, "n ??op? n ??by? n??"); + goto done; + break; } /* * Success! Now lets create the series object. */ @@ -4583,13 +4564,13 @@ case LSORT_ASCII: sortInfo.sortMode = SORTMODE_ASCII; break; case LSORT_COMMAND: if (i == objc-2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "\"-command\" option must be followed " - "by comparison command", -1)); + "by comparison command"); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (char *)NULL); sortInfo.resultCode = TCL_ERROR; goto done; } sortInfo.sortMode = SORTMODE_COMMAND; @@ -4608,13 +4589,12 @@ case LSORT_INDEX: { Tcl_Size sortindex; Tcl_Obj **indexv; if (i == objc-2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "\"-index\" option must be followed by list index", - -1)); + TclSetResult(interp, + "\"-index\" option must be followed by list index"); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (char *)NULL); sortInfo.resultCode = TCL_ERROR; goto done; } if (TclListObjGetElements(interp, objv[i+1], &sortindex, @@ -4635,13 +4615,13 @@ int encoded = 0; int result = TclIndexEncode(interp, indexv[j], TCL_INDEX_NONE, TCL_INDEX_NONE, &encoded); if ((result == TCL_OK) && (encoded == (int)TCL_INDEX_NONE)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "index \"%s\" out of range", - TclGetString(indexv[j]))); + TclGetString(indexv[j])); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" "OUTOFRANGE", (char *)NULL); result = TCL_ERROR; } if (result == TCL_ERROR) { @@ -4670,24 +4650,22 @@ case LSORT_INDICES: indices = 1; break; case LSORT_STRIDE: if (i == objc-2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "\"-stride\" option must be " - "followed by stride length", -1)); + TclSetResult(interp, + "\"-stride\" option must be followed by stride length"); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (char *)NULL); sortInfo.resultCode = TCL_ERROR; goto done; } if (TclGetWideIntFromObj(interp, objv[i+1], &wide) != TCL_OK) { sortInfo.resultCode = TCL_ERROR; goto done; } if (wide < 2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "stride length must be at least 2", -1)); + TclSetResult(interp, "stride length must be at least 2"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADSTRIDE", (char *)NULL); sortInfo.resultCode = TCL_ERROR; goto done; } @@ -4784,13 +4762,12 @@ * because of the -stride option. [TIP #326] */ if (group) { if (length % groupSize) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "list size must be a multiple of the stride length", - -1)); + TclSetResult(interp, + "list size must be a multiple of the stride length"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADSTRIDE", (char *)NULL); sortInfo.resultCode = TCL_ERROR; goto done; } @@ -4801,13 +4778,13 @@ * offset of the element within each group by which to sort. */ groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1); if (groupOffset < 0 || groupOffset >= groupSize) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "when used with \"-stride\", the leading \"-index\"" - " value must be within the group", -1)); + " value must be within the group"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADINDEX", (char *)NULL); sortInfo.resultCode = TCL_ERROR; goto done; } @@ -4865,12 +4842,13 @@ elementArray = (SortElement *)Tcl_Alloc(elmArrSize); } else { elementArray = (SortElement *)malloc(elmArrSize); } if (!elementArray) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "no enough memory to proccess sort of %" TCL_Z_MODIFIER "u items", length)); + TclPrintfResult(interp, + "no enough memory to proccess sort of %" TCL_Z_MODIFIER "u items", + length); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL); sortInfo.resultCode = TCL_ERROR; goto done; } @@ -5318,12 +5296,12 @@ * Parse the result of the command. */ if (TclGetIntFromObj(infoPtr->interp, Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) { - Tcl_SetObjResult(infoPtr->interp, Tcl_NewStringObj( - "-compare command returned non-integer result", -1)); + TclSetResult(infoPtr->interp, + "-compare command returned non-integer result"); Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT", "COMPARISONFAILED", (char *)NULL); infoPtr->resultCode = TCL_ERROR; return 0; } @@ -5528,17 +5506,17 @@ return NULL; } if (currentObj == NULL) { if (index == TCL_INDEX_NONE) { index = TCL_INDEX_END - infoPtr->indexv[i]; - Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf( + TclPrintfResult(infoPtr->interp, "element end-%d missing from sublist \"%s\"", - index, TclGetString(objPtr))); + index, TclGetString(objPtr)); } else { - Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf( + TclPrintfResult(infoPtr->interp, "element %d missing from sublist \"%s\"", - index, TclGetString(objPtr))); + index, TclGetString(objPtr)); } Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT", "INDEXFAILED", (char *)NULL); infoPtr->resultCode = TCL_ERROR; return NULL; Index: generic/tclCmdMZ.c ================================================================== --- generic/tclCmdMZ.c +++ generic/tclCmdMZ.c @@ -227,12 +227,12 @@ * Check if the user requested -inline, but specified match variables; a * no-no. */ if (doinline && ((objc - 2) != 0)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "regexp match variables not allowed when using -inline", -1)); + TclSetResult(interp, + "regexp match variables not allowed when using -inline"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "REGEXP", "MIX_VAR_INLINE", (void *)NULL); goto optionError; } @@ -679,13 +679,12 @@ if (TclListObjLength(interp, objv[2], &numParts) != TCL_OK) { return TCL_ERROR; } if (numParts < 1) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command prefix must be a list of at least one element", - -1)); + TclSetResult(interp, + "command prefix must be a list of at least one element"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "REGSUB", "CMDEMPTY", (void *)NULL); return TCL_ERROR; } regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); @@ -1970,12 +1969,12 @@ if ((length2 > 1) && strncmp(string, "-nocase", length2) == 0) { nocase = 1; } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad option \"%s\": must be -nocase", string)); + TclPrintfResult(interp, + "bad option \"%s\": must be -nocase", string); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", string, (void *)NULL); return TCL_ERROR; } } @@ -2038,12 +2037,11 @@ } else if (mapElemc & 1) { /* * The charMap must be an even number of key/value items. */ - Tcl_SetObjResult(interp, - Tcl_NewStringObj("char map list unbalanced", -1)); + TclSetResult(interp, "char map list unbalanced"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "MAP", "UNBALANCED", (void *)NULL); return TCL_ERROR; } } @@ -2242,12 +2240,12 @@ const char *string = TclGetStringFromObj(objv[1], &length); if ((length > 1) && strncmp(string, "-nocase", length) == 0) { nocase = TCL_MATCH_NOCASE; } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad option \"%s\": must be -nocase", string)); + TclPrintfResult(interp, + "bad option \"%s\": must be -nocase", string); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", string, (void *)NULL); return TCL_ERROR; } } @@ -2663,13 +2661,12 @@ } if ((Tcl_WideUInt)reqlength > TCL_SIZE_MAX) { reqlength = -1; } } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad option \"%s\": must be -nocase or -length", - string2)); + TclPrintfResult(interp, + "bad option \"%s\": must be -nocase or -length", string2); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", string2, (void *)NULL); return TCL_ERROR; } } @@ -2768,13 +2765,12 @@ *reqlength = -1; } else { *reqlength = wreqlength; } } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad option \"%s\": must be -nocase or -length", - string)); + TclPrintfResult(interp, + "bad option \"%s\": must be -nocase or -length", string); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option", string, (void *)NULL); return TCL_ERROR; } } @@ -3498,13 +3494,13 @@ if (foundmode) { /* * Mode already set via -exact, -glob, or -regexp. */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "bad option \"%s\": %s option already found", - TclGetString(objv[i]), options[mode])); + TclGetString(objv[i]), options[mode]); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "DOUBLEOPT", (void *)NULL); return TCL_ERROR; } foundmode = 1; @@ -3517,13 +3513,13 @@ */ case OPT_INDEXV: i++; if (i >= objc-2) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "missing variable name argument to %s option", - "-indexvar")); + "-indexvar"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "NOVAR", (void *)NULL); return TCL_ERROR; } indexVarObj = objv[i]; @@ -3530,13 +3526,13 @@ numMatchesSaved = -1; break; case OPT_MATCHV: i++; if (i >= objc-2) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "missing variable name argument to %s option", - "-matchvar")); + "-matchvar"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "NOVAR", (void *)NULL); return TCL_ERROR; } matchVarObj = objv[i]; @@ -3550,19 +3546,19 @@ Tcl_WrongNumArgs(interp, 1, objv, "?-option ...? string ?pattern body ...? ?default body?"); return TCL_ERROR; } if (indexVarObj != NULL && mode != OPT_REGEXP) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "%s option requires -regexp option", "-indexvar")); + TclPrintfResult(interp, + "%s option requires -regexp option", "-indexvar"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "MODERESTRICTION", (void *)NULL); return TCL_ERROR; } if (matchVarObj != NULL && mode != OPT_REGEXP) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "%s option requires -regexp option", "-matchvar")); + TclPrintfResult(interp, + "%s option requires -regexp option", "-matchvar"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "MODERESTRICTION", (void *)NULL); return TCL_ERROR; } @@ -3612,12 +3608,11 @@ * bodies. */ if (objc % 2) { Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "extra switch pattern with no body", -1)); + TclSetResult(interp, "extra switch pattern with no body"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM", (void *)NULL); /* * Check if this can be due to a badly placed comment in the switch @@ -3648,13 +3643,13 @@ * Complain if the last body is a continuation. Note that this check * assumes that the list is non-empty! */ if (strcmp(TclGetString(objv[objc-1]), "-") == 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "no body specified for pattern \"%s\"", - TclGetString(objv[objc-2]))); + TclGetString(objv[objc-2])); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM", "FALLTHROUGH", (void *)NULL); return TCL_ERROR; } @@ -3980,12 +3975,11 @@ */ if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { return TCL_ERROR; } else if (len < 1) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "type must be non-empty list", -1)); + TclSetResult(interp, "type must be non-empty list"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "THROW", "BADEXCEPTION", (void *)NULL); return TCL_ERROR; } @@ -4719,20 +4713,19 @@ return TCL_ERROR; } switch (type) { case TryFinally: /* finally script */ if (i < objc-2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "finally clause must be last", -1)); + TclSetResult(interp, "finally clause must be last"); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY", "NONTERMINAL", (void *)NULL); return TCL_ERROR; } else if (i == objc-1) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "wrong # args to finally clause: must be" - " \"... finally script\"", -1)); + " \"... finally script\""); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY", "ARGUMENT", (void *)NULL); return TCL_ERROR; } @@ -4739,13 +4732,13 @@ finallyObj = objv[++i]; break; case TryOn: /* on code variableList script */ if (i > objc-4) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "wrong # args to on clause: must be \"... on code" - " variableList script\"", -1)); + " variableList script\""); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "ON", "ARGUMENT", (void *)NULL); return TCL_ERROR; } @@ -4757,24 +4750,23 @@ info[2] = NULL; goto commonHandler; case TryTrap: /* trap pattern variableList script */ if (i > objc-4) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "wrong # args to trap clause: " - "must be \"... trap pattern variableList script\"", - -1)); + "must be \"... trap pattern variableList script\""); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP", "ARGUMENT", (void *)NULL); return TCL_ERROR; } code = 1; if (TclListObjLength(NULL, objv[i+1], &dummy) != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "bad prefix '%s': must be a list", - TclGetString(objv[i+1]))); + TclGetString(objv[i+1])); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP", "EXNFORMAT", (void *)NULL); return TCL_ERROR; } @@ -4801,12 +4793,12 @@ i += 3; break; } } if (bodyShared) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "last non-finally clause must not have a body of \"-\"", -1)); + TclSetResult(interp, + "last non-finally clause must not have a body of \"-\""); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "BADFALLTHROUGH", (void *)NULL); return TCL_ERROR; } Index: generic/tclCompile.c ================================================================== --- generic/tclCompile.c +++ generic/tclCompile.c @@ -2179,12 +2179,12 @@ * Use factor 5/4 (1.25) to avoid being too mistaken when recognizing the * limit during "mixed" evaluation and compilation process (nested * eval+compile) and is good enough for default recursionlimit (1000). */ if (iPtr->numLevels / 5 > iPtr->maxNestingDepth / 4) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "too many nested compilations (infinite loop?)", -1)); + TclSetResult(interp, + "too many nested compilations (infinite loop?)"); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", (char *)NULL); TclCompileSyntaxError(interp, envPtr); return; } @@ -2198,14 +2198,14 @@ if (numBytes >= INT_MAX) { /* * Note this gets -errorline as 1. Not worth figuring out which line * crosses the limit to get -errorline for this error case. */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "Script length %" TCL_SIZE_MODIFIER "d exceeds max permitted length %d.", - numBytes, INT_MAX-1)); + numBytes, INT_MAX - 1); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "SCRIPTLENGTH", (void *)NULL); TclCompileSyntaxError(interp, envPtr); return; } /* Index: generic/tclConfig.c ================================================================== --- generic/tclConfig.c +++ generic/tclConfig.c @@ -225,11 +225,11 @@ /* * Maybe a Tcl_Panic is better, because the package data has to be * present. */ - Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1)); + TclSetResult(interp, "package not known"); Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE", TclGetString(pkgName), (void *)NULL); return TCL_ERROR; } @@ -240,11 +240,11 @@ return TCL_ERROR; } if (Tcl_DictObjGet(interp, pkgDict, objv[2], &val) != TCL_OK || val == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1)); + TclSetResult(interp, "key not known"); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG", TclGetString(objv[2]), (void *)NULL); return TCL_ERROR; } @@ -276,12 +276,11 @@ Tcl_DictObjSize(interp, pkgDict, &m); listPtr = Tcl_NewListObj(m, NULL); if (!listPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "insufficient memory to create list", -1)); + TclSetResult(interp, "insufficient memory to create list"); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (void *)NULL); return TCL_ERROR; } if (m) { Index: generic/tclDictObj.c ================================================================== --- generic/tclDictObj.c +++ generic/tclDictObj.c @@ -714,12 +714,11 @@ DictSetInternalRep(objPtr, dict); return TCL_OK; missingValue: if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "missing value to go with key", -1)); + TclSetResult(interp, "missing value to go with key"); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", (void *)NULL); } errorInFindDictElement: DeleteChainTable(dict); Tcl_Free(dict); @@ -807,13 +806,13 @@ if (flags & DICT_PATH_EXISTS) { return DICT_PATH_NON_EXISTENT; } if ((flags & DICT_PATH_CREATE) != DICT_PATH_CREATE) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "key \"%s\" not known in dictionary", - TclGetString(keyv[i]))); + TclGetString(keyv[i])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT", TclGetString(keyv[i]), (void *)NULL); } return NULL; } @@ -1619,13 +1618,13 @@ result = Tcl_DictObjGet(interp, dictPtr, objv[objc-1], &valuePtr); if (result != TCL_OK) { return result; } if (valuePtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "key \"%s\" not known in dictionary", - TclGetString(objv[objc-1]))); + TclGetString(objv[objc-1])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT", TclGetString(objv[objc-1]), (void *)NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, valuePtr); @@ -2191,11 +2190,11 @@ if (dict == NULL) { return TCL_ERROR; } statsStr = Tcl_HashStats(&dict->table); - Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1)); + TclSetResult(interp, statsStr); Tcl_Free(statsStr); return TCL_OK; } /* @@ -2552,12 +2551,11 @@ if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) { return TCL_ERROR; } if (varc != 2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "must have exactly two variable names", -1)); + TclSetResult(interp, "must have exactly two variable names"); Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "for", (void *)NULL); return TCL_ERROR; } searchPtr = (Tcl_DictSearch *)TclStackAlloc(interp, sizeof(Tcl_DictSearch)); if (Tcl_DictObjFirst(interp, objv[2], searchPtr, &keyObj, &valueObj, @@ -2747,12 +2745,11 @@ if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) { return TCL_ERROR; } if (varc != 2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "must have exactly two variable names", -1)); + TclSetResult(interp, "must have exactly two variable names"); Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "map", (void *)NULL); return TCL_ERROR; } storagePtr = (DictMapStorage *)TclStackAlloc(interp, sizeof(DictMapStorage)); if (Tcl_DictObjFirst(interp, objv[2], &storagePtr->search, &keyObj, @@ -3187,12 +3184,11 @@ if (TclListObjGetElements(interp, objv[3], &varc, &varv) != TCL_OK) { return TCL_ERROR; } if (varc != 2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "must have exactly two variable names", -1)); + TclSetResult(interp, "must have exactly two variable names"); Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "filter", (void *)NULL); return TCL_ERROR; } keyVarObj = varv[0]; valueVarObj = varv[1]; Index: generic/tclDisassemble.c ================================================================== --- generic/tclDisassemble.c +++ generic/tclDisassemble.c @@ -1339,12 +1339,12 @@ return TCL_ERROR; } procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2])); if (procPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "\"%s\" isn't a procedure", TclGetString(objv[2]))); + TclPrintfResult(interp, + "\"%s\" isn't a procedure", TclGetString(objv[2])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROC", TclGetString(objv[2]), (void *)NULL); return TCL_ERROR; } @@ -1389,30 +1389,30 @@ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]); if (oPtr == NULL) { return TCL_ERROR; } if (oPtr->classPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "\"%s\" is not a class", TclGetString(objv[2]))); + TclPrintfResult(interp, + "\"%s\" is not a class", TclGetString(objv[2])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", TclGetString(objv[2]), (void *)NULL); return TCL_ERROR; } methodPtr = oPtr->classPtr->constructorPtr; if (methodPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "\"%s\" has no defined constructor", - TclGetString(objv[2]))); + TclGetString(objv[2])); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "CONSRUCTOR", (void *)NULL); return TCL_ERROR; } procPtr = TclOOGetProcFromMethod(methodPtr); if (procPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "body not available for this kind of constructor", -1)); + TclSetResult(interp, + "body not available for this kind of constructor"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "METHODTYPE", (void *)NULL); return TCL_ERROR; } @@ -1454,30 +1454,30 @@ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]); if (oPtr == NULL) { return TCL_ERROR; } if (oPtr->classPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "\"%s\" is not a class", TclGetString(objv[2]))); + TclPrintfResult(interp, + "\"%s\" is not a class", TclGetString(objv[2])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", TclGetString(objv[2]), (void *)NULL); return TCL_ERROR; } methodPtr = oPtr->classPtr->destructorPtr; if (methodPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "\"%s\" has no defined destructor", - TclGetString(objv[2]))); + TclGetString(objv[2])); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "DESRUCTOR", (void *)NULL); return TCL_ERROR; } procPtr = TclOOGetProcFromMethod(methodPtr); if (procPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "body not available for this kind of destructor", -1)); + TclSetResult(interp, + "body not available for this kind of destructor"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "METHODTYPE", (void *)NULL); return TCL_ERROR; } @@ -1519,12 +1519,12 @@ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]); if (oPtr == NULL) { return TCL_ERROR; } if (oPtr->classPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "\"%s\" is not a class", TclGetString(objv[2]))); + TclPrintfResult(interp, + "\"%s\" is not a class", TclGetString(objv[2])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", TclGetString(objv[2]), (void *)NULL); return TCL_ERROR; } hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods, @@ -1554,20 +1554,20 @@ */ methodBody: if (hPtr == NULL) { unknownMethod: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown method \"%s\"", TclGetString(objv[3]))); + TclPrintfResult(interp, + "unknown method \"%s\"", TclGetString(objv[3])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[3]), (void *)NULL); return TCL_ERROR; } procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr)); if (procPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "body not available for this kind of method", -1)); + TclSetResult(interp, + "body not available for this kind of method"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "METHODTYPE", (void *)NULL); return TCL_ERROR; } if (!TclHasInternalRep(procPtr->bodyPtr, &tclByteCodeType)) { @@ -1599,12 +1599,11 @@ */ ByteCodeGetInternalRep(codeObjPtr, &tclByteCodeType, codePtr); if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not disassemble prebuilt bytecode", -1)); + TclSetResult(interp, "may not disassemble prebuilt bytecode"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "BYTECODE", (void *)NULL); return TCL_ERROR; } if (clientData) { Index: generic/tclEncoding.c ================================================================== --- generic/tclEncoding.c +++ generic/tclEncoding.c @@ -1234,17 +1234,18 @@ *errorLocPtr = result == TCL_OK ? TCL_INDEX_NONE : nBytesProcessed; } else { /* Caller wants error message on failure */ if (result != TCL_OK && interp != NULL) { char buf[TCL_INTEGER_SPACE]; - snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "d", nBytesProcessed); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "d", + nBytesProcessed); + TclPrintfResult(interp, "unexpected byte sequence starting at index %" TCL_SIZE_MODIFIER "d: '\\x%02X'", - nBytesProcessed, UCHAR(srcStart[nBytesProcessed]))); - Tcl_SetErrorCode( - interp, "TCL", "ENCODING", "ILLEGALSEQUENCE", buf, (void *)NULL); + nBytesProcessed, UCHAR(srcStart[nBytesProcessed])); + Tcl_SetErrorCode(interp, + "TCL", "ENCODING", "ILLEGALSEQUENCE", buf, (void *)NULL); } } if (result != TCL_OK) { errno = (result == TCL_CONVERT_NOSPACE) ? ENOMEM : EILSEQ; } @@ -1555,14 +1556,14 @@ int ucs4; char buf[TCL_INTEGER_SPACE]; TclUtfToUniChar(&srcStart[nBytesProcessed], &ucs4); snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "d", nBytesProcessed); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "unexpected character at index %" TCL_SIZE_MODIFIER "u: 'U+%06X'", - pos, ucs4)); + pos, ucs4); Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALSEQUENCE", buf, (void *)NULL); } } if (result != TCL_OK) { @@ -1815,12 +1816,11 @@ TclSetProcessGlobalValue(&encodingFileMap, map, NULL); } } if ((NULL == chan) && (interp != NULL)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown encoding \"%s\"", name)); + TclPrintfResult(interp, "unknown encoding \"%s\"", name); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, (void *)NULL); } Tcl_DecrRefCount(fileNameObj); Tcl_DecrRefCount(nameObj); Tcl_DecrRefCount(searchPath); @@ -1890,12 +1890,11 @@ case 'E': encoding = LoadEscapeEncoding(name, chan); break; } if ((encoding == NULL) && (interp != NULL)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid encoding file \"%s\"", name)); + TclPrintfResult(interp, "invalid encoding file \"%s\"", name); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, (void *)NULL); } Tcl_CloseEx(NULL, chan, 0); return encoding; @@ -4310,18 +4309,18 @@ /* This code assumes at least two profiles :-) */ Tcl_Obj *errorObj = Tcl_ObjPrintf("bad profile name \"%s\": must be", profileName); for (i = 0; i < (numProfiles - 1); ++i) { Tcl_AppendStringsToObj( - errorObj, " ", encodingProfiles[i].name, ",", (void *)NULL); + errorObj, " ", encodingProfiles[i].name, ",", (void *)NULL); } Tcl_AppendStringsToObj( - errorObj, " or ", encodingProfiles[numProfiles-1].name, (void *)NULL); + errorObj, " or ", encodingProfiles[numProfiles-1].name, (void *)NULL); Tcl_SetObjResult(interp, errorObj); - Tcl_SetErrorCode( - interp, "TCL", "ENCODING", "PROFILE", profileName, (void *)NULL); + Tcl_SetErrorCode(interp, + "TCL", "ENCODING", "PROFILE", profileName, (void *)NULL); } return TCL_ERROR; } /* @@ -4350,13 +4349,12 @@ if (profileValue == encodingProfiles[i].value) { return encodingProfiles[i].name; } } if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "Internal error. Bad profile id \"%d\".", - profileValue)); + TclPrintfResult(interp, + "Internal error. Bad profile id \"%d\".", profileValue); Tcl_SetErrorCode( interp, "TCL", "ENCODING", "PROFILEID", (void *)NULL); } return NULL; } Index: generic/tclEnsemble.c ================================================================== --- generic/tclEnsemble.c +++ generic/tclEnsemble.c @@ -167,13 +167,12 @@ enum EnsSubcmds index; int done; if (nsPtr == NULL || nsPtr->flags & NS_DEAD) { if (!Tcl_InterpDeleted(interp)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "tried to manipulate ensemble of deleted namespace", - -1)); + TclSetResult(interp, + "tried to manipulate ensemble of deleted namespace"); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", (void *)NULL); } return TCL_ERROR; } @@ -285,13 +284,13 @@ Tcl_DecrRefCount(mapObj); } return TCL_ERROR; } if (len < 1) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "ensemble subcommand implementations " - "must be non-empty lists", -1)); + "must be non-empty lists"); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "EMPTY_TARGET", (void *)NULL); Tcl_DictObjDone(&search); if (patchedDict) { Tcl_DecrRefCount(patchedDict); @@ -573,13 +572,13 @@ Tcl_DecrRefCount(patchedDict); } goto freeMapAndError; } if (len < 1) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "ensemble subcommand implementations " - "must be non-empty lists", -1)); + "must be non-empty lists"); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "EMPTY_TARGET", (void *)NULL); Tcl_DictObjDone(&search); if (patchedDict) { Tcl_DecrRefCount(patchedDict); @@ -622,12 +621,11 @@ allocatedMapFlag = 1; } continue; } case CONF_NAMESPACE: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "option -namespace is read-only", -1)); + TclSetResult(interp, "option -namespace is read-only"); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "READ_ONLY", (void *)NULL); goto freeMapAndError; case CONF_PREFIX: if (Tcl_GetBooleanFromObj(interp, objv[1], @@ -795,12 +793,11 @@ Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; Tcl_Obj *oldList; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); + TclSetResult(interp, "command is not an ensemble"); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); return TCL_ERROR; } if (subcmdList != NULL) { Tcl_Size length; @@ -871,12 +868,11 @@ EnsembleConfig *ensemblePtr; Tcl_Obj *oldList; Tcl_Size length; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); + TclSetResult(interp, "command is not an ensemble"); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); return TCL_ERROR; } if (paramList == NULL) { length = 0; @@ -947,12 +943,11 @@ Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; Tcl_Obj *oldDict; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); + TclSetResult(interp, "command is not an ensemble"); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); return TCL_ERROR; } if (mapDict != NULL) { Tcl_Size size; @@ -973,13 +968,12 @@ Tcl_DictObjDone(&search); return TCL_ERROR; } bytes = TclGetString(cmdObjPtr); if (bytes[0] != ':' || bytes[1] != ':') { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "ensemble target is not a fully-qualified command", - -1)); + TclSetResult(interp, + "ensemble target is not a fully-qualified command"); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNQUALIFIED_TARGET", (void *)NULL); Tcl_DictObjDone(&search); return TCL_ERROR; } @@ -1047,12 +1041,11 @@ Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; Tcl_Obj *oldList; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); + TclSetResult(interp, "command is not an ensemble"); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); return TCL_ERROR; } if (unknownList != NULL) { Tcl_Size length; @@ -1113,12 +1106,11 @@ Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; int wasCompiled; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); + TclSetResult(interp, "command is not an ensemble"); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); return TCL_ERROR; } ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData; @@ -1190,12 +1182,11 @@ Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); + TclSetResult(interp, "command is not an ensemble"); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); } return TCL_ERROR; } @@ -1232,12 +1223,11 @@ Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); + TclSetResult(interp, "command is not an ensemble"); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); } return TCL_ERROR; } @@ -1274,12 +1264,11 @@ Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); + TclSetResult(interp, "command is not an ensemble"); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); } return TCL_ERROR; } @@ -1315,12 +1304,11 @@ Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); + TclSetResult(interp, "command is not an ensemble"); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); } return TCL_ERROR; } @@ -1356,12 +1344,11 @@ Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); + TclSetResult(interp, "command is not an ensemble"); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); } return TCL_ERROR; } @@ -1397,12 +1384,11 @@ Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", -1)); + TclSetResult(interp, "command is not an ensemble"); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", (void *)NULL); } return TCL_ERROR; } @@ -1456,13 +1442,13 @@ cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr); if (cmdPtr == NULL || cmdPtr->objProc != TclEnsembleImplementationCmd) { if (flags & TCL_LEAVE_ERR_MSG) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "\"%s\" is not an ensemble command", - TclGetString(cmdNameObj))); + TclGetString(cmdNameObj)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE", TclGetString(cmdNameObj), (void *)NULL); } return NULL; } @@ -1751,12 +1737,12 @@ /* * Don't know how we got here, but make things give up quickly. */ if (!Tcl_InterpDeleted(interp)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "ensemble activated for deleted namespace", -1)); + TclSetResult(interp, + "ensemble activated for deleted namespace"); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", (void *)NULL); } return TCL_ERROR; } @@ -1967,14 +1953,14 @@ Tcl_ResetResult(interp); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND", TclGetString(subObj), (void *)NULL); if (ensemblePtr->subcommandTable.numEntries == 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "unknown subcommand \"%s\": namespace %s does not" " export any commands", TclGetString(subObj), - ensemblePtr->nsPtr->fullName)); + ensemblePtr->nsPtr->fullName); return TCL_ERROR; } errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ", (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""), TclGetString(subObj)); @@ -2322,12 +2308,12 @@ Tcl_Preserve(ensemblePtr); TclSkipTailcall(interp); result = Tcl_EvalObjv(interp, paramc, paramv, 0); if ((result == TCL_OK) && (ensemblePtr->flags & ENSEMBLE_DEAD)) { if (!Tcl_InterpDeleted(interp)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unknown subcommand handler deleted its ensemble", -1)); + TclSetResult(interp, + "unknown subcommand handler deleted its ensemble"); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_DELETED", (void *)NULL); } result = TCL_ERROR; } @@ -2370,12 +2356,12 @@ */ if (!Tcl_InterpDeleted(interp)) { if (result != TCL_ERROR) { Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unknown subcommand handler returned bad code: ", -1)); + TclSetResult(interp, + "unknown subcommand handler returned bad code: "); switch (result) { case TCL_RETURN: Tcl_AppendToObj(Tcl_GetObjResult(interp), "return", -1); break; case TCL_BREAK: Index: generic/tclEvent.c ================================================================== --- generic/tclEvent.c +++ generic/tclEvent.c @@ -346,12 +346,11 @@ TclNewLiteralStringObj(keyPtr, "-level"); Tcl_IncrRefCount(keyPtr); result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); Tcl_DecrRefCount(keyPtr); if (result != TCL_OK || valuePtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "missing return option \"-level\"", -1)); + TclSetResult(interp, "missing return option \"-level\""); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (void *)NULL); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, valuePtr, &level) == TCL_ERROR) { return TCL_ERROR; @@ -359,12 +358,11 @@ TclNewLiteralStringObj(keyPtr, "-code"); Tcl_IncrRefCount(keyPtr); result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr); Tcl_DecrRefCount(keyPtr); if (result != TCL_OK || valuePtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "missing return option \"-code\"", -1)); + TclSetResult(interp, "missing return option \"-code\""); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (void *)NULL); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, valuePtr, &code) == TCL_ERROR) { return TCL_ERROR; @@ -1559,14 +1557,14 @@ case OPT_NO_WEVTS: mask &= ~TCL_WINDOW_EVENTS; break; case OPT_TIMEOUT: if (++i >= objc) { - needArg: + needArg: Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "argument required for \"%s\"", vWaitOptionStrings[index])); + TclPrintfResult(interp, + "argument required for \"%s\"", vWaitOptionStrings[index]); Tcl_SetErrorCode(interp, "TCL", "EVENT", "ARGUMENT", (void *)NULL); result = TCL_ERROR; goto done; } if (Tcl_GetIntFromObj(interp, objv[i], &timeout) != TCL_OK) { @@ -1573,12 +1571,11 @@ result = TCL_ERROR; goto done; } if (timeout < 0) { Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "timeout must be positive", -1)); + TclSetResult(interp, "timeout must be positive"); Tcl_SetErrorCode(interp, "TCL", "EVENT", "NEGTIME", (void *)NULL); result = TCL_ERROR; goto done; } break; @@ -1609,13 +1606,13 @@ != TCL_OK) { result = TCL_ERROR; goto done; } if (!(mode & TCL_READABLE)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "channel \"%s\" wasn't open for reading", - TclGetString(objv[i]))); + TclGetString(objv[i])); result = TCL_ERROR; goto done; } Tcl_CreateChannelHandler(chan, TCL_READABLE, VwaitChannelReadProc, &vwaitItems[numItems]); @@ -1633,13 +1630,13 @@ != TCL_OK) { result = TCL_ERROR; goto done; } if (!(mode & TCL_WRITABLE)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "channel \"%s\" wasn't open for writing", - TclGetString(objv[i]))); + TclGetString(objv[i])); result = TCL_ERROR; goto done; } Tcl_CreateChannelHandler(chan, TCL_WRITABLE, VwaitChannelWriteProc, &vwaitItems[numItems]); @@ -1653,20 +1650,18 @@ } endOfOptionLoop: if ((mask & (TCL_FILE_EVENTS | TCL_IDLE_EVENTS | TCL_TIMER_EVENTS | TCL_WINDOW_EVENTS)) == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can't wait: would block forever", -1)); + TclSetResult(interp, "can't wait: would block forever"); Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", (void *)NULL); result = TCL_ERROR; goto done; } if ((timeout > 0) && ((mask & TCL_TIMER_EVENTS) == 0)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "timer events disabled with timeout specified", -1)); + TclSetResult(interp, "timer events disabled with timeout specified"); Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_TIME", (void *)NULL); result = TCL_ERROR; goto done; } @@ -1689,12 +1684,12 @@ } if (!(mask & TCL_FILE_EVENTS)) { for (i = 0; i < numItems; i++) { if (vwaitItems[i].mask) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "file events disabled with channel(s) specified", -1)); + TclSetResult(interp, + "file events disabled with channel(s) specified"); Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_FILE_EVENT", (void *)NULL); result = TCL_ERROR; goto done; } } @@ -1729,11 +1724,11 @@ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { break; } if (Tcl_LimitExceeded(interp)) { Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1)); + TclSetResult(interp, "limit exceeded"); Tcl_SetErrorCode(interp, "TCL", "EVENT", "LIMIT", (void *)NULL); break; } if ((numItems == 0) && (timeout == 0)) { /* @@ -1746,14 +1741,13 @@ } } if (!foundEvent) { Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_NewStringObj((numItems == 0) ? + TclSetResult(interp, (numItems == 0) ? "can't wait: would wait forever" : - "can't wait for variable(s)/channel(s): would wait forever", - -1)); + "can't wait for variable(s)/channel(s): would wait forever"); Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", (void *)NULL); result = TCL_ERROR; goto done; } @@ -1977,11 +1971,11 @@ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { return TCL_ERROR; } if (Tcl_LimitExceeded(interp)) { Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1)); + TclSetResult(interp, "limit exceeded"); return TCL_ERROR; } } /* Index: generic/tclExecute.c ================================================================== --- generic/tclExecute.c +++ generic/tclExecute.c @@ -2374,12 +2374,11 @@ case INST_YIELD: corPtr = iPtr->execEnvPtr->corPtr; TRACE(("%.30s => ", O2S(OBJ_AT_TOS))); if (!corPtr) { TRACE_APPEND(("ERROR: yield outside coroutine\n")); - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yield can only be called in a coroutine", -1)); + TclSetResult(interp, "yield can only be called in a coroutine"); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (void *)NULL); CACHE_STACK_INFO(); goto gotError; @@ -2405,23 +2404,21 @@ corPtr = iPtr->execEnvPtr->corPtr; valuePtr = OBJ_AT_TOS; if (!corPtr) { TRACE(("[%.30s] => ERROR: yield outside coroutine\n", O2S(valuePtr))); - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yieldto can only be called in a coroutine", -1)); + TclSetResult(interp, "yieldto can only be called in a coroutine"); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (void *)NULL); CACHE_STACK_INFO(); goto gotError; } if (((Namespace *)TclGetCurrentNamespace(interp))->flags & NS_DYING) { TRACE(("[%.30s] => ERROR: yield in deleted\n", O2S(valuePtr))); - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yieldto called in deleted namespace", -1)); + TclSetResult(interp, "yieldto called in deleted namespace"); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", (void *)NULL); CACHE_STACK_INFO(); goto gotError; @@ -2479,12 +2476,12 @@ opnd = TclGetUInt1AtPtr(pc+1); if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { TRACE(("%d => ERROR: tailcall in non-proc context\n", opnd)); - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "tailcall can only be called from a proc or lambda", -1)); + TclSetResult(interp, + "tailcall can only be called from a proc or lambda"); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", (void *)NULL); CACHE_STACK_INFO(); goto gotError; } @@ -4366,12 +4363,12 @@ for (; ((int)framePtr->level!=level) && (framePtr!=rootFramePtr) ; framePtr = framePtr->callerVarPtr) { /* Empty loop body */ } if (framePtr == rootFramePtr) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad level \"%s\"", TclGetString(OBJ_AT_TOS))); + TclPrintfResult(interp, + "bad level \"%s\"", TclGetString(OBJ_AT_TOS)); TRACE_ERROR(interp); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL", TclGetString(OBJ_AT_TOS), (void *)NULL); CACHE_STACK_INFO(); @@ -4406,13 +4403,13 @@ TclNewObj(objResultPtr); Tcl_GetCommandFullName(interp, origCmd, objResultPtr); if (TclCheckEmptyString(objResultPtr) == TCL_EMPTYSTRING_YES ) { Tcl_DecrRefCount(objResultPtr); - instOriginError: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid command name \"%s\"", TclGetString(OBJ_AT_TOS))); + instOriginError: + TclPrintfResult(interp, + "invalid command name \"%s\"", TclGetString(OBJ_AT_TOS)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", TclGetString(OBJ_AT_TOS), (void *)NULL); CACHE_STACK_INFO(); TRACE_APPEND(("ERROR: not command\n")); @@ -4436,13 +4433,11 @@ case INST_TCLOO_SELF: framePtr = iPtr->varFramePtr; if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { TRACE(("=> ERROR: no TclOO call context\n")); - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "self may only be called from inside a method", - -1)); + TclSetResult(interp, "self may only be called from inside a method"); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (void *)NULL); CACHE_STACK_INFO(); goto gotError; } @@ -4464,13 +4459,12 @@ skip = 2; TRACE(("%d => ", opnd)); if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { TRACE_APPEND(("ERROR: no TclOO call context\n")); - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "nextto may only be called from inside a method", - -1)); + TclSetResult(interp, + "nextto may only be called from inside a method"); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (void *)NULL); CACHE_STACK_INFO(); goto gotError; } @@ -4486,12 +4480,12 @@ Tcl_Size i; const char *methodType; if (classPtr == NULL) { TRACE_APPEND(("ERROR: \"%.30s\" not class\n", O2S(valuePtr))); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "\"%s\" is not a class", TclGetString(valuePtr))); + TclPrintfResult(interp, + "\"%s\" is not a class", TclGetString(valuePtr)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", (void *)NULL); CACHE_STACK_INFO(); goto gotError; } @@ -4536,22 +4530,22 @@ miPtr = contextPtr->callPtr->chain + i; if (miPtr->isFilter || miPtr->mPtr->declaringClassPtr != classPtr) { continue; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "%s implementation by \"%s\" not reachable from here", - methodType, TclGetString(valuePtr))); + methodType, TclGetString(valuePtr)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE", (void *)NULL); CACHE_STACK_INFO(); goto gotError; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "%s has no non-filter implementation by \"%s\"", - methodType, TclGetString(valuePtr))); + methodType, TclGetString(valuePtr)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", (void *)NULL); CACHE_STACK_INFO(); goto gotError; } @@ -4563,13 +4557,11 @@ skip = 1; TRACE(("%d => ", opnd)); if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { TRACE_APPEND(("ERROR: no TclOO call context\n")); - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "next may only be called from inside a method", - -1)); + TclSetResult(interp, "next may only be called from inside a method"); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (void *)NULL); CACHE_STACK_INFO(); goto gotError; } @@ -4593,12 +4585,11 @@ } else { methodType = "method"; } TRACE_APPEND(("ERROR: no TclOO next impl\n")); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "no next %s implementation", methodType)); + TclPrintfResult(interp, "no next %s implementation", methodType); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", (void *)NULL); CACHE_STACK_INFO(); goto gotError; #ifdef TCL_COMPILE_DEBUG @@ -5946,12 +5937,11 @@ } break; case INST_RSHIFT: if (w2 < 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "negative shift argument", -1)); + TclSetResult(interp, "negative shift argument"); #ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", (void *)NULL); @@ -5995,12 +5985,11 @@ } break; case INST_LSHIFT: if (w2 < 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "negative shift argument", -1)); + TclSetResult(interp, "negative shift argument"); #ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", (void *)NULL); @@ -6018,12 +6007,12 @@ * in an mp_int, but since we're using mp_mul_2d() to do * the work, and it takes only an int argument, that's a * good place to draw the line. */ - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "integer value too large to represent", -1)); + TclSetResult(interp, + "integer value too large to represent"); #ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", "integer value too large to represent", (void *)NULL); CACHE_STACK_INFO(); @@ -6850,13 +6839,13 @@ TRACE_APPEND(("ERROR reading leaf dictionary key \"%.30s\": %s", O2S(dictPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; } if (!objResultPtr) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "key \"%s\" not known in dictionary", - TclGetString(OBJ_AT_TOS))); + TclGetString(OBJ_AT_TOS)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT", TclGetString(OBJ_AT_TOS), (void *)NULL); CACHE_STACK_INFO(); TRACE_ERROR(interp); @@ -7557,18 +7546,18 @@ * Division by zero in an expression. Control only reaches this point * by "goto divideByZero". */ divideByZero: - Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1)); + TclSetResult(interp, "divide by zero"); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", (void *)NULL); CACHE_STACK_INFO(); goto gotError; outOfMemory: - Tcl_SetObjResult(interp, Tcl_NewStringObj("out of memory", -1)); + TclSetResult(interp, "out of memory"); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "OUTOFMEMORY", "out of memory", (void *)NULL); CACHE_STACK_INFO(); goto gotError; @@ -7576,12 +7565,11 @@ * Exponentiation of zero by negative number in an expression. Control * only reaches this point by "goto exponOfZero". */ exponOfZero: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "exponentiation of zero by negative power", -1)); + TclSetResult(interp, "exponentiation of zero by negative power"); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "exponentiation of zero by negative power", (void *)NULL); CACHE_STACK_INFO(); @@ -8137,12 +8125,11 @@ default: /* Unused, here to silence compiler warning */ invalid = 0; } if (invalid) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "negative shift argument", -1)); + TclSetResult(interp, "negative shift argument"); return GENERAL_ARITHMETIC_ERROR; } /* * Zero shifted any number of bits is still zero. @@ -8168,12 +8155,11 @@ * an mp_int, but since we're using mp_mul_2d() to do the * work, and it takes only an int argument, that's a good * place to draw the line. */ - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "integer value too large to represent", -1)); + TclSetResult(interp, "integer value too large to represent"); return GENERAL_ARITHMETIC_ERROR; } shift = (int)(*((const Tcl_WideInt *)ptr2)); /* @@ -8415,12 +8401,11 @@ * not using TCL_NUMBER_INT type must hold a value larger than we * accept. */ if (type2 != TCL_NUMBER_INT) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "exponent too large", -1)); + TclSetResult(interp, "exponent too large"); return GENERAL_ARITHMETIC_ERROR; } /* From here (up to overflowExpon) w1 and exponent w2 are wide-int's. */ assert(type1 == TCL_NUMBER_INT && type2 == TCL_NUMBER_INT); @@ -8491,16 +8476,14 @@ WIDE_RESULT(wResult); } } overflowExpon: - if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK) || !TclHasInternalRep(value2Ptr, &tclIntType) || (Tcl_WideUInt)w2 >= (1<<28)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "exponent too large", -1)); + TclSetResult(interp, "exponent too large"); return GENERAL_ARITHMETIC_ERROR; } Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); err = mp_init(&bigResult); if (err == MP_OKAY) { @@ -9132,13 +9115,13 @@ } else { /* TODO: No caller needs this. Eliminate? */ description = "(big) integer"; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "can't use %s \"%s\" as operand of \"%s\"", description, - TclGetString(opndPtr), op)); + TclGetString(opndPtr), op); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, (void *)NULL); } /* *---------------------------------------------------------------------- @@ -9512,20 +9495,20 @@ { const char *s; if ((errno == EDOM) || isnan(value)) { s = "domain error: argument not in valid range"; - Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); + TclSetResult(interp, s); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, (void *)NULL); } else if ((errno == ERANGE) || isinf(value)) { if (value == 0.0) { s = "floating-point value too small to represent"; - Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); + TclSetResult(interp, s); Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, (void *)NULL); } else { s = "floating-point value too large to represent"; - Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); + TclSetResult(interp, s); Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (void *)NULL); } } else { Tcl_Obj *objPtr = Tcl_ObjPrintf( "unknown floating-point error, errno = %d", errno); Index: generic/tclFCmd.c ================================================================== --- generic/tclFCmd.c +++ generic/tclFCmd.c @@ -152,13 +152,13 @@ if ((Tcl_FSStat(target, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) { if ((objc - i) > 2) { errno = ENOTDIR; Tcl_PosixError(interp); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "error %s: target \"%s\" is not a directory", - (copyFlag?"copying":"renaming"), TclGetString(target))); + (copyFlag ? "copying" : "renaming"), TclGetString(target)); result = TCL_ERROR; } else { /* * Even though already have target == translated(objv[i+1]), pass * the original argument down, so if there's an error, the error @@ -319,13 +319,13 @@ split = NULL; } done: if (errfile != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "can't create directory \"%s\": %s", - TclGetString(errfile), Tcl_PosixError(interp))); + TclGetString(errfile), Tcl_PosixError(interp)); result = TCL_ERROR; } if (split != NULL) { Tcl_DecrRefCount(split); } @@ -401,13 +401,13 @@ */ result = Tcl_FSRemoveDirectory(objv[i], force, &errorBuffer); if (result != TCL_OK) { if ((force == 0) && (errno == EEXIST)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "error deleting \"%s\": directory not empty", - TclGetString(objv[i]))); + TclGetString(objv[i])); Tcl_PosixError(interp); goto done; } /* @@ -450,17 +450,17 @@ if (errfile == NULL) { /* * We try to accommodate poor error results from our Tcl_FS calls. */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "error deleting unknown file: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "error deleting \"%s\": %s", - TclGetString(errfile), Tcl_PosixError(interp))); + TclGetString(errfile), Tcl_PosixError(interp)); } } done: if (errorBuffer != NULL) { @@ -578,21 +578,21 @@ */ if (S_ISDIR(sourceStatBuf.st_mode) && !S_ISDIR(targetStatBuf.st_mode)) { errno = EISDIR; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "can't overwrite file \"%s\" with directory \"%s\"", - TclGetString(target), TclGetString(source))); + TclGetString(target), TclGetString(source)); goto done; } if (!S_ISDIR(sourceStatBuf.st_mode) && S_ISDIR(targetStatBuf.st_mode)) { errno = EISDIR; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "can't overwrite directory \"%s\" with file \"%s\"", - TclGetString(target), TclGetString(source))); + TclGetString(target), TclGetString(source)); goto done; } /* * The destination exists, but appears to be ok to over-write, and @@ -619,14 +619,14 @@ if (result == TCL_OK) { goto done; } if (errno == EINVAL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "error renaming \"%s\" to \"%s\": trying to rename a" " volume or move a directory into itself", - TclGetString(source), TclGetString(target))); + TclGetString(source), TclGetString(target)); goto done; } else if (errno != EXDEV) { errfile = target; goto done; } @@ -666,13 +666,13 @@ if (Tcl_FSStat(source, &sourceStatBuf) != 0) { /* * Actual file doesn't exist. */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "error copying \"%s\": the target of this link doesn't" - " exist", TclGetString(source))); + " exist", TclGetString(source)); goto done; } else { int counter = 0; while (1) { @@ -800,12 +800,12 @@ if (result != TCL_OK) { errfile = source; } } if (result != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't unlink \"%s\": %s", - TclGetString(errfile), Tcl_PosixError(interp))); + TclPrintfResult(interp, "can't unlink \"%s\": %s", + TclGetString(errfile), Tcl_PosixError(interp)); errfile = NULL; } } done: @@ -1022,13 +1022,13 @@ /* * There was an error, probably that the filePtr is not * accepted by any filesystem */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not read \"%s\": %s", - TclGetString(filePtr), Tcl_PosixError(interp))); + TclGetString(filePtr), Tcl_PosixError(interp)); } return TCL_ERROR; } /* @@ -1110,13 +1110,13 @@ int index; Tcl_Obj *objPtr = NULL; if (numObjStrings == 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "bad option \"%s\", there are no file attributes in this" - " filesystem", TclGetString(objv[0]))); + " filesystem", TclGetString(objv[0])); Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", (void *)NULL); goto end; } if (Tcl_GetIndexFromObj(interp, objv[0], attributeStrings, @@ -1134,13 +1134,13 @@ */ int i, index; if (numObjStrings == 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "bad option \"%s\", there are no file attributes in this" - " filesystem", TclGetString(objv[0]))); + " filesystem", TclGetString(objv[0])); Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", (void *)NULL); goto end; } for (i = 0; i < objc ; i += 2) { @@ -1147,12 +1147,12 @@ if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings, "option", TCL_INDEX_TEMP_TABLE, &index) != TCL_OK) { goto end; } if (i + 1 == objc) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "value for \"%s\" missing", TclGetString(objv[i]))); + TclPrintfResult(interp, + "value for \"%s\" missing", TclGetString(objv[i])); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR", "NOVALUE", (void *)NULL); goto end; } if (Tcl_FSFileAttrsSet(interp, index, filePtr, @@ -1264,13 +1264,13 @@ * We handle three common error cases specially, and for all other * errors, we use the standard Posix error message. */ if (errno == EEXIST) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not create new link \"%s\": that path already" - " exists", TclGetString(objv[index]))); + " exists", TclGetString(objv[index])); Tcl_PosixError(interp); } else if (errno == ENOENT) { /* * There are two cases here: either the target doesn't exist, * or the directory of the src doesn't exist. @@ -1284,27 +1284,27 @@ return TCL_ERROR; } access = Tcl_FSAccess(dirPtr, F_OK); Tcl_DecrRefCount(dirPtr); if (access != 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not create new link \"%s\": no such file" - " or directory", TclGetString(objv[index]))); + " or directory", TclGetString(objv[index])); Tcl_PosixError(interp); } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not create new link \"%s\": target \"%s\" " "doesn't exist", TclGetString(objv[index]), - TclGetString(objv[index+1]))); + TclGetString(objv[index+1])); errno = ENOENT; Tcl_PosixError(interp); } } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not create new link \"%s\" pointing to \"%s\": %s", TclGetString(objv[index]), - TclGetString(objv[index+1]), Tcl_PosixError(interp))); + TclGetString(objv[index+1]), Tcl_PosixError(interp)); } return TCL_ERROR; } } else { if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) { @@ -1321,13 +1321,13 @@ * Read link */ contents = Tcl_FSLink(objv[index], NULL, 0); if (contents == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not read link \"%s\": %s", - TclGetString(objv[index]), Tcl_PosixError(interp))); + TclGetString(objv[index]), Tcl_PosixError(interp)); return TCL_ERROR; } } Tcl_SetObjResult(interp, contents); if (objc == 2) { @@ -1385,13 +1385,13 @@ Tcl_DStringFree(&ds); contents = Tcl_FSLink(objv[1], NULL, 0); if (contents == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not read link \"%s\": %s", - TclGetString(objv[1]), Tcl_PosixError(interp))); + TclGetString(objv[1]), Tcl_PosixError(interp)); return TCL_ERROR; } Tcl_SetObjResult(interp, contents); Tcl_DecrRefCount(contents); return TCL_OK; @@ -1541,12 +1541,12 @@ if (chan == NULL) { if (nameVarObj) { TclDecrRefCount(nameObj); } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't create temporary file: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, + "can't create temporary file: %s", Tcl_PosixError(interp)); return TCL_ERROR; } Tcl_RegisterChannel(interp, chan); if (nameVarObj != NULL) { if (Tcl_ObjSetVar2(interp, nameVarObj, NULL, nameObj, @@ -1553,11 +1553,11 @@ TCL_LEAVE_ERR_MSG) == NULL) { Tcl_UnregisterChannel(interp, chan); return TCL_ERROR; } } - Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1)); + TclSetResult(interp, Tcl_GetChannelName(chan)); return TCL_OK; } /* *--------------------------------------------------------------------------- @@ -1693,13 +1693,13 @@ /* * Deal with results. */ if (dirNameObj == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "can't create temporary directory: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); return TCL_ERROR; } Tcl_SetObjResult(interp, dirNameObj); return TCL_OK; } Index: generic/tclFileName.c ================================================================== --- generic/tclFileName.c +++ generic/tclFileName.c @@ -1168,21 +1168,18 @@ * Keep accepting as a no-op option to accommodate old scripts. */ break; case GLOB_DIR: /* -dir */ if (i == (objc-1)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "missing argument to \"-directory\"", -1)); + TclSetResult(interp, "missing argument to \"-directory\""); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (void *)NULL); return TCL_ERROR; } if (dir != PATH_NONE) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - dir == PATH_DIR - ? "\"-directory\" may only be used once" - : "\"-directory\" cannot be used with \"-path\"", - -1)); + TclSetResult(interp, dir == PATH_DIR + ? "\"-directory\" may only be used once" + : "\"-directory\" cannot be used with \"-path\""); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BADOPTIONCOMBINATION", (void *)NULL); return TCL_ERROR; } dir = PATH_DIR; @@ -1196,21 +1193,18 @@ case GLOB_TAILS: /* -tails */ globFlags |= TCL_GLOBMODE_TAILS; break; case GLOB_PATH: /* -path */ if (i == (objc-1)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "missing argument to \"-path\"", -1)); + TclSetResult(interp, "missing argument to \"-path\""); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (void *)NULL); return TCL_ERROR; } if (dir != PATH_NONE) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - dir == PATH_GENERAL - ? "\"-path\" may only be used once" - : "\"-path\" cannot be used with \"-dictionary\"", - -1)); + TclSetResult(interp, dir == PATH_GENERAL + ? "\"-path\" may only be used once" + : "\"-path\" cannot be used with \"-dictionary\""); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BADOPTIONCOMBINATION", (void *)NULL); return TCL_ERROR; } dir = PATH_GENERAL; @@ -1217,12 +1211,11 @@ pathOrDir = objv[i+1]; i++; break; case GLOB_TYPE: /* -types */ if (i == (objc-1)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "missing argument to \"-types\"", -1)); + TclSetResult(interp, "missing argument to \"-types\""); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (void *)NULL); return TCL_ERROR; } typePtr = objv[i+1]; if (TclListObjLength(interp, typePtr, &length) != TCL_OK) { @@ -1236,13 +1229,13 @@ } } endOfForLoop: if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "\"-tails\" must be used with either " - "\"-directory\" or \"-path\"", -1)); + "\"-directory\" or \"-path\""); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BADOPTIONCOMBINATION", (void *)NULL); return TCL_ERROR; } @@ -1451,22 +1444,22 @@ * Error cases. We reset the 'join' flag to zero, since we * haven't yet made use of it. */ badTypesArg: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "bad argument to \"-types\": %s", - TclGetString(look))); + TclGetString(look)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", (void *)NULL); result = TCL_ERROR; join = 0; goto endOfGlob; badMacTypesArg: - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "only one MacOS type or creator argument" - " to \"-types\" allowed", -1)); + " to \"-types\" allowed"); result = TCL_ERROR; Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", (void *)NULL); join = 0; goto endOfGlob; } @@ -2032,19 +2025,17 @@ */ closeBrace = p; break; } - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unmatched open-brace in file name", -1)); + TclSetResult(interp, "unmatched open-brace in file name"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE", (void *)NULL); return TCL_ERROR; } else if (*p == '}') { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unmatched close-brace in file name", -1)); + TclSetResult(interp, "unmatched close-brace in file name"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE", (void *)NULL); return TCL_ERROR; } } Index: generic/tclIO.c ================================================================== --- generic/tclIO.c +++ generic/tclIO.c @@ -1235,13 +1235,13 @@ statePtr = ((Channel *) chan)->state->bottomChanPtr->state; if (GotFlag(statePtr, CHANNEL_INCLOSE)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "illegal recursive call to close through close-handler" - " of channel", -1)); + " of channel"); } return TCL_ERROR; } if (DetachChannel(interp, chan) != TCL_OK) { @@ -1463,12 +1463,11 @@ } hTblPtr = GetChannelTable(interp); hPtr = Tcl_FindHashEntry(hTblPtr, name); if (hPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can not find channel named \"%s\"", chanName)); + TclPrintfResult(interp, "can not find channel named \"%s\"", chanName); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanName, (char *)NULL); return NULL; } /* @@ -1832,13 +1831,13 @@ statePtr = statePtr->nextCSPtr; } if (statePtr == NULL) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't find state for channel \"%s\"", - Tcl_GetChannelName(prevChan))); + Tcl_GetChannelName(prevChan)); } return NULL; } /* @@ -1854,13 +1853,13 @@ * --+---+---+---+----+ */ if ((mask & GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE)) == 0) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "reading and writing both disallowed for channel \"%s\"", - Tcl_GetChannelName(prevChan))); + Tcl_GetChannelName(prevChan)); } return NULL; } /* @@ -1883,13 +1882,13 @@ */ if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) { statePtr->csPtrR = csPtrR; statePtr->csPtrW = csPtrW; if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not flush channel \"%s\"", - Tcl_GetChannelName(prevChan))); + Tcl_GetChannelName(prevChan)); } return NULL; } statePtr->csPtrR = csPtrR; @@ -2078,13 +2077,13 @@ * to the regular message if nothing was found in the * bypasses. */ if (!TclChanCaughtErrorBypass(interp, chan) && interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not flush channel \"%s\"", - Tcl_GetChannelName((Tcl_Channel) chanPtr))); + Tcl_GetChannelName((Tcl_Channel) chanPtr)); } return TCL_ERROR; } statePtr->csPtrR = csPtrR; @@ -2466,13 +2465,13 @@ ResetFlag(statePtr, mode); return TCL_OK; error: if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "Tcl_RemoveChannelMode error: %s. Channel: \"%s\"", - emsg, Tcl_GetChannelName((Tcl_Channel) chan))); + emsg, Tcl_GetChannelName((Tcl_Channel) chan)); } return TCL_ERROR; } /* @@ -2694,12 +2693,11 @@ return 0; } Tcl_SetErrno(EINVAL); if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unable to access channel: invalid channel", -1)); + TclSetResult(interp, "unable to access channel: invalid channel"); } return 1; } /* @@ -2892,12 +2890,11 @@ */ Tcl_SetErrno(errorCode); if (interp != NULL && !TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj(Tcl_PosixError(interp), -1)); + TclSetResult(interp, Tcl_PosixError(interp)); } /* * An unreportable bypassed message is kept, for the caller of * Tcl_Seek, Tcl_Write, etc. @@ -3454,13 +3451,13 @@ Tcl_Panic("called Tcl_Close on channel with refCount > 0"); } if (GotFlag(statePtr, CHANNEL_INCLOSE)) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "illegal recursive call to close through close-handler" - " of channel", -1)); + " of channel"); } return TCL_ERROR; } SetFlag(statePtr, CHANNEL_INCLOSE); @@ -3559,12 +3556,11 @@ } if (stickyError != 0) { Tcl_SetErrno(stickyError); if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj(Tcl_PosixError(interp), -1)); + TclSetResult(interp, Tcl_PosixError(interp)); } return TCL_ERROR; } /* @@ -3577,12 +3573,11 @@ result = flushcode; } if ((result != 0) && (result != TCL_ERROR) && (interp != NULL) && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp))) { Tcl_SetErrno(result); - Tcl_SetObjResult(interp, - Tcl_NewStringObj(Tcl_PosixError(interp), -1)); + TclSetResult(interp, Tcl_PosixError(interp)); } if (result != 0) { return TCL_ERROR; } return TCL_OK; @@ -3627,34 +3622,34 @@ if ((flags & (TCL_READABLE | TCL_WRITABLE)) == 0) { return TclClose(interp, chan); } if ((flags & (TCL_READABLE | TCL_WRITABLE)) == (TCL_READABLE | TCL_WRITABLE)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "double-close of channels not supported by %ss", - chanPtr->typePtr->typeName)); + chanPtr->typePtr->typeName); return TCL_ERROR; } /* * Does the channel support half-close anyway? Error if not. */ if (!chanPtr->typePtr->close2Proc) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "half-close of channels not supported by %ss", - chanPtr->typePtr->typeName)); + chanPtr->typePtr->typeName); return TCL_ERROR; } /* * Is the channel unstacked ? If not we fail. */ if (chanPtr != statePtr->topChanPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "half-close not applicable to stack of transformations", -1)); + TclSetResult(interp, + "half-close not applicable to stack of transformations"); return TCL_ERROR; } /* * Check direction against channel mode. It is an error if we try to close @@ -3668,13 +3663,13 @@ if (flags & TCL_CLOSE_READ) { msg = "read"; } else { msg = "write"; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "Half-close of %s-side not possible, side not opened or" - " already closed", msg)); + " already closed", msg); return TCL_ERROR; } /* * A user may try to call half-close from within a channel close handler. @@ -3681,13 +3676,13 @@ * That won't do. */ if (GotFlag(statePtr, CHANNEL_INCLOSE)) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "illegal recursive call to close through close-handler" - " of channel", -1)); + " of channel"); } return TCL_ERROR; } if (flags & TCL_CLOSE_READ) { @@ -8123,13 +8118,13 @@ * If the channel is in the middle of a background copy, fail. */ if (statePtr->csPtrR || statePtr->csPtrW) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "unable to set channel options: background copy in" - " progress", -1)); + " progress"); } return TCL_ERROR; } /* @@ -8174,13 +8169,13 @@ } else if ((newValue[0] == 'n') && (strncmp(newValue, "none", len) == 0)) { ResetFlag(statePtr, CHANNEL_LINEBUFFERED); SetFlag(statePtr, CHANNEL_UNBUFFERED); } else if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "bad value for -buffering: must be one of" - " full, line, or none", -1)); + " full, line, or none"); return TCL_ERROR; } return TCL_OK; } else if (HaveOpt(7, "-buffersize")) { Tcl_WideInt newBufferSize; @@ -8245,13 +8240,13 @@ if (GotFlag(statePtr, TCL_READABLE)) { statePtr->inEofChar = newValue[0]; } } else { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "bad value for -eofchar: must be non-NUL ASCII" - " character", TCL_INDEX_NONE)); + " character"); } Tcl_Free((void *)argv); return TCL_ERROR; } if (argv != NULL) { @@ -8292,13 +8287,13 @@ } else if (argc == 2) { readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL; writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL; } else { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "bad value for -translation: must be a one or two" - " element list", -1)); + " element list"); } Tcl_Free((void *)argv); return TCL_ERROR; } @@ -8322,13 +8317,13 @@ translation = TCL_TRANSLATE_CRLF; } else if (strcmp(readMode, "platform") == 0) { translation = TCL_PLATFORM_TRANSLATION; } else { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "bad value for -translation: must be one of " - "auto, binary, cr, lf, crlf, or platform", -1)); + "auto, binary, cr, lf, crlf, or platform"); } Tcl_Free((void *)argv); return TCL_ERROR; } @@ -8371,13 +8366,13 @@ statePtr->outputTranslation = TCL_TRANSLATE_CRLF; } else if (strcmp(writeMode, "platform") == 0) { statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION; } else { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "bad value for -translation: must be one of " - "auto, binary, cr, lf, crlf, or platform", -1)); + "auto, binary, cr, lf, crlf, or platform"); } Tcl_Free((void *)argv); return TCL_ERROR; } } @@ -9221,12 +9216,12 @@ return TCL_ERROR; } chanPtr = (Channel *) chan; statePtr = chanPtr->state; if (GotFlag(statePtr, mask) == 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf("channel is not %s", - (mask == TCL_READABLE) ? "readable" : "writable")); + TclPrintfResult(interp, "channel is not %s", + (mask == TCL_READABLE) ? "readable" : "writable"); return TCL_ERROR; } /* * If we are supposed to return the script, do so. @@ -9332,19 +9327,19 @@ inStatePtr = inPtr->state; outStatePtr = outPtr->state; if (BUSY_STATE(inStatePtr, TCL_READABLE)) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "channel \"%s\" is busy", Tcl_GetChannelName(inChan))); + TclPrintfResult(interp, + "channel \"%s\" is busy", Tcl_GetChannelName(inChan)); } return TCL_ERROR; } if (BUSY_STATE(outStatePtr, TCL_WRITABLE)) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "channel \"%s\" is busy", Tcl_GetChannelName(outChan))); + TclPrintfResult(interp, + "channel \"%s\" is busy", Tcl_GetChannelName(outChan)); } return TCL_ERROR; } readFlags = inStatePtr->flags; @@ -10464,13 +10459,13 @@ * area, StackSetBlockMode is restricted to the channel bypass. * We still need the interp as the destination of the move. */ if (!TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "error setting blocking mode: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); } } else { /* * TIP #219. * If we have no interpreter to put a bypass message into we have Index: generic/tclIOCmd.c ================================================================== --- generic/tclIOCmd.c +++ generic/tclIOCmd.c @@ -155,13 +155,13 @@ } if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if (!(mode & TCL_WRITABLE)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "channel \"%s\" wasn't opened for writing", - TclGetString(chanObjPtr))); + TclGetString(chanObjPtr)); return TCL_ERROR; } TclChannelPreserve(chan); result = Tcl_WriteObj(chan, string); @@ -184,12 +184,12 @@ * message if nothing was found in the bypass. */ error: if (!TclChanCaughtErrorBypass(interp, chan)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s", - TclGetString(chanObjPtr), Tcl_PosixError(interp))); + TclPrintfResult(interp,"error writing \"%s\": %s", + TclGetString(chanObjPtr), Tcl_PosixError(interp)); } TclChannelRelease(chan); return TCL_ERROR; } @@ -228,13 +228,13 @@ chanObjPtr = objv[1]; if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if (!(mode & TCL_WRITABLE)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "channel \"%s\" wasn't opened for writing", - TclGetString(chanObjPtr))); + TclGetString(chanObjPtr)); return TCL_ERROR; } TclChannelPreserve(chan); if (Tcl_Flush(chan) != TCL_OK) { @@ -244,13 +244,13 @@ * put them into the regular interpreter result. Fall back to the * regular message if nothing was found in the bypass. */ if (!TclChanCaughtErrorBypass(interp, chan)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "error flushing \"%s\": %s", - TclGetString(chanObjPtr), Tcl_PosixError(interp))); + TclGetString(chanObjPtr), Tcl_PosixError(interp)); } TclChannelRelease(chan); return TCL_ERROR; } TclChannelRelease(chan); @@ -294,13 +294,13 @@ chanObjPtr = objv[1]; if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if (!(mode & TCL_READABLE)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "channel \"%s\" wasn't opened for reading", - TclGetString(chanObjPtr))); + TclGetString(chanObjPtr)); return TCL_ERROR; } TclChannelPreserve(chan); TclNewObj(linePtr); @@ -315,13 +315,13 @@ * and put them into the regular interpreter result. Fall back to * the regular message if nothing was found in the bypass. */ if (!TclChanCaughtErrorBypass(interp, chan)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "error reading \"%s\": %s", - TclGetString(chanObjPtr), Tcl_PosixError(interp))); + TclGetString(chanObjPtr), Tcl_PosixError(interp)); } code = TCL_ERROR; goto done; } lineLen = TCL_IO_FAILURE; @@ -405,13 +405,13 @@ chanObjPtr = objv[i]; if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if (!(mode & TCL_READABLE)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "channel \"%s\" wasn't opened for reading", - TclGetString(chanObjPtr))); + TclGetString(chanObjPtr)); return TCL_ERROR; } i++; /* Consumed channel name. */ /* @@ -420,13 +420,13 @@ toRead = -1; if (i < objc) { if ((TclGetWideIntFromObj(NULL, objv[i], &toRead) != TCL_OK) || (toRead < 0)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "expected non-negative integer but got \"%s\"", - TclGetString(objv[i]))); + TclGetString(objv[i])); Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", (char *)NULL); return TCL_ERROR; } } @@ -448,13 +448,13 @@ * put them into the regular interpreter result. Fall back to the * regular message if nothing was found in the bypass. */ if (!TclChanCaughtErrorBypass(interp, chan)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "error reading \"%s\": %s", - TclGetString(chanObjPtr), Tcl_PosixError(interp))); + TclGetString(chanObjPtr), Tcl_PosixError(interp)); } TclChannelRelease(chan); if (returnOptsPtr) { Tcl_SetReturnOptions(interp, returnOptsPtr); } @@ -542,13 +542,13 @@ * put them into the regular interpreter result. Fall back to the * regular message if nothing was found in the bypass. */ if (!TclChanCaughtErrorBypass(interp, chan)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "error during seek on \"%s\": %s", - TclGetString(objv[1]), Tcl_PosixError(interp))); + TclGetString(objv[1]), Tcl_PosixError(interp)); } TclChannelRelease(chan); return TCL_ERROR; } TclChannelRelease(chan); @@ -673,13 +673,13 @@ * close a direction not supported by the channel (already closed, or * never opened for that direction). */ if (!(dir & Tcl_GetChannelMode(chan))) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "Half-close of %s-side not possible, side not opened" - " or already closed", dirOptions[index])); + " or already closed", dirOptions[index]); return TCL_ERROR; } /* * Special handling is needed if and only if the channel mode supports @@ -973,13 +973,13 @@ * and put them into the regular interpreter result. Fall back to * the regular message if nothing was found in the bypass. */ if (!TclChanCaughtErrorBypass(interp, chan)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "error reading output from command: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); Tcl_DecrRefCount(resultPtr); } return TCL_ERROR; } } @@ -1044,13 +1044,13 @@ if (TclGetChannelFromObj(interp, objv[1], &chan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if (!(mode & TCL_READABLE)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "channel \"%s\" wasn't opened for reading", - TclGetString(objv[1]))); + TclGetString(objv[1])); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_InputBlocked(chan))); return TCL_OK; @@ -1170,11 +1170,11 @@ } if (chan == NULL) { return TCL_ERROR; } Tcl_RegisterChannel(interp, chan); - Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1)); + TclSetResult(interp, Tcl_GetChannelName(chan)); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -1484,32 +1484,30 @@ return TCL_ERROR; } switch (optionIndex) { case SKT_ASYNC: if (server == 1) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot set -async option for server sockets", -1)); + TclSetResult(interp, + "cannot set -async option for server sockets"); return TCL_ERROR; } async = 1; break; case SKT_MYADDR: a++; if (a >= objc) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "no argument given for -myaddr option", -1)); + TclSetResult(interp, "no argument given for -myaddr option"); return TCL_ERROR; } myaddr = TclGetString(objv[a]); break; case SKT_MYPORT: { const char *myPortName; a++; if (a >= objc) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "no argument given for -myport option", -1)); + TclSetResult(interp, "no argument given for -myport option"); return TCL_ERROR; } myPortName = TclGetString(objv[a]); if (TclSockGetPort(interp, myPortName, "tcp", &myport) != TCL_OK) { return TCL_ERROR; @@ -1516,50 +1514,46 @@ } break; } case SKT_SERVER: if (async == 1) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot set -async option for server sockets", -1)); + TclSetResult(interp, + "cannot set -async option for server sockets"); return TCL_ERROR; } server = 1; a++; if (a >= objc) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "no argument given for -server option", -1)); + TclSetResult(interp, "no argument given for -server option"); return TCL_ERROR; } script = objv[a]; break; case SKT_REUSEADDR: a++; if (a >= objc) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "no argument given for -reuseaddr option", -1)); + TclSetResult(interp, "no argument given for -reuseaddr option"); return TCL_ERROR; } if (Tcl_GetBooleanFromObj(interp, objv[a], &reusea) != TCL_OK) { return TCL_ERROR; } break; case SKT_REUSEPORT: a++; if (a >= objc) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "no argument given for -reuseport option", -1)); + TclSetResult(interp, "no argument given for -reuseport option"); return TCL_ERROR; } if (Tcl_GetBooleanFromObj(interp, objv[a], &reusep) != TCL_OK) { return TCL_ERROR; } break; case SKT_BACKLOG: a++; if (a >= objc) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "no argument given for -backlog option", -1)); + TclSetResult(interp, "no argument given for -backlog option"); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[a], &backlog) != TCL_OK) { return TCL_ERROR; } @@ -1569,12 +1563,11 @@ } } if (server) { host = myaddr; /* NULL implies INADDR_ANY */ if (myport != 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "option -myport is not valid for servers", -1)); + TclSetResult(interp, "option -myport is not valid for servers"); return TCL_ERROR; } } else if (a < objc) { host = TclGetString(objv[a]); a++; @@ -1591,13 +1584,13 @@ "?-reuseaddr boolean? ?-reuseport boolean? port"); return TCL_ERROR; } if (!server && (reusea != -1 || reusep != -1 || backlog != -1)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "options -backlog, -reuseaddr, and -reuseport are only valid " - "for servers", -1)); + "for servers"); return TCL_ERROR; } /* * Set the options to their default value if the user didn't override @@ -1676,11 +1669,11 @@ return TCL_ERROR; } } Tcl_RegisterChannel(interp, chan); - Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1)); + TclSetResult(interp, Tcl_GetChannelName(chan)); return TCL_OK; } /* *---------------------------------------------------------------------- @@ -1727,22 +1720,22 @@ if (TclGetChannelFromObj(interp, objv[1], &inChan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if (!(mode & TCL_READABLE)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "channel \"%s\" wasn't opened for reading", - TclGetString(objv[1]))); + TclGetString(objv[1])); return TCL_ERROR; } if (TclGetChannelFromObj(interp, objv[2], &outChan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if (!(mode & TCL_WRITABLE)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "channel \"%s\" wasn't opened for writing", - TclGetString(objv[2]))); + TclGetString(objv[2])); return TCL_ERROR; } toRead = -1; cmdPtr = NULL; @@ -1882,32 +1875,31 @@ if (TclGetWideIntFromObj(interp, objv[2], &length) != TCL_OK) { return TCL_ERROR; } if (length < 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot truncate to negative length of file", -1)); + TclSetResult(interp, "cannot truncate to negative length of file"); return TCL_ERROR; } } else { /* * User wants to truncate to the current file position. */ length = Tcl_Tell(chan); if (length == -1) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not determine current location in \"%s\": %s", - TclGetString(objv[1]), Tcl_PosixError(interp))); + TclGetString(objv[1]), Tcl_PosixError(interp)); return TCL_ERROR; } } if (Tcl_TruncateChannel(chan, length) != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "error during truncate on \"%s\": %s", - TclGetString(objv[1]), Tcl_PosixError(interp))); + TclGetString(objv[1]), Tcl_PosixError(interp)); return TCL_ERROR; } return TCL_OK; } Index: generic/tclIOGT.c ================================================================== --- generic/tclIOGT.c +++ generic/tclIOGT.c @@ -265,12 +265,11 @@ if (chan == NULL) { return TCL_ERROR; } if (TCL_OK != TclListObjLength(interp, cmdObjPtr, &objc)) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("-command value is not a list", -1)); + TclSetResult(interp, "-command value is not a list"); return TCL_ERROR; } chanPtr = (Channel *) chan; statePtr = chanPtr->state; @@ -470,13 +469,12 @@ resBuf = Tcl_GetBytesFromObj(NULL, resObj, &resLen); if (resBuf) { ResultAdd(&dataPtr->result, resBuf, resLen); break; } - nonBytes: - Tcl_AppendResult(interp, "chan transform callback received non-bytes", - (void *)NULL); + nonBytes: + TclSetResult(interp, "chan transform callback received non-bytes"); Tcl_Release(eval); return TCL_ERROR; case TRANSMIT_NUM: /* Index: generic/tclIORChan.c ================================================================== --- generic/tclIORChan.c +++ generic/tclIORChan.c @@ -606,13 +606,13 @@ * Check for non-optionals through the mask. * Compare open mode against optional r/w. */ if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "chan handler \"%s initialize\" returned non-list: %s", - TclGetString(cmdObj), TclGetString(resObj))); + TclGetString(cmdObj), TclGetString(resObj)); Tcl_DecrRefCount(resObj); goto error; } methods = 0; @@ -632,41 +632,41 @@ listc--; } Tcl_DecrRefCount(resObj); if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "chan handler \"%s\" does not support all required methods", - TclGetString(cmdObj))); + TclGetString(cmdObj)); goto error; } if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "chan handler \"%s\" lacks a \"read\" method", - TclGetString(cmdObj))); + TclGetString(cmdObj)); goto error; } if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "chan handler \"%s\" lacks a \"write\" method", - TclGetString(cmdObj))); + TclGetString(cmdObj)); goto error; } if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "chan handler \"%s\" supports \"cget\" but not \"cgetall\"", - TclGetString(cmdObj))); + TclGetString(cmdObj)); goto error; } if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "chan handler \"%s\" supports \"cgetall\" but not \"cget\"", - TclGetString(cmdObj))); + TclGetString(cmdObj)); goto error; } Tcl_ResetResult(interp); @@ -734,12 +734,11 @@ /* * Return handle as result of command. */ - Tcl_SetObjResult(interp, - Tcl_NewStringObj(chanPtr->state->channelName, -1)); + TclSetResult(interp, chanPtr->state->channelName); return TCL_OK; error: Tcl_DecrRefCount(rcPtr->name); Tcl_DecrRefCount(rcPtr->methods); @@ -865,12 +864,12 @@ rcmPtr = GetReflectedChannelMap(interp); hPtr = Tcl_FindHashEntry(&rcmPtr->map, chanId); if (hPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can not find reflected channel named \"%s\"", chanId)); + TclPrintfResult(interp, + "can not find reflected channel named \"%s\"", chanId); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanId, (char *)NULL); return TCL_ERROR; } /* @@ -919,23 +918,22 @@ if (EncodeEventMask(interp, "event", objv[EVENT], &events) != TCL_OK) { return TCL_ERROR; } if (events == 0) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("bad event list: is empty", -1)); + TclSetResult(interp, "bad event list: is empty"); return TCL_ERROR; } /* * Check that the channel is actually interested in the provided events. */ if (events & ~rcPtr->interest) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "tried to post events channel \"%s\" is not interested in", - chanId)); + chanId); return TCL_ERROR; } /* * We have the channel and the events to post. @@ -2005,14 +2003,14 @@ /* * Odd number of elements is wrong. */ Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "Expected list with even number of " - "elements, got %" TCL_SIZE_MODIFIER "d element%s instead", listc, - (listc == 1 ? "" : "s"))); + TclPrintfResult(interp, + "Expected list with even number of elements, " + "got %" TCL_SIZE_MODIFIER "d element%s instead", + listc, (listc == 1 ? "" : "s")); goto error; } else { Tcl_Size len; const char *str = TclGetStringFromObj(resObj, &len); @@ -2451,12 +2449,12 @@ Tcl_Size cmdLen; const char *cmdString = TclGetStringFromObj(cmd, &cmdLen); Tcl_IncrRefCount(cmd); Tcl_ResetResult(rcPtr->interp); - Tcl_SetObjResult(rcPtr->interp, Tcl_ObjPrintf( - "chan handler returned bad code: %d", result)); + TclPrintfResult(rcPtr->interp, + "chan handler returned bad code: %d", result); Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString, cmdLen); Tcl_DecrRefCount(cmd); result = TCL_ERROR; } Index: generic/tclIORTrans.c ================================================================== --- generic/tclIORTrans.c +++ generic/tclIORTrans.c @@ -597,25 +597,24 @@ * - List, of method names. Convert to mask. Check for non-optionals * through the mask. Compare open mode against optional r/w. */ if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s initialize\" returned non-list: %s", - TclGetString(cmdObj), TclGetString(resObj))); + TclPrintfResult(interp, + "chan handler \"%s initialize\" returned non-list: %s", + TclGetString(cmdObj), TclGetString(resObj)); Tcl_DecrRefCount(resObj); goto error; } methods = 0; while (listc > 0) { if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames, "method", TCL_EXACT, &methIndex) != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "chan handler \"%s initialize\" returned %s", - TclGetString(cmdObj), - Tcl_GetStringResult(interp))); + TclGetString(cmdObj), Tcl_GetStringResult(interp)); Tcl_DecrRefCount(resObj); goto error; } methods |= FLAG(methIndex); @@ -622,13 +621,13 @@ listc--; } Tcl_DecrRefCount(resObj); if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" does not support all required methods", - TclGetString(cmdObj))); + TclPrintfResult(interp, + "chan handler \"%s\" does not support all required methods", + TclGetString(cmdObj)); goto error; } /* * Mode tell us what the parent channel supports. The methods tell us what @@ -644,31 +643,31 @@ if (!HAS(methods, METH_WRITE)) { mode &= ~TCL_WRITABLE; } if (!mode) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" makes the channel inaccessible", - TclGetString(cmdObj))); + TclPrintfResult(interp, + "chan handler \"%s\" makes the channel inaccessible", + TclGetString(cmdObj)); goto error; } /* * The mode and support for it is ok, now check the internal constraints. */ if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" supports \"drain\" but not \"read\"", - TclGetString(cmdObj))); + TclPrintfResult(interp, + "chan handler \"%s\" supports \"drain\" but not \"read\"", + TclGetString(cmdObj)); goto error; } if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "chan handler \"%s\" supports \"flush\" but not \"write\"", - TclGetString(cmdObj))); + TclPrintfResult(interp, + "chan handler \"%s\" supports \"flush\" but not \"write\"", + TclGetString(cmdObj)); goto error; } Tcl_ResetResult(interp); @@ -700,12 +699,11 @@ /* * Return the channel as the result of the command. */ - Tcl_SetObjResult(interp, Tcl_NewStringObj( - Tcl_GetChannelName(rtPtr->chan), -1)); + TclSetResult(interp, Tcl_GetChannelName(rtPtr->chan)); return TCL_OK; error: /* * We are not going through ReflectClose as we never had a channel @@ -2004,12 +2002,12 @@ Tcl_Size cmdLen; const char *cmdString = TclGetStringFromObj(cmd, &cmdLen); Tcl_IncrRefCount(cmd); Tcl_ResetResult(rtPtr->interp); - Tcl_SetObjResult(rtPtr->interp, Tcl_ObjPrintf( - "chan handler returned bad code: %d", result)); + TclPrintfResult(rtPtr->interp, + "chan handler returned bad code: %d", result); Tcl_LogCommandInfo(rtPtr->interp, cmdString, cmdString, cmdLen); Tcl_DecrRefCount(cmd); result = TCL_ERROR; } Tcl_AppendObjToErrorInfo(rtPtr->interp, Tcl_ObjPrintf( Index: generic/tclIOSock.c ================================================================== --- generic/tclIOSock.c +++ generic/tclIOSock.c @@ -90,12 +90,11 @@ } if (Tcl_GetInt(interp, string, portPtr) != TCL_OK) { return TCL_ERROR; } if (*portPtr > 0xFFFF) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "couldn't open socket: port number too high", -1)); + TclSetResult(interp, "couldn't open socket: port number too high"); return TCL_ERROR; } return TCL_OK; } Index: generic/tclIOUtil.c ================================================================== --- generic/tclIOUtil.c +++ generic/tclIOUtil.c @@ -1044,13 +1044,12 @@ */ cwd = Tcl_FSGetCwd(NULL); if (cwd == NULL) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "glob couldn't determine the current working directory", - -1)); + TclSetResult(interp, + "glob couldn't determine the current working directory"); } return TCL_ERROR; } fsPtr = Tcl_FSGetFileSystemForPath(cwd); @@ -1506,12 +1505,11 @@ return mode; error: *modeFlagsPtr = 0; if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "illegal access mode \"%s\"", modeString)); + TclPrintfResult(interp, "illegal access mode \"%s\"", modeString); Tcl_SetErrorCode(interp, "TCL", "OPENMODE", "INVALID", (char *)NULL); } return -1; } @@ -1542,13 +1540,13 @@ c = flag[0]; if ((c == 'R') && (strcmp(flag, "RDONLY") == 0)) { if (gotRW) { invRW: if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid access mode \"%s\": modes RDONLY, " - "RDWR, and WRONLY cannot be combined", flag)); + TclPrintfResult(interp, + "invalid access mode \"%s\": modes RDONLY, " + "RDWR, and WRONLY cannot be combined", flag); } goto invAccessMode; } mode = (mode & ~O_ACCMODE) | O_RDONLY; gotRW = 1; @@ -1566,14 +1564,14 @@ gotRW = 1; } else if ((c == 'A') && (strcmp(flag, "APPEND") == 0)) { if (mode & O_APPEND) { accessFlagRepeated: if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "access mode \"%s\" repeated", flag)); + TclPrintfResult(interp, + "access mode \"%s\" repeated", flag); } - goto invAccessMode; + goto invAccessMode; } mode |= O_APPEND; *modeFlagsPtr |= 1; } else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) { if (mode & O_CREAT) { @@ -1591,13 +1589,13 @@ goto accessFlagRepeated; } mode |= O_NOCTTY; #else if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "access mode \"%s\" not supported by this system", - flag)); + flag); } goto invAccessMode; #endif } else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) { @@ -1606,13 +1604,13 @@ goto accessFlagRepeated; } mode |= O_NONBLOCK; #else if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "access mode \"%s\" not supported by this system", - flag)); + flag); } goto invAccessMode; #endif } else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) { if (mode & O_TRUNC) { @@ -1624,26 +1622,25 @@ goto accessFlagRepeated; } *modeFlagsPtr |= CHANNEL_RAW_MODE; } else { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "invalid access mode \"%s\": must be APPEND, BINARY, " "CREAT, EXCL, NOCTTY, NONBLOCK, RDONLY, RDWR, " - "TRUNC, or WRONLY", flag)); + "TRUNC, or WRONLY", flag); } goto invAccessMode; } } Tcl_Free((void *)modeArgv); if (!gotRW) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "access mode must include either RDONLY, RDWR, or WRONLY", - -1)); + TclSetResult(interp, + "access mode must include either RDONLY, RDWR, or WRONLY"); } return -1; } return mode; } @@ -1703,20 +1700,20 @@ return result; } if (Tcl_FSStat(pathPtr, &statBuf) == -1) { Tcl_SetErrno(errno); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't read file \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp)); return result; } chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644); if (chan == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't read file \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp)); return result; } /* * The eof character is \x1A (^Z). Tcl uses it on every platform to allow @@ -1746,13 +1743,13 @@ * Read first character of stream to check for utf-8 BOM */ if (Tcl_ReadChars(chan, objPtr, 1, 0) == TCL_IO_FAILURE) { Tcl_CloseEx(interp, chan, 0); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't read file \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp)); goto end; } string = TclGetString(objPtr); /* @@ -1761,13 +1758,13 @@ */ if (Tcl_ReadChars(chan, objPtr, TCL_INDEX_NONE, memcmp(string, "\xEF\xBB\xBF", 3)) == TCL_IO_FAILURE) { Tcl_CloseEx(interp, chan, 0); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't read file \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp)); goto end; } if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) { goto end; @@ -1838,20 +1835,20 @@ return TCL_ERROR; } if (Tcl_FSStat(pathPtr, &statBuf) == -1) { Tcl_SetErrno(errno); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't read file \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp)); return TCL_ERROR; } chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644); if (chan == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't read file \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp)); return TCL_ERROR; } TclPkgFileSeen(interp, TclGetString(pathPtr)); /* @@ -1882,13 +1879,13 @@ * Read first character of stream to check for utf-8 BOM */ if (Tcl_ReadChars(chan, objPtr, 1, 0) == TCL_IO_FAILURE) { Tcl_CloseEx(interp, chan, 0); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't read file \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp)); Tcl_DecrRefCount(objPtr); return TCL_ERROR; } string = TclGetString(objPtr); @@ -1898,13 +1895,13 @@ */ if (Tcl_ReadChars(chan, objPtr, TCL_INDEX_NONE, memcmp(string, "\xEF\xBB\xBF", 3)) == TCL_IO_FAILURE) { Tcl_CloseEx(interp, chan, 0); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't read file \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp)); Tcl_DecrRefCount(objPtr); return TCL_ERROR; } if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) { @@ -2232,13 +2229,13 @@ */ if ((modeFlags & 1) && Tcl_Seek(retVal, (Tcl_WideInt) 0, SEEK_END) < (Tcl_WideInt) 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not seek to end of file while opening \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp)); } Tcl_CloseEx(NULL, retVal, 0); return NULL; } if (modeFlags & CHANNEL_RAW_MODE) { @@ -2251,13 +2248,13 @@ * File doesn't belong to any filesystem that can open it. */ Tcl_SetErrno(ENOENT); if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't open \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp)); } return NULL; } /* @@ -2676,13 +2673,13 @@ Tcl_DecrRefCount(retVal); retVal = NULL; Disclaim(); goto cdDidNotChange; } else if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "error getting working directory name: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); } } Disclaim(); if (retVal != NULL) { @@ -2751,13 +2748,13 @@ TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2 *) fsPtr->getCwdProc; retCd = proc2(tsdPtr->cwdClientData); if (retCd == NULL && interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "error getting working directory name: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); } if (retCd == tsdPtr->cwdClientData) { goto cdDidNotChange; } @@ -3215,13 +3212,13 @@ * Make sure the file is accessible. */ if (Tcl_FSAccess(pathPtr, R_OK) != 0) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't load library \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp)); } return TCL_ERROR; } #ifdef TCL_LOAD_FROM_MEMORY @@ -3297,12 +3294,11 @@ */ Tcl_FSDeleteFile(copyToPtr); Tcl_DecrRefCount(copyToPtr); if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "couldn't load from current filesystem", -1)); + TclSetResult(interp, "couldn't load from current filesystem"); } return TCL_ERROR; } if (TclCrossFilesystemCopy(interp, pathPtr, copyToPtr) != TCL_OK) { @@ -3598,13 +3594,12 @@ Tcl_Interp *interp, /* The relevant interpreter. */ Tcl_LoadHandle handle) /* A handle for the object to unload. */ { if (handle->unloadFileProcPtr == NULL) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot unload: filesystem does not support unloading", - -1)); + TclSetResult(interp, + "cannot unload: filesystem does not support unloading"); } return TCL_ERROR; } if (handle->unloadFileProcPtr != NULL) { handle->unloadFileProcPtr(handle); Index: generic/tclIndexObj.c ================================================================== --- generic/tclIndexObj.c +++ generic/tclIndexObj.c @@ -201,13 +201,13 @@ IndexRep *indexRep; const Tcl_ObjInternalRep *irPtr; if (offset < (Tcl_Size)sizeof(char *)) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "Invalid %s value %" TCL_SIZE_MODIFIER "d.", - "struct offset", offset)); + "struct offset", offset); } return TCL_ERROR; } /* * See if there is a valid cached result from a previous lookup. @@ -534,34 +534,31 @@ case PRFMATCH_EXACT: flags |= TCL_EXACT; break; case PRFMATCH_MESSAGE: if (i > objc-4) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "missing value for -message", TCL_INDEX_NONE)); + TclSetResult(interp, "missing value for -message"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", (char *)NULL); return TCL_ERROR; } i++; message = TclGetString(objv[i]); break; case PRFMATCH_ERROR: if (i > objc-4) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "missing value for -error", TCL_INDEX_NONE)); + TclSetResult(interp, "missing value for -error"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", (char *)NULL); return TCL_ERROR; } i++; result = TclListObjLength(interp, objv[i], &errorLength); if (result != TCL_OK) { return TCL_ERROR; } if ((errorLength % 2) != 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "error options must have an even number of elements", - -1)); + TclSetResult(interp, + "error options must have an even number of elements"); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", (char *)NULL); return TCL_ERROR; } errorPtr = objv[i]; break; @@ -1074,12 +1071,11 @@ if (infoPtr->keyStr[length] == 0) { matchPtr = infoPtr; goto gotMatch; } if (matchPtr != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "ambiguous option \"%s\"", str)); + TclPrintfResult(interp, "ambiguous option \"%s\"", str); goto error; } matchPtr = infoPtr; } if (matchPtr == NULL) { @@ -1087,12 +1083,11 @@ * Unrecognized argument. Just copy it down, unless the caller * prefers an error to be registered. */ if (remObjv == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unrecognized argument \"%s\"", str)); + TclPrintfResult(interp, "unrecognized argument \"%s\"", str); goto error; } dstIndex++; /* This argument is now handled */ leftovers[nrem++] = curArg; @@ -1113,13 +1108,13 @@ if (objc == 0) { goto missingArg; } if (Tcl_GetIntFromObj(interp, objv[srcIndex], (int *) infoPtr->dstPtr) == TCL_ERROR) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "expected integer argument for \"%s\" but got \"%s\"", - infoPtr->keyStr, TclGetString(objv[srcIndex]))); + infoPtr->keyStr, TclGetString(objv[srcIndex])); goto error; } srcIndex++; objc--; break; @@ -1146,13 +1141,13 @@ if (objc == 0) { goto missingArg; } if (Tcl_GetDoubleFromObj(interp, objv[srcIndex], (double *) infoPtr->dstPtr) == TCL_ERROR) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "expected floating-point argument for \"%s\" but got \"%s\"", - infoPtr->keyStr, TclGetString(objv[srcIndex]))); + infoPtr->keyStr, TclGetString(objv[srcIndex])); goto error; } srcIndex++; objc--; break; @@ -1173,12 +1168,13 @@ break; } case TCL_ARGV_GENFUNC: { if (objc > INT_MAX) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "too many (%" TCL_SIZE_MODIFIER "d) arguments for TCL_ARGV_GENFUNC", objc)); + TclPrintfResult(interp, + "too many (%" TCL_SIZE_MODIFIER "d) arguments for TCL_ARGV_GENFUNC", + objc); goto error; } Tcl_ArgvGenFuncProc *handlerProc = (Tcl_ArgvGenFuncProc *) infoPtr->srcPtr; @@ -1194,12 +1190,12 @@ } case TCL_ARGV_HELP: PrintUsage(interp, argTable); goto error; default: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad argument type %d in Tcl_ArgvInfo", infoPtr->type)); + TclPrintfResult(interp, + "bad argument type %d in Tcl_ArgvInfo", infoPtr->type); goto error; } } /* @@ -1231,12 +1227,12 @@ * Make sure to handle freeing any temporary space we've allocated on the * way to an error. */ missingArg: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "\"%s\" option requires an additional argument", str)); + TclPrintfResult(interp, + "\"%s\" option requires an additional argument", str); error: if (leftovers != NULL) { Tcl_Free(leftovers); } return TCL_ERROR; @@ -1377,14 +1373,14 @@ /* * Value is not a legal completion code. */ if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "bad completion code \"%s\": must be" " ok, error, return, break, continue, or an integer", - TclGetString(value))); + TclGetString(value)); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_CODE", (char *)NULL); } return TCL_ERROR; } Index: generic/tclInt.h ================================================================== --- generic/tclInt.h +++ generic/tclInt.h @@ -4849,10 +4849,21 @@ #define TclDStringAppendLiteral(dsPtr, sLiteral) \ Tcl_DStringAppend((dsPtr), (sLiteral), sizeof(sLiteral "") - 1) #define TclDStringClear(dsPtr) \ Tcl_DStringSetLength((dsPtr), 0) +/* + *---------------------------------------------------------------- + * Convenience for writing to the interpreter result. + */ + +#define TclSetResult(interp, str) \ + Tcl_SetObjResult((interp), Tcl_NewStringObj((str), TCL_AUTO_LENGTH)) + +#define TclPrintfResult(interp, format, ...) \ + Tcl_SetObjResult((interp), Tcl_ObjPrintf((format), __VA_ARGS__)) + /* *---------------------------------------------------------------- * Inline version of Tcl_GetCurrentNamespace and Tcl_GetGlobalNamespace. */ Index: generic/tclInterp.c ================================================================== --- generic/tclInterp.c +++ generic/tclInterp.c @@ -869,12 +869,11 @@ for (i = 2; i < objc; i++) { childInterp = GetInterp(interp, objv[i]); if (childInterp == NULL) { return TCL_ERROR; } else if (childInterp == interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot delete the current interpreter", -1)); + TclSetResult(interp, "cannot delete the current interpreter"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "DELETESELF", (char *)NULL); return TCL_ERROR; } iiPtr = (InterpInfo *) ((Interp *) childInterp)->interpInfo; @@ -1113,22 +1112,22 @@ aliasName = TclGetString(objv[3]); iiPtr = (InterpInfo *) ((Interp *) childInterp)->interpInfo; hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName); if (hPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "alias \"%s\" in path \"%s\" not found", - aliasName, TclGetString(objv[2]))); + aliasName, TclGetString(objv[2])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, (char *)NULL); return TCL_ERROR; } aliasPtr = (Alias *)Tcl_GetHashValue(hPtr); if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "target interpreter for alias \"%s\" in path \"%s\" is " - "not my descendant", aliasName, TclGetString(objv[2]))); + "not my descendant", aliasName, TclGetString(objv[2])); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "TARGETSHROUDED", (char *)NULL); return TCL_ERROR; } return TCL_OK; @@ -1304,12 +1303,11 @@ Tcl_Size objc; Tcl_Obj **objv; hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName); if (hPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "alias \"%s\" not found", aliasName)); + TclPrintfResult(interp, "alias \"%s\" not found", aliasName); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, (char *)NULL); return TCL_ERROR; } aliasPtr = (Alias *)Tcl_GetHashValue(hPtr); objc = aliasPtr->objc; @@ -1394,13 +1392,13 @@ /* * The child interpreter can be deleted while creating the alias. * [Bug #641195] */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "cannot define or rename alias \"%s\": interpreter deleted", - Tcl_GetCommandName(cmdInterp, cmd))); + Tcl_GetCommandName(cmdInterp, cmd)); return TCL_ERROR; } cmdNamePtr = nextAliasPtr->objPtr; aliasCmd = Tcl_FindCommand(nextAliasPtr->targetInterp, TclGetString(cmdNamePtr), @@ -1409,13 +1407,13 @@ if (aliasCmd == NULL) { return TCL_OK; } aliasCmdPtr = (Command *) aliasCmd; if (aliasCmdPtr == cmdPtr) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "cannot define or rename alias \"%s\": would create a loop", - Tcl_GetCommandName(cmdInterp, cmd))); + Tcl_GetCommandName(cmdInterp, cmd)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "ALIASLOOP", (char *)NULL); return TCL_ERROR; } @@ -1632,12 +1630,12 @@ */ childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child; hPtr = Tcl_FindHashEntry(&childPtr->aliasTable, TclGetString(namePtr)); if (hPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "alias \"%s\" not found", TclGetString(namePtr))); + TclPrintfResult(interp, + "alias \"%s\" not found", TclGetString(namePtr)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", TclGetString(namePtr), (char *)NULL); return TCL_ERROR; } aliasPtr = (Alias *)Tcl_GetHashValue(hPtr); @@ -2286,12 +2284,12 @@ if (searchInterp == NULL) { break; } } if (searchInterp == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not find interpreter \"%s\"", TclGetString(pathPtr))); + TclPrintfResult(interp, + "could not find interpreter \"%s\"", TclGetString(pathPtr)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INTERP", TclGetString(pathPtr), (char *)NULL); } return searchInterp; } @@ -2324,12 +2322,11 @@ if (objc) { Tcl_Size length; if (TCL_ERROR == TclListObjLength(NULL, objv[0], &length) || (length < 1)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cmdPrefix must be list of length >= 1", -1)); + TclSetResult(interp, "cmdPrefix must be list of length >= 1"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BGERRORFORMAT", (char *)NULL); return TCL_ERROR; } TclSetBgErrorHandler(childInterp, objv[0]); @@ -2395,13 +2392,13 @@ parentInfoPtr = (InterpInfo *) ((Interp *) parentInterp)->interpInfo; hPtr = Tcl_CreateHashEntry(&parentInfoPtr->parent.childTable, path, &isNew); if (isNew == 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "interpreter named \"%s\" already exists, cannot create", - path)); + path); return NULL; } childInterp = Tcl_CreateInterp(); childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child; @@ -2891,13 +2888,12 @@ Tcl_Obj *const objv[]) /* Argument strings. */ { const char *name; if (Tcl_IsSafe(interp)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "permission denied: safe interpreter cannot expose commands", - -1)); + TclSetResult(interp, + "permission denied: safe interpreter cannot expose commands"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", (char *)NULL); return TCL_ERROR; } @@ -2937,31 +2933,29 @@ Interp *iPtr; Tcl_WideInt limit; if (objc) { if (Tcl_IsSafe(interp)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("permission denied: " - "safe interpreters cannot change recursion limit", -1)); + TclSetResult(interp, "permission denied: " + "safe interpreters cannot change recursion limit"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", (char *)NULL); return TCL_ERROR; } if (TclGetWideIntFromObj(interp, objv[0], &limit) == TCL_ERROR) { return TCL_ERROR; } if (limit <= 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "recursion limit must be > 0", -1)); + TclSetResult(interp, "recursion limit must be > 0"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADLIMIT", (char *)NULL); return TCL_ERROR; } Tcl_SetRecursionLimit(childInterp, limit); iPtr = (Interp *) childInterp; if (interp == childInterp && iPtr->numLevels > limit) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "falling back due to new recursion limit", -1)); + TclSetResult(interp, "falling back due to new recursion limit"); Tcl_SetErrorCode(interp, "TCL", "RECURSION", (char *)NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, objv[0]); return TCL_OK; @@ -2997,13 +2991,12 @@ Tcl_Obj *const objv[]) /* Argument strings. */ { const char *name; if (Tcl_IsSafe(interp)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "permission denied: safe interpreter cannot hide commands", - -1)); + TclSetResult(interp, + "permission denied: safe interpreter cannot hide commands"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", (char *)NULL); return TCL_ERROR; } @@ -3082,13 +3075,12 @@ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; if (Tcl_IsSafe(interp)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "not allowed to invoke hidden commands from safe interpreter", - -1)); + TclSetResult(interp, + "not allowed to invoke hidden commands from safe interpreter"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", (char *)NULL); return TCL_ERROR; } @@ -3159,13 +3151,12 @@ Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp) /* The child interpreter which will be marked * trusted. */ { if (Tcl_IsSafe(interp)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "permission denied: safe interpreter cannot mark trusted", - -1)); + TclSetResult(interp, + "permission denied: safe interpreter cannot mark trusted"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", (char *)NULL); return TCL_ERROR; } ((Interp *) childInterp)->flags &= ~SAFE_INTERP; @@ -3413,12 +3404,11 @@ Tcl_Preserve(interp); RunLimitHandlers(iPtr->limit.cmdHandlers, interp); if (iPtr->limit.cmdCount >= iPtr->cmdCount) { iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS; } else if (iPtr->limit.exceeded & TCL_LIMIT_COMMANDS) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command count limit exceeded", -1)); + TclSetResult(interp, "command count limit exceeded"); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "COMMANDS", (char *)NULL); Tcl_Release(interp); return TCL_ERROR; } Tcl_Release(interp); @@ -3439,12 +3429,11 @@ if (iPtr->limit.time.sec > now.sec || (iPtr->limit.time.sec == now.sec && iPtr->limit.time.usec >= now.usec)) { iPtr->limit.exceeded &= ~TCL_LIMIT_TIME; } else if (iPtr->limit.exceeded & TCL_LIMIT_TIME) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "time limit exceeded", -1)); + TclSetResult(interp, "time limit exceeded"); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "TIME", (char *)NULL); Tcl_Release(interp); return TCL_ERROR; } Tcl_Release(interp); @@ -4442,12 +4431,11 @@ * the low level API enforces this with Tcl_Panic, which we want to * avoid. [Bug 3398794] */ if (interp == childInterp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "limits on current interpreter inaccessible", -1)); + TclSetResult(interp, "limits on current interpreter inaccessible"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", (char *)NULL); return TCL_ERROR; } if (objc == consumedObjc) { @@ -4540,12 +4528,11 @@ granObj = objv[i+1]; if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) { return TCL_ERROR; } if (gran < 1) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "granularity must be at least 1", -1)); + TclSetResult(interp, "granularity must be at least 1"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADVALUE", (char *)NULL); return TCL_ERROR; } break; @@ -4557,12 +4544,12 @@ } if (TclGetIntFromObj(interp, objv[i+1], &limit) != TCL_OK) { return TCL_ERROR; } if (limit < 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command limit value must be at least 0", -1)); + TclSetResult(interp, + "command limit value must be at least 0"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADVALUE", (char *)NULL); return TCL_ERROR; } break; @@ -4629,12 +4616,11 @@ * the low level API enforces this with Tcl_Panic, which we want to * avoid. [Bug 3398794] */ if (interp == childInterp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "limits on current interpreter inaccessible", -1)); + TclSetResult(interp, "limits on current interpreter inaccessible"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", (char *)NULL); return TCL_ERROR; } if (objc == consumedObjc) { @@ -4748,12 +4734,11 @@ granObj = objv[i+1]; if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) { return TCL_ERROR; } if (gran < 1) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "granularity must be at least 1", -1)); + TclSetResult(interp, "granularity must be at least 1"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADVALUE", (char *)NULL); return TCL_ERROR; } break; @@ -4765,12 +4750,11 @@ } if (TclGetWideIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) { return TCL_ERROR; } if (tmp < 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "milliseconds must be non-negative", -1)); + TclSetResult(interp, "milliseconds must be non-negative"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADVALUE", (char *)NULL); return TCL_ERROR; } limitMoment.usec = tmp*1000; @@ -4783,12 +4767,11 @@ } if (TclGetWideIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) { return TCL_ERROR; } if (tmp < 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "seconds must be non-negative", -1)); + TclSetResult(interp, "seconds must be non-negative"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADVALUE", (char *)NULL); return TCL_ERROR; } limitMoment.sec = (long long)tmp; @@ -4801,21 +4784,21 @@ * Setting -milliseconds but clearing -seconds, or resetting * -milliseconds but not resetting -seconds? Bad voodoo! */ if (secObj != NULL && secLen == 0 && milliLen > 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "may only set -milliseconds if -seconds is not " - "also being reset", -1)); + "also being reset"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADUSAGE", (char *)NULL); return TCL_ERROR; } if (milliLen == 0 && (secObj == NULL || secLen > 0)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "may only reset -milliseconds if -seconds is " - "also being reset", -1)); + "also being reset"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADUSAGE", (char *)NULL); return TCL_ERROR; } } Index: generic/tclLink.c ================================================================== --- generic/tclLink.c +++ generic/tclLink.c @@ -165,12 +165,11 @@ int code; linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL, TCL_GLOBAL_ONLY, LinkTraceProc, NULL); if (linkPtr != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "variable '%s' is already linked", varName)); + TclPrintfResult(interp, "variable '%s' is already linked", varName); return TCL_ERROR; } linkPtr = (Link *)Tcl_Alloc(sizeof(Link)); linkPtr->interp = interp; @@ -245,12 +244,11 @@ Namespace *dummy; const char *name; int code; if (size < 1) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "wrong array size given", -1)); + TclSetResult(interp, "wrong array size given"); return TCL_ERROR; } linkPtr = (Link *)Tcl_Alloc(sizeof(Link)); linkPtr->type = type & ~TCL_LINK_READ_ONLY; @@ -313,12 +311,11 @@ case TCL_LINK_BINARY: linkPtr->bytes = size * sizeof(char); break; default: LinkFree(linkPtr); - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad linked array variable type", -1)); + TclSetResult(interp, "bad linked array variable type"); return TCL_ERROR; } /* * Allocate C variable space in case no address is given Index: generic/tclListObj.c ================================================================== --- generic/tclListObj.c +++ generic/tclListObj.c @@ -465,14 +465,14 @@ MemoryAllocationError( Tcl_Interp *interp, /* Interpreter for error message. May be NULL */ size_t size) /* Size of attempted allocation that failed */ { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "list construction failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", - size)); + size); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (void *)NULL); } return TCL_ERROR; } @@ -493,13 +493,11 @@ */ static int ListLimitExceededError(Tcl_Interp *interp) { if (interp != NULL) { - Tcl_SetObjResult( - interp, - Tcl_NewStringObj("max length of a Tcl list exceeded", -1)); + TclSetResult(interp, "max length of a Tcl list exceeded"); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (void *)NULL); } return TCL_ERROR; } @@ -2967,13 +2965,13 @@ } if (index < 0 || index > elemCount || (valueObj == NULL && index >= elemCount)) { /* ...the index points outside the sublist. */ if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "index \"%s\" out of range", - Tcl_GetString(indexArray[-1]))); + Tcl_GetString(indexArray[-1])); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" "OUTOFRANGE", (void *)NULL); } result = TCL_ERROR; break; @@ -3159,12 +3157,12 @@ elemCount = ListRepLength(&listRep); /* Ensure that the index is in bounds. */ if ((index < 0) || (index >= elemCount)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "index \"%" TCL_SIZE_MODIFIER "d\" out of range", index)); + TclPrintfResult(interp, + "index \"%" TCL_SIZE_MODIFIER "d\" out of range", index); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", (void *)NULL); } return TCL_ERROR; } Index: generic/tclLoad.c ================================================================== --- generic/tclLoad.c +++ generic/tclLoad.c @@ -188,12 +188,11 @@ if (prefix[0] == '\0') { prefix = NULL; } } if ((fullFileName[0] == 0) && (prefix == NULL)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "must specify either file name or prefix", -1)); + TclSetResult(interp, "must specify either file name or prefix"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOLIBRARY", (char *)NULL); code = TCL_ERROR; goto done; } @@ -253,13 +252,13 @@ if (filesMatch && !namesMatch && (fullFileName[0] != 0)) { /* * Can't have two different libraries loaded from the same file. */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "file \"%s\" is already loaded for prefix \"%s\"", - fullFileName, libraryPtr->prefix)); + fullFileName, libraryPtr->prefix); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "SPLITPERSONALITY", (char *)NULL); code = TCL_ERROR; Tcl_MutexUnlock(&libraryMutex); goto done; @@ -291,12 +290,13 @@ * The desired file isn't currently loaded, so load it. It's an error * if the desired library is a static one. */ if (fullFileName[0] == 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "no library with prefix \"%s\" is loaded statically", prefix)); + TclPrintfResult(interp, + "no library with prefix \"%s\" is loaded statically", + prefix); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOTSTATIC", (char *)NULL); code = TCL_ERROR; goto done; } @@ -352,13 +352,12 @@ break; } } if (p == pkgGuess) { Tcl_DecrRefCount(splitPtr); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't figure out prefix for %s", - fullFileName)); + TclPrintfResult(interp, + "couldn't figure out prefix for %s", fullFileName); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "WHATLIBRARY", (char *)NULL); code = TCL_ERROR; goto done; } @@ -449,24 +448,24 @@ * the safe one, depending on whether or not the interpreter is safe). */ if (Tcl_IsSafe(target)) { if (libraryPtr->safeInitProc == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "can't use library in a safe interpreter: no" - " %s_SafeInit procedure", libraryPtr->prefix)); + " %s_SafeInit procedure", libraryPtr->prefix); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "UNSAFE", (char *)NULL); code = TCL_ERROR; goto done; } code = libraryPtr->safeInitProc(target); } else { if (libraryPtr->initProc == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "can't attach library to interpreter: no %s_Init procedure", - libraryPtr->prefix)); + libraryPtr->prefix); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT", (char *)NULL); code = TCL_ERROR; goto done; } @@ -484,11 +483,11 @@ /* * A call to Tcl_InitStubs() determined the caller extension and * this interp are incompatible in their stubs mechanisms, and * recorded the error in the oldest legacy place we have to do so. */ - Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->legacyResult, -1)); + TclSetResult(target, iPtr->legacyResult); iPtr->legacyResult = NULL; iPtr->legacyFreeProc = (void (*) (void))-1; } Tcl_TransferResult(target, code, interp); goto done; @@ -621,12 +620,11 @@ if (prefix[0] == '\0') { prefix = NULL; } } if ((fullFileName[0] == 0) && (prefix == NULL)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "must specify either file name or prefix", -1)); + TclSetResult(interp, "must specify either file name or prefix"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NOLIBRARY", (char *)NULL); code = TCL_ERROR; goto done; } @@ -688,13 +686,13 @@ if (fullFileName[0] == 0) { /* * It's an error to try unload a static library. */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "library with prefix \"%s\" is loaded statically and cannot be unloaded", - prefix)); + prefix); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "STATIC", (char *)NULL); code = TCL_ERROR; goto done; } @@ -701,12 +699,12 @@ if (libraryPtr == NULL) { /* * The DLL pointed by the provided filename has never been loaded. */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "file \"%s\" has never been loaded", fullFileName)); + TclPrintfResult(interp, + "file \"%s\" has never been loaded", fullFileName); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED", (char *)NULL); code = TCL_ERROR; goto done; } @@ -730,13 +728,13 @@ if (code != TCL_OK) { /* * The library has not been loaded in this interpreter. */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "file \"%s\" has never been loaded in this interpreter", - fullFileName)); + fullFileName); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED", (char *)NULL); code = TCL_ERROR; goto done; } @@ -791,13 +789,13 @@ */ if (Tcl_IsSafe(target)) { if (libraryPtr->safeUnloadProc == NULL) { if (!interpExiting) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "file \"%s\" cannot be unloaded under a safe interpreter", - fullFileName)); + fullFileName); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT", (char *)NULL); code = TCL_ERROR; goto done; } @@ -804,13 +802,13 @@ } unloadProc = libraryPtr->safeUnloadProc; } else { if (libraryPtr->unloadProc == NULL) { if (!interpExiting) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "file \"%s\" cannot be unloaded under a trusted interpreter", - fullFileName)); + fullFileName); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT", (char *)NULL); code = TCL_ERROR; goto done; } @@ -954,13 +952,13 @@ } else { code = TCL_ERROR; } } #else - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "file \"%s\" cannot be unloaded: unloading disabled", - fullFileName)); + fullFileName); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "DISABLED", NULL); code = TCL_ERROR; #endif } Index: generic/tclLoadNone.c ================================================================== --- generic/tclLoadNone.c +++ generic/tclLoadNone.c @@ -44,13 +44,12 @@ * function which should be used for this * file. */ int flags) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "dynamic loading is not currently available on this system", - -1)); + TclSetResult(interp, + "dynamic loading is not currently available on this system"); } return TCL_ERROR; } /* @@ -78,12 +77,12 @@ TCL_UNUSED(Tcl_LoadHandle *), TCL_UNUSED(Tcl_FSUnloadFileProc **), TCL_UNUSED(int)) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("dynamic loading from memory " - "is not available on this system", -1)); + TclSetResult(interp, + "dynamic loading from memory is not available on this system"); } return TCL_ERROR; } #endif /* TCL_LOAD_FROM_MEMORY */ Index: generic/tclNamesp.c ================================================================== --- generic/tclNamesp.c +++ generic/tclNamesp.c @@ -712,12 +712,12 @@ * the global namespace despite the global namespace existing. That's * naughty! */ if (*name == '\0') { - Tcl_SetObjResult(interp, Tcl_NewStringObj("can't create namespace" - " \"\": only global namespace can have empty name", -1)); + TclSetResult(interp, "can't create namespace" + " \"\": only global namespace can have empty name"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE", "CREATEGLOBAL", (char *)NULL); Tcl_DStringFree(&tmpBuffer); return NULL; } @@ -751,12 +751,12 @@ #else parentPtr->childTablePtr != NULL && Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL #endif ) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't create namespace \"%s\": already exists", name)); + TclPrintfResult(interp, + "can't create namespace \"%s\": already exists", name); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE", "CREATEEXISTING", (char *)NULL); Tcl_DStringFree(&tmpBuffer); return NULL; } @@ -1431,12 +1431,12 @@ TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY, &exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern); if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid export pattern" - " \"%s\": pattern can't specify a namespace", pattern)); + TclPrintfResult(interp,"invalid export pattern" + " \"%s\": pattern can't specify a namespace", pattern); Tcl_SetErrorCode(interp, "TCL", "EXPORT", "INVALID", (char *)NULL); return TCL_ERROR; } /* @@ -1638,33 +1638,33 @@ * From the pattern, find the namespace from which we are importing and * get the simple pattern (no namespace qualifiers or ::'s) at the end. */ if (strlen(pattern) == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern",-1)); + TclSetResult(interp, "empty import pattern"); Tcl_SetErrorCode(interp, "TCL", "IMPORT", "EMPTY", (char *)NULL); return TCL_ERROR; } TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY, &importNsPtr, &dummyPtr, &dummyPtr, &simplePattern); if (importNsPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown namespace in import pattern \"%s\"", pattern)); + TclPrintfResult(interp, + "unknown namespace in import pattern \"%s\"", pattern); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, (char *)NULL); return TCL_ERROR; } if (importNsPtr == nsPtr) { if (pattern == simplePattern) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "no namespace specified in import pattern \"%s\"", - pattern)); + pattern); Tcl_SetErrorCode(interp, "TCL", "IMPORT", "ORIGIN", (char *)NULL); } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "import pattern \"%s\" tries to import from namespace" - " \"%s\" into itself", pattern, importNsPtr->name)); + " \"%s\" into itself", pattern, importNsPtr->name); Tcl_SetErrorCode(interp, "TCL", "IMPORT", "SELF", (char *)NULL); } return TCL_ERROR; } @@ -1779,14 +1779,14 @@ while (linkCmd->deleteProc == DeleteImportedCmd) { dataPtr = (ImportedCmdData *)linkCmd->objClientData; linkCmd = dataPtr->realCmdPtr; if (overwrite == linkCmd) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "import pattern \"%s\" would create a loop" " containing command \"%s\"", - pattern, Tcl_DStringValue(&ds))); + pattern, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); Tcl_SetErrorCode(interp, "TCL", "IMPORT", "LOOP", (char *)NULL); return TCL_ERROR; } } @@ -1824,12 +1824,12 @@ */ return TCL_OK; } } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't import command \"%s\": already exists", cmdName)); + TclPrintfResult(interp, + "can't import command \"%s\": already exists", cmdName); Tcl_SetErrorCode(interp, "TCL", "IMPORT", "OVERWRITE", (char *)NULL); return TCL_ERROR; } return TCL_OK; } @@ -1893,13 +1893,13 @@ TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY, &sourceNsPtr, &dummyPtr, &dummyPtr, &simplePattern); if (sourceNsPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "unknown namespace in namespace forget pattern \"%s\"", - pattern)); + pattern); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, (char *)NULL); return TCL_ERROR; } if (strcmp(pattern, simplePattern) == 0) { @@ -2541,12 +2541,11 @@ if (nsPtr != NULL) { return (Tcl_Namespace *) nsPtr; } if (flags & TCL_LEAVE_ERR_MSG) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown namespace \"%s\"", name)); + TclPrintfResult(interp, "unknown namespace \"%s\"", name); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", name, (char *)NULL); } return NULL; } @@ -2731,12 +2730,11 @@ cmdPtr->flags &= ~CMD_VIA_RESOLVER; return (Tcl_Command) cmdPtr; } if (flags & TCL_LEAVE_ERR_MSG) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown command \"%s\"", name)); + TclPrintfResult(interp, "unknown command \"%s\"", name); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", name, (char *)NULL); } return NULL; } @@ -2915,21 +2913,20 @@ { if (GetNamespaceFromObj(interp, objPtr, nsPtrPtr) == TCL_ERROR) { const char *name = TclGetString(objPtr); if ((name[0] == ':') && (name[1] == ':')) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "namespace \"%s\" not found", name)); + TclPrintfResult(interp, "namespace \"%s\" not found", name); } else { /* * Get the current namespace name. */ NamespaceCurrentCmd(NULL, interp, 1, NULL); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "namespace \"%s\" not found in \"%s\"", name, - Tcl_GetStringResult(interp))); + Tcl_GetStringResult(interp)); } Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", name, (char *)NULL); return TCL_ERROR; } return TCL_OK; @@ -3250,13 +3247,13 @@ * namespace [namespace current]::bar { ... } */ currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("::", 2)); + TclSetResult(interp, "::"); } else { - Tcl_SetObjResult(interp, Tcl_NewStringObj(currNsPtr->fullName, -1)); + TclSetResult(interp, currNsPtr->fullName); } return TCL_OK; } /* @@ -3315,13 +3312,13 @@ for (i = 1; i < objc; i++) { name = TclGetString(objv[i]); namespacePtr = Tcl_FindNamespace(interp, name, NULL, /*flags*/ 0); if ((namespacePtr == NULL) || (((Namespace *) namespacePtr)->flags & NS_TEARDOWN)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "unknown namespace \"%s\" in namespace delete command", - TclGetString(objv[i]))); + TclGetString(objv[i])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", TclGetString(objv[i]), (char *)NULL); return TCL_ERROR; } } @@ -3950,12 +3947,12 @@ TclNewObj(resultPtr); Tcl_GetCommandFullName(interp, origCmd, resultPtr); if (TclCheckEmptyString(resultPtr) == TCL_EMPTYSTRING_YES ) { Tcl_DecrRefCount(resultPtr); namespaceOriginError: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid command name \"%s\"", TclGetString(objv[1]))); + TclPrintfResult(interp, + "invalid command name \"%s\"", TclGetString(objv[1])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", TclGetString(objv[1]), (char *)NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, resultPtr); @@ -4006,12 +4003,11 @@ /* * Report the parent of the specified namespace. */ if (nsPtr->parentPtr != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - nsPtr->parentPtr->fullName, -1)); + TclSetResult(interp, nsPtr->parentPtr->fullName); } return TCL_OK; } /* @@ -4552,11 +4548,11 @@ break; } } if (p >= name) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(p, -1)); + TclSetResult(interp, p); } return TCL_OK; } /* Index: generic/tclOO.c ================================================================== --- generic/tclOO.c +++ generic/tclOO.c @@ -1863,13 +1863,13 @@ * Disallow creation of an object over an existing command. */ hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simpleName); if (hPtr) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "can't create object \"%s\": command already exists with" - " that name", nameStr)); + " that name", nameStr); Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", (char *)NULL); return NULL; } } @@ -1918,12 +1918,11 @@ * Ensure an error if the object was deleted in the constructor. Don't * want to lose errors by accident. [Bug 2903011] */ if (result != TCL_ERROR && Destructing(oPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "object deleted in constructor", -1)); + TclSetResult(interp, "object deleted in constructor"); Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", (char *)NULL); result = TCL_ERROR; } if (result != TCL_OK) { Tcl_DiscardInterpState(state); @@ -1989,12 +1988,11 @@ /* * Sanity check. */ if (IsRootClass(oPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not clone the class of classes", -1)); + TclSetResult(interp, "may not clone the class of classes"); Tcl_SetErrorCode(interp, "TCL", "OO", "CLONING_CLASS", (char *)NULL); return NULL; } /* @@ -2752,13 +2750,13 @@ contextPtr = TclOOGetCallContext(oPtr, mappedMethodName, flags | (oPtr->flags & FILTER_HANDLING), callerObjPtr, callerClsPtr, methodNamePtr); TclDecrRefCount(mappedMethodName); if (contextPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "impossible to invoke method \"%s\": no defined method or" - " unknown method", TclGetString(methodNamePtr))); + " unknown method", TclGetString(methodNamePtr)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD_MAPPED", TclGetString(methodNamePtr), (char *)NULL); return TCL_ERROR; } } else { @@ -2769,13 +2767,13 @@ noMapping: contextPtr = TclOOGetCallContext(oPtr, methodNamePtr, flags | (oPtr->flags & FILTER_HANDLING), callerObjPtr, callerClsPtr, NULL); if (contextPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "impossible to invoke method \"%s\": no defined method or" - " unknown method", TclGetString(methodNamePtr))); + " unknown method", TclGetString(methodNamePtr)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(methodNamePtr), (char *)NULL); return TCL_ERROR; } } @@ -2797,12 +2795,11 @@ if (miPtr->mPtr->declaringClassPtr == startCls) { break; } } if (contextPtr->index >= contextPtr->callPtr->numChain) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "no valid method implementation", -1)); + TclSetResult(interp, "no valid method implementation"); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(methodNamePtr), (char *)NULL); TclOODeleteContext(contextPtr); return TCL_ERROR; } @@ -2879,12 +2876,11 @@ methodType = "destructor"; } else { methodType = "method"; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "no next %s implementation", methodType)); + TclPrintfResult(interp, "no next %s implementation", methodType); Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", (char *)NULL); return TCL_ERROR; } /* @@ -2948,12 +2944,11 @@ methodType = "destructor"; } else { methodType = "method"; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "no next %s implementation", methodType)); + TclPrintfResult(interp, "no next %s implementation", methodType); Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", (char *)NULL); return TCL_ERROR; } /* @@ -3026,12 +3021,12 @@ } } return (Tcl_Object)cmdPtr->objClientData; notAnObject: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "%s does not refer to an object", TclGetString(objPtr))); + TclPrintfResult(interp, + "%s does not refer to an object", TclGetString(objPtr)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "OBJECT", TclGetString(objPtr), (char *)NULL); return NULL; } Index: generic/tclOOBasic.c ================================================================== --- generic/tclOOBasic.c +++ generic/tclOOBasic.c @@ -193,12 +193,12 @@ */ if (oPtr->classPtr == NULL) { Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "object \"%s\" is not a class", TclGetString(cmdnameObj))); + TclPrintfResult(interp, + "object \"%s\" is not a class", TclGetString(cmdnameObj)); Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", (char *)NULL); return TCL_ERROR; } /* @@ -211,12 +211,11 @@ return TCL_ERROR; } objName = Tcl_GetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)], &len); if (len == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "object name must not be empty", -1)); + TclSetResult(interp, "object name must not be empty"); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", (char *)NULL); return TCL_ERROR; } /* @@ -258,12 +257,12 @@ */ if (oPtr->classPtr == NULL) { Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "object \"%s\" is not a class", TclGetString(cmdnameObj))); + TclPrintfResult(interp, + "object \"%s\" is not a class", TclGetString(cmdnameObj)); Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", (char *)NULL); return TCL_ERROR; } /* @@ -276,20 +275,18 @@ return TCL_ERROR; } objName = Tcl_GetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)], &len); if (len == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "object name must not be empty", -1)); + TclSetResult(interp, "object name must not be empty"); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", (char *)NULL); return TCL_ERROR; } nsName = Tcl_GetStringFromObj( objv[Tcl_ObjectContextSkippedArgs(context)+1], &len); if (len == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "namespace name must not be empty", -1)); + TclSetResult(interp, "namespace name must not be empty"); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", (char *)NULL); return TCL_ERROR; } /* @@ -329,12 +326,12 @@ */ if (oPtr->classPtr == NULL) { Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "object \"%s\" is not a class", TclGetString(cmdnameObj))); + TclPrintfResult(interp, + "object \"%s\" is not a class", TclGetString(cmdnameObj)); Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", (char *)NULL); return TCL_ERROR; } /* @@ -587,12 +584,12 @@ if (contextPtr->callPtr->flags & PUBLIC_METHOD) { piece = "visible methods"; } else { piece = "methods"; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "object \"%s\" has no %s", TclGetString(tmpBuf), piece)); + TclPrintfResult(interp, + "object \"%s\" has no %s", TclGetString(tmpBuf), piece); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[skip]), (char *)NULL); return TCL_ERROR; } @@ -663,13 +660,13 @@ * The variable name must not contain a '::' since that's illegal in * local names. */ if (strstr(varName, "::") != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "variable name \"%s\" illegal: must not contain namespace" - " separator", varName)); + " separator", varName); Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", (char *)NULL); return TCL_ERROR; } /* @@ -881,13 +878,13 @@ * are invoked from a suitable method context. If so, we can safely * retrieve the handle to the object call context. */ if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "%s may only be called from inside a method", - TclGetString(objv[0]))); + TclGetString(objv[0])); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL); return TCL_ERROR; } context = (Tcl_ObjectContext)framePtr->clientData; @@ -921,13 +918,13 @@ * are invoked from a suitable method context. If so, we can safely * retrieve the handle to the object call context. */ if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "%s may only be called from inside a method", - TclGetString(objv[0]))); + TclGetString(objv[0])); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL); return TCL_ERROR; } contextPtr = (CallContext *)framePtr->clientData; @@ -943,12 +940,12 @@ if (object == NULL) { return TCL_ERROR; } classPtr = ((Object *)object)->classPtr; if (classPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "\"%s\" is not a class", TclGetString(objv[1]))); + TclPrintfResult(interp, + "\"%s\" is not a class", TclGetString(objv[1])); Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", (char *)NULL); return TCL_ERROR; } /* @@ -990,21 +987,21 @@ for (i=contextPtr->index ; i != TCL_INDEX_NONE ; i--) { struct MInvoke *miPtr = contextPtr->callPtr->chain + i; if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "%s implementation by \"%s\" not reachable from here", - methodType, TclGetString(objv[1]))); + methodType, TclGetString(objv[1])); Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE", (char *)NULL); return TCL_ERROR; } } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "%s has no non-filter implementation by \"%s\"", - methodType, TclGetString(objv[1]))); + methodType, TclGetString(objv[1])); Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", (char *)NULL); return TCL_ERROR; } static int @@ -1060,13 +1057,13 @@ /* * Start with sanity checks on the calling context and the method context. */ if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "%s may only be called from inside a method", - TclGetString(objv[0]))); + TclGetString(objv[0])); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL); return TCL_ERROR; } contextPtr = (CallContext*)framePtr->clientData; @@ -1089,19 +1086,17 @@ switch (index) { case SELF_OBJECT: Tcl_SetObjResult(interp, TclOOObjectName(interp, contextPtr->oPtr)); return TCL_OK; case SELF_NS: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - contextPtr->oPtr->namespacePtr->fullName, -1)); + TclSetResult(interp, contextPtr->oPtr->namespacePtr->fullName); return TCL_OK; case SELF_CLASS: { Class *clsPtr = CurrentlyInvoked(contextPtr).mPtr->declaringClassPtr; if (clsPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "method not defined by a class", -1)); + TclSetResult(interp, "method not defined by a class"); Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", (char *)NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, TclOOObjectName(interp, clsPtr->thisPtr)); @@ -1117,12 +1112,11 @@ CurrentlyInvoked(contextPtr).mPtr->namePtr); } return TCL_OK; case SELF_FILTER: if (!CurrentlyInvoked(contextPtr).isFilter) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "not inside a filtering context", -1)); + TclSetResult(interp, "not inside a filtering context"); Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", (char *)NULL); return TCL_ERROR; } else { struct MInvoke *miPtr = &CurrentlyInvoked(contextPtr); Object *oPtr; @@ -1143,12 +1137,11 @@ return TCL_OK; } case SELF_CALLER: if ((framePtr->callerVarPtr == NULL) || !(framePtr->callerVarPtr->isProcCallFrame & FRAME_IS_METHOD)){ - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "caller is not an object", -1)); + TclSetResult(interp, "caller is not an object"); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL); return TCL_ERROR; } else { CallContext *callerPtr = (CallContext *)framePtr->callerVarPtr->clientData; Method *mPtr = callerPtr->callPtr->chain[callerPtr->index].mPtr; @@ -1161,12 +1154,11 @@ } else { /* * This should be unreachable code. */ - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "method without declarer!", -1)); + TclSetResult(interp, "method without declarer!"); return TCL_ERROR; } result[0] = TclOOObjectName(interp, declarerPtr); result[1] = TclOOObjectName(interp, callerPtr->oPtr); @@ -1193,12 +1185,11 @@ } else { /* * This should be unreachable code. */ - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "method without declarer!", -1)); + TclSetResult(interp, "method without declarer!"); return TCL_ERROR; } result[0] = TclOOObjectName(interp, declarerPtr); if (contextPtr->callPtr->flags & CONSTRUCTOR) { @@ -1211,12 +1202,11 @@ Tcl_SetObjResult(interp, Tcl_NewListObj(2, result)); } return TCL_OK; case SELF_TARGET: if (!CurrentlyInvoked(contextPtr).isFilter) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "not inside a filtering context", -1)); + TclSetResult(interp, "not inside a filtering context"); Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", (char *)NULL); return TCL_ERROR; } else { Method *mPtr; Object *declarerPtr; @@ -1238,12 +1228,11 @@ } else { /* * This should be unreachable code. */ - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "method without declarer!", -1)); + TclSetResult(interp, "method without declarer!"); return TCL_ERROR; } result[0] = TclOOObjectName(interp, declarerPtr); result[1] = mPtr->namePtr; Tcl_SetObjResult(interp, Tcl_NewListObj(2, result)); @@ -1318,12 +1307,12 @@ if (namespaceName[0] == '\0') { namespaceName = NULL; } else if (Tcl_FindNamespace(interp, namespaceName, NULL, 0) != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "%s refers to an existing namespace", namespaceName)); + TclPrintfResult(interp, + "%s refers to an existing namespace", namespaceName); return TCL_ERROR; } } o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, namespaceName); Index: generic/tclOODefineCmds.c ================================================================== --- generic/tclOODefineCmds.c +++ generic/tclOODefineCmds.c @@ -669,12 +669,12 @@ int isNew; if (!useClass) { if (!oPtr->methodsPtr) { noSuchMethod: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "method %s does not exist", TclGetString(fromPtr))); + TclPrintfResult(interp, + "method %s does not exist", TclGetString(fromPtr)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(fromPtr), (char *)NULL); return TCL_ERROR; } hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, fromPtr); @@ -684,19 +684,17 @@ if (toPtr) { newHPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, toPtr, &isNew); if (hPtr == newHPtr) { renameToSelf: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot rename method to itself", -1)); + TclSetResult(interp, "cannot rename method to itself"); Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_TO_SELF", (char *)NULL); return TCL_ERROR; } else if (!isNew) { renameToExisting: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "method called %s already exists", - TclGetString(toPtr))); + TclPrintfResult(interp, "method called %s already exists", + TclGetString(toPtr)); Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_OVER", (char *)NULL); return TCL_ERROR; } } } else { @@ -760,12 +758,11 @@ Tcl_HashEntry *hPtr; Tcl_Size soughtLen; const char *soughtStr, *matchedStr = NULL; if (objc < 2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad call of unknown handler", -1)); + TclSetResult(interp, "bad call of unknown handler"); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", (char *)NULL); return TCL_ERROR; } if (TclOOGetDefineCmdContext(interp) == NULL) { return TCL_ERROR; @@ -807,12 +804,11 @@ TclStackFree(interp, newObjv); return result; } noMatch: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid command name \"%s\"", soughtStr)); + TclPrintfResult(interp, "invalid command name \"%s\"", soughtStr); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", soughtStr, (char *)NULL); return TCL_ERROR; } /* @@ -897,12 +893,11 @@ Tcl_Obj *const objv[]) { CallFrame *framePtr, **framePtrPtr = &framePtr; if (namespacePtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "no definition namespace available", -1)); + TclSetResult(interp, "no definition namespace available"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } /* @@ -937,21 +932,20 @@ Tcl_Object object; if ((iPtr->varFramePtr == NULL) || (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE && iPtr->varFramePtr->isProcCallFrame != PRIVATE_FRAME)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "this command may only be called from within the context of" - " an ::oo::define or ::oo::objdefine command", -1)); + " an ::oo::define or ::oo::objdefine command"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return NULL; } object = (Tcl_Object)iPtr->varFramePtr->clientData; if (Tcl_ObjectDeleted(object)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "this command cannot be called when the object has been" - " deleted", -1)); + TclSetResult(interp, + "this command cannot be called when the object has been deleted"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return NULL; } return object; } @@ -990,11 +984,11 @@ iPtr->varFramePtr = savedFramePtr; if (oPtr == NULL) { return NULL; } if (oPtr->classPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); + TclSetResult(interp, errMsg); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", TclGetString(className), (char *)NULL); return NULL; } return oPtr->classPtr; @@ -1165,12 +1159,12 @@ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); if (oPtr == NULL) { return TCL_ERROR; } if (oPtr->classPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "%s does not refer to a class", TclGetString(objv[1]))); + TclPrintfResult(interp, + "%s does not refer to a class", TclGetString(objv[1])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", TclGetString(objv[1]), (char *)NULL); return TCL_ERROR; } @@ -1488,18 +1482,18 @@ oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } if (oPtr->flags & ROOT_OBJECT) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not modify the class of the root object class", -1)); + TclSetResult(interp, + "may not modify the class of the root object class"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } if (oPtr->flags & ROOT_CLASS) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not modify the class of the class of classes", -1)); + TclSetResult(interp, + "may not modify the class of the class of classes"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } /* @@ -1514,12 +1508,12 @@ "the class of an object must be a class"); if (clsPtr == NULL) { return TCL_ERROR; } if (oPtr == clsPtr->thisPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not change classes into an instance of themselves", -1)); + TclSetResult(interp, + "may not change classes into an instance of themselves"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } /* @@ -1667,19 +1661,17 @@ oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); + TclSetResult(interp, "attempt to misuse API"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } if (oPtr->flags & (ROOT_OBJECT | ROOT_CLASS)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not modify the definition namespace of the root classes", - -1)); + TclSetResult(interp, + "may not modify the definition namespace of the root classes"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } /* @@ -1751,12 +1743,11 @@ oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } if (!isInstanceDeleteMethod && !oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); + TclSetResult(interp, "attempt to misuse API"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } for (i = 1; i < objc; i++) { @@ -1877,12 +1868,11 @@ if (oPtr == NULL) { return TCL_ERROR; } clsPtr = oPtr->classPtr; if (!isInstanceExport && !clsPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); + TclSetResult(interp, "attempt to misuse API"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } for (i = 1; i < objc; i++) { @@ -1971,12 +1961,11 @@ oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } if (!isInstanceForward && !oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); + TclSetResult(interp, "attempt to misuse API"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } isPublic = Tcl_StringMatch(TclGetString(objv[1]), PUBLIC_PATTERN) ? PUBLIC_METHOD : 0; @@ -2049,12 +2038,11 @@ oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } if (!isInstanceMethod && !oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); + TclSetResult(interp, "attempt to misuse API"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } if (objc == 5) { if (Tcl_GetIndexFromObj(interp, objv[2], exportModes, "export flag", @@ -2128,12 +2116,11 @@ oPtr = (Object *) TclOOGetDefineCmdContext(interp); if (oPtr == NULL) { return TCL_ERROR; } if (!isInstanceRenameMethod && !oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); + TclSetResult(interp, "attempt to misuse API"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } /* @@ -2190,12 +2177,11 @@ if (oPtr == NULL) { return TCL_ERROR; } clsPtr = oPtr->classPtr; if (!isInstanceUnexport && !clsPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); + TclSetResult(interp, "attempt to misuse API"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } for (i = 1; i < objc; i++) { @@ -2386,12 +2372,11 @@ return TCL_ERROR; } if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); + TclSetResult(interp, "attempt to misuse API"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } TclNewObj(resultObj); @@ -2422,12 +2407,11 @@ objv += Tcl_ObjectContextSkippedArgs(context); if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); + TclSetResult(interp, "attempt to misuse API"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } else if (TclListObjGetElements(interp, objv[0], &filterc, &filterv) != TCL_OK) { return TCL_ERROR; @@ -2467,12 +2451,11 @@ return TCL_ERROR; } if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); + TclSetResult(interp, "attempt to misuse API"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } TclNewObj(resultObj); @@ -2511,12 +2494,11 @@ objv += Tcl_ObjectContextSkippedArgs(context); if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); + TclSetResult(interp, "attempt to misuse API"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } else if (TclListObjGetElements(interp, objv[0], &mixinc, &mixinv) != TCL_OK) { return TCL_ERROR; @@ -2532,18 +2514,16 @@ i--; goto freeAndError; } (void) Tcl_CreateHashEntry(&uniqueCheck, (void *) mixins[i], &isNew); if (!isNew) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "class should only be a direct mixin once", -1)); + TclSetResult(interp, "class should only be a direct mixin once"); Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS", (char *)NULL); goto freeAndError; } if (TclOOIsReachable(oPtr->classPtr, mixins[i])) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not mix a class into itself", -1)); + TclSetResult(interp, "may not mix a class into itself"); Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", (char *)NULL); goto freeAndError; } } @@ -2588,12 +2568,11 @@ return TCL_ERROR; } if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); + TclSetResult(interp, "attempt to misuse API"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } TclNewObj(resultObj); @@ -2627,17 +2606,16 @@ objv += Tcl_ObjectContextSkippedArgs(context); if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); + TclSetResult(interp, "attempt to misuse API"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } else if (oPtr == oPtr->fPtr->objectCls->thisPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not modify the superclass of the root object", -1)); + TclSetResult(interp, + "may not modify the superclass of the root object"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } else if (TclListObjGetElements(interp, objv[0], &superc, &superv) != TCL_OK) { return TCL_ERROR; @@ -2672,20 +2650,19 @@ if (superclasses[i] == NULL) { goto failedAfterAlloc; } for (j = 0; j < i; j++) { if (superclasses[j] == superclasses[i]) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "class should only be a direct superclass once", - -1)); + TclSetResult(interp, + "class should only be a direct superclass once"); Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",(char *)NULL); goto failedAfterAlloc; } } if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to form circular dependency graph", -1)); + TclSetResult(interp, + "attempt to form circular dependency graph"); Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", (char *)NULL); failedAfterAlloc: for (; i-- > 0 ;) { TclOODecrRefCount(superclasses[i]->thisPtr); } @@ -2755,12 +2732,11 @@ return TCL_ERROR; } if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); + TclSetResult(interp, "attempt to misuse API"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } TclNewObj(resultObj); @@ -2802,12 +2778,11 @@ objv += Tcl_ObjectContextSkippedArgs(context); if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); + TclSetResult(interp, "attempt to misuse API"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } else if (TclListObjGetElements(interp, objv[0], &varc, &varv) != TCL_OK) { return TCL_ERROR; @@ -2815,20 +2790,20 @@ for (i = 0; i < varc; i++) { const char *varName = TclGetString(varv[i]); if (strstr(varName, "::") != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "invalid declared variable name \"%s\": must not %s", - varName, "contain namespace separators")); + varName, "contain namespace separators"); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", (char *)NULL); return TCL_ERROR; } if (Tcl_StringMatch(varName, "*(*)")) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "invalid declared variable name \"%s\": must not %s", - varName, "refer to an array element")); + varName, "refer to an array element"); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", (char *)NULL); return TCL_ERROR; } } @@ -2992,12 +2967,11 @@ if (mixins[i] == NULL) { goto freeAndError; } (void) Tcl_CreateHashEntry(&uniqueCheck, (void *) mixins[i], &isNew); if (!isNew) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "class should only be a direct mixin once", -1)); + TclSetResult(interp, "class should only be a direct mixin once"); Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS", (char *)NULL); goto freeAndError; } } @@ -3088,20 +3062,20 @@ for (i = 0; i < varc; i++) { const char *varName = TclGetString(varv[i]); if (strstr(varName, "::") != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "invalid declared variable name \"%s\": must not %s", - varName, "contain namespace separators")); + varName, "contain namespace separators"); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", (char *)NULL); return TCL_ERROR; } if (Tcl_StringMatch(varName, "*(*)")) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "invalid declared variable name \"%s\": must not %s", - varName, "refer to an array element")); + varName, "refer to an array element"); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", (char *)NULL); return TCL_ERROR; } } @@ -3253,12 +3227,11 @@ return TCL_ERROR; } if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); + TclSetResult(interp, "attempt to misuse API"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } TclNewObj(resultObj); @@ -3289,12 +3262,11 @@ objv += Tcl_ObjectContextSkippedArgs(context); if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); + TclSetResult(interp, "attempt to misuse API"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } else if (Tcl_ListObjGetElements(interp, objv[0], &varc, &varv) != TCL_OK) { return TCL_ERROR; @@ -3450,12 +3422,11 @@ return TCL_ERROR; } if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); + TclSetResult(interp, "attempt to misuse API"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } TclNewObj(resultObj); @@ -3486,12 +3457,11 @@ objv += Tcl_ObjectContextSkippedArgs(context); if (oPtr == NULL) { return TCL_ERROR; } else if (!oPtr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", -1)); + TclSetResult(interp, "attempt to misuse API"); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (char *)NULL); return TCL_ERROR; } else if (Tcl_ListObjGetElements(interp, objv[0], &varc, &varv) != TCL_OK) { return TCL_ERROR; Index: generic/tclOOInfo.c ================================================================== --- generic/tclOOInfo.c +++ generic/tclOOInfo.c @@ -153,12 +153,12 @@ if (oPtr == NULL) { return NULL; } if (oPtr->classPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "\"%s\" is not a class", TclGetString(objPtr))); + TclPrintfResult(interp, + "\"%s\" is not a class", TclGetString(objPtr)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", TclGetString(objPtr), (char *)NULL); return NULL; } return oPtr->classPtr; @@ -258,20 +258,20 @@ goto unknownMethod; } hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, objv[2]); if (hPtr == NULL) { unknownMethod: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown method \"%s\"", TclGetString(objv[2]))); + TclPrintfResult(interp, + "unknown method \"%s\"", TclGetString(objv[2])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), (char *)NULL); return TCL_ERROR; } procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr)); if (procPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "definition not available for this kind of method", -1)); + TclSetResult(interp, + "definition not available for this kind of method"); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), (char *)NULL); return TCL_ERROR; } @@ -369,21 +369,20 @@ goto unknownMethod; } hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, objv[2]); if (hPtr == NULL) { unknownMethod: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown method \"%s\"", TclGetString(objv[2]))); + TclPrintfResult(interp, + "unknown method \"%s\"", TclGetString(objv[2])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), (char *)NULL); return TCL_ERROR; } prefixObj = TclOOGetFwdFromMethod((Method *)Tcl_GetHashValue(hPtr)); if (prefixObj == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "prefix argument list not available for this kind of method", - -1)); + TclSetResult(interp, + "prefix argument list not available for this kind of method"); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), (char *)NULL); return TCL_ERROR; } @@ -573,12 +572,11 @@ case OPT_PRIVATE: flag = 0; break; case OPT_SCOPE: if (++i >= objc) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "missing option for -scope")); + TclSetResult(interp, "missing option for -scope"); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (char *)NULL); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[i], scopes, "scope", 0, @@ -679,12 +677,12 @@ goto unknownMethod; } hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, objv[2]); if (hPtr == NULL) { unknownMethod: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown method \"%s\"", TclGetString(objv[2]))); + TclPrintfResult(interp, + "unknown method \"%s\"", TclGetString(objv[2])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), (char *)NULL); return TCL_ERROR; } mPtr = (Method *)Tcl_GetHashValue(hPtr); @@ -695,11 +693,11 @@ */ goto unknownMethod; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(mPtr->typePtr->name, -1)); + TclSetResult(interp, mPtr->typePtr->name); return TCL_OK; } /* * ---------------------------------------------------------------------- @@ -802,12 +800,11 @@ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]); if (oPtr == NULL) { return TCL_ERROR; } - Tcl_SetObjResult(interp, - Tcl_NewStringObj(oPtr->namespacePtr->fullName, -1)); + TclSetResult(interp, oPtr->namespacePtr->fullName); return TCL_OK; } /* * ---------------------------------------------------------------------- @@ -958,12 +955,12 @@ if (clsPtr->constructorPtr == NULL) { return TCL_OK; } procPtr = TclOOGetProcFromMethod(clsPtr->constructorPtr); if (procPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "definition not available for this kind of method", -1)); + TclSetResult(interp, + "definition not available for this kind of method"); Tcl_SetErrorCode(interp, "TCL", "OO", "METHOD_TYPE", (char *)NULL); return TCL_ERROR; } TclNewObj(resultObjs[0]); @@ -1017,20 +1014,20 @@ if (clsPtr == NULL) { return TCL_ERROR; } hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, objv[2]); if (hPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown method \"%s\"", TclGetString(objv[2]))); + TclPrintfResult(interp, + "unknown method \"%s\"", TclGetString(objv[2])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), (char *)NULL); return TCL_ERROR; } procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr)); if (procPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "definition not available for this kind of method", -1)); + TclSetResult(interp, + "definition not available for this kind of method"); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), (char *)NULL); return TCL_ERROR; } @@ -1136,12 +1133,12 @@ if (clsPtr->destructorPtr == NULL) { return TCL_OK; } procPtr = TclOOGetProcFromMethod(clsPtr->destructorPtr); if (procPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "definition not available for this kind of method", -1)); + TclSetResult(interp, + "definition not available for this kind of method"); Tcl_SetErrorCode(interp, "TCL", "OO", "METHOD_TYPE", (char *)NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, TclOOGetMethodBody(clsPtr->destructorPtr)); @@ -1215,21 +1212,20 @@ if (clsPtr == NULL) { return TCL_ERROR; } hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, objv[2]); if (hPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown method \"%s\"", TclGetString(objv[2]))); + TclPrintfResult(interp, + "unknown method \"%s\"", TclGetString(objv[2])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), (char *)NULL); return TCL_ERROR; } prefixObj = TclOOGetFwdFromMethod((Method *)Tcl_GetHashValue(hPtr)); if (prefixObj == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "prefix argument list not available for this kind of method", - -1)); + TclSetResult(interp, + "prefix argument list not available for this kind of method"); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), (char *)NULL); return TCL_ERROR; } @@ -1345,12 +1341,11 @@ case OPT_PRIVATE: flag = 0; break; case OPT_SCOPE: if (++i >= objc) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "missing option for -scope")); + TclSetResult(interp, "missing option for -scope"); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (char *)NULL); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[i], scopes, "scope", 0, @@ -1445,12 +1440,12 @@ } hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, objv[2]); if (hPtr == NULL) { unknownMethod: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown method \"%s\"", TclGetString(objv[2]))); + TclPrintfResult(interp, + "unknown method \"%s\"", TclGetString(objv[2])); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), (char *)NULL); return TCL_ERROR; } mPtr = (Method *)Tcl_GetHashValue(hPtr); @@ -1460,11 +1455,11 @@ * exist. */ goto unknownMethod; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(mPtr->typePtr->name, -1)); + TclSetResult(interp, mPtr->typePtr->name); return TCL_OK; } /* * ---------------------------------------------------------------------- @@ -1691,12 +1686,11 @@ */ contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL, NULL, NULL); if (contextPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot construct any call chain", -1)); + TclSetResult(interp, "cannot construct any call chain"); return TCL_ERROR; } Tcl_SetObjResult(interp, TclOORenderCallChain(interp, contextPtr->callPtr)); TclOODeleteContext(contextPtr); @@ -1736,12 +1730,11 @@ * Get an render the stereotypical call chain. */ callPtr = TclOOGetStereotypeCallChain(clsPtr, objv[2], PUBLIC_METHOD); if (callPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot construct any call chain", -1)); + TclSetResult(interp, "cannot construct any call chain"); return TCL_ERROR; } Tcl_SetObjResult(interp, TclOORenderCallChain(interp, callPtr)); TclOODeleteChain(callPtr); return TCL_OK; Index: generic/tclOOMethod.c ================================================================== --- generic/tclOOMethod.c +++ generic/tclOOMethod.c @@ -1457,12 +1457,11 @@ if (TclListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { return NULL; } if (prefixLen < 1) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "method forward prefix must be non-empty", -1)); + TclSetResult(interp, "method forward prefix must be non-empty"); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", (char *)NULL); return NULL; } fmPtr = (ForwardMethod *)Tcl_Alloc(sizeof(ForwardMethod)); @@ -1496,12 +1495,11 @@ if (TclListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { return NULL; } if (prefixLen < 1) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "method forward prefix must be non-empty", -1)); + TclSetResult(interp, "method forward prefix must be non-empty"); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", (char *)NULL); return NULL; } fmPtr = (ForwardMethod *)Tcl_Alloc(sizeof(ForwardMethod)); Index: generic/tclObj.c ================================================================== --- generic/tclObj.c +++ generic/tclObj.c @@ -945,12 +945,12 @@ * representation. */ if (typePtr->setFromAnyProc == NULL) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't convert value to type %s", typePtr->name)); + TclPrintfResult(interp, + "can't convert value to type %s", typePtr->name); Tcl_SetErrorCode(interp, "TCL", "API_ABUSE", (void *)NULL); } return TCL_ERROR; } @@ -2423,12 +2423,11 @@ { do { if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (isnan(objPtr->internalRep.doubleValue)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "floating point value is Not a Number", -1)); + TclSetResult(interp, "floating point value is Not a Number"); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN", (void *)NULL); } return TCL_ERROR; } @@ -2554,13 +2553,12 @@ if (TclGetLongFromObj(interp, objPtr, &l) != TCL_OK) { return TCL_ERROR; } if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < INT_MIN))) { if (interp != NULL) { - const char *s = - "integer value too large to represent"; - Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); + const char *s = "integer value too large to represent"; + TclSetResult(interp, s); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (void *)NULL); } return TCL_ERROR; } *intPtr = (int) l; @@ -2676,13 +2674,13 @@ goto tooLarge; } #endif if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected integer but got \"%s\"", - TclGetString(objPtr))); + TclPrintfResult(interp, + "expected integer but got \"%s\"", + TclGetString(objPtr)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; } if (TclHasInternalRep(objPtr, &tclBignumType)) { @@ -2984,13 +2982,13 @@ *wideIntPtr = objPtr->internalRep.wideValue; return TCL_OK; } if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected integer but got \"%s\"", - TclGetString(objPtr))); + TclPrintfResult(interp, + "expected integer but got \"%s\"", + TclGetString(objPtr)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; } if (TclHasInternalRep(objPtr, &tclBignumType)) { @@ -3022,13 +3020,12 @@ } } } if (interp != NULL) { const char *s = "integer value too large to represent"; - Tcl_Obj *msg = Tcl_NewStringObj(s, -1); - Tcl_SetObjResult(interp, msg); + TclSetResult(interp, s); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (void *)NULL); } return TCL_ERROR; } } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL, @@ -3067,13 +3064,13 @@ do { if (TclHasInternalRep(objPtr, &tclIntType)) { if (objPtr->internalRep.wideValue < 0) { wideUIntOutOfRange: if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "expected unsigned integer but got \"%s\"", - TclGetString(objPtr))); + TclGetString(objPtr)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; } *wideUIntPtr = (Tcl_WideUInt)objPtr->internalRep.wideValue; @@ -3106,13 +3103,12 @@ return TCL_OK; } if (interp != NULL) { const char *s = "integer value too large to represent"; - Tcl_Obj *msg = Tcl_NewStringObj(s, -1); - Tcl_SetObjResult(interp, msg); + TclSetResult(interp, s); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (void *)NULL); } return TCL_ERROR; } } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL, @@ -3153,13 +3149,13 @@ *wideIntPtr = objPtr->internalRep.wideValue; return TCL_OK; } if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected integer but got \"%s\"", - TclGetString(objPtr))); + TclPrintfResult(interp, + "expected integer but got \"%s\"", + TclGetString(objPtr)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; } if (TclHasInternalRep(objPtr, &tclBignumType)) { @@ -3477,13 +3473,13 @@ } return TCL_OK; } if (TclHasInternalRep(objPtr, &tclDoubleType)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "expected integer but got \"%s\"", - TclGetString(objPtr))); + TclGetString(objPtr)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (void *)NULL); } return TCL_ERROR; } } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL, @@ -3730,12 +3726,12 @@ if (numBytes < 0) { numBytes = strlen(bytes); } if (numBytes > INT_MAX) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "max size for a Tcl value (%d bytes) exceeded", INT_MAX)); + TclPrintfResult(interp, + "max size for a Tcl value (%d bytes) exceeded", INT_MAX); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (void *)NULL); } return TCL_ERROR; } Index: generic/tclParse.c ================================================================== --- generic/tclParse.c +++ generic/tclParse.c @@ -225,12 +225,11 @@ numBytes = strlen(start); } TclParseInit(interp, start, numBytes, parsePtr); if ((start == NULL) && (numBytes != 0)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can't parse a NULL pointer", -1)); + TclSetResult(interp, "can't parse a NULL pointer"); } return TCL_ERROR; } parsePtr->commentStart = NULL; parsePtr->commentSize = 0; @@ -279,18 +278,16 @@ /* Are we missing white space after previous word? */ if (scanned == 0) { if (src[-1] == '"') { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "extra characters after close-quote", -1)); + TclSetResult(interp, "extra characters after close-quote"); } parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA; } else { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "extra characters after close-brace", -1)); + TclSetResult(interp, "extra characters after close-brace"); } parsePtr->errorType = TCL_PARSE_BRACE_EXTRA; } parsePtr->term = src; error: @@ -1159,12 +1156,11 @@ && !(nestedPtr->incomplete)) { break; } if (numBytes == 0) { if (parsePtr->interp != NULL) { - Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "missing close-bracket", -1)); + TclSetResult(parsePtr->interp, "missing close-bracket"); } parsePtr->errorType = TCL_PARSE_MISSING_BRACKET; parsePtr->term = tokenPtr->start; parsePtr->incomplete = 1; TclStackFree(parsePtr->interp, nestedPtr); @@ -1405,12 +1401,12 @@ src++; ch= *src; } if (numBytes == 0) { if (parsePtr->interp != NULL) { - Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "missing close-brace for variable name", -1)); + TclSetResult(parsePtr->interp, + "missing close-brace for variable name"); } parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE; parsePtr->term = tokenPtr->start-1; parsePtr->incomplete = 1; goto error; @@ -1463,21 +1459,20 @@ TCL_SUBST_ALL, parsePtr)) { goto error; } if (parsePtr->term == src+numBytes){ if (parsePtr->interp != NULL) { - Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "missing )", -1)); + TclSetResult(parsePtr->interp, "missing )"); } parsePtr->errorType = TCL_PARSE_MISSING_PAREN; parsePtr->term = src; parsePtr->incomplete = 1; goto error; } else if ((*parsePtr->term != ')')){ if (parsePtr->interp != NULL) { - Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "invalid character in array index", -1)); + TclSetResult(parsePtr->interp, + "invalid character in array index"); } parsePtr->errorType = TCL_PARSE_SYNTAX; parsePtr->term = src; goto error; } @@ -1744,12 +1739,11 @@ */ goto error; } - Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "missing close-brace", -1)); + TclSetResult(parsePtr->interp, "missing close-brace"); /* * Guess if the problem is due to comments by searching the source string * for a possible open brace within the context of a comment. Since we * aren't performing a full Tcl parse, just look for an open brace @@ -1846,12 +1840,11 @@ parsePtr)) { goto error; } if (*parsePtr->term != '"') { if (parsePtr->interp != NULL) { - Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "missing \"", -1)); + TclSetResult(parsePtr->interp, "missing \""); } parsePtr->errorType = TCL_PARSE_MISSING_QUOTE; parsePtr->term = start; parsePtr->incomplete = 1; goto error; Index: generic/tclPathObj.c ================================================================== --- generic/tclPathObj.c +++ generic/tclPathObj.c @@ -2484,29 +2484,28 @@ if (user == NULL || user[0] == 0) { /* No user name specified -> current user */ dir = TclGetEnv("HOME", &dirString); if (dir == NULL) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "couldn't find HOME environment variable to expand path", - -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", - "HOMELESS", (void *)NULL); - } - return TCL_ERROR; - } + if (interp) { + TclSetResult(interp, + "couldn't find HOME environment variable to expand path"); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", + "HOMELESS", (void *)NULL); + } + return TCL_ERROR; + } } else { - /* User name specified - ~user */ + /* User name specified - ~user */ dir = TclpGetUserHome(user, &dirString); if (dir == NULL) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "user \"%s\" doesn't exist", user)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER", - (void *)NULL); - } + TclPrintfResult(interp, + "user \"%s\" doesn't exist", user); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER", + (void *)NULL); + } return TCL_ERROR; } } if (subPath) { const char *parts[2]; Index: generic/tclPipe.c ================================================================== --- generic/tclPipe.c +++ generic/tclPipe.c @@ -104,14 +104,13 @@ Tcl_GetChannelError(chan, &msg); if (msg) { Tcl_SetObjResult(interp, msg); } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "channel \"%s\" wasn't opened for %s", + TclPrintfResult(interp, "channel \"%s\" wasn't opened for %s", Tcl_GetChannelName(chan), - ((writing) ? "writing" : "reading"))); + ((writing) ? "writing" : "reading")); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "BADCHAN", (void *)NULL); } return NULL; } @@ -140,23 +139,21 @@ return NULL; } file = TclpOpenFile(name, flags); Tcl_DStringFree(&nameString); if (file == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't %s file \"%s\": %s", + TclPrintfResult(interp, "couldn't %s file \"%s\": %s", (writing ? "write" : "read"), spec, - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); return NULL; } *closePtr = 1; } return file; badLastArg: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't specify \"%s\" as last word in command", arg)); + TclPrintfResult(interp, "can't specify \"%s\" as last word in command", arg); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "SYNTAX", (void *)NULL); return NULL; } /* @@ -338,13 +335,13 @@ count = Tcl_ReadChars(errorChan, objPtr, TCL_INDEX_NONE, 0); if (count == -1) { result = TCL_ERROR; Tcl_DecrRefCount(objPtr); Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "error reading stderr output file: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); } else if (count > 0) { anyErrorInfo = 1; Tcl_SetObjResult(interp, objPtr); result = TCL_ERROR; } else { @@ -358,12 +355,11 @@ * If a child exited abnormally but didn't output any error information at * all, generate an error message here. */ if ((abnormalExit != 0) && (anyErrorInfo == 0) && (interp != NULL)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "child process exited abnormally", -1)); + TclSetResult(interp, "child process exited abnormally"); } return result; } /* @@ -509,12 +505,11 @@ if (*p == '&') { p++; } if (*p == '\0') { if ((i == (lastBar + 1)) || (i == (argc - 1))) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "illegal use of | or |& in command", -1)); + TclSetResult(interp, "illegal use of | or |& in command"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX", (void *)NULL); goto error; } } @@ -537,13 +532,13 @@ inputLiteral = p + 1; skip = 1; if (*inputLiteral == '\0') { inputLiteral = ((i + 1) == argc) ? NULL : argv[i + 1]; if (inputLiteral == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "can't specify \"%s\" as last word in command", - argv[i])); + argv[i]); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX", (void *)NULL); goto error; } skip = 2; @@ -654,13 +649,13 @@ * exec/open output pipe as well. This is meant for the end of * the command string, otherwise use |& between commands. */ if (i != argc-1) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "must specify \"%s\" as last word in command", - argv[i])); + argv[i]); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX", (void *)NULL); goto error; } errorFile = outputFile; @@ -697,12 +692,11 @@ if (needCmd) { /* * We had a bar followed only by redirections. */ - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "illegal use of | or |& in command", -1)); + TclSetResult(interp, "illegal use of | or |& in command"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX", (void *)NULL); goto error; } @@ -714,13 +708,13 @@ * file. */ inputFile = TclpCreateTempFile(inputLiteral); if (inputFile == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't create input file for command: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); goto error; } inputClose = 1; } else if (inPipePtr != NULL) { /* @@ -727,13 +721,13 @@ * The input for the first process in the pipeline is to come from * a pipe that can be written from by the caller. */ if (TclpCreatePipe(&inputFile, inPipePtr) == 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't create input pipe for command: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); goto error; } inputClose = 1; } else { /* @@ -756,13 +750,13 @@ * Output from the last process in the pipeline is to go to a pipe * that can be read by the caller. */ if (TclpCreatePipe(outPipePtr, &outputFile) == 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't create output pipe for command: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); goto error; } outputClose = 1; } else { /* @@ -796,13 +790,13 @@ * complete because stderr was backed up. */ errorFile = TclpCreateTempFile(NULL); if (errorFile == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't create error file for command: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); goto error; } *errFilePtr = errorFile; } else { /* @@ -869,12 +863,12 @@ if (lastArg == argc) { curOutFile = outputFile; } else { argv[lastArg] = NULL; if (TclpCreatePipe(&pipeIn, &curOutFile) == 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't create pipe: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't create pipe: %s", + Tcl_PosixError(interp)); goto error; } } if (joinThisError != 0) { @@ -1050,21 +1044,21 @@ * constraints. */ if (flags & TCL_ENFORCE_MODE) { if ((flags & TCL_STDOUT) && (outPipe == NULL)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "can't read output from command:" - " standard output was redirected", -1)); + " standard output was redirected"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "BADREDIRECT", (void *)NULL); goto error; } if ((flags & TCL_STDIN) && (inPipe == NULL)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "can't write input to command:" - " standard input was redirected", -1)); + " standard input was redirected"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "BADREDIRECT", (void *)NULL); goto error; } } @@ -1071,12 +1065,11 @@ channel = TclpCreateCommandChannel(outPipe, inPipe, errFile, numPids, pidPtr); if (channel == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "pipe for command could not be created", -1)); + TclSetResult(interp, "pipe for command could not be created"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "NOPIPE", (void *)NULL); goto error; } return channel; Index: generic/tclPkg.c ================================================================== --- generic/tclPkg.c +++ generic/tclPkg.c @@ -187,13 +187,13 @@ if (clientData != NULL) { pkgPtr->clientData = clientData; } return TCL_OK; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "conflicting versions provided for package \"%s\": %s, then %s", - name, Tcl_GetString(pkgPtr->version), version)); + name, Tcl_GetString(pkgPtr->version), version); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", (void *)NULL); return TCL_ERROR; } /* @@ -384,13 +384,13 @@ * that's not fully initialized. Functions in it may not work * reliably, so be very careful about adding any other calls here * without checking how they behave when initialization is incomplete. */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "Cannot load package \"%s\" in standalone executable:" - " This package is not compiled with stub support", name)); + " This package is not compiled with stub support", name); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNSTUBBED", (void *)NULL); return NULL; } /* @@ -555,18 +555,16 @@ int reqc = (int)PTR2INT(data[1]); Tcl_Obj **const reqv = (Tcl_Obj **)data[2]; const char *name = reqPtr->name; /* Name of desired package. */ if ((result != TCL_OK) && (result != TCL_ERROR)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad return code: %d", result)); + TclPrintfResult(interp, "bad return code: %d", result); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", (void *)NULL); result = TCL_ERROR; } if (result == TCL_ERROR) { - Tcl_AddErrorInfo(interp, - "\n (\"package unknown\" script)"); + Tcl_AddErrorInfo(interp, "\n (\"package unknown\" script)"); return result; } Tcl_ResetResult(interp); /* @@ -592,12 +590,11 @@ char *pkgVersionI; void *clientDataPtr = reqPtr->clientDataPtr; const char *name = reqPtr->name; /* Name of desired package. */ if (reqPtr->pkgPtr->version == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't find package %s", name)); + TclPrintfResult(interp, "can't find package %s", name); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", (void *)NULL); AddRequirementsToResult(interp, reqc, reqv); return TCL_ERROR; } @@ -611,13 +608,13 @@ satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv); Tcl_Free(pkgVersionI); if (!satisfies) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "version conflict for package \"%s\": have %s, need", - name, Tcl_GetString(reqPtr->pkgPtr->version))); + name, Tcl_GetString(reqPtr->pkgPtr->version)); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", (void *)NULL); AddRequirementsToResult(interp, reqc, reqv); return TCL_ERROR; } @@ -663,14 +660,14 @@ * Check whether we're already attempting to load some version of this * package (circular dependency detection). */ if (pkgPtr->clientData != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "circular package dependency:" " attempt to provide %s %s requires %s", - name, (char *) pkgPtr->clientData, name)); + name, (char *) pkgPtr->clientData, name); AddRequirementsToResult(interp, reqc, reqv); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", (void *)NULL); return TCL_ERROR; } @@ -859,24 +856,25 @@ /* * Pop the "ifneeded" package name from "tclPkgFiles" assocdata */ - PkgFiles *pkgFiles = (PkgFiles *)Tcl_GetAssocData(interp, "tclPkgFiles", NULL); + PkgFiles *pkgFiles = (PkgFiles *) + Tcl_GetAssocData(interp, "tclPkgFiles", NULL); PkgName *pkgName = pkgFiles->names; pkgFiles->names = pkgName->nextPtr; Tcl_Free(pkgName); reqPtr->pkgPtr = FindPackage(interp, name); if (result == TCL_OK) { Tcl_ResetResult(interp); if (reqPtr->pkgPtr->version == NULL) { result = TCL_ERROR; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "attempt to provide package %s %s failed:" " no version of package %s provided", - name, versionToProvide, name)); + name, versionToProvide, name); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED", (void *)NULL); } else { char *pvi, *vi; @@ -892,28 +890,27 @@ Tcl_Free(pvi); Tcl_Free(vi); if (res != 0) { result = TCL_ERROR; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "attempt to provide package %s %s failed:" " package %s %s provided instead", name, versionToProvide, - name, Tcl_GetString(reqPtr->pkgPtr->version))); + name, Tcl_GetString(reqPtr->pkgPtr->version)); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "WRONGPROVIDE", (void *)NULL); } } } } else if (result != TCL_ERROR) { Tcl_Obj *codePtr; TclNewIntObj(codePtr, result); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "attempt to provide package %s %s failed:" - " bad return code: %s", - name, versionToProvide, TclGetString(codePtr))); + TclPrintfResult(interp, + "attempt to provide package %s %s failed: bad return code: %s", + name, versionToProvide, TclGetString(codePtr)); Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", (void *)NULL); TclDecrRefCount(codePtr); result = TCL_ERROR; } @@ -1023,15 +1020,13 @@ return foundVersion; } } if (version != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "package %s %s is not present", name, version)); + TclPrintfResult(interp, "package %s %s is not present", name, version); } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "package %s is not present", name)); + TclPrintfResult(interp, "package %s is not present", name); } Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PACKAGE", name, (void *)NULL); return NULL; } @@ -1197,12 +1192,11 @@ Tcl_Free(avi); if (res == 0) { if (objc == 4) { Tcl_Free(argv3i); - Tcl_SetObjResult(interp, - Tcl_NewStringObj(availPtr->script, -1)); + TclSetResult(interp, availPtr->script); return TCL_OK; } Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); if (availPtr->pkgIndex) { Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC); @@ -1401,12 +1395,11 @@ case PKG_UNKNOWN: { Tcl_Size length; if (objc == 2) { if (iPtr->packageUnknown != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj(iPtr->packageUnknown, -1)); + TclSetResult(interp, iPtr->packageUnknown); } } else if (objc == 3) { if (iPtr->packageUnknown != NULL) { Tcl_Free(iPtr->packageUnknown); } @@ -1453,12 +1446,11 @@ /* * Always return current value. */ - Tcl_SetObjResult(interp, - Tcl_NewStringObj(pkgPreferOptions[iPtr->packagePrefer], -1)); + TclSetResult(interp, pkgPreferOptions[iPtr->packagePrefer]); break; } case PKG_VCOMPARE: if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "version1 version2"); @@ -1752,12 +1744,12 @@ return TCL_OK; } error: Tcl_Free(ibuf); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected version number but got \"%s\"", string)); + TclPrintfResult(interp, + "expected version number but got \"%s\"", string); Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSION", (void *)NULL); return TCL_ERROR; } /* @@ -2015,12 +2007,12 @@ if (strchr(dash+1, '-') != NULL) { /* * More dashes found after the first. This is wrong. */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected versionMin-versionMax but got \"%s\"", string)); + TclPrintfResult(interp, + "expected versionMin-versionMax but got \"%s\"", string); Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSIONRANGE", (void *)NULL); return TCL_ERROR; } /* Index: generic/tclProc.c ================================================================== --- generic/tclProc.c +++ generic/tclProc.c @@ -179,20 +179,20 @@ procName = TclGetString(objv[1]); TclGetNamespaceForQualName(interp, procName, NULL, 0, &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName); if (nsPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "can't create procedure \"%s\": unknown namespace", - procName)); + procName); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (void *)NULL); return TCL_ERROR; } if (simpleName == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "can't create procedure \"%s\": bad procedure name", - procName)); + procName); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (void *)NULL); return TCL_ERROR; } /* @@ -492,14 +492,14 @@ goto procError; } if (precompiled) { if (numArgs > procPtr->numArgs) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "procedure \"%s\": arg list contains %" TCL_SIZE_MODIFIER "d entries, " "precompiled header expects %" TCL_SIZE_MODIFIER "d", procName, numArgs, - procPtr->numArgs)); + procPtr->numArgs); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "BYTECODELIES", (void *)NULL); goto procError; } localPtr = procPtr->firstLocalPtr; @@ -521,22 +521,19 @@ &fieldValues); if (result != TCL_OK) { goto procError; } if (fieldCount > 2) { - Tcl_Obj *errorObj = Tcl_NewStringObj( - "too many fields in argument specifier \"", -1); - Tcl_AppendObjToObj(errorObj, argArray[i]); - Tcl_AppendToObj(errorObj, "\"", -1); - Tcl_SetObjResult(interp, errorObj); + TclPrintfResult(interp, + "too many fields in argument specifier \"%s\"", + TclGetString(argArray[i])); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", (void *)NULL); goto procError; } if ((fieldCount == 0) || (Tcl_GetCharLength(fieldValues[0]) == 0)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "argument with no name", -1)); + TclSetResult(interp, "argument with no name"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", (void *)NULL); goto procError; } @@ -549,23 +546,21 @@ argnamei = argname; argnamelast = (nameLength > 0) ? (argname + nameLength - 1) : argname; while (argnamei < argnamelast) { if (*argnamei == '(') { if (*argnamelast == ')') { /* We have an array element. */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "formal parameter \"%s\" is an array element", - TclGetString(fieldValues[0]))); + TclGetString(fieldValues[0])); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", (void *)NULL); goto procError; } } else if (argnamei[0] == ':' && argnamei[1] == ':') { - Tcl_Obj *errorObj = Tcl_NewStringObj( - "formal parameter \"", -1); - Tcl_AppendObjToObj(errorObj, fieldValues[0]); - Tcl_AppendToObj(errorObj, "\" is not a simple name", -1); - Tcl_SetObjResult(interp, errorObj); + TclPrintfResult(interp, + "formal parameter \"%s\" is not a simple name", + TclGetString(fieldValues[0])); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", (void *)NULL); goto procError; } argnamei++; @@ -587,13 +582,13 @@ || (memcmp(localPtr->name, argname, nameLength) != 0) || (localPtr->frameIndex != i) || !(localPtr->flags & VAR_ARGUMENT) || (localPtr->defValuePtr == NULL && fieldCount == 2) || (localPtr->defValuePtr != NULL && fieldCount != 2)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "procedure \"%s\": formal parameter %" TCL_SIZE_MODIFIER "d is " - "inconsistent with precompiled body", procName, i)); + "inconsistent with precompiled body", procName, i); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "BYTECODELIES", (void *)NULL); goto procError; } @@ -606,16 +601,14 @@ const char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr, &tmpLength); const char *value = TclGetStringFromObj(fieldValues[1], &valueLength); if ((valueLength != tmpLength) || memcmp(value, tmpPtr, tmpLength) != 0) { - Tcl_Obj *errorObj = Tcl_ObjPrintf( - "procedure \"%s\": formal parameter \"", procName); - Tcl_AppendObjToObj(errorObj, fieldValues[0]); - Tcl_AppendToObj(errorObj, "\" has " - "default value inconsistent with precompiled body", -1); - Tcl_SetObjResult(interp, errorObj); + TclPrintfResult(interp, + "procedure \"%s\": formal parameter \"%s\" has " + "default value inconsistent with precompiled body", + procName, TclGetString(fieldValues[0])); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "BYTECODELIES", (void *)NULL); goto procError; } } @@ -840,11 +833,11 @@ } badLevel: if (name == NULL) { name = objPtr ? TclGetString(objPtr) : "1" ; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name)); + TclPrintfResult(interp, "bad level \"%s\"", name); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, (void *)NULL); return -1; } /* @@ -1852,13 +1845,13 @@ /* * It's an error to get to this point from a 'break' or 'continue', so * transform to an error now. */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "invoked \"%s\" outside of a loop", - ((result == TCL_BREAK) ? "break" : "continue"))); + ((result == TCL_BREAK) ? "break" : "continue")); Tcl_SetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED", (void *)NULL); result = TCL_ERROR; /* FALLTHRU */ @@ -1935,12 +1928,11 @@ return TCL_OK; } if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) { if ((Interp *) *codePtr->interpHandle != iPtr) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "a precompiled script jumped interps", -1)); + TclSetResult(interp, "a precompiled script jumped interps"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "CROSSINTERPBYTECODE", (void *)NULL); return TCL_ERROR; } codePtr->compileEpoch = iPtr->compileEpoch; @@ -2453,21 +2445,21 @@ * length is not 2, then it cannot be converted to lambdaType. */ result = TclListObjLength(NULL, objPtr, &objc); if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "can't interpret \"%s\" as a lambda expression", - Tcl_GetString(objPtr))); + Tcl_GetString(objPtr)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", (void *)NULL); return TCL_ERROR; } result = TclListObjGetElements(NULL, objPtr, &objc, &objv); if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "can't interpret \"%s\" as a lambda expression", - TclGetString(objPtr))); + TclGetString(objPtr)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", (void *)NULL); return TCL_ERROR; } argsPtr = objv[0]; Index: generic/tclRegexp.c ================================================================== --- generic/tclRegexp.c +++ generic/tclRegexp.c @@ -725,11 +725,11 @@ const char *p; Tcl_ResetResult(interp); n = TclReError(status, buf, sizeof(buf)); p = (n > sizeof(buf)) ? "..." : ""; - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s%s%s", msg, buf, p)); + TclPrintfResult(interp, "%s%s%s", msg, buf, p); snprintf(cbuf, sizeof(cbuf), "%d", status); (void) TclReError(REG_ITOA, cbuf, sizeof(cbuf)); Tcl_SetErrorCode(interp, "REGEXP", cbuf, buf, (char *)NULL); } Index: generic/tclResult.c ================================================================== --- generic/tclResult.c +++ generic/tclResult.c @@ -840,13 +840,13 @@ &keyPtr, &valuePtr, &done)) { /* * Value is not a legal dictionary. */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad %s value: expected dictionary but got \"%s\"", - compare, TclGetString(objv[1]))); + TclPrintfResult(interp, + "bad %s value: expected dictionary but got \"%s\"", + compare, TclGetString(objv[1])); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS", (void *)NULL); goto error; } @@ -890,13 +890,13 @@ || (level < 0)) { /* * Value is not a legal level. */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad -level value: expected non-negative integer but got" - " \"%s\"", TclGetString(valuePtr))); + TclPrintfResult(interp, + "bad -level value: expected non-negative integer but got" + " \"%s\"", TclGetString(valuePtr)); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_LEVEL", (void *)NULL); goto error; } Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_LEVEL]); } @@ -912,13 +912,13 @@ if (TCL_ERROR == TclListObjLength(NULL, valuePtr, &length )) { /* * Value is not a list, which is illegal for -errorcode. */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad -errorcode value: expected a list but got \"%s\"", - TclGetString(valuePtr))); + TclPrintfResult(interp, + "bad -errorcode value: expected a list but got \"%s\"", + TclGetString(valuePtr)); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_ERRORCODE", (void *)NULL); goto error; } } @@ -934,25 +934,25 @@ if (TCL_ERROR == TclListObjLength(NULL, valuePtr, &length)) { /* * Value is not a list, which is illegal for -errorstack. */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad -errorstack value: expected a list but got \"%s\"", - TclGetString(valuePtr))); + TclPrintfResult(interp, + "bad -errorstack value: expected a list but got \"%s\"", + TclGetString(valuePtr)); Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK", (void *)NULL); goto error; } if (length % 2) { /* * Errorstack must always be an even-sized list */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "forbidden odd-sized list for -errorstack: \"%s\"", - TclGetString(valuePtr))); + TclGetString(valuePtr)); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ODDSIZEDLIST_ERRORSTACK", (void *)NULL); goto error; } } @@ -1102,12 +1102,12 @@ Tcl_Obj **objv, *mergedOpts; Tcl_IncrRefCount(options); if (TCL_ERROR == TclListObjGetElements(interp, options, &objc, &objv) || (objc % 2)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected dict but got \"%s\"", TclGetString(options))); + TclPrintfResult(interp, + "expected dict but got \"%s\"", TclGetString(options)); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS", (void *)NULL); code = TCL_ERROR; } else if (TCL_ERROR == TclMergeReturnOptions(interp, objc, objv, &mergedOpts, &code, &level)) { code = TCL_ERROR; Index: generic/tclScan.c ================================================================== --- generic/tclScan.c +++ generic/tclScan.c @@ -339,13 +339,12 @@ notXpg: gotSequential = 1; if (gotXpg) { mixedXPG: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot mix \"%\" and \"%n$\" conversion specifiers", - -1)); + TclSetResult(interp, + "cannot mix \"%\" and \"%n$\" conversion specifiers"); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "MIXEDSPECTYPES", (char *)NULL); goto error; } xpgCheckDone: @@ -358,18 +357,16 @@ unsigned long long ull; ull = strtoull( format - 1, (char **)&format, 10); /* INTL: "C" locale. */ /* Note >=, not >, to leave room for a nul */ if (ull >= TCL_SIZE_MAX) { - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf("specified field width %" TCL_LL_MODIFIER - "u exceeds limit %" TCL_SIZE_MODIFIER "d.", - ull, - (Tcl_Size)TCL_SIZE_MAX-1)); + TclPrintfResult(interp, + "specified field width %" TCL_LL_MODIFIER + "u exceeds limit %" TCL_SIZE_MODIFIER "d.", + ull, (Tcl_Size)TCL_SIZE_MAX-1); Tcl_SetErrorCode( - interp, "TCL", "FORMAT", "WIDTHLIMIT", (void *)NULL); + interp, "TCL", "FORMAT", "WIDTHLIMIT", (void *)NULL); goto error; } flags |= SCAN_WIDTH; format += TclUtfToUniChar(format, &ch); } @@ -403,27 +400,24 @@ */ switch (ch) { case 'c': if (flags & SCAN_WIDTH) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "field width may not be specified in %c conversion", - -1)); + TclSetResult(interp, + "field width may not be specified in %c conversion"); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADWIDTH", (char *)NULL); goto error; } /* FALLTHRU */ case 'n': case 's': if (flags & (SCAN_LONGER|SCAN_BIG)) { invalidFieldSize: buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; - 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); + TclPrintfResult(interp, + "field size modifier may not be specified in %%%s conversion", + buf); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADSIZE", (char *)NULL); goto error; } /* * Fall through! @@ -470,21 +464,16 @@ } format += TclUtfToUniChar(format, &ch); } break; badSet: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unmatched [ in format string", -1)); + TclSetResult(interp, "unmatched [ in format string"); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BRACKET", (char *)NULL); goto error; default: buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; - errorMsg = Tcl_NewStringObj( - "bad scan conversion character \"", -1); - Tcl_AppendToObj(errorMsg, buf, -1); - Tcl_AppendToObj(errorMsg, "\"", -1); - Tcl_SetObjResult(interp, errorMsg); + TclPrintfResult(interp, "bad scan conversion character \"%s\"", buf); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", (char *)NULL); goto error; } if (!(flags & SCAN_SUPPRESS)) { if (objIndex >= nspace) { @@ -525,24 +514,22 @@ if (totalSubs) { *totalSubs = numVars; } for (i = 0; i < numVars; i++) { if (nassign[i] > 1) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "variable is assigned by multiple \"%n$\" conversion specifiers", - -1)); + TclSetResult(interp, + "variable is assigned by multiple \"%n$\" conversion specifiers"); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "POLYASSIGNED", (char *)NULL); goto error; } else if (!xpgSize && (nassign[i] == 0)) { /* * If the space is empty, and xpgSize is 0 (means XPG wasn't used, * and/or numVars != 0), then too many vars were given */ - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "variable is not assigned by any conversion specifiers", - -1)); + TclSetResult(interp, + "variable is not assigned by any conversion specifiers"); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "UNASSIGNED", (char *)NULL); goto error; } } @@ -549,17 +536,15 @@ TclStackFree(interp, nassign); return TCL_OK; badIndex: if (gotXpg) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "\"%n$\" argument index out of range", -1)); + TclSetResult(interp, "\"%n$\" argument index out of range"); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "INDEXRANGE", (char *)NULL); } else { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "different numbers of variable names and field specifiers", - -1)); + TclSetResult(interp, + "different numbers of variable names and field specifiers"); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "FIELDVARMISMATCH", (char *)NULL); } error: TclStackFree(interp, nassign); @@ -949,12 +934,12 @@ } } if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) { mp_int big; if (mp_init_u64(&big, (Tcl_WideUInt)wideValue) != MP_OKAY) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "insufficient memory to create bignum", -1)); + TclSetResult(interp, + "insufficient memory to create bignum"); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL); return TCL_ERROR; } else { Tcl_SetBignumObj(objPtr, &big); } @@ -976,12 +961,12 @@ if (res == TCL_ERROR) { if (objs != NULL) { Tcl_Free(objs); } Tcl_DecrRefCount(objPtr); - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unsigned bignum scans are invalid", -1)); + TclSetResult(interp, + "unsigned bignum scans are invalid"); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED", (char *)NULL); return TCL_ERROR; } } @@ -995,12 +980,12 @@ } if ((flags & SCAN_UNSIGNED) && (value < 0)) { #ifdef TCL_WIDE_INT_IS_LONG mp_int big; if (mp_init_u64(&big, (unsigned long)value) != MP_OKAY) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "insufficient memory to create bignum", -1)); + TclSetResult(interp, + "insufficient memory to create bignum"); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL); return TCL_ERROR; } else { Tcl_SetBignumObj(objPtr, &big); } Index: generic/tclStrToD.c ================================================================== --- generic/tclStrToD.c +++ generic/tclStrToD.c @@ -4790,11 +4790,11 @@ if (isinf(d)) { if (interp != NULL) { const char *s = "integer value too large to represent"; - Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); + TclSetResult(interp, s); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (void *)NULL); } return TCL_ERROR; } Index: generic/tclStringObj.c ================================================================== --- generic/tclStringObj.c +++ generic/tclStringObj.c @@ -2555,12 +2555,11 @@ } break; } default: if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_ObjPrintf("bad field specifier \"%c\"", ch)); + TclPrintfResult(interp, "bad field specifier \"%c\"", ch); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", (char *)NULL); } goto error; } @@ -2616,11 +2615,11 @@ return TCL_OK; errorMsg: if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); + TclSetResult(interp, msg); Tcl_SetErrorCode(interp, "TCL", "FORMAT", errCode, (char *)NULL); } error: Tcl_SetObjLength(appendObj, originalLength); return TCL_ERROR; @@ -3036,15 +3035,13 @@ } /* maxCount includes space for null */ if (count > (maxCount-1)) { if (interp) { - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf("max size for a Tcl value (%" TCL_SIZE_MODIFIER - "d bytes) exceeded", - TCL_SIZE_MAX)); + TclPrintfResult(interp, + "max size for a Tcl value (%" TCL_SIZE_MODIFIER + "d bytes) exceeded", TCL_SIZE_MAX); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL); } return NULL; } @@ -3076,14 +3073,14 @@ } /* TODO - overflow check */ if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "string size overflow: unable to alloc %" TCL_SIZE_MODIFIER "d bytes", - STRING_SIZE(count*length))); + STRING_SIZE(count*length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL); } return NULL; } Tcl_SetObjLength(objResultPtr, length); @@ -3105,13 +3102,14 @@ objResultPtr = objPtr; } /* TODO - overflow check */ if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "string size overflow: unable to alloc %" TCL_SIZE_MODIFIER "d bytes", - count*length)); + TclPrintfResult(interp, + "string size overflow: unable to alloc %" + TCL_SIZE_MODIFIER "d bytes", + count * length); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL); } return NULL; } Tcl_SetObjLength(objResultPtr, length); @@ -3403,14 +3401,14 @@ /* Ugly interface! Force resize of the unicode array. */ (void)Tcl_GetUnicodeFromObj(objResultPtr, &start); Tcl_InvalidateStringRep(objResultPtr); if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "concatenation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", - STRING_SIZE(length))); + STRING_SIZE(length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL); } return NULL; } dst = Tcl_GetUnicode(objResultPtr) + start; @@ -3420,14 +3418,14 @@ /* Ugly interface! No scheme to init array size. */ objResultPtr = Tcl_NewUnicodeObj(&ch, 0); /* PANIC? */ if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { Tcl_DecrRefCount(objResultPtr); if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "concatenation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", - STRING_SIZE(length))); + STRING_SIZE(length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL); } return NULL; } dst = Tcl_GetUnicode(objResultPtr); @@ -3452,13 +3450,14 @@ objResultPtr = *objv++; objc--; (void)TclGetStringFromObj(objResultPtr, &start); if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "concatenation failed: unable to alloc %" TCL_SIZE_MODIFIER "d bytes", - length)); + TclPrintfResult(interp, + "concatenation failed: unable to alloc %" + TCL_SIZE_MODIFIER "d bytes", + length); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL); } return NULL; } dst = TclGetString(objResultPtr) + start; @@ -3467,13 +3466,13 @@ } else { TclNewObj(objResultPtr); /* PANIC? */ if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { Tcl_DecrRefCount(objResultPtr); if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "concatenation failed: unable to alloc %" TCL_SIZE_MODIFIER "d bytes", - length)); + length); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL); } return NULL; } dst = TclGetString(objResultPtr); @@ -3494,12 +3493,13 @@ } return objResultPtr; overflow: if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "max size for a Tcl value (%" TCL_SIZE_MODIFIER "d bytes) exceeded", TCL_SIZE_MAX)); + TclPrintfResult(interp, + "max size for a Tcl value (%" TCL_SIZE_MODIFIER + "d bytes) exceeded", TCL_SIZE_MAX); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL); } return NULL; } @@ -4244,13 +4244,14 @@ return objPtr; } if (newBytes > (TCL_SIZE_MAX - (numBytes - count))) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "max size for a Tcl value (%" TCL_SIZE_MODIFIER "d bytes) exceeded", - TCL_SIZE_MAX)); + TclPrintfResult(interp, + "max size for a Tcl value (%" TCL_SIZE_MODIFIER + "d bytes) exceeded", + TCL_SIZE_MAX); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL); } return NULL; } result = Tcl_NewByteArrayObj(NULL, numBytes - count + newBytes); Index: generic/tclTimer.c ================================================================== --- generic/tclTimer.c +++ generic/tclTimer.c @@ -820,13 +820,13 @@ if (TclGetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) { if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, &index) != TCL_OK) { const char *arg = TclGetString(objv[1]); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "bad argument \"%s\": must be" - " cancel, idle, info, or an integer", arg)); + " cancel, idle, info, or an integer", arg); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument", arg, (void *)NULL); return TCL_ERROR; } } @@ -874,11 +874,11 @@ } afterPtr->token = TclCreateAbsoluteTimerHandler(&wakeup, AfterProc, afterPtr); afterPtr->nextPtr = assocPtr->firstAfterPtr; assocPtr->firstAfterPtr = afterPtr; - Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id)); + TclPrintfResult(interp, "after#%d", afterPtr->id); return TCL_OK; } case AFTER_CANCEL: { Tcl_Obj *commandPtr; const char *command, *tempCommand; @@ -936,11 +936,11 @@ tsdPtr->afterId += 1; afterPtr->token = NULL; afterPtr->nextPtr = assocPtr->firstAfterPtr; assocPtr->firstAfterPtr = afterPtr; Tcl_DoWhenIdle(AfterProc, afterPtr); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id)); + TclPrintfResult(interp, "after#%d", afterPtr->id); break; case AFTER_INFO: if (objc == 2) { Tcl_Obj *resultObj; @@ -961,12 +961,12 @@ } afterPtr = GetAfterEvent(assocPtr, objv[2]); if (afterPtr == NULL) { const char *eventStr = TclGetString(objv[2]); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "event \"%s\" doesn't exist", eventStr)); + TclPrintfResult(interp, + "event \"%s\" doesn't exist", eventStr); Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, (void *)NULL); return TCL_ERROR; } else { Tcl_Obj *resultListPtr; Index: generic/tclTrace.c ================================================================== --- generic/tclTrace.c +++ generic/tclTrace.c @@ -313,13 +313,13 @@ result = TclListObjLength(interp, objv[4], &listLen); if (result != TCL_OK) { return result; } if (listLen == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "bad operation list \"\": must be one or more of" - " enter, leave, enterstep, or leavestep", -1)); + " enter, leave, enterstep, or leavestep"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS", (void *)NULL); return TCL_ERROR; } result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs); @@ -555,13 +555,13 @@ result = TclListObjLength(interp, objv[4], &listLen); if (result != TCL_OK) { return result; } if (listLen == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "bad operation list \"\": must be one or more of" - " delete or rename", -1)); + " delete or rename"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS", (void *)NULL); return TCL_ERROR; } result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs); @@ -754,13 +754,13 @@ result = TclListObjLength(interp, objv[4], &listLen); if (result != TCL_OK) { return result; } if (listLen == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "bad operation list \"\": must be one or more of" - " array, read, unset, or write", -1)); + " array, read, unset, or write"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS", (void *)NULL); return TCL_ERROR; } result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs); @@ -2669,12 +2669,11 @@ } if (disposeFlags & TCL_TRACE_RESULT_OBJECT) { Tcl_SetObjResult((Tcl_Interp *)iPtr, (Tcl_Obj *) result); } else { - Tcl_SetObjResult((Tcl_Interp *)iPtr, - Tcl_NewStringObj(result, -1)); + TclSetResult((Tcl_Interp *)iPtr, result); } Tcl_AddErrorInfo((Tcl_Interp *)iPtr, ""); Tcl_AppendObjToErrorInfo((Tcl_Interp *)iPtr, Tcl_ObjPrintf( "\n (%s trace on \"%s%s%s%s\")", type, part1, Index: generic/tclUtil.c ================================================================== --- generic/tclUtil.c +++ generic/tclUtil.c @@ -652,13 +652,13 @@ p2 = p; while ((p2 < limit) && (!TclIsSpaceProcM(*p2)) && (p2 < p+20)) { p2++; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "%s element in braces followed by \"%.*s\" " - "instead of space", typeStr, (int) (p2-p), p)); + "instead of space", typeStr, (int) (p2-p), p); Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "JUNK", (char *)NULL); } return TCL_ERROR; } @@ -704,13 +704,13 @@ p2 = p; while ((p2 < limit) && (!TclIsSpaceProcM(*p2)) && (p2 < p+20)) { p2++; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "%s element in quotes followed by \"%.*s\" " - "instead of space", typeStr, (int) (p2-p), p)); + "instead of space", typeStr, (int) (p2-p), p); Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "JUNK", (char *)NULL); } return TCL_ERROR; } @@ -738,20 +738,18 @@ */ if (p == limit) { if (openBraces != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unmatched open brace in %s", typeStr)); + TclPrintfResult(interp, "unmatched open brace in %s", typeStr); Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "BRACE", (char *)NULL); } return TCL_ERROR; } else if (inQuotes) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unmatched open quote in %s", typeStr)); + TclPrintfResult(interp, "unmatched open quote in %s", typeStr); Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "QUOTE", (char *)NULL); } return TCL_ERROR; } @@ -897,12 +895,11 @@ break; } if (i >= size) { Tcl_Free((void *)argv); if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "internal error in Tcl_SplitList", -1)); + TclSetResult(interp, "internal error in Tcl_SplitList"); Tcl_SetErrorCode(interp, "TCL", "INTERNAL", "Tcl_SplitList", (char *)NULL); } return TCL_ERROR; } @@ -3722,14 +3719,14 @@ return TCL_OK; /* Report a parse error. */ parseError: if (interp != NULL) { - char * bytes = TclGetString(objPtr); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + char *bytes = TclGetString(objPtr); + TclPrintfResult(interp, "bad index \"%s\": must be integer?[+-]integer? or" - " end?[+-]integer?", bytes)); + " end?[+-]integer?", bytes); if (!strncmp(bytes, "end-", 4)) { bytes += 4; } Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", (char *)NULL); } @@ -3919,13 +3916,12 @@ *indexPtr = idx; return TCL_OK; rangeerror: if (interp) { - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf("index \"%s\" out of range", TclGetString(objPtr))); + TclPrintfResult(interp, + "index \"%s\" out of range", TclGetString(objPtr)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", (void *)NULL); } return TCL_ERROR; } @@ -3979,19 +3975,19 @@ Tcl_Interp *interp, /* May be NULL */ Tcl_Size count) /* If <= 0, "unknown" */ { if (interp) { if (count > 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "Number of words (%" TCL_SIZE_MODIFIER "d) in command exceeds limit %" TCL_SIZE_MODIFIER "d.", - count, (Tcl_Size)INT_MAX)); + count, (Tcl_Size)INT_MAX); } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "Number of words in command exceeds limit %" TCL_SIZE_MODIFIER "d.", - (Tcl_Size)INT_MAX)); + (Tcl_Size)INT_MAX); } } return TCL_ERROR; /* Always */ } @@ -4583,11 +4579,11 @@ return TCL_OK; invalidGlob: if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); + TclSetResult(interp, msg); Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, (char *)NULL); } Tcl_DStringFree(dsPtr); return TCL_ERROR; } Index: generic/tclVar.c ================================================================== --- generic/tclVar.c +++ generic/tclVar.c @@ -342,12 +342,11 @@ Tcl_Interp *interp, Tcl_Obj *name) { const char *nameStr = TclGetString(name); - Tcl_SetObjResult(interp, - Tcl_ObjPrintf("\"%s\" isn't an array", nameStr)); + TclPrintfResult(interp, "\"%s\" isn't an array", nameStr); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", nameStr, (char *)NULL); return TCL_ERROR; } /* @@ -3105,12 +3104,11 @@ if (TclListObjLength(interp, objv[1], &numVars) != TCL_OK) { return TCL_ERROR; } if (numVars != 2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "must have two variable names", -1)); + TclSetResult(interp, "must have two variable names"); Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "array", "for", (char *)NULL); return TCL_ERROR; } arrayNameObj = objv[2]; @@ -3206,12 +3204,11 @@ result = TCL_OK; if (done != TCL_CONTINUE) { Tcl_ResetResult(interp); if (done == TCL_ERROR) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "array changed during iteration", -1)); + TclSetResult(interp, "array changed during iteration"); Tcl_SetErrorCode(interp, "TCL", "READ", "array", "for", (char *)NULL); varPtr->flags |= TCL_LEAVE_ERR_MSG; result = done; } goto arrayfordone; @@ -4089,12 +4086,11 @@ result = TclListObjLength(interp, arrayElemObj, &elemLen); if (result != TCL_OK) { return result; } if (elemLen & 1) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "list must have an even number of elements", -1)); + TclSetResult(interp, "list must have an even number of elements"); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "FORMAT", (char *)NULL); return TCL_ERROR; } if (elemLen == 0) { goto ensureArray; @@ -4262,15 +4258,14 @@ return NotArrayError(interp, varNameObj); } stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr); if (stats == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "error reading array statistics", -1)); + TclSetResult(interp, "error reading array statistics"); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1)); + TclSetResult(interp, stats); Tcl_Free(stats); return TCL_OK; } /* @@ -4530,14 +4525,14 @@ : (TclIsVarInHash(otherPtr) && TclGetVarNsPtr(otherPtr))) && ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) || (varFramePtr == NULL) || !HasLocalVars(varFramePtr) || (strstr(TclGetString(myNamePtr), "::") != NULL))) { - Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf( + TclPrintfResult((Tcl_Interp *) iPtr, "bad variable name \"%s\": can't create namespace " "variable that refers to procedure variable", - TclGetString(myNamePtr))); + TclGetString(myNamePtr)); Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", (char *)NULL); return TCL_ERROR; } } @@ -4646,13 +4641,13 @@ if (*p == ')') { /* * myName looks like an array reference. */ - Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf( + TclPrintfResult((Tcl_Interp *) iPtr, "bad variable name \"%s\": can't create a scalar " - "variable that looks like an array element", myName)); + "variable that looks like an array element", myName); Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", (char *)NULL); return TCL_ERROR; } } @@ -4675,19 +4670,19 @@ return TCL_ERROR; } } if (varPtr == otherPtr) { - Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_NewStringObj( - "can't upvar from variable to itself", -1)); + TclSetResult((Tcl_Interp *) iPtr, + "can't upvar from variable to itself"); Tcl_SetErrorCode(interp, "TCL", "UPVAR", "SELF", (char *)NULL); return TCL_ERROR; } if (TclIsVarTraced(varPtr)) { - Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf( - "variable \"%s\" has traces: can't use for upvar", myName)); + TclPrintfResult((Tcl_Interp *) iPtr, + "variable \"%s\" has traces: can't use for upvar", myName); Tcl_SetErrorCode(interp, "TCL", "UPVAR", "TRACED", (char *)NULL); return TCL_ERROR; } else if (!TclIsVarUndefined(varPtr)) { Var *linkPtr; @@ -4697,12 +4692,12 @@ * not an upvar then it's an error. If it is an upvar, then just * disconnect it from the thing it currently refers to. */ if (!TclIsVarLink(varPtr)) { - Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf( - "variable \"%s\" already exists", myName)); + TclPrintfResult((Tcl_Interp *) iPtr, + "variable \"%s\" already exists", myName); Tcl_SetErrorCode(interp, "TCL", "UPVAR", "EXISTS", (char *)NULL); return TCL_ERROR; } linkPtr = varPtr->value.linkPtr; @@ -5217,12 +5212,11 @@ /* * Synthesize an error message since TclObjGetFrame doesn't do this * for this particular case. */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad level \"%s\"", TclGetString(levelObj))); + TclPrintfResult(interp, "bad level \"%s\"", TclGetString(levelObj)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", TclGetString(levelObj), (char *)NULL); return TCL_ERROR; } @@ -5301,19 +5295,17 @@ } } if ((handle[0] != 's') || (handle[1] != '-') || (strtoul(handle + 2, &end, 10), end == (handle + 2)) || (*end != '-')) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "illegal search identifier \"%s\"", handle)); + TclPrintfResult(interp, "illegal search identifier \"%s\"", handle); } else if (strcmp(end + 1, TclGetString(varNamePtr)) != 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "search identifier \"%s\" isn't for variable \"%s\"", - handle, TclGetString(varNamePtr))); + handle, TclGetString(varNamePtr)); } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't find search \"%s\"", handle)); + TclPrintfResult(interp, "couldn't find search \"%s\"", handle); } Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", handle, (char *)NULL); return NULL; } @@ -5702,14 +5694,14 @@ if (index == -1) { Tcl_Panic("invalid part1Ptr and invalid index together"); } part1Ptr = localName(((Interp *)interp)->varFramePtr, index); } - Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't %s \"%s%s%s%s\": %s", + TclPrintfResult(interp,"can't %s \"%s%s%s%s\": %s", operation, TclGetString(part1Ptr), (part2Ptr ? "(" : ""), (part2Ptr ? TclGetString(part2Ptr) : ""), (part2Ptr ? ")" : ""), - reason)); + reason); } /* *---------------------------------------------------------------------- * @@ -5953,12 +5945,11 @@ } if (simpleName != name) { Tcl_DecrRefCount(simpleNamePtr); } if ((varPtr == NULL) && (flags & TCL_LEAVE_ERR_MSG)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown variable \"%s\"", name)); + TclPrintfResult(interp, "unknown variable \"%s\"", name); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", name, (char *)NULL); } return (Tcl_Var) varPtr; } @@ -6899,12 +6890,11 @@ } defaultValueObj = TclGetArrayDefault(varPtr); if (!defaultValueObj) { /* Array default must exist. */ - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "array has no default value", -1)); + TclSetResult(interp, "array has no default value"); Tcl_SetErrorCode(interp, "TCL", "READ", "ARRAY", "DEFAULT", (char *)NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, defaultValueObj); return TCL_OK; Index: generic/tclZipfs.c ================================================================== --- generic/tclZipfs.c +++ generic/tclZipfs.c @@ -46,26 +46,25 @@ */ #define ZIPFS_ERROR(interp,errstr) \ do { \ if (interp) { \ - Tcl_SetObjResult(interp, Tcl_NewStringObj(errstr, -1)); \ + TclSetResult(interp, errstr); \ } \ } while (0) #define ZIPFS_MEM_ERROR(interp) \ do { \ if (interp) { \ - Tcl_SetObjResult(interp, Tcl_NewStringObj( \ - "out of memory", -1)); \ - Tcl_SetErrorCode(interp, "TCL", "MALLOC", (char *)NULL); \ + TclSetResult(interp, "out of memory"); \ + Tcl_SetErrorCode(interp, "TCL", "MALLOC", (char *)NULL); \ } \ } while (0) #define ZIPFS_POSIX_ERROR(interp,errstr) \ do { \ if (interp) { \ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( \ - "%s: %s", errstr, Tcl_PosixError(interp))); \ + TclPrintfResult(interp, \ + "%s: %s", errstr, Tcl_PosixError(interp)); \ } \ } while (0) #define ZIPFS_ERROR_CODE(interp,errcode) \ do { \ if (interp) { \ @@ -1035,12 +1034,11 @@ Tcl_DecrRefCount(normalizedObj); return TCL_OK; invalidMountPath: if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "Invalid mount path \"%s\"", mountPath)); + TclPrintfResult(interp, "Invalid mount path \"%s\"", mountPath); ZIPFS_ERROR_CODE(interp, "MOUNT_PATH"); } errorReturn: Tcl_DStringFree(&dsJoin); @@ -1890,12 +1888,12 @@ hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, mountPoint, &isNew); if (!isNew) { if (interp) { zf0 = (ZipFile *) Tcl_GetHashValue(hPtr); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "%s is already mounted on %s", zf0->name, mountPoint)); + TclPrintfResult(interp, + "%s is already mounted on %s", zf0->name, mountPoint); ZIPFS_ERROR_CODE(interp, "MOUNTED"); } Unlock(); ZipFSCloseArchive(interp, zf); Tcl_DStringFree(&ds); @@ -2274,11 +2272,11 @@ { if (interp) { ZipFile *zf = ZipFSLookupZip(mountPoint); if (zf) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(zf->name, -1)); + TclSetResult(interp, zf->name); return TCL_OK; } } return (interp ? TCL_OK : TCL_BREAK); } @@ -2354,12 +2352,12 @@ zipPathObj = Tcl_NewStringObj(zipname, -1); Tcl_IncrRefCount(zipPathObj); normZipPathObj = Tcl_FSGetNormalizedPath(interp, zipPathObj); if (normZipPathObj == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not normalize zip filename \"%s\"", zipname)); + TclPrintfResult(interp, + "could not normalize zip filename \"%s\"", zipname); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NORMALIZE", (char *)NULL); ret = TCL_ERROR; } else { Tcl_IncrRefCount(normZipPathObj); const char *normPath = Tcl_GetString(normZipPathObj); @@ -2687,11 +2685,11 @@ { if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(ZIPFS_VOLUME, -1)); + TclSetResult(interp, ZIPFS_VOLUME); return TCL_OK; } /* *------------------------------------------------------------------------- @@ -2895,19 +2893,20 @@ /* * Convert to encoded form. Note that we use strlen() here; if someone's * crazy enough to embed NULs in filenames, they deserve what they get! */ - if (Tcl_UtfToExternalDStringEx(interp, tclUtf8Encoding, zpathTcl, TCL_INDEX_NONE, 0, &zpathDs, NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(interp, tclUtf8Encoding, zpathTcl, + TCL_INDEX_NONE, 0, &zpathDs, NULL) != TCL_OK) { Tcl_DStringFree(&zpathDs); return TCL_ERROR; } zpathExt = Tcl_DStringValue(&zpathDs); zpathlen = strlen(zpathExt); if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "path too long for \"%s\"", TclGetString(pathObj))); + TclPrintfResult(interp, + "path too long for \"%s\"", TclGetString(pathObj)); ZIPFS_ERROR_CODE(interp, "PATH_LEN"); Tcl_DStringFree(&zpathDs); return TCL_ERROR; } in = Tcl_FSOpenFileChannel(interp, pathObj, "rb", 0); @@ -2944,12 +2943,12 @@ if (nbyte == 0 && errno == EISDIR) { Tcl_Close(interp, in); return TCL_OK; } readErrorWithChannelOpen: - Tcl_SetObjResult(interp, Tcl_ObjPrintf("read error on \"%s\": %s", - TclGetString(pathObj), Tcl_PosixError(interp))); + TclPrintfResult(interp,"read error on \"%s\": %s", + TclGetString(pathObj), Tcl_PosixError(interp)); Tcl_Close(interp, in); return TCL_ERROR; } if (len == 0) { break; @@ -2956,12 +2955,12 @@ } crc = crc32(crc, (unsigned char *) buf, len); nbyte += len; } if (Tcl_Seek(in, 0, SEEK_SET) == -1) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf("seek error on \"%s\": %s", - TclGetString(pathObj), Tcl_PosixError(interp))); + TclPrintfResult(interp,"seek error on \"%s\": %s", + TclGetString(pathObj), Tcl_PosixError(interp)); Tcl_Close(interp, in); Tcl_DStringFree(&zpathDs); return TCL_ERROR; } @@ -2980,13 +2979,13 @@ memset(buf, '\0', ZIP_LOCAL_HEADER_LEN); memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpathExt, zpathlen); len = zpathlen + ZIP_LOCAL_HEADER_LEN; if (Tcl_Write(out, buf, len) != len) { writeErrorWithChannelOpen: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "write error on \"%s\": %s", - TclGetString(pathObj), Tcl_PosixError(interp))); + TclGetString(pathObj), Tcl_PosixError(interp)); Tcl_Close(interp, in); Tcl_DStringFree(&zpathDs); return TCL_ERROR; } @@ -3057,12 +3056,12 @@ stream.zalloc = Z_NULL; stream.zfree = Z_NULL; stream.opaque = Z_NULL; if (deflateInit2(&stream, 9, Z_DEFLATED, -15, 8, Z_DEFAULT_STRATEGY) != Z_OK) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "compression init error on \"%s\"", TclGetString(pathObj))); + TclPrintfResult(interp, + "compression init error on \"%s\"", TclGetString(pathObj)); ZIPFS_ERROR_CODE(interp, "DEFLATE_INIT"); Tcl_Close(interp, in); Tcl_DStringFree(&zpathDs); return TCL_ERROR; } @@ -3079,12 +3078,12 @@ do { stream.avail_out = sizeof(obuf); stream.next_out = (unsigned char *) obuf; len = deflate(&stream, flush); if (len == Z_STREAM_ERROR) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "deflate error on \"%s\"", TclGetString(pathObj))); + TclPrintfResult(interp, + "deflate error on \"%s\"", TclGetString(pathObj)); ZIPFS_ERROR_CODE(interp, "DEFLATE"); deflateEnd(&stream); Tcl_Close(interp, in); Tcl_DStringFree(&zpathDs); return TCL_ERROR; @@ -3122,12 +3121,11 @@ if (Tcl_Seek(in, 0, SEEK_SET) != 0) { goto seekErr; } if (Tcl_Seek(out, dataStartOffset, SEEK_SET) != dataStartOffset) { seekErr: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "seek error: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, "seek error: %s", Tcl_PosixError(interp)); Tcl_Close(interp, in); Tcl_DStringFree(&zpathDs); return TCL_ERROR; } nbytecompr = (passwd ? ZIP_CRYPT_HDR_LEN : 0); @@ -3166,12 +3164,12 @@ Tcl_DStringFree(&zpathDs); zpathExt = NULL; hPtr = Tcl_CreateHashEntry(fileHash, zpathTcl, &isNew); if (!isNew) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "non-unique path name \"%s\"", TclGetString(pathObj))); + TclPrintfResult(interp, + "non-unique path name \"%s\"", TclGetString(pathObj)); ZIPFS_ERROR_CODE(interp, "DUPLICATE_PATH"); return TCL_ERROR; } /* @@ -3198,27 +3196,24 @@ SerializeLocalEntryHeader(start, end, (unsigned char *) buf, z, zpathlen, align); if (Tcl_Seek(out, headerStartOffset, SEEK_SET) != headerStartOffset) { Tcl_DeleteHashEntry(hPtr); Tcl_Free(z); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "seek error: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, "seek error: %s", Tcl_PosixError(interp)); return TCL_ERROR; } if (Tcl_Write(out, buf, ZIP_LOCAL_HEADER_LEN) != ZIP_LOCAL_HEADER_LEN) { Tcl_DeleteHashEntry(hPtr); Tcl_Free(z); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "write error: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, "write error: %s", Tcl_PosixError(interp)); return TCL_ERROR; } Tcl_Flush(out); if (Tcl_Seek(out, dataEndOffset, SEEK_SET) != dataEndOffset) { Tcl_DeleteHashEntry(hPtr); Tcl_Free(z); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "seek error: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, "seek error: %s", Tcl_PosixError(interp)); return TCL_ERROR; } return TCL_OK; } @@ -3474,12 +3469,12 @@ if ((size_t) Tcl_Write(out, (char *) zf->data, zf->passOffset) != zf->passOffset) { memset(passBuf, 0, sizeof(passBuf)); Tcl_DecrRefCount(list); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "write error: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, + "write error: %s", Tcl_PosixError(interp)); Tcl_Close(interp, out); if (zf == &zf0) { ZipFSCloseArchive(interp, zf); } else { WriteLock(); @@ -3516,12 +3511,12 @@ len = strlen(passBuf); if (len > 0) { i = Tcl_Write(out, passBuf, len); if (i != len) { Tcl_DecrRefCount(list); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "write error: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, + "write error: %s", Tcl_PosixError(interp)); Tcl_Close(interp, out); return TCL_ERROR; } } memset(passBuf, 0, sizeof(passBuf)); @@ -3568,11 +3563,12 @@ if (!hPtr) { continue; } z = (ZipEntry *) Tcl_GetHashValue(hPtr); - if (Tcl_UtfToExternalDStringEx(interp, tclUtf8Encoding, z->name, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(interp, tclUtf8Encoding, z->name, + TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { ret = TCL_ERROR; goto done; } name = Tcl_DStringValue(&ds); len = Tcl_DStringLength(&ds); @@ -3579,12 +3575,11 @@ SerializeCentralDirectoryEntry(start, end, (unsigned char *) buf, z, len); if ((Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN) != ZIP_CENTRAL_HEADER_LEN) || (Tcl_Write(out, name, len) != len)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "write error: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, "write error: %s", Tcl_PosixError(interp)); Tcl_DStringFree(&ds); goto done; } Tcl_DStringFree(&ds); count++; @@ -3597,12 +3592,11 @@ Tcl_Flush(out); suffixStartOffset = Tcl_Tell(out); SerializeCentralDirectorySuffix(start, end, (unsigned char *) buf, count, directoryStartOffset, suffixStartOffset); if (Tcl_Write(out, buf, ZIP_CENTRAL_END_LEN) != ZIP_CENTRAL_END_LEN) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "write error: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, "write error: %s", Tcl_PosixError(interp)); goto done; } Tcl_Flush(out); ret = TCL_OK; @@ -3695,12 +3689,11 @@ } Tcl_Close(interp, in); return TCL_OK; copyError: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "%s: %s", errMsg, Tcl_PosixError(interp))); + TclPrintfResult(interp, "%s: %s", errMsg, Tcl_PosixError(interp)); Tcl_Close(interp, in); return TCL_ERROR; } /* @@ -4091,13 +4084,13 @@ Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(z->offset)); ret = TCL_OK; } else { Tcl_SetErrno(ENOENT); if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "path \"%s\" not found in any zipfs volume", - filename)); + filename); } ret = TCL_ERROR; } Unlock(); return ret; @@ -4750,24 +4743,24 @@ /* Check for unsupported modes. */ if ((ZipFS.wrmax <= 0) && wr) { Tcl_SetErrno(EACCES); if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "writes not permitted: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); } return NULL; } if ((mode & (O_APPEND|O_TRUNC)) && !wr) { Tcl_SetErrno(EINVAL); if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "Invalid flags 0x%x. O_APPEND and " "O_TRUNC require write access: %s", - mode, Tcl_PosixError(interp))); + mode, Tcl_PosixError(interp)); } return NULL; } /* @@ -4777,14 +4770,14 @@ WriteLock(); z = ZipFSLookup(filename); if (!z) { Tcl_SetErrno(wr ? ENOTSUP : ENOENT); if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "file \"%s\" not %s: %s", filename, wr ? "created" : "found", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); } goto error; } if (z->numBytes < 0 || z->numCompressedBytes < 0 || @@ -4798,13 +4791,13 @@ /* Do we support opening the file that way? */ if (wr && z->isDirectory) { Tcl_SetErrno(EISDIR); if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "unsupported file type: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); } goto error; } if ((z->compressMethod != ZIP_COMPMETH_STORED) && (z->compressMethod != ZIP_COMPMETH_DEFLATED)) { Index: generic/tclZlib.c ================================================================== --- generic/tclZlib.c +++ generic/tclZlib.c @@ -262,12 +262,11 @@ * really uncommon because Tcl handles all I/O rather than delegating * it to zlib, but proving it can't happen is hard. */ case Z_ERRNO: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - Tcl_PosixError(interp), TCL_AUTO_LENGTH)); + TclSetResult(interp, Tcl_PosixError(interp)); return; /* * Normal errors/conditions, some of which have additional detail and * some which don't. (This is not defined by array lookup because zlib @@ -314,11 +313,11 @@ codeStr = "UNKNOWN"; codeStr2 = codeStrBuf; snprintf(codeStrBuf, sizeof(codeStrBuf), "%d", code); break; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(zError(code), TCL_AUTO_LENGTH)); + TclSetResult(interp, zError(code)); /* * Tricky point! We might pass NULL twice here (and will when the error * type is known). */ @@ -457,15 +456,13 @@ &state, headerPtr->nativeCommentBuf, MAX_COMMENT_LEN - 1, NULL, &len, NULL); if (result != TCL_OK) { if (interp) { if (result == TCL_CONVERT_UNKNOWN) { - Tcl_AppendResult(interp, - "Comment contains characters > 0xFF", (char *)NULL); + TclSetResult(interp, "Comment contains characters > 0xFF"); } else { - Tcl_AppendResult(interp, "Comment too large for zip", - (char *)NULL); + TclSetResult(interp, "Comment too large for zip"); } } result = TCL_ERROR; /* TCL_CONVERT_* -> TCL_ERROR */ goto error; } @@ -493,15 +490,13 @@ &state, headerPtr->nativeFilenameBuf, MAXPATHLEN - 1, NULL, &len, NULL); if (result != TCL_OK) { if (interp) { if (result == TCL_CONVERT_UNKNOWN) { - Tcl_AppendResult(interp, - "Filename contains characters > 0xFF", (char *)NULL); + TclSetResult(interp, "Filename contains characters > 0xFF"); } else { - Tcl_AppendResult(interp, - "Filename too large for zip", (char *)NULL); + TclSetResult(interp, "Filename too large for zip"); } } result = TCL_ERROR; /* TCL_CONVERT_* -> TCL_ERROR */ goto error; } @@ -840,12 +835,11 @@ Tcl_DStringInit(&cmdname); TclDStringAppendLiteral(&cmdname, "::tcl::zlib::streamcmd_"); TclDStringAppendObj(&cmdname, Tcl_GetObjResult(interp)); if (Tcl_FindCommand(interp, Tcl_DStringValue(&cmdname), NULL, 0) != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "BUG: Stream command name already exists", TCL_AUTO_LENGTH)); + TclSetResult(interp, "BUG: Stream command name already exists"); Tcl_SetErrorCode(interp, "TCL", "BUG", "EXISTING_CMD", (char *)NULL); Tcl_DStringFree(&cmdname); goto error; } Tcl_ResetResult(interp); @@ -1232,12 +1226,11 @@ size_t outSize, toStore; unsigned char *bytes; if (zshPtr->streamEnd) { if (zshPtr->interp) { - Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj( - "already past compressed stream end", TCL_AUTO_LENGTH)); + TclSetResult(zshPtr->interp, "already past compressed stream end"); Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", (char *)NULL); } return TCL_ERROR; } @@ -1462,13 +1455,12 @@ * more to inflate. */ if (zshPtr->stream.avail_in > 0) { if (zshPtr->interp) { - Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj( - "unexpected zlib internal state during" - " decompression", TCL_AUTO_LENGTH)); + TclSetResult(zshPtr->interp, + "unexpected zlib internal state during decompression"); Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "STATE", (char *)NULL); } Tcl_SetByteArrayLength(data, existing); return TCL_ERROR; @@ -2231,21 +2223,19 @@ } return TCL_ERROR; badLevel: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "level must be 0 to 9", TCL_AUTO_LENGTH)); + TclSetResult(interp, "level must be 0 to 9"); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", (char *)NULL); if (extraInfoStr) { Tcl_AddErrorInfo(interp, extraInfoStr); } return TCL_ERROR; badBuffer: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "buffer size must be %d to %d", - MIN_NONSTREAM_BUFFER_SIZE, MAX_BUFFER_SIZE)); + TclPrintfResult(interp, "buffer size must be %d to %d", + MIN_NONSTREAM_BUFFER_SIZE, MAX_BUFFER_SIZE); Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", (char *)NULL); return TCL_ERROR; } /* @@ -2376,12 +2366,11 @@ if (levelObj == NULL) { level = Z_DEFAULT_COMPRESSION; } else if (Tcl_GetIntFromObj(interp, levelObj, &level) != TCL_OK) { return TCL_ERROR; } else if (level < 0 || level > 9) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "level must be 0 to 9", TCL_AUTO_LENGTH)); + TclSetResult(interp, "level must be 0 to 9"); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", (char *)NULL); Tcl_AddErrorInfo(interp, "\n (in -level option)"); return TCL_ERROR; } @@ -2495,20 +2484,18 @@ /* * Sanity checks. */ if (mode == TCL_ZLIB_STREAM_DEFLATE && !(chanMode & TCL_WRITABLE)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "compression may only be applied to writable channels", - TCL_AUTO_LENGTH)); + TclSetResult(interp, + "compression may only be applied to writable channels"); Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNWRITABLE", (char *)NULL); return TCL_ERROR; } if (mode == TCL_ZLIB_STREAM_INFLATE && !(chanMode & TCL_READABLE)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "decompression may only be applied to readable channels", - TCL_AUTO_LENGTH)); + TclSetResult(interp, + "decompression may only be applied to readable channels"); Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNREADABLE", (char *)NULL); return TCL_ERROR; } /* @@ -2520,12 +2507,12 @@ if (Tcl_GetIndexFromObj(interp, objv[i], pushOptions, "option", 0, &option) != TCL_OK) { return TCL_ERROR; } if (++i > objc - 1) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "value missing for %s option", pushOptions[option])); + TclPrintfResult(interp, + "value missing for %s option", pushOptions[option]); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", (char *)NULL); return TCL_ERROR; } switch (option) { case poHeader: /* -header headerDict */ @@ -2537,12 +2524,11 @@ case poLevel: /* -level compLevel */ if (Tcl_GetIntFromObj(interp, objv[i], (int *) &level) != TCL_OK) { goto genericOptionError; } if (level < 0 || level > 9) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "level must be 0 to 9", TCL_AUTO_LENGTH)); + TclSetResult(interp, "level must be 0 to 9"); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", (char *)NULL); goto genericOptionError; } break; @@ -2549,22 +2535,21 @@ case poLimit: /* -limit numBytes */ if (Tcl_GetIntFromObj(interp, objv[i], (int *) &limit) != TCL_OK) { goto genericOptionError; } if (limit < 1 || limit > MAX_BUFFER_SIZE) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "read ahead limit must be 1 to %d", - MAX_BUFFER_SIZE)); + TclPrintfResult(interp, + "read ahead limit must be 1 to %d", MAX_BUFFER_SIZE); Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", (char *)NULL); goto genericOptionError; } break; case poDictionary: /* -dictionary compDict */ if (format == TCL_ZLIB_FORMAT_GZIP) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "a compression dictionary may not be set in the " - "gzip format", TCL_AUTO_LENGTH)); + "gzip format"); Tcl_SetErrorCode(interp, "TCL", "ZIP", "BADOPT", (char *)NULL); goto genericOptionError; } compDictObj = objv[i]; break; @@ -2771,43 +2756,42 @@ flush = Z_FINISH; } break; case ao_buffer: /* -buffer bufferSize */ if (i == objc - 2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "\"-buffer\" option must be followed by integer " - "decompression buffersize", TCL_AUTO_LENGTH)); + "decompression buffersize"); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", (char *)NULL); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[++i], &buffersize) != TCL_OK) { return TCL_ERROR; } if (buffersize < 1 || buffersize > MAX_BUFFER_SIZE) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "buffer size must be 1 to %d", - MAX_BUFFER_SIZE)); + TclPrintfResult(interp, + "buffer size must be 1 to %d", MAX_BUFFER_SIZE); Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", (char *)NULL); return TCL_ERROR; } break; case ao_dictionary: /* -dictionary compDict */ if (i == objc - 2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "\"-dictionary\" option must be followed by" - " compression dictionary bytes", TCL_AUTO_LENGTH)); + " compression dictionary bytes"); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", (char *)NULL); return TCL_ERROR; } compDictObj = objv[++i]; break; } if (flush == -2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "\"-flush\", \"-fullflush\" and \"-finalize\" options" - " are mutually exclusive", TCL_AUTO_LENGTH)); + " are mutually exclusive"); Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", (char *)NULL); return TCL_ERROR; } } if (flush == -1) { @@ -2898,23 +2882,23 @@ flush = Z_FINISH; } break; case po_dictionary: /* -dictionary compDict */ if (i == objc - 2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "\"-dictionary\" option must be followed by" - " compression dictionary bytes", TCL_AUTO_LENGTH)); + " compression dictionary bytes"); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", (char *)NULL); return TCL_ERROR; } compDictObj = objv[++i]; break; } if (flush == -2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "\"-flush\", \"-fullflush\" and \"-finalize\" options" - " are mutually exclusive", TCL_AUTO_LENGTH)); + " are mutually exclusive"); Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", (char *)NULL); return TCL_ERROR; } } if (flush == -1) { @@ -2957,13 +2941,12 @@ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } else if (zshPtr->mode != TCL_ZLIB_STREAM_INFLATE || zshPtr->format != TCL_ZLIB_FORMAT_GZIP) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "only gunzip streams can produce header information", - TCL_AUTO_LENGTH)); + TclSetResult(interp, + "only gunzip streams can produce header information"); Tcl_SetErrorCode(interp, "TCL", "ZIP", "BADOP", (char *)NULL); return TCL_ERROR; } TclNewObj(resultObj); @@ -3046,13 +3029,13 @@ chanDataPtr->outBuffer, written) == TCL_IO_FAILURE) { /* TODO: is this the right way to do errors on close? * Note: when close is called from FinalizeIOSubsystem then * interp may be NULL */ if (!TclInThreadExit() && interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "error while finalizing file: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); } result = TCL_ERROR; break; } } while (e != Z_STREAM_END); @@ -3334,13 +3317,13 @@ * Write the bytes we've received to the next layer. */ if (len > 0 && Tcl_WriteRaw(chanDataPtr->parent, chanDataPtr->outBuffer, len) == TCL_IO_FAILURE) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "problem flushing channel: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); return TCL_ERROR; } /* * If we get to this point, either we're in the Z_OK or the @@ -3420,13 +3403,13 @@ if (value[0] == 'f' && strcmp(value, "full") == 0) { flushType = Z_FULL_FLUSH; } else if (value[0] == 's' && strcmp(value, "sync") == 0) { flushType = Z_SYNC_FLUSH; } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "unknown -flush type \"%s\": must be full or sync", - value)); + value); Tcl_SetErrorCode(interp, "TCL", "VALUE", "FLUSH", (char *)NULL); return TCL_ERROR; } /* @@ -3440,12 +3423,11 @@ int newLimit; if (Tcl_GetInt(interp, value, &newLimit) != TCL_OK) { return TCL_ERROR; } else if (newLimit < 1 || newLimit > MAX_BUFFER_SIZE) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "-limit must be between 1 and 65536", TCL_AUTO_LENGTH)); + TclSetResult(interp, "-limit must be between 1 and 65536"); Tcl_SetErrorCode(interp, "TCL", "VALUE", "READLIMIT", (char *)NULL); return TCL_ERROR; } } @@ -3854,12 +3836,11 @@ if (chan == NULL) { goto error; } chanDataPtr->chan = chan; chanDataPtr->parent = Tcl_GetStackedChannel(chan); - Tcl_SetObjResult(interp, Tcl_NewStringObj( - Tcl_GetChannelName(chan), TCL_AUTO_LENGTH)); + TclSetResult(interp, Tcl_GetChannelName(chan)); return chan; error: if (chanDataPtr->inBuffer) { Tcl_Free(chanDataPtr->inBuffer); @@ -4069,12 +4050,11 @@ int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unimplemented", TCL_AUTO_LENGTH)); + TclSetResult(interp, "unimplemented"); Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", (char *)NULL); } return TCL_ERROR; } @@ -4138,12 +4118,11 @@ Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unimplemented", TCL_AUTO_LENGTH)); + TclSetResult(interp, "unimplemented"); Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", (char *)NULL); } return TCL_ERROR; } @@ -4154,12 +4133,11 @@ Tcl_Obj *data, size_t bufferSize, Tcl_Obj *gzipHeaderDictObj) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unimplemented", TCL_AUTO_LENGTH)); + TclSetResult(interp, "unimplemented"); Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", (char *)NULL); } return TCL_ERROR; } Index: macosx/tclMacOSXFCmd.c ================================================================== --- macosx/tclMacOSXFCmd.c +++ macosx/tclMacOSXFCmd.c @@ -147,24 +147,24 @@ const char *native; result = TclpObjStat(fileName, &statBuf); if (result != 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not read \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + TclGetString(fileName), Tcl_PosixError(interp)); return TCL_ERROR; } if (S_ISDIR(statBuf.st_mode) && objIndex != MACOSX_HIDDEN_ATTRIBUTE) { /* * Directories only support attribute "-hidden". */ errno = EISDIR; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid attribute: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, + "invalid attribute: %s", Tcl_PosixError(interp)); return TCL_ERROR; } bzero(&alist, sizeof(struct attrlist)); alist.bitmapcount = ATTR_BIT_MAP_COUNT; @@ -175,13 +175,13 @@ } native = (const char *)Tcl_FSGetNativePath(fileName); result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0); if (result != 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not read attributes of \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + TclGetString(fileName), Tcl_PosixError(interp)); return TCL_ERROR; } switch (objIndex) { case MACOSX_CREATOR_ATTRIBUTE: @@ -200,12 +200,11 @@ TclNewIntObj(*attributePtrPtr, *rsrcForkSize); break; } return TCL_OK; #else - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "Mac OS X file attributes not supported", TCL_INDEX_NONE)); + TclSetResult(interp, "Mac OS X file attributes not supported"); Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (char *)NULL); return TCL_ERROR; #endif /* HAVE_GETATTRLIST */ } @@ -243,24 +242,24 @@ const char *native; result = TclpObjStat(fileName, &statBuf); if (result != 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not read \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + TclGetString(fileName), Tcl_PosixError(interp)); return TCL_ERROR; } if (S_ISDIR(statBuf.st_mode) && objIndex != MACOSX_HIDDEN_ATTRIBUTE) { /* * Directories only support attribute "-hidden". */ errno = EISDIR; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid attribute: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, + "invalid attribute: %s", Tcl_PosixError(interp)); return TCL_ERROR; } bzero(&alist, sizeof(struct attrlist)); alist.bitmapcount = ATTR_BIT_MAP_COUNT; @@ -271,13 +270,13 @@ } native = (const char *)Tcl_FSGetNativePath(fileName); result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0); if (result != 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not read attributes of \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + TclGetString(fileName), Tcl_PosixError(interp)); return TCL_ERROR; } if (objIndex != MACOSX_RSRCLENGTH_ATTRIBUTE) { OSType t; @@ -310,13 +309,13 @@ result = setattrlist(native, &alist, &finfo.data, sizeof(finfo.data), 0); if (result != 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not set attributes of \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + TclGetString(fileName), Tcl_PosixError(interp)); return TCL_ERROR; } } else { Tcl_WideInt newRsrcForkSize; @@ -332,12 +331,12 @@ * Only setting rsrclength to 0 to strip a file's resource fork is * supported. */ if (newRsrcForkSize != 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "setting nonzero rsrclength not supported", TCL_INDEX_NONE)); + TclSetResult(interp, + "setting nonzero rsrclength not supported"); Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (char *)NULL); return TCL_ERROR; } /* @@ -364,21 +363,20 @@ } Tcl_DStringFree(&ds); if (result != 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not truncate resource fork of \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + TclGetString(fileName), Tcl_PosixError(interp)); return TCL_ERROR; } } } return TCL_OK; #else - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "Mac OS X file attributes not supported", TCL_INDEX_NONE)); + TclSetResult(interp, "Mac OS X file attributes not supported"); Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (char *)NULL); return TCL_ERROR; #endif } @@ -645,12 +643,12 @@ string = TclGetStringFromObj(objPtr, &length); Tcl_UtfToExternalDStringEx(NULL, encoding, string, length, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); if (Tcl_DStringLength(&ds) > 4) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected Macintosh OS type but got \"%s\": ", string)); + TclPrintfResult(interp, + "expected Macintosh OS type but got \"%s\": ", string); Tcl_SetErrorCode(interp, "TCL", "VALUE", "MAC_OSTYPE", (char *)NULL); } result = TCL_ERROR; } else { OSType osType; Index: unix/tclLoadDl.c ================================================================== --- unix/tclLoadDl.c +++ unix/tclLoadDl.c @@ -127,13 +127,13 @@ */ const char *errorStr = dlerror(); if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't load file \"%s\": %s", - TclGetString(pathPtr), errorStr)); + TclGetString(pathPtr), errorStr); } return TCL_ERROR; } newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle)); newHandle->clientData = handle; @@ -227,12 +227,12 @@ if (interp) { if (!errorStr) { errorStr = "unknown"; } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "cannot find symbol \"%s\": %s", symbol, errorStr)); + TclPrintfResult(interp, + "cannot find symbol \"%s\": %s", symbol, errorStr); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, (char *)NULL); } } return proc; Index: unix/tclLoadDyld.c ================================================================== --- unix/tclLoadDyld.c +++ unix/tclLoadDyld.c @@ -417,12 +417,12 @@ Tcl_DStringFree(&newName); #endif /* TCL_DYLD_USE_NSMODULE */ } Tcl_DStringFree(&ds); if (errMsg && (interp != NULL)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "cannot find symbol \"%s\": %s", symbol, errMsg)); + TclPrintfResult(interp, + "cannot find symbol \"%s\": %s", symbol, errMsg); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, (char *)NULL); } return (void *)proc; } @@ -645,13 +645,13 @@ */ if (dyldObjFileImage == NULL) { vm_deallocate(mach_task_self(), (vm_address_t) buffer, size); if (objFileImageErrMsg != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "NSCreateObjectFileImageFromMemory() error: %s", - objFileImageErrMsg)); + objFileImageErrMsg); } return TCL_ERROR; } /* @@ -670,11 +670,11 @@ NSLinkEditErrors editError; int errorNumber; const char *errorName, *errMsg; NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg); - Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, TCL_INDEX_NONE)); + TclSetResult(interp, errMsg); return TCL_ERROR; } /* * Stash the module reference within the load handle we create and return. Index: unix/tclLoadNext.c ================================================================== --- unix/tclLoadNext.c +++ unix/tclLoadNext.c @@ -98,12 +98,12 @@ if (!result) { char *data; int len, maxlen; NXGetMemoryBuffer(errorStream, &data, &len, &maxlen); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't load file \"%s\": %s", fileName, data)); + TclPrintfResult(interp, + "couldn't load file \"%s\": %s", fileName, data); NXCloseMemory(errorStream, NX_FREEBUFFER); return TCL_ERROR; } NXCloseMemory(errorStream, NX_FREEBUFFER); @@ -148,12 +148,12 @@ sym[1] = 0; strcat(sym, symbol); rld_lookup(NULL, sym, (unsigned long *) &proc); } if (proc == NULL && interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "cannot find symbol \"%s\"", symbol)); + TclPrintfResult(interp, + "cannot find symbol \"%s\"", symbol); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, (char *)NULL); } return proc; } Index: unix/tclLoadOSF.c ================================================================== --- unix/tclLoadOSF.c +++ unix/tclLoadOSF.c @@ -108,13 +108,13 @@ lm = (Tcl_LibraryInitProc *) load(native, LDR_NOFLAGS); Tcl_DStringFree(&ds); } if (lm == LDR_NULL_MODULE) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't load file \"%s\": %s", - fileName, Tcl_PosixError(interp))); + fileName, Tcl_PosixError(interp)); return TCL_ERROR; } *clientDataPtr = NULL; @@ -165,12 +165,12 @@ const char *symbol) { void *proc = ldr_lookup_package((char *) loadHandle, symbol); if (proc == NULL && interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "cannot find symbol \"%s\"", symbol)); + TclPrintfResult(interp, + "cannot find symbol \"%s\"", symbol); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, (char *)NULL); } return proc; } Index: unix/tclLoadShl.c ================================================================== --- unix/tclLoadShl.c +++ unix/tclLoadShl.c @@ -94,13 +94,13 @@ handle = shl_load(native, BIND_DEFERRED|BIND_VERBOSE|DYNAMIC_PATH, 0L); Tcl_DStringFree(&ds); } if (handle == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't load file \"%s\": %s", - fileName, Tcl_PosixError(interp))); + fileName, Tcl_PosixError(interp)); return TCL_ERROR; } newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle)); newHandle->clientData = handle; newHandle->findSymbolProcPtr = &FindSymbol; @@ -150,13 +150,13 @@ proc = NULL; } Tcl_DStringFree(&newName); } if (proc == NULL && interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "cannot find symbol \"%s\": %s", - symbol, Tcl_PosixError(interp))); + symbol, Tcl_PosixError(interp)); } return proc; } /* Index: unix/tclUnixChan.c ================================================================== --- unix/tclUnixChan.c +++ unix/tclUnixChan.c @@ -108,13 +108,13 @@ #endif /* SUPPORTS_TTY */ #define UNSUPPORTED_OPTION(detail) \ if (interp) { \ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( \ - "%s not supported for this platform", (detail))); \ - Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (char *)NULL); \ + TclPrintfResult(interp, \ + "%s not supported for this platform", (detail)); \ + Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (char *)NULL); \ } /* * Static routines for this file: */ @@ -692,13 +692,13 @@ Tcl_Obj *dictObj = StatOpenFile(fsPtr); const char *dictContents; Tcl_Size dictLength; if (dictObj == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't read file channel status: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); return TCL_ERROR; } /* * Transfer dictionary to the DString. Note that we don't do this as @@ -835,13 +835,13 @@ } else if (strncasecmp(value, "DTRDSR", vlen) == 0) { UNSUPPORTED_OPTION("-handshake DTRDSR"); return TCL_ERROR; } else { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "bad value for -handshake: must be one of" - " xonxoff, rtscts, dtrdsr or none", -1)); + " xonxoff, rtscts, dtrdsr or none"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "VALUE", (char *)NULL); } return TCL_ERROR; } @@ -857,13 +857,13 @@ if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } else if (argc != 2) { badXchar: if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "bad value for -xchar: should be a list of" - " two elements with each a single 8-bit character", -1)); + " two elements with each a single 8-bit character"); Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", (char *)NULL); } Tcl_Free(argv); return TCL_ERROR; } @@ -922,13 +922,13 @@ if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } if ((argc % 2) == 1) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "bad value for -ttycontrol: should be a list of" - " signal,value pairs", -1)); + " signal,value pairs"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "VALUE", (char *)NULL); } Tcl_Free(argv); return TCL_ERROR; @@ -964,15 +964,15 @@ Tcl_Free(argv); return TCL_ERROR; #endif /* TIOCSBRK & TIOCCBRK */ } else { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "bad signal \"%s\" for -ttycontrol: must be" - " DTR, RTS or BREAK", argv[i])); + " DTR, RTS or BREAK", argv[i]); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", - "VALUE", (char *)NULL); + "VALUE", (char *)NULL); } Tcl_Free(argv); return TCL_ERROR; } } /* -ttycontrol options loop */ @@ -996,13 +996,13 @@ fsPtr->closeMode = CLOSE_DRAIN; } else if (strncasecmp(value, "DISCARD", vlen) == 0) { fsPtr->closeMode = CLOSE_DISCARD; } else { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "bad mode \"%s\" for -closemode: must be" - " default, discard, or drain", value)); + " default, discard, or drain", value); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "VALUE", (char *)NULL); } return TCL_ERROR; } @@ -1014,13 +1014,13 @@ */ if ((len > 2) && (strncmp(optionName, "-inputmode", len) == 0)) { if (tcgetattr(fsPtr->fileState.fd, &iostate) < 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't read serial terminal control state: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); } return TCL_ERROR; } if (strncasecmp(value, "NORMAL", vlen) == 0) { SET_BITS(iostate.c_iflag, BRKINT | IGNPAR | ISTRIP | ICRNL | IXON); @@ -1054,23 +1054,23 @@ */ memcpy(&iostate, &fsPtr->initState, sizeof(struct termios)); } else { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "bad mode \"%s\" for -inputmode: must be" - " normal, password, raw, or reset", value)); + " normal, password, raw, or reset", value); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "VALUE", (char *)NULL); } return TCL_ERROR; } if (tcsetattr(fsPtr->fileState.fd, TCSADRAIN, &iostate) < 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't update serial terminal control state: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); } return TCL_ERROR; } /* @@ -1163,13 +1163,13 @@ } if (len==0 || (len>1 && strncmp(optionName, "-inputmode", len)==0)) { valid = 1; if (tcgetattr(fsPtr->fileState.fd, &iostate) < 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't read serial terminal control state: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); } return TCL_ERROR; } if (iostate.c_lflag & ICANON) { if (iostate.c_lflag & ECHO) { @@ -1273,13 +1273,13 @@ struct winsize ws; valid = 1; if (ioctl(fsPtr->fileState.fd, TIOCGWINSZ, &ws) < 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't read terminal size: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); } return TCL_ERROR; } snprintf(buf, sizeof(buf), "%d", ws.ws_col); Tcl_DStringAppendElement(dsPtr, buf); @@ -1634,12 +1634,12 @@ &parity, &ttyPtr->data, &ttyPtr->stop, &end); if ((i != 4) || (mode[end] != '\0')) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "%s: should be baud,parity,data,stop", bad)); + TclPrintfResult(interp, + "%s: should be baud,parity,data,stop", bad); Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", (char *)NULL); } return TCL_ERROR; } @@ -1658,35 +1658,35 @@ #else strchr("noe", parity) #endif /* PAREXT */ == NULL) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "%s parity: should be %s", bad, #if defined(PAREXT) "n, o, e, m, or s" #else "n, o, or e" #endif /* PAREXT */ - )); + ); Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", (char *)NULL); } return TCL_ERROR; } ttyPtr->parity = parity; if ((ttyPtr->data < 5) || (ttyPtr->data > 8)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "%s data: should be 5, 6, 7, or 8", bad)); + TclPrintfResult(interp, + "%s data: should be 5, 6, 7, or 8", bad); Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", (char *)NULL); } return TCL_ERROR; } if ((ttyPtr->stop < 0) || (ttyPtr->stop > 2)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "%s stop: should be 1 or 2", bad)); + TclPrintfResult(interp, + "%s stop: should be 1 or 2", bad); Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", (char *)NULL); } return TCL_ERROR; } return TCL_OK; @@ -1788,13 +1788,13 @@ } native = (const char *)Tcl_FSGetNativePath(pathPtr); if (native == NULL) { if (interp != (Tcl_Interp *) NULL) { - Tcl_AppendResult(interp, "couldn't open \"", - TclGetString(pathPtr), "\": filename is invalid on this platform", - (char *)NULL); + TclPrintfResult(interp, + "couldn't open \"%s\": filename is invalid on this platform", + TclGetString(pathPtr)); } return NULL; } #ifdef DJGPP @@ -1803,13 +1803,13 @@ fd = TclOSopen(native, mode, permissions); if (fd < 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't open \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + TclGetString(pathPtr), Tcl_PosixError(interp)); } return NULL; } /* @@ -2080,18 +2080,16 @@ chan = Tcl_GetChannel(interp, chanID, &chanMode); if (chan == NULL) { return TCL_ERROR; } if (forWriting && !(chanMode & TCL_WRITABLE)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "\"%s\" wasn't opened for writing", chanID)); + TclPrintfResult(interp, "\"%s\" wasn't opened for writing", chanID); Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NOT_WRITABLE", (char *)NULL); return TCL_ERROR; } else if (!forWriting && !(chanMode & TCL_READABLE)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "\"%s\" wasn't opened for reading", chanID)); + TclPrintfResult(interp, "\"%s\" wasn't opened for reading", chanID); Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NOT_READABLE", (char *)NULL); return TCL_ERROR; } @@ -2118,23 +2116,22 @@ * writing.... */ f = fdopen(fd, (forWriting ? "w" : "r")); if (f == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "cannot get a FILE * for \"%s\"", chanID)); + TclPrintfResult(interp, + "cannot get a FILE * for \"%s\"", chanID); Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "FILE_FAILURE", (char *)NULL); return TCL_ERROR; } *filePtr = f; return TCL_OK; } } - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "\"%s\" cannot be used to get a FILE *", chanID)); + TclPrintfResult(interp, "\"%s\" cannot be used to get a FILE *", chanID); Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NO_DESCRIPTOR", (char *)NULL); return TCL_ERROR; } Index: unix/tclUnixFCmd.c ================================================================== --- unix/tclUnixFCmd.c +++ unix/tclUnixFCmd.c @@ -1363,13 +1363,12 @@ result = TclpObjStat(fileName, &statBuf); if (result != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not read \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + TclPrintfResult(interp, "could not read \"%s\": %s", + TclGetString(fileName), Tcl_PosixError(interp)); } return TCL_ERROR; } groupPtr = TclpGetGrGid(statBuf.st_gid); @@ -1417,13 +1416,13 @@ result = TclpObjStat(fileName, &statBuf); if (result != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not read \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + TclGetString(fileName), Tcl_PosixError(interp)); } return TCL_ERROR; } pwPtr = TclpGetPwUid(statBuf.st_uid); @@ -1468,13 +1467,13 @@ result = TclpObjStat(fileName, &statBuf); if (result != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not read \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + TclGetString(fileName), Tcl_PosixError(interp)); } return TCL_ERROR; } *attributePtrPtr = Tcl_ObjPrintf( @@ -1525,14 +1524,14 @@ groupPtr = TclpGetGrNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); if (groupPtr == NULL) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not set group for file \"%s\":" " group \"%s\" does not exist", - TclGetString(fileName), string)); + TclGetString(fileName), string); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SETGRP", "NO_GROUP", (char *)NULL); } return TCL_ERROR; } @@ -1542,13 +1541,12 @@ native = (const char *)Tcl_FSGetNativePath(fileName); result = chown(native, (uid_t) -1, (gid_t) gid); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not set group for file \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + TclPrintfResult(interp, "could not set group for file \"%s\": %s", + TclGetString(fileName), Tcl_PosixError(interp)); } return TCL_ERROR; } return TCL_OK; } @@ -1596,14 +1594,14 @@ pwPtr = TclpGetPwNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); if (pwPtr == NULL) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not set owner for file \"%s\":" " user \"%s\" does not exist", - TclGetString(fileName), string)); + TclGetString(fileName), string); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SETOWN", "NO_USER", (char *)NULL); } return TCL_ERROR; } @@ -1613,13 +1611,13 @@ native = (const char *)Tcl_FSGetNativePath(fileName); result = chown(native, (uid_t) uid, (gid_t) -1); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not set owner for file \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + TclGetString(fileName), Tcl_PosixError(interp)); } return TCL_ERROR; } return TCL_OK; } @@ -1683,23 +1681,22 @@ */ result = TclpObjStat(fileName, &buf); if (result != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not read \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + TclPrintfResult(interp, "could not read \"%s\": %s", + TclGetString(fileName), Tcl_PosixError(interp)); } return TCL_ERROR; } newMode = (mode_t) (buf.st_mode & 0x00007FFF); if (GetModeFromPermString(NULL, modeStringPtr, &newMode) != TCL_OK) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "unknown permission string format \"%s\"", - modeStringPtr)); + modeStringPtr); Tcl_SetErrorCode(interp, "TCL", "VALUE", "PERMISSION", (char *)NULL); } return TCL_ERROR; } } @@ -1706,13 +1703,13 @@ native = (const char *)Tcl_FSGetNativePath(fileName); result = chmod(native, newMode); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not set permissions for file \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + TclGetString(fileName), Tcl_PosixError(interp)); } return TCL_ERROR; } return TCL_OK; } @@ -2403,12 +2400,12 @@ Tcl_Interp *interp, /* The interp that has the error */ Tcl_Obj *fileName) /* The name of the file which caused the * error. */ { Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + TclPrintfResult(interp,"could not read \"%s\": %s", + TclGetString(fileName), Tcl_PosixError(interp)); } static WCHAR * winPathFromObj( Tcl_Obj *fileName) @@ -2556,13 +2553,13 @@ result = TclpObjStat(fileName, &statBuf); if (result != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not read \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + TclGetString(fileName), Tcl_PosixError(interp)); } return TCL_ERROR; } TclNewIntObj(*attributePtrPtr, (statBuf.st_flags & UF_IMMUTABLE) != 0); @@ -2602,13 +2599,13 @@ result = TclpObjStat(fileName, &statBuf); if (result != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not read \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + TclGetString(fileName), Tcl_PosixError(interp)); } return TCL_ERROR; } if (readonly) { @@ -2619,13 +2616,13 @@ native = (const char *)Tcl_FSGetNativePath(fileName); result = chflags(native, statBuf.st_flags); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not set flags for file \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + TclGetString(fileName), Tcl_PosixError(interp)); } return TCL_ERROR; } return TCL_OK; } Index: unix/tclUnixFile.c ================================================================== --- unix/tclUnixFile.c +++ unix/tclUnixFile.c @@ -326,13 +326,12 @@ d = TclOSopendir(native); /* INTL: Native. */ if (d == NULL) { Tcl_DStringFree(&ds); if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't read directory \"%s\": %s", - Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't read directory \"%s\": %s", + Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp)); } Tcl_DStringFree(&dsOrig); Tcl_DecrRefCount(fileNamePtr); return TCL_ERROR; } @@ -797,13 +796,13 @@ #else if (getcwd(buffer, MAXPATHLEN+1) == NULL) /* INTL: Native. */ #endif /* USEGETWD */ { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "error getting working directory name: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); } return NULL; } if (Tcl_ExternalToUtfDStringEx(interp, NULL, buffer, TCL_INDEX_NONE, 0, bufferPtr, NULL) != TCL_OK) { return NULL; Index: unix/tclUnixPipe.c ================================================================== --- unix/tclUnixPipe.c +++ unix/tclUnixPipe.c @@ -292,13 +292,12 @@ TCL_UNUSED(Tcl_Obj *) /*path*/) { Tcl_Obj *retval = TclpTempFileName(); if (retval == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't create temporary file: %s", - Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't create temporary file: %s", + Tcl_PosixError(interp)); } return retval; } /* @@ -445,12 +444,12 @@ * Create a pipe that the child can use to return error information if * anything goes wrong. */ if (TclpCreatePipe(&errPipeIn, &errPipeOut) == 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't create pipe: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, + "couldn't create pipe: %s", Tcl_PosixError(interp)); goto error; } /* * We need to allocate and convert this before the fork so it is properly @@ -608,12 +607,12 @@ if (pid == -1) { #ifdef HAVE_POSIX_SPAWNP errno = childErrno; #endif - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't fork child process: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, + "couldn't fork child process: %s", Tcl_PosixError(interp)); goto error; } /* * Read back from the error pipe to see if the child started up OK. The @@ -629,12 +628,11 @@ if (count > 0) { char *end; errSpace[count] = 0; errno = strtol(errSpace, &end, 10); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s: %s", - end, Tcl_PosixError(interp))); + TclPrintfResult(interp, "%s: %s", end, Tcl_PosixError(interp)); goto error; } TclpCloseFile(errPipeIn); *pidPtr = (Tcl_Pid)INT2PTR(pid); @@ -914,12 +912,12 @@ TCL_UNUSED(int) /*flags*/) /* Reserved for future use. */ { int fileNums[2]; if (pipe(fileNums) < 0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf("pipe creation failed: %s", - Tcl_PosixError(interp))); + TclPrintfResult(interp,"pipe creation failed: %s", + Tcl_PosixError(interp)); return TCL_ERROR; } fcntl(fileNums[0], F_SETFD, FD_CLOEXEC); fcntl(fileNums[1], F_SETFD, FD_CLOEXEC); Index: unix/tclUnixSock.c ================================================================== --- unix/tclUnixSock.c +++ unix/tclUnixSock.c @@ -827,13 +827,12 @@ ret = -1; Tcl_SetErrno(ENOTSUP); #endif if (ret < 0) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't set socket option: %s", - Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't set socket option: %s", + Tcl_PosixError(interp)); } return TCL_ERROR; } return TCL_OK; } @@ -851,13 +850,12 @@ ret = -1; Tcl_SetErrno(ENOTSUP); #endif if (ret < 0) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't set socket option: %s", - Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't set socket option: %s", + Tcl_PosixError(interp)); } return TCL_ERROR; } return TCL_OK; } @@ -976,13 +974,12 @@ * Same must be done on win&mac. */ if (len) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get peername: %s", - Tcl_PosixError(interp))); + TclPrintfResult(interp, + "can't get peername: %s", Tcl_PosixError(interp)); } return TCL_ERROR; } } } @@ -1002,30 +999,30 @@ if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) { /* * In async connect output an empty string */ - found = 1; + found = 1; } else { for (fds = &statePtr->fds; fds != NULL; fds = fds->next) { size = sizeof(sockname); if (getsockname(fds->fd, &(sockname.sa), &size) >= 0) { found = 1; TcpHostPortList(interp, dsPtr, sockname, size); } } } - if (found) { - if (len) { - return TCL_OK; - } - Tcl_DStringEndSublist(dsPtr); - } else { - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get sockname: %s", Tcl_PosixError(interp))); - } + if (found) { + if (len) { + return TCL_OK; + } + Tcl_DStringEndSublist(dsPtr); + } else { + if (interp) { + TclPrintfResult(interp, + "can't get sockname: %s", Tcl_PosixError(interp)); + } return TCL_ERROR; } } if ((len == 0) || ((len > 1) && (optionName[1] == 'k') && @@ -1455,22 +1452,22 @@ if (statePtr->cachedBlocking == TCL_MODE_NONBLOCKING) { Tcl_NotifyChannel(statePtr->channel, TCL_WRITABLE); } } if (error != 0) { - /* - * Failure for either a synchronous connection, or an async one that - * failed before it could enter background mode, e.g. because an - * invalid -myaddr was given. - */ - - if (interp != NULL) { - errno = error; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open socket: %s", Tcl_PosixError(interp))); - } - return TCL_ERROR; + /* + * Failure for either a synchronous connection, or an async one that + * failed before it could enter background mode, e.g. because an + * invalid -myaddr was given. + */ + + if (interp != NULL) { + errno = error; + TclPrintfResult(interp, + "couldn't open socket: %s", Tcl_PosixError(interp)); + } + return TCL_ERROR; } return TCL_OK; } /* @@ -1509,20 +1506,19 @@ /* * Do the name lookups for the local and remote addresses. */ if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg) - || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, - &errorMsg)) { - if (addrlist != NULL) { - freeaddrinfo(addrlist); - } - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open socket: %s", errorMsg)); - } - return NULL; + || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, + &errorMsg)) { + if (addrlist != NULL) { + freeaddrinfo(addrlist); + } + if (interp != NULL) { + TclPrintfResult(interp, "couldn't open socket: %s", errorMsg); + } + return NULL; } /* * Allocate a new TcpState for this socket. */ Index: win/tclWinChan.c ================================================================== --- win/tclWinChan.c +++ win/tclWinChan.c @@ -946,13 +946,12 @@ Tcl_Obj *dictObj = StatOpenFile(infoPtr); const char *dictContents; Tcl_Size dictLength; if (dictObj == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't read file channel status: %s", - Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't read file channel status: %s", + Tcl_PosixError(interp)); return TCL_ERROR; } /* * Transfer dictionary to the DString. Note that we don't do this as @@ -1009,13 +1008,13 @@ TclFile readFile = NULL, writeFile = NULL; nativeName = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); if (nativeName == NULL) { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "couldn't open \"%s\": filename is invalid on this platform", - TclGetString(pathPtr))); + TclGetString(pathPtr)); } return NULL; } switch (mode & O_ACCMODE) { @@ -1069,13 +1068,12 @@ if (NativeIsComPort(nativeName)) { handle = TclWinSerialOpen(INVALID_HANDLE_VALUE, nativeName, accessMode); if (handle == INVALID_HANDLE_VALUE) { Tcl_WinConvertError(GetLastError()); if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open serial \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't open serial \"%s\": %s", + TclGetString(pathPtr), Tcl_PosixError(interp)); } return NULL; } /* @@ -1126,13 +1124,12 @@ err = TEST_FLAG(mode, O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND; } Tcl_WinConvertError(err); if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't open \"%s\": %s", + TclGetString(pathPtr), Tcl_PosixError(interp)); } return NULL; } channel = NULL; @@ -1150,13 +1147,12 @@ handle = TclWinSerialOpen(handle, nativeName, accessMode); if (handle == INVALID_HANDLE_VALUE) { Tcl_WinConvertError(GetLastError()); if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't reopen serial \"%s\": %s", - TclGetString(pathPtr), Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't reopen serial \"%s\": %s", + TclGetString(pathPtr), Tcl_PosixError(interp)); } return NULL; } channel = TclWinOpenSerialChannel(handle, channelName, channelPermissions); @@ -1187,13 +1183,12 @@ * The handle is of an unknown type, probably /dev/nul equivalent or * possibly a closed handle. */ channel = NULL; - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open \"%s\": bad file type", - TclGetString(pathPtr))); + TclPrintfResult(interp, "couldn't open \"%s\": bad file type", + TclGetString(pathPtr)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "BAD_TYPE", (char *)NULL); break; } Index: win/tclWinConsole.c ================================================================== --- win/tclWinConsole.c +++ win/tclWinConsole.c @@ -2275,13 +2275,12 @@ DWORD mode; if (GetConsoleMode(chanInfoPtr->handle, &mode) == 0) { Tcl_WinConvertError(GetLastError()); if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't read console mode: %s", - Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't read console mode: %s", + Tcl_PosixError(interp)); } return TCL_ERROR; } if (strncasecmp(value, "NORMAL", vlen) == 0) { mode |= @@ -2296,24 +2295,23 @@ * Reset to the initial mode, whatever that is. */ mode = chanInfoPtr->initMode; } else { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "bad mode \"%s\" for -inputmode: must be" - " normal, password, raw, or reset", value)); + " normal, password, raw, or reset", value); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "VALUE", (char *)NULL); } return TCL_ERROR; } if (SetConsoleMode(chanInfoPtr->handle, mode) == 0) { Tcl_WinConvertError(GetLastError()); if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't set console mode: %s", - Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't set console mode: %s", + Tcl_PosixError(interp)); } return TCL_ERROR; } return TCL_OK; @@ -2378,13 +2376,12 @@ valid = 1; if (GetConsoleMode(chanInfoPtr->handle, &mode) == 0) { Tcl_WinConvertError(GetLastError()); if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't read console mode: %s", - Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't read console mode: %s", + Tcl_PosixError(interp)); } return TCL_ERROR; } if (mode & ENABLE_LINE_INPUT) { if (mode & ENABLE_ECHO_INPUT) { @@ -2412,13 +2409,12 @@ valid = 1; if (!GetConsoleScreenBufferInfo(chanInfoPtr->handle, &consoleInfo)) { Tcl_WinConvertError(GetLastError()); if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't read console size: %s", - Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't read console size: %s", + Tcl_PosixError(interp)); } return TCL_ERROR; } Tcl_DStringStartSublist(dsPtr); snprintf(buf, sizeof(buf), "%d", Index: win/tclWinFCmd.c ================================================================== --- win/tclWinFCmd.c +++ win/tclWinFCmd.c @@ -1478,12 +1478,12 @@ Tcl_Interp *interp, /* The interp that has the error */ Tcl_Obj *fileName) /* The name of the file which caused the * error. */ { Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + TclPrintfResult(interp,"could not read \"%s\": %s", + TclGetString(fileName), Tcl_PosixError(interp)); } /* *---------------------------------------------------------------------- * @@ -1597,13 +1597,13 @@ splitPath = Tcl_FSSplitPath(fileName, &pathc); if (splitPath == NULL || pathc == 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "could not read \"%s\": no such file or directory", - TclGetString(fileName))); + TclGetString(fileName)); errno = ENOENT; Tcl_PosixError(interp); } goto cleanup; } @@ -1877,13 +1877,13 @@ Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file. */ TCL_UNUSED(Tcl_Obj *) /*attributePtr*/) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "cannot set attribute \"%s\" for file \"%s\": attribute is readonly", - tclpFileAttrStrings[objIndex], TclGetString(fileName))); + tclpFileAttrStrings[objIndex], TclGetString(fileName)); errno = EINVAL; Tcl_PosixError(interp); return TCL_ERROR; } Index: win/tclWinFile.c ================================================================== --- win/tclWinFile.c +++ win/tclWinFile.c @@ -1038,13 +1038,12 @@ return TCL_OK; } Tcl_WinConvertError(err); if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't read directory \"%s\": %s", - Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't read directory \"%s\": %s", + Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp)); } Tcl_DStringFree(&dsOrig); return TCL_ERROR; } Tcl_DStringFree(&ds); @@ -1945,13 +1944,13 @@ WCHAR *native; if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) { Tcl_WinConvertError(GetLastError()); if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "error getting working directory name: %s", - Tcl_PosixError(interp))); + Tcl_PosixError(interp)); } return NULL; } /* Index: win/tclWinLoad.c ================================================================== --- win/tclWinLoad.c +++ win/tclWinLoad.c @@ -223,12 +223,11 @@ sym2 = Tcl_DStringAppend(&ds, symbol, TCL_INDEX_NONE); proc = (void *)GetProcAddress(hInstance, sym2); Tcl_DStringFree(&ds); } if (proc == NULL && interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "cannot find symbol \"%s\"", symbol)); + TclPrintfResult(interp, "cannot find symbol \"%s\"", symbol); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, (char *)NULL); } return proc; } @@ -290,13 +289,12 @@ Tcl_Obj *tail; /* Tail of the source path. */ Tcl_MutexLock(&dllDirectoryNameMutex); if (dllDirectoryName == NULL) { if (InitDLLDirectoryName() == TCL_ERROR) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't create temporary directory: %s", - Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't create temporary directory: %s", + Tcl_PosixError(interp)); Tcl_MutexUnlock(&dllDirectoryNameMutex); return NULL; } } Tcl_MutexUnlock(&dllDirectoryNameMutex); Index: win/tclWinPipe.c ================================================================== --- win/tclWinPipe.c +++ win/tclWinPipe.c @@ -1030,13 +1030,12 @@ DuplicateHandle(hProcess, inputHandle, hProcess, &startInfo.hStdInput, 0, TRUE, DUPLICATE_SAME_ACCESS); } if (startInfo.hStdInput == INVALID_HANDLE_VALUE) { Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't duplicate input handle: %s", - Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't duplicate input handle: %s", + Tcl_PosixError(interp)); goto end; } if (outputHandle == INVALID_HANDLE_VALUE) { /* @@ -1059,13 +1058,12 @@ DuplicateHandle(hProcess, outputHandle, hProcess, &startInfo.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS); } if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) { Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't duplicate output handle: %s", - Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't duplicate output handle: %s", + Tcl_PosixError(interp)); goto end; } if (errorHandle == INVALID_HANDLE_VALUE) { /* @@ -1079,13 +1077,12 @@ DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError, 0, TRUE, DUPLICATE_SAME_ACCESS); } if (startInfo.hStdError == INVALID_HANDLE_VALUE) { Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't duplicate error handle: %s", - Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't duplicate error handle: %s", + Tcl_PosixError(interp)); goto end; } /* * If we do not have a console window, then we must run DOS and WIN32 @@ -1141,12 +1138,12 @@ if (CreateProcessW(NULL, (WCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE, (DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) { Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s", - argv[0], Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't execute \"%s\": %s", + argv[0], Tcl_PosixError(interp)); goto end; } /* * This wait is used to force the OS to give some time to the DOS process. @@ -1390,12 +1387,12 @@ } Tcl_DStringFree(&nameBuf); if (applType == APPL_NONE) { Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s", - originalName, Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't execute \"%s\": %s", + originalName, Tcl_PosixError(interp)); return APPL_NONE; } if (applType == APPL_WIN3X) { /* @@ -1872,12 +1869,12 @@ sec.lpSecurityDescriptor = NULL; sec.bInheritHandle = FALSE; if (!CreatePipe(&readHandle, &writeHandle, &sec, 0)) { Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "pipe creation failed: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, "pipe creation failed: %s", + Tcl_PosixError(interp)); return TCL_ERROR; } *rchan = Tcl_MakeFileChannel((void *)readHandle, TCL_READABLE); Tcl_RegisterChannel(interp, *rchan); Index: win/tclWinSerial.c ================================================================== --- win/tclWinSerial.c +++ win/tclWinSerial.c @@ -1647,13 +1647,13 @@ } else if (strncasecmp(value, "DISCARD", vlen) == 0) { infoPtr->flags &= ~SERIAL_CLOSE_MASK; infoPtr->flags |= SERIAL_CLOSE_DISCARD; } else { if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "bad mode \"%s\" for -closemode: must be" - " default, discard, or drain", value)); + " default, discard, or drain", value); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "VALUE", (char *)NULL); } return TCL_ERROR; } @@ -1673,13 +1673,13 @@ result = BuildCommDCBW(native, &dcb); Tcl_DStringFree(&ds); if (result == FALSE) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "bad value \"%s\" for -mode: should be baud,parity,data,stop", - value)); + value); Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", (char *)NULL); } return TCL_ERROR; } @@ -1737,13 +1737,13 @@ } else if (strncasecmp(value, "DTRDSR", vlen) == 0) { dcb.fOutxDsrFlow = TRUE; dcb.fDtrControl = DTR_CONTROL_HANDSHAKE; } else { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "bad value \"%s\" for -handshake: must be one of" - " xonxoff, rtscts, dtrdsr or none", value)); + " xonxoff, rtscts, dtrdsr or none", value); Tcl_SetErrorCode(interp, "TCL", "VALUE", "HANDSHAKE", (char *)NULL); } return TCL_ERROR; } @@ -1766,13 +1766,13 @@ return TCL_ERROR; } if (argc != 2) { badXchar: if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + TclSetResult(interp, "bad value for -xchar: should be a list of" - " two elements with each a single 8-bit character", TCL_INDEX_NONE)); + " two elements with each a single 8-bit character"); Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", (char *)NULL); } Tcl_Free((void *)argv); return TCL_ERROR; } @@ -1823,13 +1823,13 @@ if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { return TCL_ERROR; } if ((argc % 2) == 1) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "bad value \"%s\" for -ttycontrol: should be " - "a list of signal,value pairs", value)); + "a list of signal,value pairs", value); Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", (char *)NULL); } Tcl_Free((void *)argv); return TCL_ERROR; } @@ -1841,12 +1841,11 @@ } if (strncasecmp(argv[i], "DTR", strlen(argv[i])) == 0) { if (!EscapeCommFunction(infoPtr->handle, (DWORD) (flag ? SETDTR : CLRDTR))) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can't set DTR signal", TCL_INDEX_NONE)); + TclSetResult(interp, "can't set DTR signal"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "TTY_SIGNAL", (char *)NULL); } res = TCL_ERROR; break; @@ -1853,12 +1852,11 @@ } } else if (strncasecmp(argv[i], "RTS", strlen(argv[i])) == 0) { if (!EscapeCommFunction(infoPtr->handle, (DWORD) (flag ? SETRTS : CLRRTS))) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can't set RTS signal", TCL_INDEX_NONE)); + TclSetResult(interp, "can't set RTS signal"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "TTY_SIGNAL", (char *)NULL); } res = TCL_ERROR; break; @@ -1865,23 +1863,22 @@ } } else if (strncasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) { if (!EscapeCommFunction(infoPtr->handle, (DWORD) (flag ? SETBREAK : CLRBREAK))) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can't set BREAK signal", TCL_INDEX_NONE)); + TclSetResult(interp, "can't set BREAK signal"); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "TTY_SIGNAL", (char *)NULL); } res = TCL_ERROR; break; } } else { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "bad signal name \"%s\" for -ttycontrol: must be" - " DTR, RTS or BREAK", argv[i])); + " DTR, RTS or BREAK", argv[i]); Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTY_SIGNAL", (char *)NULL); } res = TCL_ERROR; break; @@ -1916,24 +1913,23 @@ } Tcl_Free((void *)argv); if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + TclPrintfResult(interp, "bad value \"%s\" for -sysbuffer: should be " - "a list of one or two integers > 0", value)); + "a list of one or two integers > 0", value); Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", (char *)NULL); } return TCL_ERROR; } if (!SetupComm(infoPtr->handle, inSize, outSize)) { if (interp != NULL) { Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't setup comm buffers: %s", - Tcl_PosixError(interp))); + TclPrintfResult(interp, "can't setup comm buffers: %s", + Tcl_PosixError(interp)); } return TCL_ERROR; } infoPtr->sysBufRead = inSize; infoPtr->sysBufWrite = outSize; @@ -1978,13 +1974,12 @@ } tout.ReadTotalTimeoutConstant = msec; if (!SetCommTimeouts(infoPtr->handle, &tout)) { if (interp != NULL) { Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't set comm timeouts: %s", - Tcl_PosixError(interp))); + TclPrintfResult(interp, "can't set comm timeouts: %s", + Tcl_PosixError(interp)); } return TCL_ERROR; } return TCL_OK; @@ -1995,20 +1990,20 @@ "ttycontrol xchar"); getStateFailed: if (interp != NULL) { Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get comm state: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, "can't get comm state: %s", + Tcl_PosixError(interp)); } return TCL_ERROR; setStateFailed: if (interp != NULL) { Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't set comm state: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, "can't set comm state: %s", + Tcl_PosixError(interp)); } return TCL_ERROR; } /* @@ -2086,12 +2081,12 @@ char buf[2 * TCL_INTEGER_SPACE + 16]; if (!GetCommState(infoPtr->handle, &dcb)) { if (interp != NULL) { Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get comm state: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, "can't get comm state: %s", + Tcl_PosixError(interp)); } return TCL_ERROR; } valid = 1; @@ -2156,12 +2151,12 @@ valid = 1; if (!GetCommState(infoPtr->handle, &dcb)) { if (interp != NULL) { Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get comm state: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, "can't get comm state: %s", + Tcl_PosixError(interp)); } return TCL_ERROR; } buf[Tcl_UniCharToUtf(UCHAR(dcb.XonChar), buf)] = '\0'; Tcl_DStringAppendElement(dsPtr, buf); @@ -2234,12 +2229,12 @@ DWORD status; if (!GetCommModemStatus(infoPtr->handle, &status)) { if (interp != NULL) { Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get tty status: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, "can't get tty status: %s", + Tcl_PosixError(interp)); } return TCL_ERROR; } valid = 1; SerialModemStatusStr(status, dsPtr); Index: win/tclWinSock.c ================================================================== --- win/tclWinSock.c +++ win/tclWinSock.c @@ -1217,13 +1217,12 @@ rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (const char *) &boolVar, sizeof(boolVar)); if (rtn != 0) { Tcl_WinConvertError(WSAGetLastError()); if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't set socket option: %s", - Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't set socket option: %s", + Tcl_PosixError(interp)); } return TCL_ERROR; } return TCL_OK; } @@ -1238,13 +1237,12 @@ rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (const char *) &boolVar, sizeof(boolVar)); if (rtn != 0) { Tcl_WinConvertError(WSAGetLastError()); if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't set socket option: %s", - Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't set socket option: %s", + Tcl_PosixError(interp)); } return TCL_ERROR; } return TCL_OK; } @@ -1426,13 +1424,12 @@ */ if (len) { Tcl_WinConvertError((DWORD) WSAGetLastError()); if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get peername: %s", - Tcl_PosixError(interp))); + TclPrintfResult(interp, "can't get peername: %s", + Tcl_PosixError(interp)); } return TCL_ERROR; } } } @@ -1500,12 +1497,12 @@ } Tcl_DStringEndSublist(dsPtr); } else { if (interp) { Tcl_WinConvertError((DWORD) WSAGetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't get sockname: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, "can't get sockname: %s", + Tcl_PosixError(interp)); } return TCL_ERROR; } } @@ -1969,12 +1966,12 @@ /* * Error message on synchronous connect */ if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open socket: %s", Tcl_PosixError(interp))); + TclPrintfResult(interp, "couldn't open socket: %s", + Tcl_PosixError(interp)); } return TCL_ERROR; } return TCL_OK; } @@ -2023,12 +2020,11 @@ &errorMsg)) { if (addrlist != NULL) { freeaddrinfo(addrlist); } if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open socket: %s", errorMsg)); + TclPrintfResult(interp, "couldn't open socket: %s", errorMsg); } return NULL; } statePtr = NewSocketInfo(INVALID_SOCKET); @@ -2298,13 +2294,12 @@ } return statePtr->channel; } if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open socket: %s", - (errorMsg ? errorMsg : Tcl_PosixError(interp)))); + TclPrintfResult(interp, "couldn't open socket: %s", + (errorMsg ? errorMsg : Tcl_PosixError(interp))); } if (sock != INVALID_SOCKET) { closesocket(sock); }