summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2012-08-06 07:59:01 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2012-08-06 07:59:01 (GMT)
commit276404432ecf07fa12997ae2aecf6cf8ef0f9714 (patch)
tree9726218d2767be111aba0feda74cd0ac220f4355 /generic
parent33bcb6e718ec30da522f10e0388743eafab975c7 (diff)
parent22298666ade7c7396ece86e2976309e955e9abd5 (diff)
downloadtcl-276404432ecf07fa12997ae2aecf6cf8ef0f9714.zip
tcl-276404432ecf07fa12997ae2aecf6cf8ef0f9714.tar.gz
tcl-276404432ecf07fa12997ae2aecf6cf8ef0f9714.tar.bz2
merge trunk
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c129
-rw-r--r--generic/tclBinary.c24
-rw-r--r--generic/tclCkalloc.c53
-rw-r--r--generic/tclClock.c12
-rw-r--r--generic/tclCmdAH.c44
-rw-r--r--generic/tclCmdIL.c251
-rw-r--r--generic/tclCmdMZ.c94
-rw-r--r--generic/tclConfig.c8
-rw-r--r--generic/tclDictObj.c39
-rw-r--r--generic/tclEncoding.c6
-rw-r--r--generic/tclEnsemble.c167
-rw-r--r--generic/tclEvent.c9
-rw-r--r--generic/tclExecute.c38
-rw-r--r--generic/tclFCmd.c141
-rw-r--r--generic/tclFileName.c39
-rw-r--r--generic/tclIO.c125
-rw-r--r--generic/tclIOCmd.c152
-rw-r--r--generic/tclIOGT.c4
-rw-r--r--generic/tclIORChan.c132
-rw-r--r--generic/tclIORTrans.c111
-rw-r--r--generic/tclIOSock.c36
-rw-r--r--generic/tclIOUtil.c107
-rw-r--r--generic/tclIndexObj.c87
-rw-r--r--generic/tclInterp.c101
-rw-r--r--generic/tclLoad.c67
-rw-r--r--generic/tclLoadNone.c4
-rw-r--r--generic/tclNamesp.c64
-rw-r--r--generic/tclOO.c48
-rw-r--r--generic/tclOOBasic.c100
-rw-r--r--generic/tclOODefineCmds.c140
-rw-r--r--generic/tclOOInfo.c64
-rw-r--r--generic/tclOOMethod.c8
-rw-r--r--generic/tclOOStubLib.c11
-rw-r--r--generic/tclObj.c42
-rw-r--r--generic/tclParse.c33
-rw-r--r--generic/tclPathObj.c16
-rw-r--r--generic/tclPipe.c101
-rw-r--r--generic/tclPkg.c108
-rw-r--r--generic/tclProc.c71
-rw-r--r--generic/tclRegexp.c4
-rw-r--r--generic/tclResult.c43
-rw-r--r--generic/tclScan.c55
-rw-r--r--generic/tclTest.c2
-rw-r--r--generic/tclTimer.c9
-rw-r--r--generic/tclTomMathStubLib.c8
-rw-r--r--generic/tclTrace.c24
-rw-r--r--generic/tclUtil.c40
-rw-r--r--generic/tclVar.c73
-rw-r--r--generic/tclZlib.c87
49 files changed, 1692 insertions, 1439 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 537750e..db365e3 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -1708,9 +1708,9 @@ Tcl_HideCommand(
*/
if (strstr(hiddenCmdToken, "::") != NULL) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot use namespace qualifiers in hidden command"
- " token (rename)", NULL);
+ " token (rename)", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", NULL);
return TCL_ERROR;
}
@@ -1733,8 +1733,9 @@ Tcl_HideCommand(
*/
if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
- Tcl_AppendResult(interp, "can only hide global namespace commands"
- " (use rename then hide)", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can only hide global namespace commands (use rename then hide)",
+ -1));
Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", NULL);
return TCL_ERROR;
}
@@ -1758,8 +1759,9 @@ Tcl_HideCommand(
hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew);
if (!isNew) {
- Tcl_AppendResult(interp, "hidden command named \"", hiddenCmdToken,
- "\" already exists", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "hidden command named \"%s\" already exists",
+ hiddenCmdToken));
Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", NULL);
return TCL_ERROR;
}
@@ -1861,8 +1863,9 @@ Tcl_ExposeCommand(
*/
if (strstr(cmdName, "::") != NULL) {
- Tcl_AppendResult(interp, "cannot expose to a namespace "
- "(use expose to toplevel, then rename)", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot expose to a namespace (use expose to toplevel, then rename)",
+ -1));
Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", NULL);
return TCL_ERROR;
}
@@ -1877,8 +1880,8 @@ Tcl_ExposeCommand(
hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken);
}
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "unknown hidden command \"", hiddenCmdToken,
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown hidden command \"%s\"", hiddenCmdToken));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN",
hiddenCmdToken, NULL);
return TCL_ERROR;
@@ -1897,9 +1900,9 @@ Tcl_ExposeCommand(
* than 'nicely' erroring out ?
*/
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"trying to expose a non-global command namespace command",
- NULL);
+ -1));
return TCL_ERROR;
}
@@ -1916,8 +1919,8 @@ Tcl_ExposeCommand(
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
if (!isNew) {
- Tcl_AppendResult(interp, "exposed command \"", cmdName,
- "\" already exists", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "exposed command \"%s\" already exists", cmdName));
Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", NULL);
return TCL_ERROR;
}
@@ -2497,9 +2500,10 @@ TclRenameCommand(
cmd = Tcl_FindCommand(interp, oldName, NULL, /*flags*/ 0);
cmdPtr = (Command *) cmd;
if (cmdPtr == NULL) {
- Tcl_AppendResult(interp, "can't ",
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't %s \"%s\": command doesn't exist",
((newName == NULL)||(*newName == '\0'))? "delete":"rename",
- " \"", oldName, "\": command doesn't exist", NULL);
+ oldName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, NULL);
return TCL_ERROR;
}
@@ -2529,15 +2533,15 @@ TclRenameCommand(
TCL_CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail);
if ((newNsPtr == NULL) || (newTail == NULL)) {
- Tcl_AppendResult(interp, "can't rename to \"", newName,
- "\": bad command name", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't rename to \"%s\": bad command name", newName));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
result = TCL_ERROR;
goto done;
}
if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) {
- Tcl_AppendResult(interp, "can't rename to \"", newName,
- "\": command already exists", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't rename to \"%s\": command already exists", newName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME",
"TARGET_EXISTS", NULL);
result = TCL_ERROR;
@@ -3538,9 +3542,9 @@ OldMathFuncProc(
* We have a non-numeric argument.
*/
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"argument to math function didn't have numeric value",
- TCL_STATIC);
+ -1));
TclCheckBadOctal(interp, Tcl_GetString(valuePtr));
ckfree(args);
return TCL_ERROR;
@@ -3827,9 +3831,8 @@ TclInterpReady(
*/
if (iPtr->flags & DELETED) {
- /* JJM - Superfluous Tcl_ResetResult call removed. */
- Tcl_AppendResult(interp,
- "attempt to call eval in deleted interpreter", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to call eval in deleted interpreter", -1));
Tcl_SetErrorCode(interp, "TCL", "IDELETE",
"attempt to call eval in deleted interpreter", NULL);
return TCL_ERROR;
@@ -3857,8 +3860,8 @@ TclInterpReady(
return TCL_OK;
}
- Tcl_AppendResult(interp,
- "too many nested evaluations (infinite loop?)", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "too many nested evaluations (infinite loop?)", -1));
Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL);
return TCL_ERROR;
}
@@ -3992,8 +3995,7 @@ Tcl_Canceled(
}
}
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, message, NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1));
Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, NULL);
}
@@ -4616,8 +4618,8 @@ TEOV_NotFound(
cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr);
if (cmdPtr == NULL) {
- Tcl_AppendResult(interp, "invalid command name \"",
- TclGetString(objv[0]), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid command name \"%s\"", TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
TclGetString(objv[0]), NULL);
@@ -6285,11 +6287,11 @@ ProcessUnexpectedResult(
Tcl_ResetResult(interp);
if (returnCode == TCL_BREAK) {
- Tcl_AppendResult(interp,
- "invoked \"break\" outside of a loop", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "invoked \"break\" outside of a loop", -1));
} else if (returnCode == TCL_CONTINUE) {
- Tcl_AppendResult(interp,
- "invoked \"continue\" outside of a loop", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "invoked \"continue\" outside of a loop", -1));
} else {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"command returned bad code: %d", returnCode));
@@ -6624,7 +6626,8 @@ TclObjInvoke(
}
if ((objc < 1) || (objv == NULL)) {
- Tcl_AppendResult(interp, "illegal argument vector", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal argument vector", -1));
return TCL_ERROR;
}
@@ -6642,8 +6645,8 @@ TclObjInvoke(
hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
}
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "invalid hidden command name \"",
- cmdName, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid hidden command name \"%s\"", cmdName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName,
NULL);
return TCL_ERROR;
@@ -7269,7 +7272,8 @@ ExprIsqrtFunc(
return TCL_OK;
negarg:
- Tcl_SetResult(interp, "square root of negative argument", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "square root of negative argument", -1));
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"domain error: argument not in valid range", NULL);
return TCL_ERROR;
@@ -8319,9 +8323,8 @@ TclNRTailcallObjCmd(
}
if (!iPtr->varFramePtr->isProcCallFrame) { /* or is upleveled */
- Tcl_SetResult(interp,
- "tailcall can only be called from a proc or lambda",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "tailcall can only be called from a proc or lambda", -1));
Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
return TCL_ERROR;
}
@@ -8480,8 +8483,8 @@ TclNRYieldObjCmd(
}
if (!corPtr) {
- Tcl_SetResult(interp, "yield can only be called in a coroutine",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "yield can only be called in a coroutine", -1));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL);
return TCL_ERROR;
}
@@ -8514,8 +8517,8 @@ TclNRYieldToObjCmd(
}
if (!corPtr) {
- Tcl_SetResult(interp, "yieldto can only be called in a coroutine",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "yieldto can only be called in a coroutine", -1));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL);
return TCL_ERROR;
}
@@ -8763,8 +8766,8 @@ NRCoroutineActivateCallback(
*/
if (corPtr->stackLevel != stackLevel) {
- Tcl_SetResult(interp, "cannot yield: C stack busy",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot yield: C stack busy", -1));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD",
NULL);
return TCL_ERROR;
@@ -8823,8 +8826,8 @@ NRCoroInjectObjCmd(
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]);
if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) {
- Tcl_AppendResult(interp, "can only inject a command into a coroutine",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can only inject a command into a coroutine", -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
TclGetString(objv[1]), NULL);
return TCL_ERROR;
@@ -8832,8 +8835,8 @@ NRCoroInjectObjCmd(
corPtr = cmdPtr->objClientData;
if (!COR_IS_SUSPENDED(corPtr)) {
- Tcl_AppendResult(interp,
- "can only inject a command into a suspended coroutine", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can only inject a command into a suspended coroutine", -1));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL);
return TCL_ERROR;
}
@@ -8860,9 +8863,9 @@ TclNRInterpCoroutine(
CoroutineData *corPtr = clientData;
if (!COR_IS_SUSPENDED(corPtr)) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "coroutine \"", Tcl_GetString(objv[0]),
- "\" is already running", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "coroutine \"%s\" is already running",
+ Tcl_GetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", NULL);
return TCL_ERROR;
}
@@ -8943,22 +8946,24 @@ TclNRCoroutineObjCmd(
&nsPtr, &altNsPtr, &cxtNsPtr, &procName);
if (nsPtr == NULL) {
- Tcl_AppendResult(interp, "can't create procedure \"", fullName,
- "\": unknown namespace", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create procedure \"%s\": unknown namespace",
+ fullName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", NULL);
return TCL_ERROR;
}
if (procName == NULL) {
- Tcl_AppendResult(interp, "can't create procedure \"", fullName,
- "\": bad procedure name", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create procedure \"%s\": bad procedure name",
+ fullName));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", fullName, NULL);
return TCL_ERROR;
}
if ((nsPtr != iPtr->globalNsPtr)
&& (procName != NULL) && (procName[0] == ':')) {
- Tcl_AppendResult(interp, "can't create procedure \"", procName,
- "\" in non-global namespace with name starting with \":\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create procedure \"%s\" in non-global namespace with"
+ " name starting with \":\"", procName));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, NULL);
return TCL_ERROR;
}
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 444e7fa..a1e836e 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -873,9 +873,9 @@ BinaryFormatCmd(
if (count == BINARY_ALL) {
count = listc;
} else if (count > listc) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"number of elements in list does not match count",
- NULL);
+ -1));
return TCL_ERROR;
}
}
@@ -884,9 +884,8 @@ BinaryFormatCmd(
case 'x':
if (count == BINARY_ALL) {
- Tcl_AppendResult(interp,
- "cannot use \"*\" in format string with \"x\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot use \"*\" in format string with \"x\"", -1));
return TCL_ERROR;
} else if (count == BINARY_NOCOUNT) {
count = 1;
@@ -1198,8 +1197,9 @@ BinaryFormatCmd(
badValue:
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "expected ", errorString,
- " string but got \"", errorValue, "\" instead", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected %s string but got \"%s\" instead",
+ errorString, errorValue));
return TCL_ERROR;
badCount:
@@ -1217,12 +1217,13 @@ BinaryFormatCmd(
Tcl_UtfToUniChar(errorString, &ch);
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
- Tcl_AppendResult(interp, "bad field specifier \"", buf, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad field specifier \"%s\"", buf));
return TCL_ERROR;
}
error:
- Tcl_AppendResult(interp, errorString, NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1));
return TCL_ERROR;
}
@@ -1586,12 +1587,13 @@ BinaryScanCmd(
Tcl_UtfToUniChar(errorString, &ch);
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
- Tcl_AppendResult(interp, "bad field specifier \"", buf, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad field specifier \"%s\"", buf));
return TCL_ERROR;
}
error:
- Tcl_AppendResult(interp, errorString, NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1));
return TCL_ERROR;
}
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index 5b5a0d6..6443975 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -815,15 +815,16 @@ MemoryCmd(
size_t len;
if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " option [args..]\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s option [args..]\"", argv[0]));
return TCL_ERROR;
}
- if ((strcmp(argv[1],"active") == 0) || (strcmp(argv[1],"display") == 0)) {
+ if (strcmp(argv[1], "active") == 0 || strcmp(argv[1], "display") == 0) {
if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ", argv[1], " file\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s %s file\"",
+ argv[0], argv[1]));
return TCL_ERROR;
}
fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
@@ -833,7 +834,8 @@ MemoryCmd(
result = Tcl_DumpActiveMemory(fileName);
Tcl_DStringFree(&buffer);
if (result != TCL_OK) {
- Tcl_AppendResult(interp, "error accessing ", argv[2], NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s",
+ argv[2], Tcl_PosixError(interp)));
return TCL_ERROR;
}
return TCL_OK;
@@ -857,17 +859,17 @@ MemoryCmd(
"maximum bytes allocated", (unsigned long)maximum_bytes_malloced));
return TCL_OK;
}
- if (strcmp(argv[1],"init") == 0) {
+ if (strcmp(argv[1], "init") == 0) {
if (argc != 3) {
goto bad_suboption;
}
init_malloced_bodies = (strcmp(argv[2],"on") == 0);
return TCL_OK;
}
- if (strcmp(argv[1],"objs") == 0) {
+ if (strcmp(argv[1], "objs") == 0) {
if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " objs file\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s objs file\"", argv[0]));
return TCL_ERROR;
}
fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
@@ -876,7 +878,9 @@ MemoryCmd(
}
fileP = fopen(fileName, "w");
if (fileP == NULL) {
- Tcl_AppendResult(interp, "cannot open output file", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot open output file: %s",
+ Tcl_PosixError(interp)));
return TCL_ERROR;
}
TclDbDumpActiveObjects(fileP);
@@ -886,8 +890,8 @@ MemoryCmd(
}
if (strcmp(argv[1],"onexit") == 0) {
if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " onexit file\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s onexit file\"", argv[0]));
return TCL_ERROR;
}
fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
@@ -901,8 +905,8 @@ MemoryCmd(
}
if (strcmp(argv[1],"tag") == 0) {
if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " tag string\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s tag string\"", argv[0]));
return TCL_ERROR;
}
if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
@@ -939,19 +943,20 @@ MemoryCmd(
return TCL_OK;
}
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": should be active, break_on_malloc, info, init, objs, onexit, "
- "tag, trace, trace_on_at_malloc, or validate", NULL);
+ 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",
+ argv[1]));
return TCL_ERROR;
argError:
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ", argv[1], " count\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s %s count\"", argv[0], argv[1]));
return TCL_ERROR;
bad_suboption:
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ", argv[1], " on|off\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s %s on|off\"", argv[0], argv[1]));
return TCL_ERROR;
}
@@ -981,8 +986,8 @@ CheckmemCmd(
const char *argv[]) /* String values of arguments. */
{
if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " fileName\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: should be \"%s fileName\"", argv[0]));
return TCL_ERROR;
}
tclMemDumpFileName = dumpFile;
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 7fa4017..6d2976d 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -878,8 +878,8 @@ ConvertLocalToUTCUsingC(
if (localErrno != 0
|| (fields->seconds == -1 && timeVal.tm_yday == -1)) {
- Tcl_SetResult(interp, "time value too large/small to represent",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "time value too large/small to represent", -1));
return TCL_ERROR;
}
return TCL_OK;
@@ -1018,17 +1018,17 @@ ConvertUTCToLocalUsingC(
tock = (time_t) fields->seconds;
if ((Tcl_WideInt) tock != fields->seconds) {
- Tcl_AppendResult(interp,
- "number too large to represent as a Posix time", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "number too large to represent as a Posix time", -1));
Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", NULL);
return TCL_ERROR;
}
TzsetIfNecessary();
timeVal = ThreadSafeLocalTime(&tock);
if (timeVal == NULL) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"localtime failed (clock value may be too "
- "large/small to represent)", NULL);
+ "large/small to represent)", -1));
Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", NULL);
return TCL_ERROR;
}
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index f09ee70..5ca5cf8 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -194,7 +194,8 @@ Tcl_CaseObjCmd(
if (i == caseObjc-1) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "extra case pattern with no body", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "extra case pattern with no body", -1));
return TCL_ERROR;
}
@@ -409,8 +410,9 @@ Tcl_CdObjCmd(
} else {
result = Tcl_FSChdir(dir);
if (result != TCL_OK) {
- Tcl_AppendResult(interp, "couldn't change working directory to \"",
- TclGetString(dir), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't change working directory to \"%s\": %s",
+ TclGetString(dir), Tcl_PosixError(interp)));
result = TCL_ERROR;
}
}
@@ -642,8 +644,9 @@ EncodingDirsObjCmd(
dirListObj = objv[2];
if (Tcl_SetEncodingSearchPath(dirListObj) == TCL_ERROR) {
- Tcl_AppendResult(interp, "expected directory list but got \"",
- TclGetString(dirListObj), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected directory list but got \"%s\"",
+ TclGetString(dirListObj)));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "ENCODING", "BADPATH",
NULL);
return TCL_ERROR;
@@ -1165,9 +1168,9 @@ FileAttrAccessTimeCmd(
tval.modtime = buf.st_mtime;
if (Tcl_FSUtime(objv[1], &tval) != 0) {
- Tcl_AppendResult(interp, "could not set access time for file \"",
- TclGetString(objv[1]), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set access time for file \"%s\": %s",
+ TclGetString(objv[1]), Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -1237,9 +1240,9 @@ FileAttrModifyTimeCmd(
tval.modtime = newTime;
if (Tcl_FSUtime(objv[1], &tval) != 0) {
- Tcl_AppendResult(interp, "could not set modification time for "
- "file \"", TclGetString(objv[1]), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set modification time for file \"%s\": %s",
+ TclGetString(objv[1]), Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -1842,7 +1845,7 @@ PathFilesystemCmd(
}
fsInfo = Tcl_FSFileSystemInfo(objv[1]);
if (fsInfo == NULL) {
- Tcl_SetResult(interp, "unrecognised path", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unrecognised path", -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM",
Tcl_GetString(objv[1]), NULL);
return TCL_ERROR;
@@ -1990,8 +1993,9 @@ PathSplitCmd(
}
res = Tcl_FSSplitPath(objv[1], NULL);
if (res == NULL) {
- Tcl_AppendResult(interp, "could not read \"", TclGetString(objv[1]),
- "\": no such file or directory", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": no such file or directory",
+ TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PATHSPLIT", "NONESUCH",
NULL);
return TCL_ERROR;
@@ -2092,7 +2096,8 @@ FilesystemSeparatorCmd(
Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[1]);
if (separatorObj == NULL) {
- Tcl_SetResult(interp, "unrecognised path", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unrecognised path", -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM",
Tcl_GetString(objv[1]), NULL);
return TCL_ERROR;
@@ -2211,9 +2216,9 @@ GetStatBuf(
if (status < 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(pathPtr), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(pathPtr), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -2648,7 +2653,8 @@ TclNRForeachCmd(
TclListObjGetElements(NULL, statePtr->vCopyList[i],
&statePtr->varcList[i], &statePtr->varvList[i]);
if (statePtr->varcList[i] < 1) {
- Tcl_AppendResult(interp, "foreach varlist is empty", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "foreach varlist is empty", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FOREACH",
"NEEDVARS", NULL);
result = TCL_ERROR;
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index b312026..14e0092 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -27,15 +27,15 @@
*/
typedef struct SortElement {
- union { /* The value that we sorting by. */
+ union { /* The value that we sorting by. */
const char *strValuePtr;
long intValue;
double doubleValue;
Tcl_Obj *objValuePtr;
} collationKey;
- union { /* Object being sorted, or its index. */
- Tcl_Obj *objPtr;
- int index;
+ union { /* Object being sorted, or its index. */
+ Tcl_Obj *objPtr;
+ int index;
} payload;
struct SortElement *nextPtr;/* Next element in the list, or NULL for end
* of list. */
@@ -229,8 +229,9 @@ TclNRIfObjCmd(
Tcl_Obj *boolObj;
if (objc <= 1) {
- Tcl_AppendResult(interp, "wrong # args: no expression after \"",
- TclGetString(objv[0]), "\" argument", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: no expression after \"%s\" argument",
+ TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
return TCL_ERROR;
}
@@ -319,8 +320,9 @@ IfConditionCallback(
*/
if (i >= objc) {
- Tcl_AppendResult(interp, "wrong # args: ",
- "no expression after \"", clause, "\" argument", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: no expression after \"%s\" argument",
+ clause));
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
return TCL_ERROR;
}
@@ -345,8 +347,9 @@ IfConditionCallback(
}
}
if (i < objc - 1) {
- Tcl_AppendResult(interp, "wrong # args: ",
- "extra words after \"else\" clause in \"if\" command", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "wrong # args: extra words after \"else\" clause in \"if\" command",
+ -1));
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
return TCL_ERROR;
}
@@ -361,9 +364,9 @@ IfConditionCallback(
return TclNREvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i);
missingScript:
- clause = TclGetString(objv[i-1]);
- Tcl_AppendResult(interp, "wrong # args: no script following \"", clause,
- "\" argument", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "wrong # args: no script following \"%s\" argument",
+ TclGetString(objv[i-1])));
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
return TCL_ERROR;
}
@@ -491,7 +494,8 @@ InfoArgsCmd(
name = TclGetString(objv[1]);
procPtr = TclFindProc(iPtr, name);
if (procPtr == NULL) {
- Tcl_AppendResult(interp, "\"", name, "\" isn't a procedure", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't a procedure", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL);
return TCL_ERROR;
}
@@ -552,7 +556,8 @@ InfoBodyCmd(
name = TclGetString(objv[1]);
procPtr = TclFindProc(iPtr, name);
if (procPtr == NULL) {
- Tcl_AppendResult(interp, "\"", name, "\" isn't a procedure", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't a procedure", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL);
return TCL_ERROR;
}
@@ -981,7 +986,8 @@ InfoDefaultCmd(
procPtr = TclFindProc(iPtr, procName);
if (procPtr == NULL) {
- Tcl_AppendResult(interp, "\"", procName, "\" isn't a procedure",NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't a procedure", procName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", procName,
NULL);
return TCL_ERROR;
@@ -1012,8 +1018,9 @@ InfoDefaultCmd(
}
}
- Tcl_AppendResult(interp, "procedure \"", procName,
- "\" doesn't have an argument \"", argName, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "procedure \"%s\" doesn't have an argument \"%s\"",
+ procName, argName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARGUMENT", argName, NULL);
return TCL_ERROR;
}
@@ -1055,10 +1062,10 @@ InfoErrorStackCmd(
target = interp;
if (objc == 2) {
- target = Tcl_GetSlave(interp, Tcl_GetString(objv[1]));
- if (target == NULL) {
- return TCL_ERROR;
- }
+ target = Tcl_GetSlave(interp, Tcl_GetString(objv[1]));
+ if (target == NULL) {
+ return TCL_ERROR;
+ }
}
iPtr = (Interp *) target;
@@ -1158,12 +1165,13 @@ InfoFrameCmd(
* A coroutine: must fix the level computations AND the cmdFrame chain,
* which is interrupted at the base.
*/
+
CmdFrame *lastPtr = NULL;
- runPtr = iPtr->cmdFramePtr;
+ runPtr = iPtr->cmdFramePtr;
/* TODO - deal with overflow */
- topLevel += corPtr->caller.cmdFramePtr->level;
+ topLevel += corPtr->caller.cmdFramePtr->level;
while (runPtr) {
runPtr->level += corPtr->caller.cmdFramePtr->level;
lastPtr = runPtr;
@@ -1196,8 +1204,8 @@ InfoFrameCmd(
if ((level > topLevel) || (level <= - topLevel)) {
levelError:
- Tcl_AppendResult(interp, "bad level \"", TclGetString(objv[1]), "\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad level \"%s\"", TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_FRAME",
TclGetString(objv[1]), NULL);
code = TCL_ERROR;
@@ -1401,15 +1409,15 @@ TclInfoFrame(
Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr;
if (namePtr) {
- Tcl_Obj *procNameObj;
+ Tcl_Obj *procNameObj;
/*
* This is a regular command.
*/
- TclNewObj(procNameObj);
- Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr,
- procNameObj);
+ TclNewObj(procNameObj);
+ Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr,
+ procNameObj);
ADD_PAIR("proc", procNameObj);
} else if (procPtr->cmdPtr->clientData) {
ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData;
@@ -1538,7 +1546,9 @@ InfoHostnameCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1));
return TCL_OK;
}
- Tcl_SetResult(interp, "unable to determine name of host", TCL_STATIC);
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unable to determine name of host", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "HOSTNAME", "UNKNOWN", NULL);
return TCL_ERROR;
}
@@ -1609,8 +1619,8 @@ InfoLevelCmd(
return TCL_ERROR;
levelError:
- Tcl_AppendResult(interp, "bad level \"", TclGetString(objv[1]), "\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad level \"%s\"", TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
TclGetString(objv[1]), NULL);
return TCL_ERROR;
@@ -1656,7 +1666,9 @@ InfoLibraryCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1));
return TCL_OK;
}
- Tcl_SetResult(interp, "no library has been specified for Tcl",TCL_STATIC);
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no library has been specified for Tcl", -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", "tcl_library",NULL);
return TCL_ERROR;
}
@@ -2590,9 +2602,10 @@ Tcl_LrepeatObjCmd(
return TCL_ERROR;
}
if (elementCount < 0) {
- Tcl_SetObjResult(interp, Tcl_Format(NULL,
- "bad count \"%d\": must be integer >= 0", 1, objv+1));
- Tcl_SetErrorCode(interp, "TCL","OPERATION","LREPEAT","NEGARG", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad count \"%d\": must be integer >= 0", elementCount));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG",
+ NULL);
return TCL_ERROR;
}
@@ -2608,7 +2621,7 @@ Tcl_LrepeatObjCmd(
if (elementCount && objc > LIST_MAX/elementCount) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"max length of a Tcl list (%d elements) exceeded", LIST_MAX));
- Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
return TCL_ERROR;
}
totalElems = objc * elementCount;
@@ -2723,9 +2736,10 @@ Tcl_LreplaceObjCmd(
*/
if ((first >= listLen) && (listLen > 0)) {
- Tcl_AppendResult(interp, "list doesn't contain element ",
- TclGetString(objv[2]), NULL);
- Tcl_SetErrorCode(interp, "TCL","OPERATION","LREPLACE","BADIDX", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "list doesn't contain element %s", TclGetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX",
+ NULL);
return TCL_ERROR;
}
if (last >= listLen) {
@@ -2996,8 +3010,9 @@ Tcl_LsearchObjCmd(
Tcl_DecrRefCount(startPtr);
}
if (i > objc-4) {
- Tcl_AppendResult(interp, "missing starting index", NULL);
- Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "missing starting index", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
result = TCL_ERROR;
goto done;
}
@@ -3027,10 +3042,10 @@ Tcl_LsearchObjCmd(
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
}
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"\"-index\" option must be followed by list index",
- NULL);
- Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
return TCL_ERROR;
}
@@ -3088,18 +3103,18 @@ Tcl_LsearchObjCmd(
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
}
- Tcl_AppendResult(interp,
- "-subindices cannot be used without -index option", NULL);
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
- "BAD_OPTION_MIX", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "-subindices cannot be used without -index option", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
+ "BAD_OPTION_MIX", NULL);
return TCL_ERROR;
}
if (bisect && (allMatches || negatedMatch)) {
- Tcl_AppendResult(interp,
- "-bisect is not compatible with -all or -not", NULL);
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
- "BAD_OPTION_MIX", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "-bisect is not compatible with -all or -not", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
+ "BAD_OPTION_MIX", NULL);
return TCL_ERROR;
}
@@ -3531,7 +3546,7 @@ Tcl_LsetObjCmd(
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv,
- "listVar ?index? ?index ...? value");
+ "listVar ?index? ?index ...? value");
return TCL_ERROR;
}
@@ -3664,10 +3679,10 @@ Tcl_LsortObjCmd(
break;
case LSORT_COMMAND:
if (i == objc-2) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"\"-command\" option must be followed "
- "by comparison command", NULL);
- Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
+ "by comparison command", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
sortInfo.resultCode = TCL_ERROR;
goto done2;
}
@@ -3685,29 +3700,30 @@ Tcl_LsortObjCmd(
sortInfo.isIncreasing = 1;
break;
case LSORT_INDEX: {
- int indexc, dummy;
+ int indexc, dummy;
Tcl_Obj **indexv;
if (i == objc-2) {
- Tcl_AppendResult(interp, "\"-index\" option must be "
- "followed by list index", NULL);
- Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
- sortInfo.resultCode = TCL_ERROR;
- goto done2;
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "\"-index\" option must be followed by list index",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
+ sortInfo.resultCode = TCL_ERROR;
+ goto done2;
}
if (TclListObjGetElements(interp, objv[i+1], &indexc,
&indexv) != TCL_OK) {
- sortInfo.resultCode = TCL_ERROR;
- goto done2;
+ sortInfo.resultCode = TCL_ERROR;
+ goto done2;
}
- /*
- * Check each of the indices for syntactic correctness. Note that
- * we do not store the converted values here because we do not
- * know if this is the only -index option yet and so we can't
- * allocate any space; that happens after the scan through all the
- * options is done.
- */
+ /*
+ * Check each of the indices for syntactic correctness. Note that
+ * we do not store the converted values here because we do not
+ * know if this is the only -index option yet and so we can't
+ * allocate any space; that happens after the scan through all the
+ * options is done.
+ */
for (j=0 ; j<indexc ; j++) {
if (TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
@@ -3719,7 +3735,7 @@ Tcl_LsortObjCmd(
}
}
indexPtr = objv[i+1];
- i++;
+ i++;
break;
}
case LSORT_INTEGER:
@@ -3739,9 +3755,10 @@ Tcl_LsortObjCmd(
break;
case LSORT_STRIDE:
if (i == objc-2) {
- Tcl_AppendResult(interp, "\"-stride\" option must be ",
- "followed by stride length", NULL);
- Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "\"-stride\" option must be "
+ "followed by stride length", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
sortInfo.resultCode = TCL_ERROR;
goto done2;
}
@@ -3750,10 +3767,10 @@ Tcl_LsortObjCmd(
goto done2;
}
if (groupSize < 2) {
- Tcl_AppendResult(interp, "stride length must be at least 2",
- NULL);
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
- "BADSTRIDE", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "stride length must be at least 2", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
+ "BADSTRIDE", NULL);
sortInfo.resultCode = TCL_ERROR;
goto done2;
}
@@ -3773,26 +3790,26 @@ Tcl_LsortObjCmd(
*/
if (indexPtr) {
- Tcl_Obj **indexv;
-
- TclListObjGetElements(interp, indexPtr, &sortInfo.indexc, &indexv);
- switch (sortInfo.indexc) {
- case 0:
- sortInfo.indexv = NULL;
- break;
- case 1:
- sortInfo.indexv = &sortInfo.singleIndex;
- break;
- default:
- sortInfo.indexv =
+ Tcl_Obj **indexv;
+
+ TclListObjGetElements(interp, indexPtr, &sortInfo.indexc, &indexv);
+ switch (sortInfo.indexc) {
+ case 0:
+ sortInfo.indexv = NULL;
+ break;
+ case 1:
+ sortInfo.indexv = &sortInfo.singleIndex;
+ break;
+ default:
+ sortInfo.indexv =
TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
- allocatedIndexVector = 1; /* Cannot use indexc field, as it
- * might be decreased by 1 later. */
- }
- for (j=0 ; j<sortInfo.indexc ; j++) {
- TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
+ allocatedIndexVector = 1; /* Cannot use indexc field, as it
+ * might be decreased by 1 later. */
+ }
+ for (j=0 ; j<sortInfo.indexc ; j++) {
+ TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
&sortInfo.indexv[j]);
- }
+ }
}
listObj = objv[objc-1];
@@ -3847,11 +3864,11 @@ Tcl_LsortObjCmd(
if (group) {
if (length % groupSize) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"list size must be a multiple of the stride length",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADSTRIDE",
NULL);
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADSTRIDE",
- NULL);
sortInfo.resultCode = TCL_ERROR;
goto done;
}
@@ -3867,11 +3884,11 @@ Tcl_LsortObjCmd(
groupOffset = (groupOffset - SORTIDX_END) + groupSize - 1;
}
if (groupOffset < 0 || groupOffset >= groupSize) {
- Tcl_AppendResult(interp, "when used with \"-stride\", the "
- "leading \"-index\" value must be within the group",
- NULL);
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
- "BADINDEX", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "when used with \"-stride\", the leading \"-index\""
+ " value must be within the group", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
+ "BADINDEX", NULL);
sortInfo.resultCode = TCL_ERROR;
goto done;
}
@@ -4255,11 +4272,10 @@ SortCompare(
if (TclGetIntFromObj(infoPtr->interp,
Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) {
- Tcl_ResetResult(infoPtr->interp);
- Tcl_AppendResult(infoPtr->interp,
- "-compare command returned non-integer result", NULL);
- Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
- "COMPARISONFAILED", NULL);
+ Tcl_SetObjResult(infoPtr->interp, Tcl_NewStringObj(
+ "-compare command returned non-integer result", -1));
+ Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
+ "COMPARISONFAILED", NULL);
infoPtr->resultCode = TCL_ERROR;
return 0;
}
@@ -4470,11 +4486,11 @@ SelectObjFromSublist(
return NULL;
}
if (currentObj == NULL) {
- Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
- "element %d missing from sublist \"%s\"",
- index, TclGetString(objPtr)));
- Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
- "INDEXFAILED", NULL);
+ Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
+ "element %d missing from sublist \"%s\"",
+ index, TclGetString(objPtr)));
+ Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
+ "INDEXFAILED", NULL);
infoPtr->resultCode = TCL_ERROR;
return NULL;
}
@@ -4489,6 +4505,5 @@ SelectObjFromSublist(
* c-basic-offset: 4
* fill-column: 78
* tab-width: 8
- * indent-tabs-mode: nil
* End:
*/
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 7e94d9f..9e720ea 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -204,8 +204,8 @@ Tcl_RegexpObjCmd(
*/
if (doinline && ((objc - 2) != 0)) {
- Tcl_AppendResult(interp, "regexp match variables not allowed"
- " when using -inline", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "regexp match variables not allowed when using -inline", -1));
goto optionError;
}
@@ -1839,8 +1839,8 @@ StringMapCmd(
strncmp(string, "-nocase", (size_t) length2) == 0) {
nocase = 1;
} else {
- Tcl_AppendResult(interp, "bad option \"", string,
- "\": must be -nocase", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": must be -nocase", string));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
string, NULL);
return TCL_ERROR;
@@ -2106,8 +2106,8 @@ StringMatchCmd(
strncmp(string, "-nocase", (size_t) length) == 0) {
nocase = TCL_MATCH_NOCASE;
} else {
- Tcl_AppendResult(interp, "bad option \"", string,
- "\": must be -nocase", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": must be -nocase", string));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
string, NULL);
return TCL_ERROR;
@@ -2567,8 +2567,9 @@ StringEqualCmd(
return TCL_ERROR;
}
} else {
- Tcl_AppendResult(interp, "bad option \"", string2,
- "\": must be -nocase or -length", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": must be -nocase or -length",
+ string2));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
string2, NULL);
return TCL_ERROR;
@@ -2716,8 +2717,9 @@ StringCmpCmd(
return TCL_ERROR;
}
} else {
- Tcl_AppendResult(interp, "bad option \"", string2,
- "\": must be -nocase or -length", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": must be -nocase or -length",
+ string2));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
string2, NULL);
return TCL_ERROR;
@@ -3515,9 +3517,9 @@ TclNRSwitchObjCmd(
* Mode already set via -exact, -glob, or -regexp.
*/
- Tcl_AppendResult(interp, "bad option \"",
- TclGetString(objv[i]), "\": ", options[mode],
- " option already found", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": %s option already found",
+ TclGetString(objv[i]), options[mode]));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
"DOUBLEOPT", NULL);
return TCL_ERROR;
@@ -3534,8 +3536,9 @@ TclNRSwitchObjCmd(
case OPT_INDEXV:
i++;
if (i >= objc-2) {
- Tcl_AppendResult(interp, "missing variable name argument to ",
- "-indexvar", " option", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "missing variable name argument to %s option",
+ "-indexvar"));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
"NOVAR", NULL);
return TCL_ERROR;
@@ -3546,8 +3549,9 @@ TclNRSwitchObjCmd(
case OPT_MATCHV:
i++;
if (i >= objc-2) {
- Tcl_AppendResult(interp, "missing variable name argument to ",
- "-matchvar", " option", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "missing variable name argument to %s option",
+ "-matchvar"));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
"NOVAR", NULL);
return TCL_ERROR;
@@ -3565,15 +3569,15 @@ TclNRSwitchObjCmd(
return TCL_ERROR;
}
if (indexVarObj != NULL && mode != OPT_REGEXP) {
- Tcl_AppendResult(interp,
- "-indexvar option requires -regexp option", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s option requires -regexp option", "-indexvar"));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
"MODERESTRICTION", NULL);
return TCL_ERROR;
}
if (matchVarObj != NULL && mode != OPT_REGEXP) {
- Tcl_AppendResult(interp,
- "-matchvar option requires -regexp option", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s option requires -regexp option", "-matchvar"));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
"MODERESTRICTION", NULL);
return TCL_ERROR;
@@ -3622,7 +3626,8 @@ TclNRSwitchObjCmd(
if (objc % 2) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "extra switch pattern with no body", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "extra switch pattern with no body", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM",
NULL);
@@ -3637,10 +3642,10 @@ TclNRSwitchObjCmd(
if (splitObjs) {
for (i=0 ; i<objc ; i+=2) {
if (TclGetString(objv[i])[0] == '#') {
- Tcl_AppendResult(interp, ", this may be due to a "
- "comment incorrectly placed outside of a "
- "switch body - see the \"switch\" "
- "documentation", NULL);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ ", this may be due to a comment incorrectly"
+ " placed outside of a switch body - see the"
+ " \"switch\" documentation", -1);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
"BADARM", "COMMENT?", NULL);
break;
@@ -3657,9 +3662,9 @@ TclNRSwitchObjCmd(
*/
if (strcmp(TclGetString(objv[objc-1]), "-") == 0) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "no body specified for pattern \"",
- TclGetString(objv[objc-2]), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no body specified for pattern \"%s\"",
+ TclGetString(objv[objc-2])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM",
"FALLTHROUGH", NULL);
return TCL_ERROR;
@@ -3985,7 +3990,8 @@ Tcl_ThrowObjCmd(
if (Tcl_ListObjLength(interp, objv[1], &len) != TCL_OK) {
return TCL_ERROR;
} else if (len < 1) {
- Tcl_AppendResult(interp, "type must be non-empty list", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "type must be non-empty list", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "THROW", "BADEXCEPTION",
NULL);
return TCL_ERROR;
@@ -4169,15 +4175,16 @@ TclNRTryObjCmd(
switch ((enum Handlers) type) {
case TryFinally: /* finally script */
if (i < objc-2) {
- Tcl_AppendResult(interp, "finally clause must be last", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "finally clause must be last", -1));
Tcl_DecrRefCount(handlersObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
"NONTERMINAL", NULL);
return TCL_ERROR;
} else if (i == objc-1) {
- Tcl_AppendResult(interp, "wrong # args to finally clause: ",
- "must be \"", TclGetString(objv[0]),
- " ... finally script\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "wrong # args to finally clause: must be"
+ " \"... finally script\"", -1));
Tcl_DecrRefCount(handlersObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
"ARGUMENT", NULL);
@@ -4188,15 +4195,16 @@ TclNRTryObjCmd(
case TryOn: /* on code variableList script */
if (i > objc-4) {
- Tcl_AppendResult(interp, "wrong # args to on clause: ",
- "must be \"", TclGetString(objv[0]),
- " ... on code variableList script\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "wrong # args to on clause: must be \"... on code"
+ " variableList script\"", -1));
Tcl_DecrRefCount(handlersObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "ON",
"ARGUMENT", NULL);
return TCL_ERROR;
}
- if (TCL_ERROR == TclGetCompletionCodeFromObj(interp, objv[i+1], &code)) {
+ if (TclGetCompletionCodeFromObj(interp, objv[i+1],
+ &code) != TCL_OK) {
Tcl_DecrRefCount(handlersObj);
return TCL_ERROR;
}
@@ -4205,9 +4213,10 @@ TclNRTryObjCmd(
case TryTrap: /* trap pattern variableList script */
if (i > objc-4) {
- Tcl_AppendResult(interp, "wrong # args to trap clause: ",
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "wrong # args to trap clause: "
"must be \"... trap pattern variableList script\"",
- NULL);
+ -1));
Tcl_DecrRefCount(handlersObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
"ARGUMENT", NULL);
@@ -4248,9 +4257,8 @@ TclNRTryObjCmd(
}
}
if (bodyShared) {
- Tcl_AppendResult(interp,
- "last non-finally clause must not have a body of \"-\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "last non-finally clause must not have a body of \"-\"", -1));
Tcl_DecrRefCount(handlersObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "BADFALLTHROUGH",
NULL);
diff --git a/generic/tclConfig.c b/generic/tclConfig.c
index dea487a..a4ba71a 100644
--- a/generic/tclConfig.c
+++ b/generic/tclConfig.c
@@ -236,7 +236,7 @@ QueryConfigObjCmd(
* present.
*/
- Tcl_SetResult(interp, "package not known", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1));
Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE",
Tcl_GetString(pkgName), NULL);
return TCL_ERROR;
@@ -251,7 +251,7 @@ QueryConfigObjCmd(
if (Tcl_DictObjGet(interp, pkgDict, objv[2], &val) != TCL_OK
|| val == NULL) {
- Tcl_SetResult(interp, "key not known", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG",
Tcl_GetString(objv[2]), NULL);
return TCL_ERROR;
@@ -270,8 +270,8 @@ QueryConfigObjCmd(
listPtr = Tcl_NewListObj(n, NULL);
if (!listPtr) {
- Tcl_SetResult(interp, "insufficient memory to create list",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "insufficient memory to create list", -1));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
return TCL_ERROR;
}
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index ac2cb62..691fab9 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -700,7 +700,8 @@ SetDictFromAny(
missingValue:
if (interp != NULL) {
- Tcl_SetResult(interp, "missing value to go with key", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "missing value to go with key", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
}
result = TCL_ERROR;
@@ -779,9 +780,9 @@ TclTraceDictPath(
}
if ((flags & DICT_PATH_CREATE) != DICT_PATH_CREATE) {
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "key \"", TclGetString(keyv[i]),
- "\" not known in dictionary", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "key \"%s\" not known in dictionary",
+ TclGetString(keyv[i])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
TclGetString(keyv[i]), NULL);
}
@@ -1571,9 +1572,9 @@ DictGetCmd(
return result;
}
if (valuePtr == NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "key \"", TclGetString(objv[objc-1]),
- "\" not known in dictionary", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "key \"%s\" not known in dictionary",
+ TclGetString(objv[objc-1])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
TclGetString(objv[objc-1]), NULL);
return TCL_ERROR;
@@ -2027,6 +2028,7 @@ DictInfoCmd(
{
Tcl_Obj *dictPtr;
Dict *dict;
+ char *statsStr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
@@ -2042,7 +2044,9 @@ DictInfoCmd(
}
dict = dictPtr->internalRep.otherValuePtr;
- Tcl_SetResult(interp, Tcl_HashStats(&dict->table), TCL_DYNAMIC);
+ statsStr = Tcl_HashStats(&dict->table);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1));
+ ckfree(statsStr);
return TCL_OK;
}
@@ -2371,8 +2375,8 @@ DictForNRCmd(
return TCL_ERROR;
}
if (varc != 2) {
- Tcl_SetResult(interp, "must have exactly two variable names",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "must have exactly two variable names", -1));
return TCL_ERROR;
}
searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch));
@@ -2787,8 +2791,8 @@ DictFilterCmd(
return TCL_ERROR;
}
if (varc != 2) {
- Tcl_SetResult(interp, "must have exactly two variable names",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "must have exactly two variable names", -1));
return TCL_ERROR;
}
keyVarObj = varv[0];
@@ -2828,16 +2832,19 @@ DictFilterCmd(
if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't set key variable: \"",
- TclGetString(keyVarObj), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't set key variable: \"%s\"",
+ TclGetString(keyVarObj)));
result = TCL_ERROR;
goto abnormalResult;
}
if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't set value variable: \"",
- TclGetString(valueVarObj), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't set value variable: \"%s\"",
+ TclGetString(valueVarObj)));
+ result = TCL_ERROR;
goto abnormalResult;
}
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 0fa6661..7a55724 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -1542,7 +1542,8 @@ OpenEncodingFileChannel(
}
if ((NULL == chan) && (interp != NULL)) {
- Tcl_AppendResult(interp, "unknown encoding \"", name, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown encoding \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL);
}
Tcl_DecrRefCount(fileNameObj);
@@ -1616,7 +1617,8 @@ LoadEncodingFile(
break;
}
if ((encoding == NULL) && (interp != NULL)) {
- Tcl_AppendResult(interp, "invalid encoding file \"", name, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid encoding file \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL);
}
Tcl_Close(NULL, chan);
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 754e480..b76c603 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -17,6 +17,7 @@
* Declarations for functions local to this file:
*/
+static inline Tcl_Obj * NewNsObj(Tcl_Namespace *namespacePtr);
static inline int EnsembleUnknownCallback(Tcl_Interp *interp,
EnsembleConfig *ensemblePtr, int objc,
Tcl_Obj *const objv[], Tcl_Obj **prefixObjPtr);
@@ -78,6 +79,19 @@ const Tcl_ObjType tclEnsembleCmdType = {
NULL /* setFromAnyProc */
};
+static inline Tcl_Obj *
+NewNsObj(
+ Tcl_Namespace *namespacePtr)
+{
+ register Namespace *nsPtr = (Namespace *) namespacePtr;
+
+ if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) {
+ return Tcl_NewStringObj("::", 2);
+ } else {
+ return Tcl_NewStringObj(nsPtr->fullName, -1);
+ }
+}
+
/*
*----------------------------------------------------------------------
*
@@ -116,9 +130,10 @@ TclNamespaceEnsembleCmd(
if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
if (!Tcl_InterpDeleted(interp)) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"tried to manipulate ensemble of deleted namespace",
- NULL);
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", NULL);
}
return TCL_ERROR;
}
@@ -235,9 +250,11 @@ TclNamespaceEnsembleCmd(
return TCL_ERROR;
}
if (len < 1) {
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"ensemble subcommand implementations "
- "must be non-empty lists", TCL_STATIC);
+ "must be non-empty lists", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
+ "EMPTY_TARGET", NULL);
Tcl_DictObjDone(&search);
if (patchedDict) {
Tcl_DecrRefCount(patchedDict);
@@ -250,7 +267,7 @@ TclNamespaceEnsembleCmd(
cmd = TclGetString(listv[0]);
if (!(cmd[0] == ':' && cmd[1] == ':')) {
Tcl_Obj *newList = Tcl_NewListObj(len, listv);
- Tcl_Obj *newCmd = Tcl_NewStringObj(nsPtr->fullName,-1);
+ Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace *) nsPtr);
if (nsPtr->parentPtr) {
Tcl_AppendStringsToObj(newCmd, "::", NULL);
@@ -370,8 +387,7 @@ TclNamespaceEnsembleCmd(
case CONF_NAMESPACE:
namespacePtr = NULL; /* silence gcc 4 warning */
Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
- Tcl_SetResult(interp, ((Namespace *) namespacePtr)->fullName,
- TCL_VOLATILE);
+ Tcl_SetObjResult(interp, NewNsObj(namespacePtr));
break;
case CONF_PREFIX: {
int flags = 0; /* silence gcc 4 warning */
@@ -411,9 +427,7 @@ TclNamespaceEnsembleCmd(
-1));
namespacePtr = NULL; /* silence gcc 4 warning */
Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
- Tcl_ListObjAppendElement(NULL, resultObj,
- Tcl_NewStringObj(((Namespace *) namespacePtr)->fullName,
- -1));
+ Tcl_ListObjAppendElement(NULL, resultObj, NewNsObj(namespacePtr));
/* -parameters option */
Tcl_ListObjAppendElement(NULL, resultObj,
@@ -515,9 +529,11 @@ TclNamespaceEnsembleCmd(
goto freeMapAndError;
}
if (len < 1) {
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"ensemble subcommand implementations "
- "must be non-empty lists", TCL_STATIC);
+ "must be non-empty lists", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
+ "EMPTY_TARGET", NULL);
Tcl_DictObjDone(&search);
if (patchedDict) {
Tcl_DecrRefCount(patchedDict);
@@ -527,8 +543,7 @@ TclNamespaceEnsembleCmd(
cmd = TclGetString(listv[0]);
if (!(cmd[0] == ':' && cmd[1] == ':')) {
Tcl_Obj *newList = Tcl_DuplicateObj(listObj);
- Tcl_Obj *newCmd =
- Tcl_NewStringObj(nsPtr->fullName, -1);
+ Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace*)nsPtr);
if (nsPtr->parentPtr) {
Tcl_AppendStringsToObj(newCmd, "::", NULL);
@@ -554,7 +569,9 @@ TclNamespaceEnsembleCmd(
continue;
}
case CONF_NAMESPACE:
- Tcl_AppendResult(interp, "option -namespace is read-only",
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "option -namespace is read-only", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "READ_ONLY",
NULL);
goto freeMapAndError;
case CONF_PREFIX:
@@ -629,7 +646,7 @@ Tcl_CreateEnsemble(
*/
if (!(name[0] == ':' && name[1] == ':')) {
- nameObj = Tcl_NewStringObj(nsPtr->fullName, -1);
+ nameObj = NewNsObj((Tcl_Namespace *) nsPtr);
if (nsPtr->parentPtr == NULL) {
Tcl_AppendStringsToObj(nameObj, name, NULL);
} else {
@@ -702,7 +719,9 @@ Tcl_SetEnsembleSubcommandList(
Tcl_Obj *oldList;
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
return TCL_ERROR;
}
if (subcmdList != NULL) {
@@ -776,7 +795,9 @@ Tcl_SetEnsembleParameterList(
int length;
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
return TCL_ERROR;
}
if (paramList == NULL) {
@@ -850,7 +871,9 @@ Tcl_SetEnsembleMappingDict(
Tcl_Obj *oldDict;
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
return TCL_ERROR;
}
if (mapDict != NULL) {
@@ -873,9 +896,11 @@ Tcl_SetEnsembleMappingDict(
}
bytes = TclGetString(cmdObjPtr);
if (bytes[0] != ':' || bytes[1] != ':') {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"ensemble target is not a fully-qualified command",
- NULL);
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
+ "UNQUALIFIED_TARGET", NULL);
Tcl_DictObjDone(&search);
return TCL_ERROR;
}
@@ -945,7 +970,9 @@ Tcl_SetEnsembleUnknownHandler(
Tcl_Obj *oldList;
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
return TCL_ERROR;
}
if (unknownList != NULL) {
@@ -1009,7 +1036,9 @@ Tcl_SetEnsembleFlags(
int wasCompiled;
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
return TCL_ERROR;
}
@@ -1084,7 +1113,9 @@ Tcl_GetEnsembleSubcommandList(
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
}
return TCL_ERROR;
}
@@ -1124,7 +1155,9 @@ Tcl_GetEnsembleParameterList(
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
}
return TCL_ERROR;
}
@@ -1164,7 +1197,9 @@ Tcl_GetEnsembleMappingDict(
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
}
return TCL_ERROR;
}
@@ -1203,7 +1238,9 @@ Tcl_GetEnsembleUnknownHandler(
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
}
return TCL_ERROR;
}
@@ -1242,7 +1279,9 @@ Tcl_GetEnsembleFlags(
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
}
return TCL_ERROR;
}
@@ -1281,7 +1320,9 @@ Tcl_GetEnsembleNamespace(
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command is not an ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
}
return TCL_ERROR;
}
@@ -1337,8 +1378,9 @@ Tcl_FindEnsemble(
if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd){
if (flags & TCL_LEAVE_ERR_MSG) {
- Tcl_AppendResult(interp, "\"", TclGetString(cmdNameObj),
- "\" is not an ensemble command", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" is not an ensemble command",
+ TclGetString(cmdNameObj)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
TclGetString(cmdNameObj), NULL);
}
@@ -1591,6 +1633,7 @@ NsEnsembleImplementationCmdNR(
* specified but not yet cached command
* names. */
int reparseCount = 0; /* Number of reparses. */
+ Tcl_Obj *errorObj; /* Used for building error messages. */
/*
* Must recheck objc, since numParameters might have changed. Cf. test
@@ -1631,8 +1674,9 @@ NsEnsembleImplementationCmdNR(
*/
if (!Tcl_InterpDeleted(interp)) {
- Tcl_AppendResult(interp,
- "ensemble activated for deleted namespace", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "ensemble activated for deleted namespace", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", NULL);
}
return TCL_ERROR;
}
@@ -1880,35 +1924,34 @@ NsEnsembleImplementationCmdNR(
*/
Tcl_ResetResult(interp);
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
if (ensemblePtr->subcommandTable.numEntries == 0) {
- Tcl_AppendResult(interp, "unknown subcommand \"",
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown subcommand \"%s\": namespace %s does not"
+ " export any commands",
TclGetString(objv[1+ensemblePtr->numParameters]),
- "\": namespace ", ensemblePtr->nsPtr->fullName,
- " does not export any commands", NULL);
+ ensemblePtr->nsPtr->fullName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
return TCL_ERROR;
}
- Tcl_AppendResult(interp, "unknown ",
- (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? "or ambiguous " : ""),
- "subcommand \"", TclGetString(objv[1+ensemblePtr->numParameters]),
- "\": must be ", NULL);
+ errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ",
+ (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""),
+ TclGetString(objv[1+ensemblePtr->numParameters]));
if (ensemblePtr->subcommandTable.numEntries == 1) {
- Tcl_AppendResult(interp, ensemblePtr->subcommandArrayPtr[0], NULL);
+ Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1);
} else {
int i;
for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) {
- Tcl_AppendResult(interp,
- ensemblePtr->subcommandArrayPtr[i], ", ", NULL);
+ Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], -1);
+ Tcl_AppendToObj(errorObj, ", ", 2);
}
- Tcl_AppendResult(interp, "or ",
- ensemblePtr->subcommandArrayPtr[i], NULL);
+ Tcl_AppendPrintfToObj(errorObj, "or %s",
+ ensemblePtr->subcommandArrayPtr[i]);
}
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
- TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
+ Tcl_SetObjResult(interp, errorObj);
return TCL_ERROR;
}
@@ -2034,7 +2077,6 @@ EnsembleUnknownCallback(
{
int paramc, i, result, prefixObjc;
Tcl_Obj **paramv, *unknownCmd, *ensObj;
- char buf[TCL_INTEGER_SPACE];
/*
* Create the unknown command callback to determine what to do.
@@ -2061,9 +2103,12 @@ EnsembleUnknownCallback(
((Interp *) interp)->evalFlags |= TCL_EVAL_REDIRECT;
result = Tcl_EvalObjv(interp, paramc, paramv, 0);
if ((result == TCL_OK) && (ensemblePtr->flags & ENSEMBLE_DEAD)) {
- Tcl_SetResult(interp,
- "unknown subcommand handler deleted its ensemble",
- TCL_STATIC);
+ if (!Tcl_InterpDeleted(interp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unknown subcommand handler deleted its ensemble", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_DELETED",
+ NULL);
+ }
result = TCL_ERROR;
}
Tcl_Release(ensemblePtr);
@@ -2112,26 +2157,26 @@ EnsembleUnknownCallback(
if (!Tcl_InterpDeleted(interp)) {
if (result != TCL_ERROR) {
Tcl_ResetResult(interp);
- Tcl_SetResult(interp,
- "unknown subcommand handler returned bad code: ",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unknown subcommand handler returned bad code: ", -1));
switch (result) {
case TCL_RETURN:
- Tcl_AppendResult(interp, "return", NULL);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), "return", -1);
break;
case TCL_BREAK:
- Tcl_AppendResult(interp, "break", NULL);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), "break", -1);
break;
case TCL_CONTINUE:
- Tcl_AppendResult(interp, "continue", NULL);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), "continue", -1);
break;
default:
- sprintf(buf, "%d", result);
- Tcl_AppendResult(interp, buf, NULL);
+ Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp), "%d", result);
}
Tcl_AddErrorInfo(interp, "\n result of "
"ensemble unknown subcommand handler: ");
Tcl_AddErrorInfo(interp, TclGetString(unknownCmd));
+ Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_RESULT",
+ NULL);
} else {
Tcl_AddErrorInfo(interp,
"\n (ensemble unknown subcommand handler)");
@@ -2392,7 +2437,7 @@ BuildEnsembleConfig(
* the programmer's responsibility (or [::unknown] of course).
*/
- cmdObj = Tcl_NewStringObj(ensemblePtr->nsPtr->fullName, -1);
+ cmdObj = NewNsObj((Tcl_Namespace *) ensemblePtr->nsPtr);
if (ensemblePtr->nsPtr->parentPtr != NULL) {
Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
} else {
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index e65862c..0b585b6 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -1416,7 +1416,7 @@ Tcl_VwaitObjCmd(
}
if (Tcl_LimitExceeded(interp)) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "limit exceeded", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1));
break;
}
}
@@ -1426,8 +1426,9 @@ Tcl_VwaitObjCmd(
if (!foundEvent) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "can't wait for variable \"", nameString,
- "\": would wait forever", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't wait for variable \"%s\": would wait forever",
+ nameString));
Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", NULL);
return TCL_ERROR;
}
@@ -1519,7 +1520,7 @@ Tcl_UpdateObjCmd(
}
if (Tcl_LimitExceeded(interp)) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "limit exceeded", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1));
return TCL_ERROR;
}
}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index e402634..3c0b472 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4896,8 +4896,8 @@ TEBCresume(
case INST_RSHIFT:
if (l2 < 0) {
- Tcl_SetResult(interp, "negative shift argument",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "negative shift argument", -1));
#if 0
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
@@ -4944,8 +4944,8 @@ TEBCresume(
case INST_LSHIFT:
if (l2 < 0) {
- Tcl_SetResult(interp, "negative shift argument",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "negative shift argument", -1));
#if 0
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
@@ -4967,9 +4967,8 @@ TEBCresume(
* good place to draw the line.
*/
- Tcl_SetResult(interp,
- "integer value too large to represent",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "integer value too large to represent", -1));
#if 0
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
@@ -5671,9 +5670,9 @@ TEBCresume(
NEXT_INST_V(5, opnd+1, 1);
}
DECACHE_STACK_INFO();
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "key \"", TclGetString(OBJ_AT_TOS),
- "\" not known in dictionary", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "key \"%s\" not known in dictionary",
+ TclGetString(OBJ_AT_TOS)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
TclGetString(OBJ_AT_TOS), NULL);
CACHE_STACK_INFO();
@@ -6304,7 +6303,7 @@ TEBCresume(
divideByZero:
DECACHE_STACK_INFO();
- Tcl_SetResult(interp, "divide by zero", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1));
Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
CACHE_STACK_INFO();
goto gotError;
@@ -6316,8 +6315,8 @@ TEBCresume(
exponOfZero:
DECACHE_STACK_INFO();
- Tcl_SetResult(interp, "exponentiation of zero by negative power",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "exponentiation of zero by negative power", -1));
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"exponentiation of zero by negative power", NULL);
CACHE_STACK_INFO();
@@ -6693,7 +6692,8 @@ ExecuteExtendedBinaryMathOp(
invalid = 0;
}
if (invalid) {
- Tcl_SetResult(interp, "negative shift argument", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "negative shift argument", -1));
return GENERAL_ARITHMETIC_ERROR;
}
@@ -6723,8 +6723,8 @@ ExecuteExtendedBinaryMathOp(
* place to draw the line.
*/
- Tcl_SetResult(interp, "integer value too large to represent",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "integer value too large to represent", -1));
return GENERAL_ARITHMETIC_ERROR;
}
shift = (int)(*((const long *)ptr2));
@@ -7125,7 +7125,8 @@ ExecuteExtendedBinaryMathOp(
*/
if (type2 != TCL_NUMBER_LONG) {
- Tcl_SetResult(interp, "exponent too large", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "exponent too large", -1));
return GENERAL_ARITHMETIC_ERROR;
}
@@ -7363,7 +7364,8 @@ ExecuteExtendedBinaryMathOp(
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
if (big2.used > 1) {
mp_clear(&big2);
- Tcl_SetResult(interp, "exponent too large", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "exponent too large", -1));
return GENERAL_ARITHMETIC_ERROR;
}
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index a868fe3..6611480 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -11,7 +11,7 @@
*/
#ifndef _WIN64
-/* See [Bug 2935503]: file mtime sets wrong time */
+/* See [Bug 3354324]: file mtime sets wrong time */
# define _USE_32BIT_TIME_T
#endif
@@ -152,9 +152,9 @@ FileCopyRename(
if ((objc - i) > 2) {
errno = ENOTDIR;
Tcl_PosixError(interp);
- Tcl_AppendResult(interp, "error ",
- (copyFlag ? "copying" : "renaming"), ": target \"",
- TclGetString(target), "\" is not a directory", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error %s: target \"%s\" is not a directory",
+ (copyFlag?"copying":"renaming"), TclGetString(target)));
result = TCL_ERROR;
} else {
/*
@@ -304,8 +304,9 @@ TclFileMakeDirsCmd(
done:
if (errfile != NULL) {
- Tcl_AppendResult(interp, "can't create directory \"",
- TclGetString(errfile), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create directory \"%s\": %s",
+ TclGetString(errfile), Tcl_PosixError(interp)));
result = TCL_ERROR;
}
if (split != NULL) {
@@ -384,9 +385,9 @@ TclFileDeleteCmd(
result = Tcl_FSRemoveDirectory(objv[i], force, &errorBuffer);
if (result != TCL_OK) {
if ((force == 0) && (errno == EEXIST)) {
- Tcl_AppendResult(interp, "error deleting \"",
- TclGetString(objv[i]), "\": directory not empty",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error deleting \"%s\": directory not empty",
+ TclGetString(objv[i])));
Tcl_PosixError(interp);
goto done;
}
@@ -426,12 +427,13 @@ TclFileDeleteCmd(
* We try to accomodate poor error results from our Tcl_FS calls.
*/
- Tcl_AppendResult(interp, "error deleting unknown file: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error deleting unknown file: %s",
+ Tcl_PosixError(interp)));
} else {
- Tcl_AppendResult(interp, "error deleting \"",
- TclGetString(errfile), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error deleting \"%s\": %s",
+ TclGetString(errfile), Tcl_PosixError(interp)));
}
}
@@ -540,17 +542,17 @@ CopyRenameOneFile(
if (S_ISDIR(sourceStatBuf.st_mode)
&& !S_ISDIR(targetStatBuf.st_mode)) {
errno = EISDIR;
- Tcl_AppendResult(interp, "can't overwrite file \"",
- TclGetString(target), "\" with directory \"",
- TclGetString(source), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't overwrite file \"%s\" with directory \"%s\"",
+ TclGetString(target), TclGetString(source)));
goto done;
}
if (!S_ISDIR(sourceStatBuf.st_mode)
&& S_ISDIR(targetStatBuf.st_mode)) {
errno = EISDIR;
- Tcl_AppendResult(interp, "can't overwrite directory \"",
- TclGetString(target), "\" with file \"",
- TclGetString(source), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't overwrite directory \"%s\" with file \"%s\"",
+ TclGetString(target), TclGetString(source)));
goto done;
}
@@ -581,10 +583,10 @@ CopyRenameOneFile(
}
if (errno == EINVAL) {
- Tcl_AppendResult(interp, "error renaming \"",
- TclGetString(source), "\" to \"", TclGetString(target),
- "\": trying to rename a volume or "
- "move a directory into itself", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error renaming \"%s\" to \"%s\": trying to rename a"
+ " volume or move a directory into itself",
+ TclGetString(source), TclGetString(target)));
goto done;
} else if (errno != EXDEV) {
errfile = target;
@@ -628,8 +630,9 @@ CopyRenameOneFile(
* Actual file doesn't exist.
*/
- Tcl_AppendResult(interp, "error copying \"", TclGetString(source),
- "\": the target of this link doesn't exist", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error copying \"%s\": the target of this link doesn't"
+ " exist", TclGetString(source)));
goto done;
} else {
int counter = 0;
@@ -764,23 +767,27 @@ CopyRenameOneFile(
}
}
if (result != TCL_OK) {
- Tcl_AppendResult(interp, "can't unlink \"", TclGetString(errfile),
- "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't unlink \"%s\": %s",
+ TclGetString(errfile), Tcl_PosixError(interp)));
errfile = NULL;
}
}
done:
if (errfile != NULL) {
- Tcl_AppendResult(interp, "error ", (copyFlag ? "copying" : "renaming"),
- " \"", TclGetString(source), NULL);
+ Tcl_Obj *errorMsg = Tcl_ObjPrintf("error %s \"%s\"",
+ (copyFlag ? "copying" : "renaming"), TclGetString(source));
+
if (errfile != source) {
- Tcl_AppendResult(interp, "\" to \"", TclGetString(target), NULL);
+ Tcl_AppendPrintfToObj(errorMsg, " to \"%s\"",
+ TclGetString(target));
if (errfile != target) {
- Tcl_AppendResult(interp, "\": \"", TclGetString(errfile),NULL);
+ Tcl_AppendPrintfToObj(errorMsg, ": \"%s\"",
+ TclGetString(errfile));
}
}
- Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_AppendPrintfToObj(errorMsg, ": %s", Tcl_PosixError(interp));
+ Tcl_SetObjResult(interp, errorMsg);
}
if (errorBuffer != NULL) {
Tcl_DecrRefCount(errorBuffer);
@@ -983,9 +990,10 @@ TclFileAttrsCmd(
* There was an error, probably that the filePtr is not
* accepted by any filesystem
*/
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(filePtr), "\": ", Tcl_PosixError(interp),
- NULL);
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(filePtr), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1071,9 +1079,9 @@ TclFileAttrsCmd(
Tcl_Obj *objPtr = NULL;
if (numObjStrings == 0) {
- Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]),
- "\", there are no file attributes in this filesystem.",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\", there are no file attributes in this"
+ " filesystem", TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
goto end;
}
@@ -1098,9 +1106,9 @@ TclFileAttrsCmd(
int i, index;
if (numObjStrings == 0) {
- Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]),
- "\", there are no file attributes in this filesystem.",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\", there are no file attributes in this"
+ " filesystem", TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
goto end;
}
@@ -1114,8 +1122,8 @@ TclFileAttrsCmd(
TclFreeIntRep(objv[i]);
}
if (i + 1 == objc) {
- Tcl_AppendResult(interp, "value for \"",
- TclGetString(objv[i]), "\" missing", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "value for \"%s\" missing", TclGetString(objv[i])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR",
"NOVALUE", NULL);
goto end;
@@ -1224,9 +1232,9 @@ TclFileLinkCmd(
*/
if (errno == EEXIST) {
- Tcl_AppendResult(interp, "could not create new link \"",
- TclGetString(objv[index]),
- "\": that path already exists", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not create new link \"%s\": that path already"
+ " exists", TclGetString(objv[index])));
Tcl_PosixError(interp);
} else if (errno == ENOENT) {
/*
@@ -1244,23 +1252,23 @@ TclFileLinkCmd(
access = Tcl_FSAccess(dirPtr, F_OK);
Tcl_DecrRefCount(dirPtr);
if (access != 0) {
- Tcl_AppendResult(interp, "could not create new link \"",
- TclGetString(objv[index]),
- "\": no such file or directory", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not create new link \"%s\": no such file"
+ " or directory", TclGetString(objv[index])));
Tcl_PosixError(interp);
} else {
- Tcl_AppendResult(interp, "could not create new link \"",
- TclGetString(objv[index]), "\": target \"",
- TclGetString(objv[index+1]), "\" doesn't exist",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not create new link \"%s\": target \"%s\" "
+ "doesn't exist", TclGetString(objv[index]),
+ TclGetString(objv[index+1])));
errno = ENOENT;
Tcl_PosixError(interp);
}
} else {
- Tcl_AppendResult(interp, "could not create new link \"",
- TclGetString(objv[index]), "\" pointing to \"",
- TclGetString(objv[index+1]), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not create new link \"%s\" pointing to \"%s\": %s",
+ TclGetString(objv[index]),
+ TclGetString(objv[index+1]), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1275,9 +1283,9 @@ TclFileLinkCmd(
contents = Tcl_FSLink(objv[index], NULL, 0);
if (contents == NULL) {
- Tcl_AppendResult(interp, "could not read link \"",
- TclGetString(objv[index]), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read link \"%s\": %s",
+ TclGetString(objv[index]), Tcl_PosixError(interp)));
return TCL_ERROR;
}
}
@@ -1332,8 +1340,9 @@ TclFileReadLinkCmd(
contents = Tcl_FSLink(objv[1], NULL, 0);
if (contents == NULL) {
- Tcl_AppendResult(interp, "could not readlink \"",
- TclGetString(objv[1]), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read link \"%s\": %s",
+ TclGetString(objv[1]), Tcl_PosixError(interp)));
return TCL_ERROR;
}
Tcl_SetObjResult(interp, contents);
@@ -1487,8 +1496,8 @@ TclFileTemporaryCmd(
if (nameVarObj) {
TclDecrRefCount(nameObj);
}
- Tcl_AppendResult(interp, "can't create temporary file: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create temporary file: %s", Tcl_PosixError(interp)));
return TCL_ERROR;
}
Tcl_RegisterChannel(interp, chan);
@@ -1499,7 +1508,7 @@ TclFileTemporaryCmd(
return TCL_ERROR;
}
}
- Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
return TCL_OK;
}
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index edb6581..5d90351 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -1174,9 +1174,10 @@ DoTildeSubst(
dir = TclGetEnv("HOME", &dirString);
if (dir == NULL) {
if (interp) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't find HOME environment "
- "variable to expand path", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "couldn't find HOME environment "
+ "variable to expand path", -1));
+ Tcl_SetErrorCode(interp, "TCL", "FILENAME", "NO_HOME", NULL);
}
return NULL;
}
@@ -1185,8 +1186,9 @@ DoTildeSubst(
} else if (TclpGetUserHome(user, resultPtr) == NULL) {
if (interp) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "user \"%s\" doesn't exist", user));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "USER", user, NULL);
}
return NULL;
}
@@ -1329,9 +1331,9 @@ Tcl_GlobObjCmd(
endOfForLoop:
if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"\"-tails\" must be used with either "
- "\"-directory\" or \"-path\"", NULL);
+ "\"-directory\" or \"-path\"", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
"BADOPTIONCOMBINATION", NULL);
return TCL_ERROR;
@@ -1625,20 +1627,23 @@ Tcl_GlobObjCmd(
}
if (length == 0) {
- Tcl_AppendResult(interp, "no files matched glob pattern",
- (join || (objc == 1)) ? " \"" : "s \"", NULL);
+ Tcl_Obj *errorMsg =
+ Tcl_ObjPrintf("no files matched glob pattern%s \"",
+ (join || (objc == 1)) ? "" : "s");
+
if (join) {
- Tcl_AppendResult(interp, Tcl_DStringValue(&prefix), NULL);
+ Tcl_AppendToObj(errorMsg, Tcl_DStringValue(&prefix), -1);
} else {
const char *sep = "";
for (i = 0; i < objc; i++) {
- string = Tcl_GetString(objv[i]);
- Tcl_AppendResult(interp, sep, string, NULL);
+ Tcl_AppendPrintfToObj(errorMsg, "%s%s",
+ sep, Tcl_GetString(objv[i]));
sep = " ";
}
}
- Tcl_AppendResult(interp, "\"", NULL);
+ Tcl_AppendToObj(errorMsg, "\"", -1);
+ Tcl_SetObjResult(interp, errorMsg);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH",
NULL);
result = TCL_ERROR;
@@ -2206,15 +2211,15 @@ DoGlob(
closeBrace = p;
break;
}
- Tcl_SetResult(interp, "unmatched open-brace in file name",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unmatched open-brace in file name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
NULL);
return TCL_ERROR;
} else if (*p == '}') {
- Tcl_SetResult(interp, "unmatched close-brace in file name",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unmatched close-brace in file name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
NULL);
return TCL_ERROR;
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 2de8b53..4e24533 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -1027,8 +1027,9 @@ Tcl_UnregisterChannel(
if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "Illegal recursive call to close "
- "through close-handler of channel", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal recursive call to close through close-handler"
+ " of channel", -1));
}
return TCL_ERROR;
}
@@ -1263,8 +1264,8 @@ Tcl_GetChannel(
hTblPtr = GetChannelTable(interp);
hPtr = Tcl_FindHashEntry(hTblPtr, name);
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "can not find channel named \"", chanName,
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can not find channel named \"%s\"", chanName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanName, NULL);
return NULL;
}
@@ -1584,8 +1585,9 @@ Tcl_StackChannel(
if (statePtr == NULL) {
if (interp) {
- Tcl_AppendResult(interp, "couldn't find state for channel \"",
- Tcl_GetChannelName(prevChan), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't find state for channel \"%s\"",
+ Tcl_GetChannelName(prevChan)));
}
return NULL;
}
@@ -1605,9 +1607,9 @@ Tcl_StackChannel(
if ((mask & (statePtr->flags & (TCL_READABLE | TCL_WRITABLE))) == 0) {
if (interp) {
- Tcl_AppendResult(interp,
- "reading and writing both disallowed for channel \"",
- Tcl_GetChannelName(prevChan), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "reading and writing both disallowed for channel \"%s\"",
+ Tcl_GetChannelName(prevChan)));
}
return NULL;
}
@@ -1630,8 +1632,9 @@ Tcl_StackChannel(
statePtr->csPtrR = csPtrR;
statePtr->csPtrW = csPtrW;
if (interp) {
- Tcl_AppendResult(interp, "could not flush channel \"",
- Tcl_GetChannelName(prevChan), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not flush channel \"%s\"",
+ Tcl_GetChannelName(prevChan)));
}
return NULL;
}
@@ -1784,9 +1787,9 @@ Tcl_UnstackChannel(
*/
if (!TclChanCaughtErrorBypass(interp, chan) && interp) {
- Tcl_AppendResult(interp, "could not flush channel \"",
- Tcl_GetChannelName((Tcl_Channel) chanPtr), "\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not flush channel \"%s\"",
+ Tcl_GetChannelName((Tcl_Channel) chanPtr)));
}
return TCL_ERROR;
}
@@ -2318,8 +2321,8 @@ CheckForDeadChannel(
Tcl_SetErrno(EINVAL);
if (interp) {
- Tcl_AppendResult(interp, "unable to access channel: invalid channel",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unable to access channel: invalid channel", -1));
}
return 1;
}
@@ -3051,8 +3054,9 @@ Tcl_Close(
if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
if (interp) {
- Tcl_AppendResult(interp, "Illegal recursive call to close "
- "through close-handler of channel", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal recursive call to close through close-handler"
+ " of channel", -1));
}
return TCL_ERROR;
}
@@ -3210,8 +3214,9 @@ Tcl_CloseEx(
*/
if (!chanPtr->typePtr->close2Proc) {
- Tcl_AppendResult(interp, "Half-close of channels not supported by ",
- chanPtr->typePtr->typeName, "s", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "half-close of channels not supported by %ss",
+ chanPtr->typePtr->typeName));
return TCL_ERROR;
}
@@ -3220,9 +3225,8 @@ Tcl_CloseEx(
*/
if (chanPtr != statePtr->topChanPtr) {
- Tcl_AppendResult(interp,
- "Half-close not applicable to stack of transformations",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "half-close not applicable to stack of transformations", -1));
return TCL_ERROR;
}
@@ -3240,9 +3244,9 @@ Tcl_CloseEx(
} else {
msg = "write";
}
- Tcl_AppendResult(interp, "Half-close of ", msg,
- "-side not possible, side not opened or already closed",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Half-close of %s-side not possible, side not opened or"
+ " already closed", msg));
return TCL_ERROR;
}
@@ -3253,8 +3257,9 @@ Tcl_CloseEx(
if (statePtr->flags & CHANNEL_INCLOSE) {
if (interp) {
- Tcl_AppendResult(interp, "Illegal recursive call to close "
- "through close-handler of channel", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal recursive call to close through close-handler"
+ " of channel", -1));
}
return TCL_ERROR;
}
@@ -7547,6 +7552,7 @@ Tcl_BadChannelOption(
const char **argv;
int argc, i;
Tcl_DString ds;
+ Tcl_Obj *errObj;
Tcl_DStringInit(&ds);
Tcl_DStringAppend(&ds, genericopt, -1);
@@ -7559,13 +7565,14 @@ Tcl_BadChannelOption(
Tcl_Panic("malformed option list in channel driver");
}
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad option \"", optionName,
- "\": should be one of ", NULL);
+ errObj = Tcl_ObjPrintf("bad option \"%s\": should be one of ",
+ optionName);
argc--;
for (i = 0; i < argc; i++) {
- Tcl_AppendResult(interp, "-", argv[i], ", ", NULL);
+ Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]);
}
- Tcl_AppendResult(interp, "or -", argv[i], NULL);
+ Tcl_AppendPrintfToObj(errObj, "or -%s", argv[i]);
+ Tcl_SetObjResult(interp, errObj);
Tcl_DStringFree(&ds);
ckfree(argv);
}
@@ -7843,8 +7850,9 @@ Tcl_SetChannelOption(
if (statePtr->csPtrR || statePtr->csPtrW) {
if (interp) {
- Tcl_AppendResult(interp, "unable to set channel options: "
- "background copy in progress", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unable to set channel options: background copy in"
+ " progress", -1));
}
return TCL_ERROR;
}
@@ -7893,8 +7901,9 @@ Tcl_SetChannelOption(
ResetFlag(statePtr, CHANNEL_LINEBUFFERED);
SetFlag(statePtr, CHANNEL_UNBUFFERED);
} else if (interp) {
- Tcl_AppendResult(interp, "bad value for -buffering: "
- "must be one of full, line, or none", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -buffering: must be one of"
+ " full, line, or none", -1));
return TCL_ERROR;
}
return TCL_OK;
@@ -7949,8 +7958,9 @@ Tcl_SetChannelOption(
if (inValue & 0x80 || outValue & 0x80) {
if (interp) {
- Tcl_AppendResult(interp, "bad value for -eofchar: ",
- "must be non-NUL ASCII character", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -eofchar: must be non-NUL ASCII"
+ " character", -1));
}
ckfree(argv);
return TCL_ERROR;
@@ -7963,9 +7973,9 @@ Tcl_SetChannelOption(
}
} else {
if (interp) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"bad value for -eofchar: should be a list of zero,"
- " one, or two elements", NULL);
+ " one, or two elements", -1));
}
ckfree(argv);
return TCL_ERROR;
@@ -7997,9 +8007,9 @@ Tcl_SetChannelOption(
writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL;
} else {
if (interp) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"bad value for -translation: must be a one or two"
- " element list", NULL);
+ " element list", -1));
}
ckfree(argv);
return TCL_ERROR;
@@ -8027,10 +8037,9 @@ Tcl_SetChannelOption(
translation = TCL_PLATFORM_TRANSLATION;
} else {
if (interp) {
- Tcl_AppendResult(interp,
- "bad value for -translation: "
- "must be one of auto, binary, cr, lf, crlf,"
- " or platform", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -translation: must be one of "
+ "auto, binary, cr, lf, crlf, or platform", -1));
}
ckfree(argv);
return TCL_ERROR;
@@ -8078,10 +8087,9 @@ Tcl_SetChannelOption(
statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
} else {
if (interp) {
- Tcl_AppendResult(interp,
- "bad value for -translation: "
- "must be one of auto, binary, cr, lf, crlf,"
- " or platform", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -translation: must be one of "
+ "auto, binary, cr, lf, crlf, or platform", -1));
}
ckfree(argv);
return TCL_ERROR;
@@ -8901,8 +8909,8 @@ Tcl_FileEventObjCmd(
chanPtr = (Channel *) chan;
statePtr = chanPtr->state;
if ((statePtr->flags & mask) == 0) {
- Tcl_AppendResult(interp, "channel is not ",
- (mask == TCL_READABLE) ? "readable" : "writable", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("channel is not %s",
+ (mask == TCL_READABLE) ? "readable" : "writable"));
return TCL_ERROR;
}
@@ -9023,15 +9031,15 @@ TclCopyChannel(
if (BUSY_STATE(inStatePtr, TCL_READABLE)) {
if (interp) {
- Tcl_AppendResult(interp, "channel \"",
- Tcl_GetChannelName(inChan), "\" is busy", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" is busy", Tcl_GetChannelName(inChan)));
}
return TCL_ERROR;
}
if (BUSY_STATE(outStatePtr, TCL_WRITABLE)) {
if (interp) {
- Tcl_AppendResult(interp, "channel \"",
- Tcl_GetChannelName(outChan), "\" is busy", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" is busy", Tcl_GetChannelName(outChan)));
}
return TCL_ERROR;
}
@@ -10157,8 +10165,9 @@ SetBlockMode(
*/
if (!TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) {
- Tcl_AppendResult(interp, "error setting blocking mode: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error setting blocking mode: %s",
+ Tcl_PosixError(interp)));
}
} else {
/*
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 59856d0..005713d 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -174,9 +174,10 @@ Tcl_PutsObjCmd(
if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_WRITABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
- "\" wasn't opened for writing", NULL);
+ if (!(mode & TCL_WRITABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for writing",
+ TclGetString(chanObjPtr)));
return TCL_ERROR;
}
@@ -201,8 +202,8 @@ Tcl_PutsObjCmd(
error:
if (!TclChanCaughtErrorBypass(interp, chan)) {
- Tcl_AppendResult(interp, "error writing \"", TclGetString(chanObjPtr),
- "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s",
+ TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -244,9 +245,10 @@ Tcl_FlushObjCmd(
if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_WRITABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
- "\" wasn't opened for writing", NULL);
+ if (!(mode & TCL_WRITABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for writing",
+ TclGetString(chanObjPtr)));
return TCL_ERROR;
}
@@ -259,9 +261,9 @@ Tcl_FlushObjCmd(
*/
if (!TclChanCaughtErrorBypass(interp, chan)) {
- Tcl_AppendResult(interp, "error flushing \"",
- TclGetString(chanObjPtr), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error flushing \"%s\": %s",
+ TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -306,9 +308,10 @@ Tcl_GetsObjCmd(
if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_READABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
- "\" wasn't opened for reading", NULL);
+ if (!(mode & TCL_READABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for reading",
+ TclGetString(chanObjPtr)));
return TCL_ERROR;
}
@@ -326,10 +329,9 @@ Tcl_GetsObjCmd(
*/
if (!TclChanCaughtErrorBypass(interp, chan)) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "error reading \"",
- TclGetString(chanObjPtr), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error reading \"%s\": %s",
+ TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -411,9 +413,10 @@ Tcl_ReadObjCmd(
if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_READABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
- "\" wasn't opened for reading", NULL);
+ if (!(mode & TCL_READABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for reading",
+ TclGetString(chanObjPtr)));
return TCL_ERROR;
}
i++; /* Consumed channel name. */
@@ -436,11 +439,11 @@ Tcl_ReadObjCmd(
if (strcmp(TclGetString(objv[i]), "nonewline") != 0) {
#endif
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "expected non-negative integer but got \"",
- TclGetString(objv[i]), "\"", NULL);
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
- return TCL_ERROR;
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected non-negative integer but got \"%s\"",
+ TclGetString(objv[i])));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
+ return TCL_ERROR;
#if TCL_MAJOR_VERSION < 9
}
newline = 1;
@@ -460,10 +463,9 @@ Tcl_ReadObjCmd(
*/
if (!TclChanCaughtErrorBypass(interp, chan)) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "error reading \"",
- TclGetString(chanObjPtr), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error reading \"%s\": %s",
+ TclGetString(chanObjPtr), Tcl_PosixError(interp)));
}
Tcl_DecrRefCount(resultPtr);
return TCL_ERROR;
@@ -552,9 +554,9 @@ Tcl_SeekObjCmd(
*/
if (!TclChanCaughtErrorBypass(interp, chan)) {
- Tcl_AppendResult(interp, "error during seek on \"",
- TclGetString(objv[1]), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error during seek on \"%s\": %s",
+ TclGetString(objv[1]), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -679,9 +681,9 @@ Tcl_CloseObjCmd(
*/
if (!(dir & Tcl_GetChannelMode(chan))) {
- Tcl_AppendResult(interp, "Half-close of ", dirOptions[index],
- "-side not possible, side not opened or already closed",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Half-close of %s-side not possible, side not opened"
+ " or already closed", dirOptions[index]));
return TCL_ERROR;
}
@@ -977,9 +979,9 @@ Tcl_ExecObjCmd(
*/
if (!TclChanCaughtErrorBypass(interp, chan)) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "error reading output from command: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error reading output from command: %s",
+ Tcl_PosixError(interp)));
Tcl_DecrRefCount(resultPtr);
}
return TCL_ERROR;
@@ -1048,9 +1050,10 @@ Tcl_FblockedObjCmd(
if (TclGetChannelFromObj(interp, objv[1], &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_READABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", TclGetString(objv[1]),
- "\" wasn't opened for reading", NULL);
+ if (!(mode & TCL_READABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for reading",
+ TclGetString(objv[1])));
return TCL_ERROR;
}
@@ -1174,7 +1177,7 @@ Tcl_OpenObjCmd(
return TCL_ERROR;
}
Tcl_RegisterChannel(interp, chan);
- Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
return TCL_OK;
}
@@ -1479,8 +1482,8 @@ Tcl_SocketObjCmd(
switch ((enum socketOptions) optionIndex) {
case SKT_ASYNC:
if (server == 1) {
- Tcl_AppendResult(interp,
- "cannot set -async option for server sockets", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot set -async option for server sockets", -1));
return TCL_ERROR;
}
async = 1;
@@ -1488,8 +1491,8 @@ Tcl_SocketObjCmd(
case SKT_MYADDR:
a++;
if (a >= objc) {
- Tcl_AppendResult(interp,
- "no argument given for -myaddr option", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no argument given for -myaddr option", -1));
return TCL_ERROR;
}
myaddr = TclGetString(objv[a]);
@@ -1499,8 +1502,8 @@ Tcl_SocketObjCmd(
a++;
if (a >= objc) {
- Tcl_AppendResult(interp,
- "no argument given for -myport option", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no argument given for -myport option", -1));
return TCL_ERROR;
}
myPortName = TclGetString(objv[a]);
@@ -1511,15 +1514,15 @@ Tcl_SocketObjCmd(
}
case SKT_SERVER:
if (async == 1) {
- Tcl_AppendResult(interp,
- "cannot set -async option for server sockets", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot set -async option for server sockets", -1));
return TCL_ERROR;
}
server = 1;
a++;
if (a >= objc) {
- Tcl_AppendResult(interp,
- "no argument given for -server option", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no argument given for -server option", -1));
return TCL_ERROR;
}
script = TclGetString(objv[a]);
@@ -1531,8 +1534,8 @@ Tcl_SocketObjCmd(
if (server) {
host = myaddr; /* NULL implies INADDR_ANY */
if (myport != 0) {
- Tcl_AppendResult(interp, "option -myport is not valid for servers",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "option -myport is not valid for servers", -1));
return TCL_ERROR;
}
} else if (a < objc) {
@@ -1599,9 +1602,9 @@ Tcl_SocketObjCmd(
return TCL_ERROR;
}
}
- Tcl_RegisterChannel(interp, chan);
- Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);
+ Tcl_RegisterChannel(interp, chan);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
return TCL_OK;
}
@@ -1651,17 +1654,19 @@ Tcl_FcopyObjCmd(
if (TclGetChannelFromObj(interp, objv[1], &inChan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_READABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", TclGetString(objv[1]),
- "\" wasn't opened for reading", NULL);
+ if (!(mode & TCL_READABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for reading",
+ TclGetString(objv[1])));
return TCL_ERROR;
}
if (TclGetChannelFromObj(interp, objv[2], &outChan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
- if ((mode & TCL_WRITABLE) == 0) {
- Tcl_AppendResult(interp, "channel \"", TclGetString(objv[2]),
- "\" wasn't opened for writing", NULL);
+ if (!(mode & TCL_WRITABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for writing",
+ TclGetString(objv[2])));
return TCL_ERROR;
}
@@ -1745,14 +1750,14 @@ ChanPendingObjCmd(
switch ((enum options) index) {
case PENDING_INPUT:
- if ((mode & TCL_READABLE) == 0) {
+ if (!(mode & TCL_READABLE)) {
Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
} else {
Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_InputBuffered(chan)));
}
break;
case PENDING_OUTPUT:
- if ((mode & TCL_WRITABLE) == 0) {
+ if (!(mode & TCL_WRITABLE)) {
Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
} else {
Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_OutputBuffered(chan)));
@@ -1806,8 +1811,8 @@ ChanTruncateObjCmd(
return TCL_ERROR;
}
if (length < 0) {
- Tcl_AppendResult(interp,
- "cannot truncate to negative length of file", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot truncate to negative length of file", -1));
return TCL_ERROR;
}
} else {
@@ -1817,18 +1822,17 @@ ChanTruncateObjCmd(
length = Tcl_Tell(chan);
if (length == Tcl_WideAsLong(-1)) {
- Tcl_AppendResult(interp,
- "could not determine current location in \"",
- TclGetString(objv[1]), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not determine current location in \"%s\": %s",
+ TclGetString(objv[1]), Tcl_PosixError(interp)));
return TCL_ERROR;
}
}
if (Tcl_TruncateChannel(chan, length) != TCL_OK) {
- Tcl_AppendResult(interp, "error during truncate on \"",
- TclGetString(objv[1]), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error during truncate on \"%s\": %s",
+ TclGetString(objv[1]), Tcl_PosixError(interp)));
return TCL_ERROR;
}
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index 6f80c25..bfe6a10 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -284,8 +284,8 @@ TclChannelTransform(
dataPtr->self = Tcl_StackChannel(interp, &transformChannelType, dataPtr,
mode, chan);
if (dataPtr->self == NULL) {
- Tcl_AppendResult(interp, "\nfailed to stack channel \"",
- Tcl_GetChannelName(chan), "\"", NULL);
+ Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp),
+ "\nfailed to stack channel \"%s\"", Tcl_GetChannelName(chan));
Tcl_DecrRefCount(dataPtr->command);
ResultClear(&dataPtr->result);
ckfree(dataPtr);
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 6fec40a..a354d60 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -404,25 +404,25 @@ static int ForwardProc(Tcl_Event *evPtr, int mask);
static void SrcExitProc(ClientData clientData);
#define FreeReceivedError(p) \
- if ((p)->base.mustFree) { \
- ckfree((p)->base.msgStr); \
+ if ((p)->base.mustFree) { \
+ ckfree((p)->base.msgStr); \
}
#define PassReceivedErrorInterp(i,p) \
- if ((i) != NULL) { \
- Tcl_SetChannelErrorInterp((i), \
- Tcl_NewStringObj((p)->base.msgStr, -1)); \
- } \
+ if ((i) != NULL) { \
+ Tcl_SetChannelErrorInterp((i), \
+ Tcl_NewStringObj((p)->base.msgStr, -1)); \
+ } \
FreeReceivedError(p)
#define PassReceivedError(c,p) \
Tcl_SetChannelError((c), Tcl_NewStringObj((p)->base.msgStr, -1)); \
FreeReceivedError(p)
#define ForwardSetStaticError(p,emsg) \
- (p)->base.code = TCL_ERROR; \
- (p)->base.mustFree = 0; \
+ (p)->base.code = TCL_ERROR; \
+ (p)->base.mustFree = 0; \
(p)->base.msgStr = (char *) (emsg)
#define ForwardSetDynamicError(p,emsg) \
- (p)->base.code = TCL_ERROR; \
- (p)->base.mustFree = 1; \
+ (p)->base.code = TCL_ERROR; \
+ (p)->base.mustFree = 1; \
(p)->base.msgStr = (char *) (emsg)
static void ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr);
@@ -739,7 +739,8 @@ TclChanCreateObjCmd(
* Return handle as result of command.
*/
- Tcl_SetResult(interp, (char *)chanPtr->state->channelName, TCL_VOLATILE);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(chanPtr->state->channelName, -1));
return TCL_OK;
error:
@@ -774,13 +775,15 @@ TclChanCreateObjCmd(
*/
typedef struct ReflectEvent {
- Tcl_Event header;
- ReflectedChannel* rcPtr;
- int events;
+ Tcl_Event header;
+ ReflectedChannel *rcPtr;
+ int events;
} ReflectEvent;
static int
-ReflectEventRun (Tcl_Event* ev, int flags)
+ReflectEventRun(
+ Tcl_Event *ev,
+ int flags)
{
/* OWNER thread
*
@@ -789,14 +792,16 @@ ReflectEventRun (Tcl_Event* ev, int flags)
* accomplishing that.
*/
- ReflectEvent* e = (ReflectEvent*) ev;
+ ReflectEvent *e = (ReflectEvent *) ev;
- Tcl_NotifyChannel (e->rcPtr->chan, e->events);
+ Tcl_NotifyChannel(e->rcPtr->chan, e->events);
return 1;
}
static int
-ReflectEventDelete (Tcl_Event* ev, ClientData cd)
+ReflectEventDelete(
+ Tcl_Event *ev,
+ ClientData cd)
{
/* OWNER thread
*
@@ -805,11 +810,9 @@ ReflectEventDelete (Tcl_Event* ev, ClientData cd)
* invalid channel.
*/
- ReflectEvent* e = (ReflectEvent*) ev;
+ ReflectEvent *e = (ReflectEvent *) ev;
- if ((ev->proc != ReflectEventRun) ||
- ((cd != NULL) &&
- (cd != e->rcPtr))) {
+ if ((ev->proc != ReflectEventRun) || ((cd != NULL) && (cd != e->rcPtr))) {
return 0;
}
return 1;
@@ -867,8 +870,8 @@ TclChanPostEventObjCmd(
hPtr = Tcl_FindHashEntry(&rcmPtr->map, chanId);
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "can not find reflected channel named \"",
- chanId, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can not find reflected channel named \"%s\"", chanId));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanId, NULL);
return TCL_ERROR;
}
@@ -925,8 +928,9 @@ TclChanPostEventObjCmd(
*/
if (events & ~rcPtr->interest) {
- Tcl_AppendResult(interp, "tried to post events channel \"", chanId,
- "\" is not interested in", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "tried to post events channel \"%s\" is not interested in",
+ chanId));
return TCL_ERROR;
}
@@ -937,10 +941,11 @@ TclChanPostEventObjCmd(
#ifdef TCL_THREADS
if (rcPtr->owner == rcPtr->thread) {
#endif
- Tcl_NotifyChannel (chan, events);
+ Tcl_NotifyChannel(chan, events);
#ifdef TCL_THREADS
} else {
- ReflectEvent* ev = ckalloc (sizeof (ReflectEvent));
+ ReflectEvent *ev = ckalloc(sizeof(ReflectEvent));
+
ev->header.proc = ReflectEventRun;
ev->events = events;
ev->rcPtr = rcPtr;
@@ -957,7 +962,8 @@ TclChanPostEventObjCmd(
* The teardown of unprocessed events is currently coupled to the
* thread reflected channel map
*/
- (void) GetThreadReflectedChannelMap ();
+
+ (void) GetThreadReflectedChannelMap();
/* XXX Race condition !!
* XXX The destination thread may not exist anymore already.
@@ -965,8 +971,9 @@ TclChanPostEventObjCmd(
* XXX Can we detect this ? (check the validity of the owner threadid ?)
* XXX Actually, in that case the channel should be dead also !
*/
- Tcl_ThreadQueueEvent (rcPtr->owner, (Tcl_Event*) ev, TCL_QUEUE_TAIL);
- Tcl_ThreadAlert (rcPtr->owner);
+
+ Tcl_ThreadQueueEvent(rcPtr->owner, (Tcl_Event *) ev, TCL_QUEUE_TAIL);
+ Tcl_ThreadAlert(rcPtr->owner);
}
#endif
@@ -1156,8 +1163,11 @@ ReflectClose(
ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p);
result = p.base.code;
- /* Now squash the pending reflection events for this channel. */
- Tcl_DeleteEvents (ReflectEventDelete, rcPtr);
+ /*
+ * Now squash the pending reflection events for this channel.
+ */
+
+ Tcl_DeleteEvents(ReflectEventDelete, rcPtr);
if (result != TCL_OK) {
FreeReceivedError(&p);
@@ -1165,7 +1175,7 @@ ReflectClose(
}
#endif
- Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
+ Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
return EOK;
}
@@ -1177,7 +1187,7 @@ ReflectClose(
*/
if (rcPtr->methods == 0) {
- Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
+ Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
return EOK;
}
@@ -1192,10 +1202,13 @@ ReflectClose(
ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p);
result = p.base.code;
- /* Now squash the pending reflection events for this channel. */
- Tcl_DeleteEvents (ReflectEventDelete, rcPtr);
+ /*
+ * Now squash the pending reflection events for this channel.
+ */
- Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
+ Tcl_DeleteEvents(ReflectEventDelete, rcPtr);
+
+ Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
if (result != TCL_OK) {
PassReceivedErrorInterp(interp, &p);
@@ -1240,7 +1253,7 @@ ReflectClose(
}
#endif
- Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
+ Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
#ifdef TCL_THREADS
}
#endif
@@ -1348,7 +1361,7 @@ ReflectInput(
*errorCodePtr = EOK;
if (bytec > 0) {
- memcpy(buf, bytev, (size_t)bytec);
+ memcpy(buf, bytev, (size_t) bytec);
}
stop:
@@ -1549,12 +1562,13 @@ ReflectSeekWide(
Tcl_Preserve(rcPtr);
offObj = Tcl_NewWideIntObj(offset);
- baseObj = Tcl_NewStringObj((seekMode == SEEK_SET) ? "start" :
- ((seekMode == SEEK_CUR) ? "current" : "end"), -1);
+ baseObj = Tcl_NewStringObj(
+ (seekMode == SEEK_SET) ? "start" :
+ (seekMode == SEEK_CUR) ? "current" : "end", -1);
Tcl_IncrRefCount(offObj);
Tcl_IncrRefCount(baseObj);
- if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK) {
+ if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj) != TCL_OK) {
Tcl_SetChannelError(rcPtr->chan, resObj);
goto invalid;
}
@@ -1772,7 +1786,7 @@ ReflectThread(ClientData clientData, int action)
rcPtr->owner = NULL;
break;
default:
- Tcl_Panic ("Unknown thread action code.");
+ Tcl_Panic("Unknown thread action code.");
break;
}
}
@@ -2046,7 +2060,8 @@ EncodeEventMask(
}
if (listc < 1) {
- Tcl_AppendResult(interp, "bad ", objName, " list: is empty", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad %s list: is empty", objName));
return TCL_ERROR;
}
@@ -2807,7 +2822,7 @@ DeleteThreadReflectedChannelMap(
* actually.
*/
- Tcl_DeleteEvents (ReflectEventDelete, NULL);
+ Tcl_DeleteEvents(ReflectEventDelete, NULL);
/*
* Get the map of all channels handled by the current thread. This is a
@@ -2978,9 +2993,8 @@ ForwardProc(
Tcl_Interp *interp = rcPtr->interp;
ForwardParam *paramPtr = evPtr->param;
Tcl_Obj *resObj = NULL; /* Interp result of InvokeTclMethod */
- ReflectedChannelMap *rcmPtr;
- /* Map of reflected channels with handlers in
- * this interp. */
+ ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
+ * this interp. */
Tcl_HashEntry *hPtr; /* Entry in the above map */
/*
@@ -3023,12 +3037,12 @@ ForwardProc(
rcmPtr = GetReflectedChannelMap(interp);
hPtr = Tcl_FindHashEntry(&rcmPtr->map,
- Tcl_GetChannelName(rcPtr->chan));
+ Tcl_GetChannelName(rcPtr->chan));
Tcl_DeleteHashEntry(hPtr);
rcmPtr = GetThreadReflectedChannelMap();
hPtr = Tcl_FindHashEntry(&rcmPtr->map,
- Tcl_GetChannelName(rcPtr->chan));
+ Tcl_GetChannelName(rcPtr->chan));
Tcl_DeleteHashEntry(hPtr);
FreeReflectedChannelArgs(rcPtr);
@@ -3063,7 +3077,7 @@ ForwardProc(
paramPtr->input.toRead = -1;
} else {
if (bytec > 0) {
- memcpy(paramPtr->input.buf, bytev, (size_t)bytec);
+ memcpy(paramPtr->input.buf, bytev, (size_t) bytec);
}
paramPtr->input.toRead = bytec;
}
@@ -3075,7 +3089,7 @@ ForwardProc(
case ForwardedOutput: {
Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
- paramPtr->output.buf, paramPtr->output.toWrite);
+ paramPtr->output.buf, paramPtr->output.toWrite);
Tcl_IncrRefCount(bufObj);
Tcl_Preserve(rcPtr);
@@ -3115,8 +3129,8 @@ ForwardProc(
case ForwardedSeek: {
Tcl_Obj *offObj = Tcl_NewWideIntObj(paramPtr->seek.offset);
Tcl_Obj *baseObj = Tcl_NewStringObj(
- (paramPtr->seek.seekMode==SEEK_SET) ? "start" :
- (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1);
+ (paramPtr->seek.seekMode==SEEK_SET) ? "start" :
+ (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1);
Tcl_IncrRefCount(offObj);
Tcl_IncrRefCount(baseObj);
@@ -3166,11 +3180,11 @@ ForwardProc(
case ForwardedBlock: {
Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking);
- Tcl_IncrRefCount(blockObj);
+ Tcl_IncrRefCount(blockObj);
Tcl_Preserve(rcPtr);
if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL,
- &resObj) != TCL_OK) {
+ &resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
}
Tcl_Release(rcPtr);
@@ -3186,7 +3200,7 @@ ForwardProc(
Tcl_IncrRefCount(valueObj);
Tcl_Preserve(rcPtr);
if (InvokeTclMethod(rcPtr, "configure", optionObj, valueObj,
- &resObj) != TCL_OK) {
+ &resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
}
Tcl_Release(rcPtr);
@@ -3201,8 +3215,8 @@ ForwardProc(
*/
Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1);
- Tcl_IncrRefCount(optionObj);
+ Tcl_IncrRefCount(optionObj);
Tcl_Preserve(rcPtr);
if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){
ForwardSetObjError(paramPtr, resObj);
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index 8f111b0..2b9efb9 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -363,33 +363,43 @@ static int ForwardProc(Tcl_Event *evPtr, int mask);
static void SrcExitProc(ClientData clientData);
#define FreeReceivedError(p) \
- if ((p)->base.mustFree) { \
- ckfree((p)->base.msgStr); \
- }
+ do { \
+ if ((p)->base.mustFree) { \
+ ckfree((p)->base.msgStr); \
+ } \
+ } while (0)
#define PassReceivedErrorInterp(i,p) \
- if ((i) != NULL) { \
- Tcl_SetChannelErrorInterp((i), \
- Tcl_NewStringObj((p)->base.msgStr, -1)); \
- } \
- FreeReceivedError(p)
+ do { \
+ if ((i) != NULL) { \
+ Tcl_SetChannelErrorInterp((i), \
+ Tcl_NewStringObj((p)->base.msgStr, -1)); \
+ } \
+ FreeReceivedError(p); \
+ } while (0)
#define PassReceivedError(c,p) \
- Tcl_SetChannelError((c), Tcl_NewStringObj((p)->base.msgStr, -1)); \
- FreeReceivedError(p)
+ do { \
+ Tcl_SetChannelError((c), \
+ Tcl_NewStringObj((p)->base.msgStr, -1)); \
+ FreeReceivedError(p); \
+ } while (0)
#define ForwardSetStaticError(p,emsg) \
- (p)->base.code = TCL_ERROR; \
- (p)->base.mustFree = 0; \
- (p)->base.msgStr = (char *) (emsg)
+ do { \
+ (p)->base.code = TCL_ERROR; \
+ (p)->base.mustFree = 0; \
+ (p)->base.msgStr = (char *) (emsg); \
+ } while (0)
#define ForwardSetDynamicError(p,emsg) \
- (p)->base.code = TCL_ERROR; \
- (p)->base.mustFree = 1; \
- (p)->base.msgStr = (char *) (emsg)
+ do { \
+ (p)->base.code = TCL_ERROR; \
+ (p)->base.mustFree = 1; \
+ (p)->base.msgStr = (char *) (emsg); \
+ } while (0)
static void ForwardSetObjError(ForwardParam *p,
Tcl_Obj *objPtr);
-
static ReflectedTransformMap * GetThreadReflectedTransformMap(void);
-static void DeleteThreadReflectedTransformMap(ClientData clientData);
-
+static void DeleteThreadReflectedTransformMap(
+ ClientData clientData);
#endif /* TCL_THREADS */
#define SetChannelErrorStr(c,msgStr) \
@@ -513,7 +523,6 @@ TclChanPushObjCmd(
int result; /* Result code for 'initialize' */
Tcl_Obj *resObj; /* Result data for 'initialize' */
int methods; /* Bitmask for supported methods. */
- Tcl_Obj *err; /* Error message */
ReflectedTransformMap *rtmPtr;
/* Map of reflected transforms with handlers
* in this interp. */
@@ -608,11 +617,10 @@ TclChanPushObjCmd(
while (listc > 0) {
if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames,
"method", TCL_EXACT, &methIndex) != TCL_OK) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, " initialize\" returned ", -1);
- Tcl_AppendObjToObj(err, Tcl_GetObjResult(interp));
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s initialize\" returned %s",
+ Tcl_GetString(cmdObj),
+ Tcl_GetString(Tcl_GetObjResult(interp))));
Tcl_DecrRefCount(resObj);
goto error;
}
@@ -695,13 +703,14 @@ TclChanPushObjCmd(
rtmPtr = GetThreadReflectedTransformMap();
hPtr = Tcl_CreateHashEntry(&rtmPtr->map, Tcl_GetString(rtId), &isNew);
Tcl_SetHashValue(hPtr, rtPtr);
-#endif
+#endif /* TCL_THREADS */
/*
* Return the channel as the result of the command.
*/
- Tcl_AppendResult(interp, Tcl_GetChannelName(rtPtr->chan), NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ Tcl_GetChannelName(rtPtr->chan), -1));
return TCL_OK;
error:
@@ -710,7 +719,7 @@ TclChanPushObjCmd(
* structure.
*/
- Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
+ Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
return TCL_ERROR;
#undef CHAN
@@ -913,9 +922,9 @@ ReflectClose(
FreeReceivedError(&p);
}
}
-#endif
+#endif /* TCL_THREADS */
- Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
+ Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
return EOK;
}
@@ -931,11 +940,11 @@ ReflectClose(
if (!TransformDrain(rtPtr, &errorCode)) {
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
- Tcl_EventuallyFree (rtPtr,
+ Tcl_EventuallyFree(rtPtr,
(Tcl_FreeProc *) FreeReflectedTransform);
return errorCode;
}
-#endif
+#endif /* TCL_THREADS */
errorCodeSet = 1;
goto cleanup;
}
@@ -945,11 +954,11 @@ ReflectClose(
if (!TransformFlush(rtPtr, &errorCode, FLUSH_WRITE)) {
#ifdef TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
- Tcl_EventuallyFree (rtPtr,
+ Tcl_EventuallyFree(rtPtr,
(Tcl_FreeProc *) FreeReflectedTransform);
return errorCode;
}
-#endif
+#endif /* TCL_THREADS */
errorCodeSet = 1;
goto cleanup;
}
@@ -966,7 +975,7 @@ ReflectClose(
ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
result = p.base.code;
- Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
+ Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
if (result != TCL_OK) {
PassReceivedErrorInterp(interp, &p);
@@ -974,7 +983,7 @@ ReflectClose(
}
return EOK;
}
-#endif
+#endif /* TCL_THREADS */
/*
* Do the actual invokation of "finalize" now; we're in the right thread.
@@ -1022,7 +1031,7 @@ ReflectClose(
if (hPtr) {
Tcl_DeleteHashEntry(hPtr);
}
-#endif
+#endif /* TCL_THREADS */
}
Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
@@ -1348,7 +1357,7 @@ ReflectSeekWide(
* transformation.
*/
- if ((rtPtr->methods & FLAG(METH_CLEAR))) {
+ if (rtPtr->methods & FLAG(METH_CLEAR)) {
TransformClear(rtPtr);
}
@@ -2140,7 +2149,7 @@ DeleteReflectedTransformMap(
ForwardingResult *resultPtr;
ForwardingEvent *evPtr;
ForwardParam *paramPtr;
-#endif
+#endif /* TCL_THREADS */
/*
* Delete all entries. The channels may have been closed already, or will
@@ -2232,8 +2241,7 @@ DeleteReflectedTransformMap(
Tcl_ConditionNotify(&resultPtr->done);
}
Tcl_MutexUnlock(&rtForwardMutex);
-
-#endif
+#endif /* TCL_THREADS */
}
#ifdef TCL_THREADS
@@ -2631,7 +2639,7 @@ ForwardProc(
break;
}
- case ForwardedDrain: {
+ case ForwardedDrain:
if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
paramPtr->transform.size = -1;
@@ -2656,9 +2664,8 @@ ForwardProc(
}
}
break;
- }
- case ForwardedFlush: {
+ case ForwardedFlush:
if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
paramPtr->transform.size = -1;
@@ -2684,12 +2691,10 @@ ForwardProc(
}
}
break;
- }
- case ForwardedClear: {
+ case ForwardedClear:
(void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL);
break;
- }
case ForwardedLimit:
if (InvokeTclMethod(rtPtr, "limit?", NULL, NULL, &resObj) != TCL_OK) {
@@ -2795,7 +2800,7 @@ ForwardSetObjError(
ForwardSetDynamicError(paramPtr, ckalloc(len));
memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
}
-#endif
+#endif /* TCL_THREADS */
/*
*----------------------------------------------------------------------
@@ -3092,7 +3097,7 @@ TransformRead(
ckfree(p.transform.buf);
return 1;
}
-#endif
+#endif /* TCL_THREADS */
/* ASSERT: rtPtr->method & FLAG(METH_READ) */
/* ASSERT: rtPtr->mode & TCL_READABLE */
@@ -3153,7 +3158,7 @@ TransformWrite(
p.transform.size);
ckfree(p.transform.buf);
} else
-#endif
+#endif /* TCL_THREADS */
{
/* ASSERT: rtPtr->method & FLAG(METH_WRITE) */
/* ASSERT: rtPtr->mode & TCL_WRITABLE */
@@ -3215,7 +3220,7 @@ TransformDrain(
ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size);
ckfree(p.transform.buf);
} else
-#endif
+#endif /* TCL_THREADS */
{
if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj)!=TCL_OK) {
Tcl_SetChannelError(rtPtr->chan, resObj);
@@ -3270,7 +3275,7 @@ TransformFlush(
}
ckfree(p.transform.buf);
} else
-#endif
+#endif /* TCL_THREADS */
{
if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj)!=TCL_OK) {
Tcl_SetChannelError(rtPtr->chan, resObj);
@@ -3311,7 +3316,7 @@ TransformClear(
ForwardOpToOwnerThread(rtPtr, ForwardedClear, &p);
return;
}
-#endif
+#endif /* TCL_THREADS */
/* ASSERT: rtPtr->method & FLAG(METH_READ) */
/* ASSERT: rtPtr->mode & TCL_READABLE */
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 018f9f5..e603c91 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -64,8 +64,8 @@ TclSockGetPort(
return TCL_ERROR;
}
if (*portPtr > 0xFFFF) {
- Tcl_AppendResult(interp, "couldn't open socket: port number too high",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "couldn't open socket: port number too high", -1));
return TCL_ERROR;
}
return TCL_OK;
@@ -100,16 +100,20 @@ TclSockMinimumBuffers(
socklen_t len;
len = sizeof(int);
- getsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_SNDBUF, (char *)&current, &len);
+ getsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_SNDBUF,
+ (char *) &current, &len);
if (current < size) {
len = sizeof(int);
- setsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_SNDBUF, (char *)&size, len);
+ setsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_SNDBUF,
+ (char *) &size, len);
}
len = sizeof(int);
- getsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_RCVBUF, (char *)&current, &len);
+ getsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_RCVBUF,
+ (char *) &current, &len);
if (current < size) {
len = sizeof(int);
- setsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_RCVBUF, (char *)&size, len);
+ setsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_RCVBUF,
+ (char *) &size, len);
}
return TCL_OK;
}
@@ -152,19 +156,18 @@ TclCreateSocketAddress(
Tcl_DString ds;
int result, i;
- TclFormatInt(portstring, port);
-
if (host != NULL) {
native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
}
-
+ TclFormatInt(portstring, port);
(void) memset(&hints, 0, sizeof(hints));
-
hints.ai_family = AF_UNSPEC;
+
/*
* Magic variable to enforce a certain address family - to be superseded
* by a TIP that adds explicit switches to [socket]
*/
+
if (interp != NULL) {
family = Tcl_GetVar(interp, "::tcl::unsupported::socketAF", 0);
if (family != NULL) {
@@ -182,7 +185,7 @@ TclCreateSocketAddress(
/*
* We found some problems when using AI_ADDRCONFIG, e.g. on systems that
* have no networking besides the loopback interface and want to resolve
- * localhost. See bugs 3385024, 3382419, 3382431. As the advantage of
+ * localhost. See [Bugs 3385024, 3382419, 3382431]. As the advantage of
* using AI_ADDRCONFIG in situations where it works, is probably low,
* we'll leave it out for now. After all, it is just an optimisation.
*
@@ -206,12 +209,11 @@ TclCreateSocketAddress(
}
if (result != 0) {
-#ifdef EAI_SYSTEM /* Doesn't exist on Windows */
- if (result == EAI_SYSTEM)
- *errorMsgPtr = Tcl_PosixError(interp);
- else
-#endif
- *errorMsgPtr = gai_strerror(result);
+ *errorMsgPtr =
+#ifdef EAI_SYSTEM /* Doesn't exist on Windows */
+ (result == EAI_SYSTEM) ? Tcl_PosixError(interp) :
+#endif /* EAI_SYSTEM */
+ gai_strerror(result);
return 0;
}
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 41a5aac..115c132 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -1094,8 +1094,9 @@ Tcl_FSMatchInDirectory(
cwd = Tcl_FSGetCwd(NULL);
if (cwd == NULL) {
if (interp != NULL) {
- Tcl_SetResult(interp, "glob couldn't determine "
- "the current working directory", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "glob couldn't determine the current working directory",
+ -1));
}
return TCL_ERROR;
}
@@ -1572,8 +1573,8 @@ TclGetOpenModeEx(
*seekFlagPtr = 0;
*binaryPtr = 0;
if (interp != NULL) {
- Tcl_AppendResult(interp, "illegal access mode \"", modeString,
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "illegal access mode \"%s\"", modeString));
}
return -1;
}
@@ -1622,8 +1623,9 @@ TclGetOpenModeEx(
mode |= O_NOCTTY;
#else
if (interp != NULL) {
- Tcl_AppendResult(interp, "access mode \"", flag,
- "\" not supported by this system", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "access mode \"%s\" not supported by this system",
+ flag));
}
ckfree(modeArgv);
return -1;
@@ -1634,8 +1636,9 @@ TclGetOpenModeEx(
mode |= O_NONBLOCK;
#else
if (interp != NULL) {
- Tcl_AppendResult(interp, "access mode \"", flag,
- "\" not supported by this system", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "access mode \"%s\" not supported by this system",
+ flag));
}
ckfree(modeArgv);
return -1;
@@ -1648,9 +1651,10 @@ TclGetOpenModeEx(
} else {
if (interp != NULL) {
- Tcl_AppendResult(interp, "invalid access mode \"", flag,
- "\": must be RDONLY, WRONLY, RDWR, APPEND, BINARY, "
- "CREAT, EXCL, NOCTTY, NONBLOCK, or TRUNC", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid access mode \"%s\": must be RDONLY, WRONLY, "
+ "RDWR, APPEND, BINARY, CREAT, EXCL, NOCTTY, NONBLOCK,"
+ " or TRUNC", flag));
}
ckfree(modeArgv);
return -1;
@@ -1661,8 +1665,9 @@ TclGetOpenModeEx(
if (!gotRW) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "access mode must include either"
- " RDONLY, WRONLY, or RDWR", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "access mode must include either RDONLY, WRONLY, or RDWR",
+ -1));
}
return -1;
}
@@ -1721,15 +1726,16 @@ Tcl_FSEvalFileEx(
if (Tcl_FSStat(pathPtr, &statBuf) == -1) {
Tcl_SetErrno(errno);
- Tcl_AppendResult(interp, "couldn't read file \"",
- Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read file \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
return result;
}
chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644);
if (chan == NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't read file \"",
- Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read file \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
return result;
}
@@ -1763,8 +1769,9 @@ Tcl_FSEvalFileEx(
if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) {
Tcl_Close(interp, chan);
- Tcl_AppendResult(interp, "couldn't read file \"",
- Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read file \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
goto end;
}
string = Tcl_GetString(objPtr);
@@ -1777,8 +1784,9 @@ Tcl_FSEvalFileEx(
if (Tcl_ReadChars(chan, objPtr, -1,
memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
Tcl_Close(interp, chan);
- Tcl_AppendResult(interp, "couldn't read file \"",
- Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read file \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
goto end;
}
@@ -1852,15 +1860,16 @@ TclNREvalFile(
if (Tcl_FSStat(pathPtr, &statBuf) == -1) {
Tcl_SetErrno(errno);
- Tcl_AppendResult(interp, "couldn't read file \"",
- Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read file \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
return TCL_ERROR;
}
chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644);
if (chan == NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't read file \"",
- Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read file \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -1894,8 +1903,9 @@ TclNREvalFile(
if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) {
Tcl_Close(interp, chan);
- Tcl_AppendResult(interp, "couldn't read file \"",
- Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read file \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
Tcl_DecrRefCount(objPtr);
return TCL_ERROR;
}
@@ -1909,8 +1919,9 @@ TclNREvalFile(
if (Tcl_ReadChars(chan, objPtr, -1,
memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
Tcl_Close(interp, chan);
- Tcl_AppendResult(interp, "couldn't read file \"",
- Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read file \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
Tcl_DecrRefCount(objPtr);
return TCL_ERROR;
}
@@ -2246,9 +2257,9 @@ Tcl_FSOpenFileChannel(
if (seekFlag && Tcl_Seek(retVal, (Tcl_WideInt) 0, SEEK_END)
< (Tcl_WideInt) 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not seek to end of file "
- "while opening \"", Tcl_GetString(pathPtr), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not seek to end of file while opening \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
}
Tcl_Close(NULL, retVal);
return NULL;
@@ -2265,8 +2276,9 @@ Tcl_FSOpenFileChannel(
Tcl_SetErrno(ENOENT);
if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't open \"", Tcl_GetString(pathPtr),
- "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't open \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
}
return NULL;
}
@@ -2684,9 +2696,9 @@ Tcl_FSGetCwd(
Disclaim();
goto cdDidNotChange;
} else if (interp != NULL) {
- Tcl_AppendResult(interp,
- "error getting working directory name: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error getting working directory name: %s",
+ Tcl_PosixError(interp)));
}
}
Disclaim();
@@ -2760,9 +2772,9 @@ Tcl_FSGetCwd(
retCd = proc2(tsdPtr->cwdClientData);
if (retCd == NULL && interp != NULL) {
- Tcl_AppendResult(interp,
- "error getting working directory name: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error getting working directory name: %s",
+ Tcl_PosixError(interp)));
}
if (retCd == tsdPtr->cwdClientData) {
@@ -3152,8 +3164,9 @@ Tcl_LoadFile(
*/
if (Tcl_FSAccess(pathPtr, R_OK) != 0) {
- Tcl_AppendResult(interp, "couldn't load library \"",
- Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't load library \"%s\": %s",
+ Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -3203,7 +3216,7 @@ Tcl_LoadFile(
mustCopyToTempAnyway:
Tcl_ResetResult(interp);
-#endif
+#endif /* TCL_LOAD_FROM_MEMORY */
/*
* Get a temporary filename to use, first to copy the file into, and then
@@ -3223,8 +3236,8 @@ Tcl_LoadFile(
Tcl_FSDeleteFile(copyToPtr);
Tcl_DecrRefCount(copyToPtr);
- Tcl_AppendResult(interp, "couldn't load from current filesystem",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "couldn't load from current filesystem", -1));
return TCL_ERROR;
}
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 85e0730..731d759 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -600,8 +600,9 @@ PrefixMatchObjCmd(
flags |= TCL_EXACT;
break;
case PRFMATCH_MESSAGE:
- if (i > (objc - 4)) {
- Tcl_AppendResult(interp, "missing message", NULL);
+ if (i > objc-4) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "missing value for -message", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL);
return TCL_ERROR;
}
@@ -610,7 +611,8 @@ PrefixMatchObjCmd(
break;
case PRFMATCH_ERROR:
if (i > objc-4) {
- Tcl_AppendResult(interp, "missing error options", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "missing value for -error", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL);
return TCL_ERROR;
}
@@ -620,8 +622,9 @@ PrefixMatchObjCmd(
return TCL_ERROR;
}
if ((errorLength % 2) != 0) {
- Tcl_AppendResult(interp, "error options must have an even"
- " number of elements", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "error options must have an even number of elements",
+ -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
return TCL_ERROR;
}
@@ -1174,8 +1177,8 @@ Tcl_ParseArgsObjv(
goto gotMatch;
}
if (matchPtr != NULL) {
- Tcl_AppendResult(interp, "ambiguous option \"", str, "\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "ambiguous option \"%s\"", str));
goto error;
}
matchPtr = infoPtr;
@@ -1187,8 +1190,8 @@ Tcl_ParseArgsObjv(
*/
if (remObjv == NULL) {
- Tcl_AppendResult(interp, "unrecognized argument \"", str,
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unrecognized argument \"%s\"", str));
goto error;
}
@@ -1213,9 +1216,9 @@ Tcl_ParseArgsObjv(
}
if (Tcl_GetIntFromObj(interp, objv[srcIndex],
(int *) infoPtr->dstPtr) == TCL_ERROR) {
- Tcl_AppendResult(interp, "expected integer argument for \"",
- infoPtr->keyStr, "\" but got \"",
- Tcl_GetString(objv[srcIndex]), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer argument for \"%s\" but got \"%s\"",
+ infoPtr->keyStr, Tcl_GetString(objv[srcIndex])));
goto error;
}
srcIndex++;
@@ -1246,9 +1249,9 @@ Tcl_ParseArgsObjv(
}
if (Tcl_GetDoubleFromObj(interp, objv[srcIndex],
(double *) infoPtr->dstPtr) == TCL_ERROR) {
- Tcl_AppendResult(interp, "expected floating-point argument ",
- "for \"", infoPtr->keyStr, "\" but got \"",
- Tcl_GetString(objv[srcIndex]), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected floating-point argument for \"%s\" but got \"%s\"",
+ infoPtr->keyStr, Tcl_GetString(objv[srcIndex])));
goto error;
}
srcIndex++;
@@ -1322,8 +1325,8 @@ Tcl_ParseArgsObjv(
*/
missingArg:
- Tcl_AppendResult(interp, "\"", str,
- "\" option requires an additional argument", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" option requires an additional argument", str));
error:
if (leftovers != NULL) {
ckfree(leftovers);
@@ -1361,6 +1364,7 @@ PrintUsage(
#define NUM_SPACES 20
static const char spaces[] = " ";
char tmp[TCL_DOUBLE_SPACE];
+ Tcl_Obj *msg;
/*
* First, compute the width of the widest option key, so that we can make
@@ -1384,39 +1388,39 @@ PrintUsage(
* Now add the option information, with pretty-printing.
*/
- Tcl_AppendResult(interp, "Command-specific options:", NULL);
+ msg = Tcl_NewStringObj("Command-specific options:", -1);
for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) {
if ((infoPtr->type == TCL_ARGV_HELP) && (infoPtr->keyStr == NULL)) {
- Tcl_AppendResult(interp, "\n", infoPtr->helpStr, NULL);
+ Tcl_AppendPrintfToObj(msg, "\n%s", infoPtr->helpStr);
continue;
}
- Tcl_AppendResult(interp, "\n ", infoPtr->keyStr, ":", NULL);
+ Tcl_AppendPrintfToObj(msg, "\n %s:", infoPtr->keyStr);
numSpaces = width + 1 - strlen(infoPtr->keyStr);
while (numSpaces > 0) {
if (numSpaces >= NUM_SPACES) {
- Tcl_AppendResult(interp, spaces, NULL);
+ Tcl_AppendToObj(msg, spaces, NUM_SPACES);
} else {
- Tcl_AppendResult(interp, spaces+NUM_SPACES-numSpaces, NULL);
+ Tcl_AppendToObj(msg, spaces, numSpaces);
}
numSpaces -= NUM_SPACES;
}
- Tcl_AppendResult(interp, infoPtr->helpStr, NULL);
+ Tcl_AppendToObj(msg, infoPtr->helpStr, -1);
switch (infoPtr->type) {
case TCL_ARGV_INT:
- sprintf(tmp, "%d", *((int *) infoPtr->dstPtr));
- Tcl_AppendResult(interp, "\n\t\tDefault value: ", tmp, NULL);
+ Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %d",
+ *((int *) infoPtr->dstPtr));
break;
case TCL_ARGV_FLOAT:
+ Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %g",
+ *((double *) infoPtr->dstPtr));
sprintf(tmp, "%g", *((double *) infoPtr->dstPtr));
- Tcl_AppendResult(interp, "\n\t\tDefault value: ", tmp, NULL);
break;
case TCL_ARGV_STRING: {
- char *string;
+ char *string = *((char **) infoPtr->dstPtr);
- string = *((char **) infoPtr->dstPtr);
if (string != NULL) {
- Tcl_AppendResult(interp, "\n\t\tDefault value: \"", string,
- "\"", NULL);
+ Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: \"%s\"",
+ string);
}
break;
}
@@ -1424,6 +1428,7 @@ PrintUsage(
break;
}
}
+ Tcl_SetObjResult(interp, msg);
}
/*
@@ -1435,8 +1440,8 @@ PrintUsage(
*
* Results:
* Returns TCL_ERROR if the value is an invalid completion code.
- * Otherwise, returns TCL_OK, and writes the completion code to
- * the pointer provided.
+ * Otherwise, returns TCL_OK, and writes the completion code to the
+ * pointer provided.
*
* Side effects:
* None.
@@ -1448,30 +1453,30 @@ int
TclGetCompletionCodeFromObj(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *value,
- int *code) /* Argument objects. */
+ int *codePtr) /* Argument objects. */
{
static const char *const returnCodes[] = {
"ok", "error", "return", "break", "continue", NULL
};
if ((value->typePtr != &indexType)
- && (TCL_OK == TclGetIntFromObj(NULL, value, code))) {
+ && TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) {
return TCL_OK;
}
- if (TCL_OK == Tcl_GetIndexFromObj(NULL, value, returnCodes, NULL,
- TCL_EXACT, code)) {
+ if (Tcl_GetIndexFromObj(NULL, value, returnCodes, NULL, TCL_EXACT,
+ codePtr) == TCL_OK) {
return TCL_OK;
}
+
/*
* Value is not a legal completion code.
*/
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad completion code \"",
- TclGetString(value),
- "\": must be ok, error, return, break, "
- "continue, or an integer", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad completion code \"%s\": must be"
+ " ok, error, return, break, continue, or an integer",
+ TclGetString(value)));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_CODE", NULL);
}
return TCL_ERROR;
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 5bae041..0b0f652 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -1043,18 +1043,18 @@ Tcl_InterpObjCmd(
iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "alias \"", aliasName, "\" in path \"",
- Tcl_GetString(objv[2]), "\" not found", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "alias \"%s\" in path \"%s\" not found",
+ aliasName, Tcl_GetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName,
NULL);
return TCL_ERROR;
}
aliasPtr = Tcl_GetHashValue(hPtr);
if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "target interpreter for alias \"",
- aliasName, "\" in path \"", Tcl_GetString(objv[2]),
- "\" is not my descendant", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "target interpreter for alias \"%s\" in path \"%s\" is "
+ "not my descendant", aliasName, Tcl_GetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
"TARGETSHROUDED", NULL);
return TCL_ERROR;
@@ -1234,7 +1234,8 @@ Tcl_GetAlias(
hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "alias \"%s\" not found", aliasName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL);
return TCL_ERROR;
}
@@ -1295,7 +1296,8 @@ Tcl_GetAliasObj(
hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "alias \"%s\" not found", aliasName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL);
return TCL_ERROR;
}
@@ -1383,9 +1385,9 @@ TclPreventAliasLoop(
* [Bug #641195]
*/
- Tcl_AppendResult(interp, "cannot define or rename alias \"",
- Tcl_GetCommandName(cmdInterp, cmd),
- "\": interpreter deleted", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot define or rename alias \"%s\": interpreter deleted",
+ Tcl_GetCommandName(cmdInterp, cmd)));
return TCL_ERROR;
}
cmdNamePtr = nextAliasPtr->objPtr;
@@ -1398,9 +1400,9 @@ TclPreventAliasLoop(
}
aliasCmdPtr = (Command *) aliasCmd;
if (aliasCmdPtr == cmdPtr) {
- Tcl_AppendResult(interp, "cannot define or rename alias \"",
- Tcl_GetCommandName(cmdInterp, cmd),
- "\": would create a loop", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot define or rename alias \"%s\": would create a loop",
+ Tcl_GetCommandName(cmdInterp, cmd)));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
"ALIASLOOP", NULL);
return TCL_ERROR;
@@ -1621,8 +1623,8 @@ AliasDelete(
slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, TclGetString(namePtr));
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "alias \"", TclGetString(namePtr),
- "\" not found", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "alias \"%s\" not found", TclGetString(namePtr)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS",
TclGetString(namePtr), NULL);
return TCL_ERROR;
@@ -2220,8 +2222,8 @@ GetInterp(
}
}
if (searchInterp == NULL) {
- Tcl_AppendResult(interp, "could not find interpreter \"",
- TclGetString(pathPtr), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not find interpreter \"%s\"", TclGetString(pathPtr)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INTERP",
TclGetString(pathPtr), NULL);
}
@@ -2258,8 +2260,8 @@ SlaveBgerror(
if (TCL_ERROR == TclListObjLength(NULL, objv[0], &length)
|| (length < 1)) {
- Tcl_AppendResult(interp, "cmdPrefix must be list of length >= 1",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cmdPrefix must be list of length >= 1", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
"BGERRORFORMAT", NULL);
return TCL_ERROR;
@@ -2328,8 +2330,9 @@ SlaveCreate(
hPtr = Tcl_CreateHashEntry(&masterInfoPtr->master.slaveTable, path,
&isNew);
if (isNew == 0) {
- Tcl_AppendResult(interp, "interpreter named \"", path,
- "\" already exists, cannot create", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "interpreter named \"%s\" already exists, cannot create",
+ path));
return NULL;
}
@@ -2862,8 +2865,8 @@ SlaveRecursionLimit(
if (objc) {
if (Tcl_IsSafe(interp)) {
- Tcl_AppendResult(interp, "permission denied: "
- "safe interpreters cannot change recursion limit", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("permission denied: "
+ "safe interpreters cannot change recursion limit", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
NULL);
return TCL_ERROR;
@@ -3322,8 +3325,8 @@ Tcl_LimitCheck(
if (iPtr->limit.cmdCount >= iPtr->cmdCount) {
iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS;
} else if (iPtr->limit.exceeded & TCL_LIMIT_COMMANDS) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "command count limit exceeded", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command count limit exceeded", -1));
Tcl_SetErrorCode(interp, "TCL", "LIMIT", "COMMANDS", NULL);
Tcl_Release(interp);
return TCL_ERROR;
@@ -3348,8 +3351,8 @@ Tcl_LimitCheck(
iPtr->limit.time.usec >= now.usec)) {
iPtr->limit.exceeded &= ~TCL_LIMIT_TIME;
} else if (iPtr->limit.exceeded & TCL_LIMIT_TIME) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "time limit exceeded", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "time limit exceeded", -1));
Tcl_SetErrorCode(interp, "TCL", "LIMIT", "TIME", NULL);
Tcl_Release(interp);
return TCL_ERROR;
@@ -4355,8 +4358,9 @@ SlaveCommandLimitCmd(
*/
if (interp == slaveInterp) {
- Tcl_AppendResult(interp,
- "limits on current interpreter inaccessible", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "limits on current interpreter inaccessible", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", NULL);
return TCL_ERROR;
}
@@ -4452,8 +4456,8 @@ SlaveCommandLimitCmd(
return TCL_ERROR;
}
if (gran < 1) {
- Tcl_AppendResult(interp, "granularity must be at "
- "least 1", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "granularity must be at least 1", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
"BADVALUE", NULL);
return TCL_ERROR;
@@ -4469,8 +4473,8 @@ SlaveCommandLimitCmd(
return TCL_ERROR;
}
if (limit < 0) {
- Tcl_AppendResult(interp, "command limit value must be at "
- "least 0", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command limit value must be at least 0", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
"BADVALUE", NULL);
return TCL_ERROR;
@@ -4542,8 +4546,9 @@ SlaveTimeLimitCmd(
*/
if (interp == slaveInterp) {
- Tcl_AppendResult(interp,
- "limits on current interpreter inaccessible", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "limits on current interpreter inaccessible", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", NULL);
return TCL_ERROR;
}
@@ -4660,8 +4665,8 @@ SlaveTimeLimitCmd(
return TCL_ERROR;
}
if (gran < 1) {
- Tcl_AppendResult(interp, "granularity must be at "
- "least 1", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "granularity must be at least 1", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
"BADVALUE", NULL);
return TCL_ERROR;
@@ -4677,13 +4682,13 @@ SlaveTimeLimitCmd(
return TCL_ERROR;
}
if (tmp < 0) {
- Tcl_AppendResult(interp, "milliseconds must be at least 0",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "milliseconds must be at least 0", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
"BADVALUE", NULL);
return TCL_ERROR;
}
- limitMoment.usec = ((long)tmp)*1000;
+ limitMoment.usec = ((long) tmp)*1000;
break;
case OPT_SEC:
secObj = objv[i+1];
@@ -4695,8 +4700,8 @@ SlaveTimeLimitCmd(
return TCL_ERROR;
}
if (tmp < 0) {
- Tcl_AppendResult(interp, "seconds must be at least 0",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "seconds must be at least 0", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
"BADVALUE", NULL);
return TCL_ERROR;
@@ -4713,15 +4718,17 @@ SlaveTimeLimitCmd(
*/
if (secObj != NULL && secLen == 0 && milliLen > 0) {
- Tcl_AppendResult(interp, "may only set -milliseconds "
- "if -seconds is not also being reset", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may only set -milliseconds if -seconds is not "
+ "also being reset", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
"BADUSAGE", NULL);
return TCL_ERROR;
}
if (milliLen == 0 && (secObj == NULL || secLen > 0)) {
- Tcl_AppendResult(interp, "may only reset -milliseconds "
- "if -seconds is also being reset", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may only reset -milliseconds if -seconds is "
+ "also being reset", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
"BADUSAGE", NULL);
return TCL_ERROR;
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index ce4d6a4..3fead6f 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -157,9 +157,8 @@ Tcl_LoadObjCmd(
}
}
if ((fullFileName[0] == 0) && (packageName == NULL)) {
- Tcl_SetResult(interp,
- "must specify either file name or package name",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "must specify either file name or package name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOLIBRARY",
NULL);
code = TCL_ERROR;
@@ -225,9 +224,9 @@ Tcl_LoadObjCmd(
* Can't have two different packages loaded from the same file.
*/
- Tcl_AppendResult(interp, "file \"", fullFileName,
- "\" is already loaded for package \"",
- pkgPtr->packageName, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "file \"%s\" is already loaded for package \"%s\"",
+ fullFileName, pkgPtr->packageName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
"SPLITPERSONALITY", NULL);
code = TCL_ERROR;
@@ -263,8 +262,8 @@ Tcl_LoadObjCmd(
*/
if (fullFileName[0] == 0) {
- Tcl_AppendResult(interp, "package \"", packageName,
- "\" isn't loaded statically", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "package \"%s\" isn't loaded statically", packageName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOTSTATIC",
NULL);
code = TCL_ERROR;
@@ -321,9 +320,9 @@ Tcl_LoadObjCmd(
}
if (p == pkgGuess) {
Tcl_DecrRefCount(splitPtr);
- Tcl_AppendResult(interp,
- "couldn't figure out package name for ",
- fullFileName, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't figure out package name for %s",
+ fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
"WHATPACKAGE", NULL);
code = TCL_ERROR;
@@ -418,9 +417,9 @@ Tcl_LoadObjCmd(
if (Tcl_IsSafe(target)) {
if (pkgPtr->safeInitProc == NULL) {
- Tcl_AppendResult(interp,
- "can't use package in a safe interpreter: no ",
- pkgPtr->packageName, "_SafeInit procedure", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't use package in a safe interpreter: no"
+ " %s_SafeInit procedure", pkgPtr->packageName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "UNSAFE",
NULL);
code = TCL_ERROR;
@@ -429,9 +428,9 @@ Tcl_LoadObjCmd(
code = pkgPtr->safeInitProc(target);
} else {
if (pkgPtr->initProc == NULL) {
- Tcl_AppendResult(interp,
- "can't attach package to interpreter: no ",
- pkgPtr->packageName, "_Init procedure", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't attach package to interpreter: no %s_Init procedure",
+ pkgPtr->packageName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT",
NULL);
code = TCL_ERROR;
@@ -581,9 +580,8 @@ Tcl_UnloadObjCmd(
}
}
if ((fullFileName[0] == 0) && (packageName == NULL)) {
- Tcl_SetResult(interp,
- "must specify either file name or package name",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "must specify either file name or package name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NOLIBRARY",
NULL);
code = TCL_ERROR;
@@ -655,8 +653,9 @@ Tcl_UnloadObjCmd(
* It's an error to try unload a static package.
*/
- Tcl_AppendResult(interp, "package \"", packageName,
- "\" is loaded statically and cannot be unloaded", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "package \"%s\" is loaded statically and cannot be unloaded",
+ packageName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "STATIC",
NULL);
code = TCL_ERROR;
@@ -667,8 +666,8 @@ Tcl_UnloadObjCmd(
* The DLL pointed by the provided filename has never been loaded.
*/
- Tcl_AppendResult(interp, "file \"", fullFileName,
- "\" has never been loaded", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "file \"%s\" has never been loaded", fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED",
NULL);
code = TCL_ERROR;
@@ -696,8 +695,9 @@ Tcl_UnloadObjCmd(
* The package has not been loaded in this interpreter.
*/
- Tcl_AppendResult(interp, "file \"", fullFileName,
- "\" has never been loaded in this interpreter", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "file \"%s\" has never been loaded in this interpreter",
+ fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED",
NULL);
code = TCL_ERROR;
@@ -712,8 +712,9 @@ Tcl_UnloadObjCmd(
if (Tcl_IsSafe(target)) {
if (pkgPtr->safeUnloadProc == NULL) {
- Tcl_AppendResult(interp, "file \"", fullFileName,
- "\" cannot be unloaded under a safe interpreter", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "file \"%s\" cannot be unloaded under a safe interpreter",
+ fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
NULL);
code = TCL_ERROR;
@@ -722,8 +723,9 @@ Tcl_UnloadObjCmd(
unloadProc = pkgPtr->safeUnloadProc;
} else {
if (pkgPtr->unloadProc == NULL) {
- Tcl_AppendResult(interp, "file \"", fullFileName,
- "\" cannot be unloaded under a trusted interpreter", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "file \"%s\" cannot be unloaded under a trusted interpreter",
+ fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
NULL);
code = TCL_ERROR;
@@ -862,8 +864,9 @@ Tcl_UnloadObjCmd(
}
}
#else
- Tcl_AppendResult(interp, "file \"", fullFileName,
- "\" cannot be unloaded: unloading disabled", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "file \"%s\" cannot be unloaded: unloading disabled",
+ fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "DISABLED",
NULL);
code = TCL_ERROR;
diff --git a/generic/tclLoadNone.c b/generic/tclLoadNone.c
index ac094e6..6b48aee 100644
--- a/generic/tclLoadNone.c
+++ b/generic/tclLoadNone.c
@@ -44,9 +44,9 @@ TclpDlopen(
* function which should be used for this
* file. */
{
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"dynamic loading is not currently available on this system",
- TCL_STATIC);
+ -1));
return TCL_ERROR;
}
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 6a241f0..3c93400 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -687,9 +687,8 @@ Tcl_CreateNamespace(
parentPtr = NULL;
simpleName = "";
} else if (*name == '\0') {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "can't create namespace \"\": "
- "only global namespace can have empty name", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("can't create namespace"
+ " \"\": only global namespace can have empty name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
"CREATEGLOBAL", NULL);
return NULL;
@@ -725,8 +724,8 @@ Tcl_CreateNamespace(
Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL
#endif
) {
- Tcl_AppendResult(interp, "can't create namespace \"", name,
- "\": already exists", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create namespace \"%s\": already exists", name));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
"CREATEEXISTING", NULL);
return NULL;
@@ -1336,8 +1335,8 @@ Tcl_Export(
&exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
- Tcl_AppendResult(interp, "invalid export pattern \"", pattern,
- "\": pattern can't specify a namespace", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid export pattern"
+ " \"%s\": pattern can't specify a namespace", pattern));
Tcl_SetErrorCode(interp, "TCL", "EXPORT", "INVALID", NULL);
return TCL_ERROR;
}
@@ -1551,21 +1550,21 @@ Tcl_Import(
&importNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
if (importNsPtr == NULL) {
- Tcl_AppendResult(interp, "unknown namespace in import pattern \"",
- pattern, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown namespace in import pattern \"%s\"", pattern));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, NULL);
return TCL_ERROR;
}
if (importNsPtr == nsPtr) {
if (pattern == simplePattern) {
- Tcl_AppendResult(interp,
- "no namespace specified in import pattern \"", pattern,
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no namespace specified in import pattern \"%s\"",
+ pattern));
Tcl_SetErrorCode(interp, "TCL", "IMPORT", "ORIGIN", NULL);
} else {
- Tcl_AppendResult(interp, "import pattern \"", pattern,
- "\" tries to import from namespace \"",
- importNsPtr->name, "\" into itself", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "import pattern \"%s\" tries to import from namespace"
+ " \"%s\" into itself", pattern, importNsPtr->name));
Tcl_SetErrorCode(interp, "TCL", "IMPORT", "SELF", NULL);
}
return TCL_ERROR;
@@ -1684,9 +1683,10 @@ DoImport(
dataPtr = linkCmd->objClientData;
linkCmd = dataPtr->realCmdPtr;
if (overwrite == linkCmd) {
- Tcl_AppendResult(interp, "import pattern \"", pattern,
- "\" would create a loop containing command \"",
- Tcl_DStringValue(&ds), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "import pattern \"%s\" would create a loop"
+ " containing command \"%s\"",
+ pattern, Tcl_DStringValue(&ds)));
Tcl_DStringFree(&ds);
Tcl_SetErrorCode(interp, "TCL", "IMPORT", "LOOP", NULL);
return TCL_ERROR;
@@ -1726,8 +1726,8 @@ DoImport(
return TCL_OK;
}
}
- Tcl_AppendResult(interp, "can't import command \"", cmdName,
- "\": already exists", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't import command \"%s\": already exists", cmdName));
Tcl_SetErrorCode(interp, "TCL", "IMPORT", "OVERWRITE", NULL);
return TCL_ERROR;
}
@@ -1796,9 +1796,9 @@ Tcl_ForgetImport(
&sourceNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
if (sourceNsPtr == NULL) {
- Tcl_AppendResult(interp,
- "unknown namespace in namespace forget pattern \"",
- pattern, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown namespace in namespace forget pattern \"%s\"",
+ pattern));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, NULL);
return TCL_ERROR;
}
@@ -2402,8 +2402,8 @@ Tcl_FindNamespace(
}
if (flags & TCL_LEAVE_ERR_MSG) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "unknown namespace \"", name, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown namespace \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", name, NULL);
}
return NULL;
@@ -2589,8 +2589,8 @@ Tcl_FindCommand(
}
if (flags & TCL_LEAVE_ERR_MSG) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "unknown command \"", name, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown command \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", name, NULL);
}
return NULL;
@@ -3170,9 +3170,9 @@ NamespaceDeleteCmd(
namespacePtr = Tcl_FindNamespace(interp, name, NULL, /*flags*/ 0);
if ((namespacePtr == NULL)
|| (((Namespace *) namespacePtr)->flags & NS_KILLED)) {
- Tcl_AppendResult(interp, "unknown namespace \"",
- TclGetString(objv[i]),
- "\" in namespace delete command", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown namespace \"%s\" in namespace delete command",
+ TclGetString(objv[i])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE",
TclGetString(objv[i]), NULL);
return TCL_ERROR;
@@ -3834,8 +3834,8 @@ NamespaceOriginCmd(
command = Tcl_GetCommandFromObj(interp, objv[1]);
if (command == NULL) {
- Tcl_AppendResult(interp, "invalid command name \"",
- TclGetString(objv[1]), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid command name \"%s\"", TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
TclGetString(objv[1]), NULL);
return TCL_ERROR;
diff --git a/generic/tclOO.c b/generic/tclOO.c
index df7d49d..d9f5d60 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -1582,8 +1582,9 @@ Tcl_NewObjectInstance(
if (nameStr && Tcl_FindCommand(interp, nameStr, NULL,
TCL_NAMESPACE_ONLY)) {
- Tcl_AppendResult(interp, "can't create object \"", nameStr,
- "\": command already exists with that name", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create object \"%s\": command already exists with"
+ " that name", nameStr));
Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
return NULL;
}
@@ -1649,8 +1650,8 @@ Tcl_NewObjectInstance(
*/
if (result != TCL_ERROR && Deleted(oPtr)) {
- Tcl_SetResult(interp, "object deleted in constructor",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "object deleted in constructor", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
result = TCL_ERROR;
}
@@ -1705,8 +1706,9 @@ TclNRNewObjectInstance(
if (nameStr && Tcl_FindCommand(interp, nameStr, NULL,
TCL_NAMESPACE_ONLY)) {
- Tcl_AppendResult(interp, "can't create object \"", nameStr,
- "\": command already exists with that name", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create object \"%s\": command already exists with"
+ " that name", nameStr));
Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
return TCL_ERROR;
}
@@ -1794,7 +1796,8 @@ FinalizeAlloc(
*/
if (result != TCL_ERROR && Deleted(oPtr)) {
- Tcl_SetResult(interp, "object deleted in constructor", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "object deleted in constructor", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
result = TCL_ERROR;
}
@@ -1851,7 +1854,8 @@ Tcl_CopyObjectInstance(
*/
if (IsRootClass(oPtr)) {
- Tcl_AppendResult(interp, "may not clone the class of classes", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may not clone the class of classes", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "CLONING_CLASS", NULL);
return NULL;
}
@@ -2514,9 +2518,9 @@ TclOOObjectCmdCore(
flags | (oPtr->flags & FILTER_HANDLING), methodNamePtr);
TclDecrRefCount(mappedMethodName);
if (contextPtr == NULL) {
- Tcl_AppendResult(interp, "impossible to invoke method \"",
- TclGetString(methodNamePtr),
- "\": no defined method or unknown method", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "impossible to invoke method \"%s\": no defined method or"
+ " unknown method", TclGetString(methodNamePtr)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD_MAPPED",
TclGetString(methodNamePtr), NULL);
return TCL_ERROR;
@@ -2530,9 +2534,9 @@ TclOOObjectCmdCore(
contextPtr = TclOOGetCallContext(oPtr, methodNamePtr,
flags | (oPtr->flags & FILTER_HANDLING), NULL);
if (contextPtr == NULL) {
- Tcl_AppendResult(interp, "impossible to invoke method \"",
- TclGetString(methodNamePtr),
- "\": no defined method or unknown method", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "impossible to invoke method \"%s\": no defined method or"
+ " unknown method", TclGetString(methodNamePtr)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(methodNamePtr), NULL);
return TCL_ERROR;
@@ -2558,8 +2562,8 @@ TclOOObjectCmdCore(
}
}
if (contextPtr->index >= contextPtr->callPtr->numChain) {
- Tcl_SetResult(interp, "no valid method implementation",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no valid method implementation", -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(methodNamePtr), NULL);
TclOODeleteContext(contextPtr);
@@ -2640,8 +2644,8 @@ Tcl_ObjectContextInvokeNext(
methodType = "method";
}
- Tcl_AppendResult(interp, "no next ", methodType, " implementation",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no next %s implementation", methodType));
Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
return TCL_ERROR;
}
@@ -2709,8 +2713,8 @@ TclNRObjectContextInvokeNext(
methodType = "method";
}
- Tcl_AppendResult(interp, "no next ", methodType, " implementation",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no next %s implementation", methodType));
Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
return TCL_ERROR;
}
@@ -2787,8 +2791,8 @@ Tcl_GetObjectFromObj(
return cmdPtr->objClientData;
notAnObject:
- Tcl_AppendResult(interp, TclGetString(objPtr),
- " does not refer to an object", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s does not refer to an object", TclGetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "OBJECT", TclGetString(objPtr),
NULL);
return NULL;
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index 35ad1eb..3637ede 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -168,8 +168,8 @@ TclOO_Class_Create(
if (oPtr->classPtr == NULL) {
Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);
- Tcl_AppendResult(interp, "object \"", TclGetString(cmdnameObj),
- "\" is not a class", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "object \"%s\" is not a class", TclGetString(cmdnameObj)));
Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
return TCL_ERROR;
}
@@ -186,7 +186,8 @@ TclOO_Class_Create(
objName = Tcl_GetStringFromObj(
objv[Tcl_ObjectContextSkippedArgs(context)], &len);
if (len == 0) {
- Tcl_AppendResult(interp, "object name must not be empty", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "object name must not be empty", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
return TCL_ERROR;
}
@@ -232,8 +233,8 @@ TclOO_Class_CreateNs(
if (oPtr->classPtr == NULL) {
Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);
- Tcl_AppendResult(interp, "object \"", TclGetString(cmdnameObj),
- "\" is not a class", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "object \"%s\" is not a class", TclGetString(cmdnameObj)));
Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
return TCL_ERROR;
}
@@ -250,14 +251,16 @@ TclOO_Class_CreateNs(
objName = Tcl_GetStringFromObj(
objv[Tcl_ObjectContextSkippedArgs(context)], &len);
if (len == 0) {
- Tcl_AppendResult(interp, "object name must not be empty", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "object name must not be empty", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
return TCL_ERROR;
}
nsName = Tcl_GetStringFromObj(
objv[Tcl_ObjectContextSkippedArgs(context)+1], &len);
if (len == 0) {
- Tcl_AppendResult(interp, "namespace name must not be empty", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "namespace name must not be empty", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
return TCL_ERROR;
}
@@ -301,8 +304,8 @@ TclOO_Class_New(
if (oPtr->classPtr == NULL) {
Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);
- Tcl_AppendResult(interp, "object \"", TclGetString(cmdnameObj),
- "\" is not a class", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "object \"%s\" is not a class", TclGetString(cmdnameObj)));
Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
return TCL_ERROR;
}
@@ -504,6 +507,7 @@ TclOO_Object_Unknown(
Object *oPtr = contextPtr->oPtr;
const char **methodNames;
int numMethodNames, i, skip = Tcl_ObjectContextSkippedArgs(context);
+ Tcl_Obj *errorMsg;
/*
* If no method name, generate an error asking for a method name. (Only by
@@ -529,31 +533,34 @@ TclOO_Object_Unknown(
if (numMethodNames == 0) {
Tcl_Obj *tmpBuf = TclOOObjectName(interp, oPtr);
+ const char *piece;
- Tcl_AppendResult(interp, "object \"", TclGetString(tmpBuf), NULL);
if (contextPtr->callPtr->flags & PUBLIC_METHOD) {
- Tcl_AppendResult(interp, "\" has no visible methods", NULL);
+ piece = "visible methods";
} else {
- Tcl_AppendResult(interp, "\" has no methods", NULL);
+ piece = "methods";
}
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "object \"%s\" has no %s", TclGetString(tmpBuf), piece));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[skip]), NULL);
return TCL_ERROR;
}
- Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[skip]),
- "\": must be ", NULL);
+ errorMsg = Tcl_ObjPrintf("unknown method \"%s\": must be ",
+ TclGetString(objv[skip]));
for (i=0 ; i<numMethodNames-1 ; i++) {
if (i) {
- Tcl_AppendResult(interp, ", ", NULL);
+ Tcl_AppendToObj(errorMsg, ", ", -1);
}
- Tcl_AppendResult(interp, methodNames[i], NULL);
+ Tcl_AppendToObj(errorMsg, methodNames[i], -1);
}
if (i) {
- Tcl_AppendResult(interp, " or ", NULL);
+ Tcl_AppendToObj(errorMsg, " or ", -1);
}
- Tcl_AppendResult(interp, methodNames[i], NULL);
+ Tcl_AppendToObj(errorMsg, methodNames[i], -1);
ckfree(methodNames);
+ Tcl_SetObjResult(interp, errorMsg);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[skip]), NULL);
return TCL_ERROR;
@@ -609,8 +616,9 @@ TclOO_Object_LinkVar(
*/
if (strstr(varName, "::") != NULL) {
- Tcl_AppendResult(interp, "variable name \"", varName,
- "\" illegal: must not contain namespace separator", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "variable name \"%s\" illegal: must not contain namespace"
+ " separator", varName));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", NULL);
return TCL_ERROR;
}
@@ -784,8 +792,9 @@ TclOONextObjCmd(
*/
if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
- Tcl_AppendResult(interp, TclGetString(objv[0]),
- " may only be called from inside a method", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s may only be called from inside a method",
+ TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
return TCL_ERROR;
}
@@ -822,8 +831,9 @@ TclOONextToObjCmd(
*/
if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
- Tcl_AppendResult(interp, TclGetString(objv[0]),
- " may only be called from inside a method", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s may only be called from inside a method",
+ TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
return TCL_ERROR;
}
@@ -843,8 +853,9 @@ TclOONextToObjCmd(
}
classPtr = ((Object *)object)->classPtr;
if (classPtr == NULL) {
- Tcl_AppendResult(interp, "\"", TclGetString(objv[1]),
- "\" is not a class", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" is not a class", TclGetString(objv[1])));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", NULL);
return TCL_ERROR;
}
@@ -881,14 +892,15 @@ TclOONextToObjCmd(
struct MInvoke *miPtr = contextPtr->callPtr->chain + i;
if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) {
- Tcl_AppendResult(interp, "method implementation by \"",
- TclGetString(objv[1]), "\" not reachable from here",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "method implementation by \"%s\" not reachable from here",
+ TclGetString(objv[1])));
return TCL_ERROR;
}
}
- Tcl_AppendResult(interp, "method has no non-filter implementation by \"",
- TclGetString(objv[1]), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "method has no non-filter implementation by \"%s\"",
+ TclGetString(objv[1])));
return TCL_ERROR;
}
@@ -948,8 +960,9 @@ TclOOSelfObjCmd(
*/
if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
- Tcl_AppendResult(interp, TclGetString(objv[0]),
- " may only be called from inside a method", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s may only be called from inside a method",
+ TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
return TCL_ERROR;
}
@@ -983,7 +996,8 @@ TclOOSelfObjCmd(
Class *clsPtr = CurrentlyInvoked(contextPtr).mPtr->declaringClassPtr;
if (clsPtr == NULL) {
- Tcl_AppendResult(interp, "method not defined by a class", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "method not defined by a class", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
return TCL_ERROR;
}
@@ -1003,7 +1017,8 @@ TclOOSelfObjCmd(
return TCL_OK;
case SELF_FILTER:
if (!CurrentlyInvoked(contextPtr).isFilter) {
- Tcl_AppendResult(interp, "not inside a filtering context", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "not inside a filtering context", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
return TCL_ERROR;
} else {
@@ -1028,7 +1043,8 @@ TclOOSelfObjCmd(
case SELF_CALLER:
if ((framePtr->callerVarPtr == NULL) ||
!(framePtr->callerVarPtr->isProcCallFrame & FRAME_IS_METHOD)){
- Tcl_AppendResult(interp, "caller is not an object", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "caller is not an object", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
return TCL_ERROR;
} else {
@@ -1045,7 +1061,8 @@ TclOOSelfObjCmd(
* This should be unreachable code.
*/
- Tcl_AppendResult(interp, "method without declarer!", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "method without declarer!", -1));
return TCL_ERROR;
}
@@ -1076,7 +1093,8 @@ TclOOSelfObjCmd(
* This should be unreachable code.
*/
- Tcl_AppendResult(interp, "method without declarer!", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "method without declarer!", -1));
return TCL_ERROR;
}
@@ -1093,7 +1111,8 @@ TclOOSelfObjCmd(
return TCL_OK;
case SELF_TARGET:
if (!CurrentlyInvoked(contextPtr).isFilter) {
- Tcl_AppendResult(interp, "not inside a filtering context", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "not inside a filtering context", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
return TCL_ERROR;
} else {
@@ -1119,7 +1138,8 @@ TclOOSelfObjCmd(
* This should be unreachable code.
*/
- Tcl_AppendResult(interp, "method without declarer!", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "method without declarer!", -1));
return TCL_ERROR;
}
result[0] = TclOOObjectName(interp, declarerPtr);
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 69cffb0..c022e6b 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -423,8 +423,8 @@ RenameDeleteMethod(
if (!useClass) {
if (!oPtr->methodsPtr) {
noSuchMethod:
- Tcl_AppendResult(interp, "method ", TclGetString(fromPtr),
- " does not exist", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "method %s does not exist", TclGetString(fromPtr)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(fromPtr), NULL);
return TCL_ERROR;
@@ -438,14 +438,15 @@ RenameDeleteMethod(
&isNew);
if (hPtr == newHPtr) {
renameToSelf:
- Tcl_AppendResult(interp, "cannot rename method to itself",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot rename method to itself", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_TO_SELF", NULL);
return TCL_ERROR;
} else if (!isNew) {
renameToExisting:
- Tcl_AppendResult(interp, "method called ",
- TclGetString(toPtr), " already exists", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "method called %s already exists",
+ TclGetString(toPtr)));
Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_OVER", NULL);
return TCL_ERROR;
}
@@ -513,7 +514,8 @@ TclOOUnknownDefinition(
const char *soughtStr, *matchedStr = NULL;
if (objc < 2) {
- Tcl_AppendResult(interp, "bad call of unknown handler", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad call of unknown handler", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", NULL);
return TCL_ERROR;
}
@@ -558,7 +560,8 @@ TclOOUnknownDefinition(
}
noMatch:
- Tcl_AppendResult(interp, "invalid command name \"",soughtStr,"\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid command name \"%s\"", soughtStr));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", soughtStr, NULL);
return TCL_ERROR;
}
@@ -646,9 +649,9 @@ InitDefineContext(
int result;
if (namespacePtr == NULL) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot process definitions; support namespace deleted",
- NULL);
+ -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
@@ -686,16 +689,17 @@ TclOOGetDefineCmdContext(
if ((iPtr->varFramePtr == NULL)
|| (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE)) {
- Tcl_AppendResult(interp, "this command may only be called from within"
- " the context of an ::oo::define or ::oo::objdefine command",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "this command may only be called from within the context of"
+ " an ::oo::define or ::oo::objdefine command", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return NULL;
}
object = iPtr->varFramePtr->clientData;
if (Tcl_ObjectDeleted(object)) {
- Tcl_AppendResult(interp, "this command cannot be called when the "
- "object has been deleted", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "this command cannot be called when the object has been"
+ " deleted", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return NULL;
}
@@ -736,7 +740,7 @@ GetClassInOuterContext(
return NULL;
}
if (oPtr->classPtr == NULL) {
- Tcl_AppendResult(interp, errMsg, NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
TclGetString(className), NULL);
return NULL;
@@ -816,8 +820,8 @@ TclOODefineObjCmd(
return TCL_ERROR;
}
if (oPtr->classPtr == NULL) {
- Tcl_AppendResult(interp, TclGetString(objv[1]),
- " does not refer to a class", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s does not refer to a class",TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
TclGetString(objv[1]), NULL);
return TCL_ERROR;
@@ -1161,14 +1165,14 @@ TclOODefineClassObjCmd(
return TCL_ERROR;
}
if (oPtr->flags & ROOT_OBJECT) {
- Tcl_AppendResult(interp,
- "may not modify the class of the root object class", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may not modify the class of the root object class", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
if (oPtr->flags & ROOT_CLASS) {
- Tcl_AppendResult(interp,
- "may not modify the class of the class of classes", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may not modify the class of the class of classes", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
@@ -1194,9 +1198,10 @@ TclOODefineClassObjCmd(
*/
if ((oPtr->classPtr==NULL) == TclOOIsReachable(fPtr->classCls, clsPtr)) {
- Tcl_AppendResult(interp, "may not change a ",
- (oPtr->classPtr==NULL ? "non-" : ""), "class object into a ",
- (oPtr->classPtr==NULL ? "" : "non-"), "class object", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "may not change a %sclass object into a %sclass object",
+ (oPtr->classPtr==NULL ? "non-" : ""),
+ (oPtr->classPtr==NULL ? "" : "non-")));
Tcl_SetErrorCode(interp, "TCL", "OO", "TRANSMUTATION", NULL);
return TCL_ERROR;
}
@@ -1317,7 +1322,8 @@ TclOODefineDeleteMethodObjCmd(
return TCL_ERROR;
}
if (!isInstanceDeleteMethod && !oPtr->classPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
@@ -1440,7 +1446,8 @@ TclOODefineExportObjCmd(
}
clsPtr = oPtr->classPtr;
if (!isInstanceExport && !clsPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
@@ -1531,7 +1538,8 @@ TclOODefineForwardObjCmd(
return TCL_ERROR;
}
if (!isInstanceForward && !oPtr->classPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
@@ -1588,7 +1596,8 @@ TclOODefineMethodObjCmd(
return TCL_ERROR;
}
if (!isInstanceMethod && !oPtr->classPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
@@ -1639,7 +1648,8 @@ TclOODefineMixinObjCmd(
return TCL_ERROR;
}
if (!isInstanceMixin && !oPtr->classPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
@@ -1653,7 +1663,8 @@ TclOODefineMixinObjCmd(
goto freeAndError;
}
if (!isInstanceMixin && TclOOIsReachable(oPtr->classPtr, clsPtr)) {
- Tcl_AppendResult(interp, "may not mix a class into itself", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may not mix a class into itself", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL);
goto freeAndError;
}
@@ -1704,7 +1715,8 @@ TclOODefineRenameMethodObjCmd(
return TCL_ERROR;
}
if (!isInstanceRenameMethod && !oPtr->classPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
@@ -1764,7 +1776,8 @@ TclOODefineUnexportObjCmd(
}
clsPtr = oPtr->classPtr;
if (!isInstanceUnexport && !clsPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
@@ -1949,7 +1962,8 @@ ClassFilterGet(
if (oPtr == NULL) {
return TCL_ERROR;
} else if (!oPtr->classPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
@@ -1984,7 +1998,8 @@ ClassFilterSet(
if (oPtr == NULL) {
return TCL_ERROR;
} else if (!oPtr->classPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
} else if (Tcl_ListObjGetElements(interp, objv[0], &filterc,
@@ -2027,7 +2042,8 @@ ClassMixinGet(
if (oPtr == NULL) {
return TCL_ERROR;
} else if (!oPtr->classPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
@@ -2065,7 +2081,8 @@ ClassMixinSet(
if (oPtr == NULL) {
return TCL_ERROR;
} else if (!oPtr->classPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
} else if (Tcl_ListObjGetElements(interp, objv[0], &mixinc,
@@ -2082,7 +2099,8 @@ ClassMixinSet(
goto freeAndError;
}
if (TclOOIsReachable(oPtr->classPtr, mixins[i])) {
- Tcl_AppendResult(interp, "may not mix a class into itself", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may not mix a class into itself", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL);
goto freeAndError;
}
@@ -2128,7 +2146,8 @@ ClassSuperGet(
if (oPtr == NULL) {
return TCL_ERROR;
} else if (!oPtr->classPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
@@ -2165,12 +2184,13 @@ ClassSuperSet(
if (oPtr == NULL) {
return TCL_ERROR;
} else if (!oPtr->classPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
} else if (oPtr == oPtr->fPtr->objectCls->thisPtr) {
- Tcl_AppendResult(interp,
- "may not modify the superclass of the root object", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may not modify the superclass of the root object", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
} else if (Tcl_ListObjGetElements(interp, objv[0], &superc,
@@ -2196,15 +2216,15 @@ ClassSuperSet(
}
for (j=0 ; j<i ; j++) {
if (superclasses[j] == superclasses[i]) {
- Tcl_AppendResult(interp,
- "class should only be a direct superclass once",NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "class should only be a direct superclass once", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS", NULL);
goto failedAfterAlloc;
}
}
if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) {
- Tcl_AppendResult(interp,
- "attempt to form circular dependency graph", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to form circular dependency graph", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
failedAfterAlloc:
ckfree((char *) superclasses);
@@ -2265,7 +2285,8 @@ ClassVarsGet(
if (oPtr == NULL) {
return TCL_ERROR;
} else if (!oPtr->classPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
@@ -2301,7 +2322,8 @@ ClassVarsSet(
if (oPtr == NULL) {
return TCL_ERROR;
} else if (!oPtr->classPtr) {
- Tcl_AppendResult(interp, "attempt to misuse API", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
} else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
@@ -2313,15 +2335,16 @@ ClassVarsSet(
const char *varName = Tcl_GetString(varv[i]);
if (strstr(varName, "::") != NULL) {
- Tcl_AppendResult(interp, "invalid declared variable name \"",
- varName, "\": must not contain namespace separators",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid declared variable name \"%s\": must not %s",
+ varName, "contain namespace separators"));
Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
return TCL_ERROR;
}
if (Tcl_StringMatch(varName, "*(*)")) {
- Tcl_AppendResult(interp, "invalid declared variable name \"",
- varName, "\": must not refer to an array element", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid declared variable name \"%s\": must not %s",
+ varName, "refer to an array element"));
Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
return TCL_ERROR;
}
@@ -2591,15 +2614,16 @@ ObjVarsSet(
const char *varName = Tcl_GetString(varv[i]);
if (strstr(varName, "::") != NULL) {
- Tcl_AppendResult(interp, "invalid declared variable name \"",
- varName, "\": must not contain namespace separators",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid declared variable name \"%s\": must not %s",
+ varName, "contain namespace separators"));
Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
return TCL_ERROR;
}
if (Tcl_StringMatch(varName, "*(*)")) {
- Tcl_AppendResult(interp, "invalid declared variable name \"",
- varName, "\": must not refer to an array element", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid declared variable name \"%s\": must not %s",
+ varName, "refer to an array element"));
Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
return TCL_ERROR;
}
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
index f298320..796442b 100644
--- a/generic/tclOOInfo.c
+++ b/generic/tclOOInfo.c
@@ -177,8 +177,8 @@ GetClassFromObj(
return NULL;
}
if (oPtr->classPtr == NULL) {
- Tcl_AppendResult(interp, "\"", TclGetString(objPtr),
- "\" is not a class", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" is not a class", TclGetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
TclGetString(objPtr), NULL);
return NULL;
@@ -279,16 +279,16 @@ InfoObjectDefnCmd(
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
if (hPtr == NULL) {
unknownMethod:
- Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown method \"%s\"", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
if (procPtr == NULL) {
- Tcl_AppendResult(interp,
- "definition not available for this kind of method", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "definition not available for this kind of method", -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
@@ -390,17 +390,17 @@ InfoObjectForwardCmd(
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
if (hPtr == NULL) {
unknownMethod:
- Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown method \"%s\"", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr));
if (prefixObj == NULL) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"prefix argument list not available for this kind of method",
- NULL);
+ -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
@@ -491,7 +491,8 @@ InfoObjectIsACmd(
return TCL_ERROR;
}
if (o2Ptr->classPtr == NULL) {
- Tcl_AppendResult(interp, "non-classes cannot be mixins", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "non-classes cannot be mixins", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "NONCLASS", NULL);
return TCL_ERROR;
} else {
@@ -516,7 +517,8 @@ InfoObjectIsACmd(
return TCL_ERROR;
}
if (o2Ptr->classPtr == NULL) {
- Tcl_AppendResult(interp, "non-classes cannot be types", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "non-classes cannot be types", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "NONCLASS", NULL);
return TCL_ERROR;
}
@@ -651,8 +653,8 @@ InfoObjectMethodTypeCmd(
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
if (hPtr == NULL) {
unknownMethod:
- Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown method \"%s\"", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
@@ -878,8 +880,8 @@ InfoClassConstrCmd(
}
procPtr = TclOOGetProcFromMethod(clsPtr->constructorPtr);
if (procPtr == NULL) {
- Tcl_AppendResult(interp,
- "definition not available for this kind of method", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "definition not available for this kind of method", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "METHOD_TYPE", NULL);
return TCL_ERROR;
}
@@ -937,16 +939,16 @@ InfoClassDefnCmd(
}
hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown method \"%s\"", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
if (procPtr == NULL) {
- Tcl_AppendResult(interp,
- "definition not available for this kind of method", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "definition not available for this kind of method", -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
@@ -1006,8 +1008,8 @@ InfoClassDestrCmd(
}
procPtr = TclOOGetProcFromMethod(clsPtr->destructorPtr);
if (procPtr == NULL) {
- Tcl_AppendResult(interp,
- "definition not available for this kind of method", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "definition not available for this kind of method", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "METHOD_TYPE", NULL);
return TCL_ERROR;
}
@@ -1085,17 +1087,17 @@ InfoClassForwardCmd(
}
hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
if (hPtr == NULL) {
- Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown method \"%s\"", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr));
if (prefixObj == NULL) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"prefix argument list not available for this kind of method",
- NULL);
+ -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
@@ -1269,8 +1271,8 @@ InfoClassMethodTypeCmd(
hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
if (hPtr == NULL) {
unknownMethod:
- Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown method \"%s\"", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
@@ -1494,7 +1496,8 @@ InfoObjectCallCmd(
contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL);
if (contextPtr == NULL) {
- Tcl_AppendResult(interp, "cannot construct any call chain", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot construct any call chain", -1));
return TCL_ERROR;
}
Tcl_SetObjResult(interp,
@@ -1538,7 +1541,8 @@ InfoClassCallCmd(
callPtr = TclOOGetStereotypeCallChain(clsPtr, objv[2], PUBLIC_METHOD);
if (callPtr == NULL) {
- Tcl_AppendResult(interp, "cannot construct any call chain", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot construct any call chain", -1));
return TCL_ERROR;
}
Tcl_SetObjResult(interp, TclOORenderCallChain(interp, callPtr));
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 877c3db..60eaa6e 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -1329,8 +1329,8 @@ TclOONewForwardInstanceMethod(
return NULL;
}
if (prefixLen < 1) {
- Tcl_AppendResult(interp, "method forward prefix must be non-empty",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "method forward prefix must be non-empty", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
return NULL;
}
@@ -1371,8 +1371,8 @@ TclOONewForwardMethod(
return NULL;
}
if (prefixLen < 1) {
- Tcl_AppendResult(interp, "method forward prefix must be non-empty",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "method forward prefix must be non-empty", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
return NULL;
}
diff --git a/generic/tclOOStubLib.c b/generic/tclOOStubLib.c
index 3b6ce37..55f2378 100644
--- a/generic/tclOOStubLib.c
+++ b/generic/tclOOStubLib.c
@@ -53,8 +53,9 @@ TclOOInitializeStubs(
if (clientData == NULL) {
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "Error loading ", packageName, " package; ",
- "package not present or incomplete", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error loading %s package; package not present or incomplete",
+ packageName));
return NULL;
} else {
const TclOOStubs * const stubsPtr = clientData;
@@ -76,9 +77,9 @@ TclOOInitializeStubs(
error:
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "Error loading ", packageName, " package",
- " (requested version '", version, "', loaded version '",
- actualVersion, "'): ", errMsg, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error loading %s package"
+ " (requested version '%s', loaded version '%s'): %s",
+ packageName, version, actualVersion, errMsg));
return NULL;
}
}
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 099b67d..74cb29e 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -4462,11 +4462,8 @@ Tcl_RepresentationCmd(
int objc,
Tcl_Obj *const objv[])
{
- char refcountBuffer[TCL_INTEGER_SPACE+1];
- char objPtrBuffer[TCL_INTEGER_SPACE+3];
- char internalRepBuffer[2*(TCL_INTEGER_SPACE+2)+2];
-#define TCLOBJ_TRUNCATE_STRINGREP 16
- char stringRepBuffer[TCLOBJ_TRUNCATE_STRINGREP+1];
+ char ptrBuffer[2*TCL_INTEGER_SPACE+6];
+ Tcl_Obj *descObj;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "value");
@@ -4479,27 +4476,30 @@ Tcl_RepresentationCmd(
* "1872361827361287"
*/
- sprintf(refcountBuffer, "%d", objv[1]->refCount);
- sprintf(objPtrBuffer, "%p", (void *)objv[1]);
- Tcl_AppendResult(interp, "value is a ", objv[1]->typePtr ?
- objv[1]->typePtr->name : "pure string", " with a refcount of ",
- refcountBuffer, ", object pointer at ", objPtrBuffer, NULL);
+ sprintf(ptrBuffer, "%p", (void *) objv[1]);
+ descObj = Tcl_ObjPrintf("value is a %s with a refcount of %d,"
+ " object pointer at %s",
+ objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
+ objv[1]->refCount, ptrBuffer);
+
if (objv[1]->typePtr) {
- sprintf(internalRepBuffer, "%p:%p",
- (void *)objv[1]->internalRep.twoPtrValue.ptr1,
- (void *)objv[1]->internalRep.twoPtrValue.ptr2);
- Tcl_AppendResult(interp, ", internal representation ",
- internalRepBuffer, NULL);
+ sprintf(ptrBuffer, "%p:%p",
+ (void *) objv[1]->internalRep.twoPtrValue.ptr1,
+ (void *) objv[1]->internalRep.twoPtrValue.ptr2);
+ Tcl_AppendPrintfToObj(descObj, ", internal representation %s",
+ ptrBuffer);
}
+
if (objv[1]->bytes) {
- strncpy(stringRepBuffer, objv[1]->bytes, TCLOBJ_TRUNCATE_STRINGREP);
- stringRepBuffer[TCLOBJ_TRUNCATE_STRINGREP] = 0;
- Tcl_AppendResult(interp, ", string representation \"",
- stringRepBuffer, objv[1]->length > TCLOBJ_TRUNCATE_STRINGREP ?
- "\"..." : "\".", NULL);
+ Tcl_AppendToObj(descObj, ", string representation \"", -1);
+ Tcl_AppendLimitedToObj(descObj, objv[1]->bytes, objv[1]->length,
+ 16, "...");
+ Tcl_AppendToObj(descObj, "\"", -1);
} else {
- Tcl_AppendResult(interp, ", no string representation.", NULL);
+ Tcl_AppendToObj(descObj, ", no string representation", -1);
}
+
+ Tcl_SetObjResult(interp, descObj);
return TCL_OK;
}
diff --git a/generic/tclParse.c b/generic/tclParse.c
index f0050c6..309e232 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -258,7 +258,8 @@ Tcl_ParseCommand(
if ((start == NULL) && (numBytes != 0)) {
if (interp != NULL) {
- Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't parse a NULL pointer", -1));
}
return TCL_ERROR;
}
@@ -568,14 +569,14 @@ Tcl_ParseCommand(
}
if (src[-1] == '"') {
if (interp != NULL) {
- Tcl_SetResult(interp, "extra characters after close-quote",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "extra characters after close-quote", -1));
}
parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA;
} else {
if (interp != NULL) {
- Tcl_SetResult(interp, "extra characters after close-brace",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "extra characters after close-brace", -1));
}
parsePtr->errorType = TCL_PARSE_BRACE_EXTRA;
}
@@ -1175,8 +1176,8 @@ ParseTokens(
}
if (numBytes == 0) {
if (parsePtr->interp != NULL) {
- Tcl_SetResult(parsePtr->interp,
- "missing close-bracket", TCL_STATIC);
+ Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
+ "missing close-bracket", -1));
}
parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
parsePtr->term = tokenPtr->start;
@@ -1411,8 +1412,8 @@ Tcl_ParseVarName(
}
if (numBytes == 0) {
if (parsePtr->interp != NULL) {
- Tcl_SetResult(parsePtr->interp,
- "missing close-brace for variable name", TCL_STATIC);
+ Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
+ "missing close-brace for variable name", -1));
}
parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE;
parsePtr->term = tokenPtr->start-1;
@@ -1479,8 +1480,8 @@ Tcl_ParseVarName(
}
if ((parsePtr->term == src+numBytes) || (*parsePtr->term != ')')){
if (parsePtr->interp != NULL) {
- Tcl_SetResult(parsePtr->interp, "missing )",
- TCL_STATIC);
+ Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
+ "missing )", -1));
}
parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
parsePtr->term = src;
@@ -1755,7 +1756,8 @@ Tcl_ParseBraces(
goto error;
}
- Tcl_SetResult(parsePtr->interp, "missing close-brace", TCL_STATIC);
+ Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
+ "missing close-brace", -1));
/*
* Guess if the problem is due to comments by searching the source string
@@ -1777,8 +1779,8 @@ Tcl_ParseBraces(
break;
case '#' :
if (openBrace && TclIsSpaceProc(src[-1])) {
- Tcl_AppendResult(parsePtr->interp,
- ": possible unbalanced brace in comment", NULL);
+ Tcl_AppendToObj(Tcl_GetObjResult(parsePtr->interp),
+ ": possible unbalanced brace in comment", -1);
goto error;
}
break;
@@ -1857,7 +1859,8 @@ Tcl_ParseQuotedString(
}
if (*parsePtr->term != '"') {
if (parsePtr->interp != NULL) {
- Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC);
+ Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
+ "missing \"", -1));
}
parsePtr->errorType = TCL_PARSE_MISSING_QUOTE;
parsePtr->term = start;
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 8bae4fb..db07c0e 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -1492,9 +1492,8 @@ MakePathFromNormalized(
if (pathPtr->bytes == NULL) {
if (pathPtr->typePtr->updateStringProc == NULL) {
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "can't find object"
- "string representation", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't find object string representation", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "WTF",
NULL);
}
@@ -2368,9 +2367,9 @@ SetFsPathFromAny(
dir = TclGetEnv("HOME", &dirString);
if (dir == NULL) {
if (interp) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't find HOME environment "
- "variable to expand path", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "couldn't find HOME environment variable to"
+ " expand path", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH",
"HOMELESS", NULL);
}
@@ -2387,9 +2386,8 @@ SetFsPathFromAny(
Tcl_DStringInit(&temp);
if (TclpGetUserHome(name+1, &temp) == NULL) {
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "user \"", name+1,
- "\" doesn't exist", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "user \"%s\" doesn't exist", name+1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER",
NULL);
}
diff --git a/generic/tclPipe.c b/generic/tclPipe.c
index d0b136d..83fb818 100644
--- a/generic/tclPipe.c
+++ b/generic/tclPipe.c
@@ -106,9 +106,10 @@ FileForRedirect(
if (msg) {
Tcl_SetObjResult(interp, msg);
} else {
- Tcl_AppendResult(interp, "channel \"",
- Tcl_GetChannelName(chan), "\" wasn't opened for ",
- ((writing) ? "writing" : "reading"), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "channel \"%s\" wasn't opened for %s",
+ Tcl_GetChannelName(chan),
+ ((writing) ? "writing" : "reading")));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
"BADCHAN", NULL);
}
@@ -141,9 +142,10 @@ FileForRedirect(
file = TclpOpenFile(name, flags);
Tcl_DStringFree(&nameString);
if (file == NULL) {
- Tcl_AppendResult(interp, "couldn't ",
- ((writing) ? "write" : "read"), " file \"", spec, "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't %s file \"%s\": %s",
+ (writing ? "write" : "read"), spec,
+ Tcl_PosixError(interp)));
return NULL;
}
*closePtr = 1;
@@ -151,8 +153,8 @@ FileForRedirect(
return file;
badLastArg:
- Tcl_AppendResult(interp, "can't specify \"", arg,
- "\" as last word in command", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't specify \"%s\" as last word in command", arg));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "SYNTAX", NULL);
return NULL;
}
@@ -304,8 +306,8 @@ TclCleanupChildren(
msg =
"child process lost (is SIGCHLD ignored or trapped?)";
}
- Tcl_AppendResult(interp, "error waiting for process to exit: ",
- msg, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error waiting for process to exit: %s", msg));
}
continue;
}
@@ -335,16 +337,17 @@ TclCleanupChildren(
p = Tcl_SignalMsg(WTERMSIG(waitStatus));
Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
Tcl_SignalId(WTERMSIG(waitStatus)), p, NULL);
- Tcl_AppendResult(interp, "child killed: ", p, "\n", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "child killed: %s\n", p));
} else if (WIFSTOPPED(waitStatus)) {
p = Tcl_SignalMsg(WSTOPSIG(waitStatus));
Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
Tcl_SignalId(WSTOPSIG(waitStatus)), p, NULL);
- Tcl_AppendResult(interp, "child suspended: ", p, "\n",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "child suspended: %s\n", p));
} else {
- Tcl_AppendResult(interp,
- "child wait status didn't make sense\n", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "child wait status didn't make sense\n", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
"ODDWAITRESULT", msg1, NULL);
}
@@ -374,8 +377,9 @@ TclCleanupChildren(
result = TCL_ERROR;
Tcl_DecrRefCount(objPtr);
Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "error reading stderr output file: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error reading stderr output file: %s",
+ Tcl_PosixError(interp)));
} else if (count > 0) {
anyErrorInfo = 1;
Tcl_SetObjResult(interp, objPtr);
@@ -393,7 +397,8 @@ TclCleanupChildren(
*/
if ((abnormalExit != 0) && (anyErrorInfo == 0) && (interp != NULL)) {
- Tcl_AppendResult(interp, "child process exited abnormally", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "child process exited abnormally", -1));
}
return result;
}
@@ -542,8 +547,8 @@ TclCreatePipeline(
}
if (*p == '\0') {
if ((i == (lastBar + 1)) || (i == (argc - 1))) {
- Tcl_SetResult(interp, "illegal use of | or |& in command",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal use of | or |& in command", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
"PIPESYNTAX", NULL);
goto error;
@@ -570,8 +575,9 @@ TclCreatePipeline(
if (*inputLiteral == '\0') {
inputLiteral = ((i + 1) == argc) ? NULL : argv[i + 1];
if (inputLiteral == NULL) {
- Tcl_AppendResult(interp, "can't specify \"", argv[i],
- "\" as last word in command", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't specify \"%s\" as last word in command",
+ argv[i]));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
"PIPESYNTAX", NULL);
goto error;
@@ -680,8 +686,9 @@ TclCreatePipeline(
*/
if (i != argc-1) {
- Tcl_AppendResult(interp, "must specify \"", argv[i],
- "\" as last word in command", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "must specify \"%s\" as last word in command",
+ argv[i]));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
"PIPESYNTAX", NULL);
goto error;
@@ -722,8 +729,8 @@ TclCreatePipeline(
* We had a bar followed only by redirections.
*/
- Tcl_SetResult(interp, "illegal use of | or |& in command",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "illegal use of | or |& in command", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX",
NULL);
goto error;
@@ -739,9 +746,9 @@ TclCreatePipeline(
inputFile = TclpCreateTempFile(inputLiteral);
if (inputFile == NULL) {
- Tcl_AppendResult(interp,
- "couldn't create input file for command: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't create input file for command: %s",
+ Tcl_PosixError(interp)));
goto error;
}
inputClose = 1;
@@ -752,9 +759,9 @@ TclCreatePipeline(
*/
if (TclpCreatePipe(&inputFile, inPipePtr) == 0) {
- Tcl_AppendResult(interp,
- "couldn't create input pipe for command: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't create input pipe for command: %s",
+ Tcl_PosixError(interp)));
goto error;
}
inputClose = 1;
@@ -781,9 +788,9 @@ TclCreatePipeline(
*/
if (TclpCreatePipe(outPipePtr, &outputFile) == 0) {
- Tcl_AppendResult(interp,
- "couldn't create output pipe for command: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't create output pipe for command: %s",
+ Tcl_PosixError(interp)));
goto error;
}
outputClose = 1;
@@ -821,9 +828,9 @@ TclCreatePipeline(
errorFile = TclpCreateTempFile(NULL);
if (errorFile == NULL) {
- Tcl_AppendResult(interp,
- "couldn't create error file for command: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't create error file for command: %s",
+ Tcl_PosixError(interp)));
goto error;
}
*errFilePtr = errorFile;
@@ -894,8 +901,8 @@ TclCreatePipeline(
} else {
argv[lastArg] = NULL;
if (TclpCreatePipe(&pipeIn, &curOutFile) == 0) {
- Tcl_AppendResult(interp, "couldn't create pipe: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't create pipe: %s", Tcl_PosixError(interp)));
goto error;
}
}
@@ -1074,15 +1081,17 @@ Tcl_OpenCommandChannel(
if (flags & TCL_ENFORCE_MODE) {
if ((flags & TCL_STDOUT) && (outPipe == NULL)) {
- Tcl_AppendResult(interp, "can't read output from command:"
- " standard output was redirected", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't read output from command:"
+ " standard output was redirected", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
"BADREDIRECT", NULL);
goto error;
}
if ((flags & TCL_STDIN) && (inPipe == NULL)) {
- Tcl_AppendResult(interp, "can't write input to command:"
- " standard input was redirected", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't write input to command:"
+ " standard input was redirected", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
"BADREDIRECT", NULL);
goto error;
@@ -1093,8 +1102,8 @@ Tcl_OpenCommandChannel(
numPids, pidPtr);
if (channel == NULL) {
- Tcl_AppendResult(interp, "pipe for command could not be created",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "pipe for command could not be created", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "NOPIPE", NULL);
goto error;
}
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 382ffe3..9b6e942 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -154,8 +154,9 @@ Tcl_PkgProvideEx(
}
return TCL_OK;
}
- Tcl_AppendResult(interp, "conflicting versions provided for package \"",
- name, "\": ", pkgPtr->version, ", then ", version, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "conflicting versions provided for package \"%s\": %s, then %s",
+ name, pkgPtr->version, version));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", NULL);
return TCL_ERROR;
}
@@ -284,9 +285,9 @@ Tcl_PkgRequireEx(
*/
tclEmptyStringRep = &tclEmptyString;
- Tcl_AppendResult(interp, "Cannot load package \"", name,
- "\" in standalone executable: This package is not "
- "compiled with stub support", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "Cannot load package \"%s\" in standalone executable:"
+ " This package is not compiled with stub support", name));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNSTUBBED", NULL);
return NULL;
}
@@ -374,9 +375,10 @@ PkgRequireCore(
*/
if (pkgPtr->clientData != NULL) {
- Tcl_AppendResult(interp, "circular package dependency: "
- "attempt to provide ", name, " ",
- (char *) pkgPtr->clientData, " requires ", name, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "circular package dependency:"
+ " attempt to provide %s %s requires %s",
+ name, (char *) pkgPtr->clientData, name));
AddRequirementsToResult(interp, reqc, reqv);
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL);
return NULL;
@@ -494,10 +496,10 @@ PkgRequireCore(
Tcl_ResetResult(interp);
if (pkgPtr->version == NULL) {
code = TCL_ERROR;
- Tcl_AppendResult(interp, "attempt to provide package ",
- name, " ", versionToProvide,
- " failed: no version of package ", name,
- " provided", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "attempt to provide package %s %s failed:"
+ " no version of package %s provided",
+ name, versionToProvide, name));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
NULL);
} else {
@@ -517,11 +519,11 @@ PkgRequireCore(
ckfree(vi);
if (res != 0) {
code = TCL_ERROR;
- Tcl_AppendResult(interp,
- "attempt to provide package ", name, " ",
- versionToProvide, " failed: package ",
- name, " ", pkgPtr->version,
- " provided instead", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "attempt to provide package %s %s failed:"
+ " package %s %s provided instead",
+ name, versionToProvide,
+ name, pkgPtr->version));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE",
"WRONGPROVIDE", NULL);
}
@@ -530,10 +532,10 @@ PkgRequireCore(
} else if (code != TCL_ERROR) {
Tcl_Obj *codePtr = Tcl_NewIntObj(code);
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "attempt to provide package ", name,
- " ", versionToProvide, " failed: bad return code: ",
- TclGetString(codePtr), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "attempt to provide package %s %s failed:"
+ " bad return code: %s",
+ name, versionToProvide, TclGetString(codePtr)));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
TclDecrRefCount(codePtr);
code = TCL_ERROR;
@@ -591,13 +593,9 @@ PkgRequireCore(
Tcl_DStringFree(&command);
if ((code != TCL_OK) && (code != TCL_ERROR)) {
- Tcl_Obj *codePtr = Tcl_NewIntObj(code);
-
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad return code: ",
- TclGetString(codePtr), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad return code: %d", code));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
- Tcl_DecrRefCount(codePtr);
code = TCL_ERROR;
}
if (code == TCL_ERROR) {
@@ -610,7 +608,8 @@ PkgRequireCore(
}
if (pkgPtr->version == NULL) {
- Tcl_AppendResult(interp, "can't find package ", name, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't find package %s", name));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL);
AddRequirementsToResult(interp, reqc, reqv);
return NULL;
@@ -628,8 +627,9 @@ PkgRequireCore(
ckfree(pkgVersionI);
if (!satisfies) {
- Tcl_AppendResult(interp, "version conflict for package \"", name,
- "\": have ", pkgPtr->version, ", need", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "version conflict for package \"%s\": have %s, need",
+ name, pkgPtr->version));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
NULL);
AddRequirementsToResult(interp, reqc, reqv);
@@ -721,10 +721,11 @@ Tcl_PkgPresentEx(
}
if (version != NULL) {
- Tcl_AppendResult(interp, "package ", name, " ", version,
- " is not present", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "package %s %s is not present", name, version));
} else {
- Tcl_AppendResult(interp, "package ", name, " is not present", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "package %s is not present", name));
}
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PACKAGE", name, NULL);
return NULL;
@@ -850,7 +851,8 @@ Tcl_PackageObjCmd(
if (res == 0){
if (objc == 4) {
ckfree(argv3i);
- Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(availPtr->script, -1));
return TCL_OK;
}
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
@@ -955,7 +957,8 @@ Tcl_PackageObjCmd(
if (hPtr != NULL) {
pkgPtr = Tcl_GetHashValue(hPtr);
if (pkgPtr->version != NULL) {
- Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(pkgPtr->version, -1));
}
}
return TCL_OK;
@@ -1017,7 +1020,8 @@ Tcl_PackageObjCmd(
if (objc == 2) {
if (iPtr->packageUnknown != NULL) {
- Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(iPtr->packageUnknown, -1));
}
} else if (objc == 3) {
if (iPtr->packageUnknown != NULL) {
@@ -1351,8 +1355,8 @@ CheckVersionAndConvert(
error:
ckfree(ibuf);
- Tcl_AppendResult(interp, "expected version number but got \"", string,
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected version number but got \"%s\"", string));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSION", NULL);
return TCL_ERROR;
}
@@ -1614,8 +1618,8 @@ CheckRequirement(
* More dashes found after the first. This is wrong.
*/
- Tcl_AppendResult(interp, "expected versionMin-versionMax but got \"",
- string, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected versionMin-versionMax but got \"%s\"", string));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSIONRANGE", NULL);
return TCL_ERROR;
}
@@ -1667,19 +1671,17 @@ AddRequirementsToResult(
Tcl_Obj *const reqv[]) /* 0 means to use the latest version
* available. */
{
- if (reqc > 0) {
- int i;
+ Tcl_Obj *result = Tcl_GetObjResult(interp);
+ int i, length;
- for (i = 0; i < reqc; i++) {
- int length;
- const char *v = Tcl_GetStringFromObj(reqv[i], &length);
+ for (i = 0; i < reqc; i++) {
+ const char *v = Tcl_GetStringFromObj(reqv[i], &length);
- if ((length & 0x1) && (v[length/2] == '-')
- && (strncmp(v, v+((length+1)/2), length/2) == 0)) {
- Tcl_AppendResult(interp, " exactly ", v+((length+1)/2), NULL);
- } else {
- Tcl_AppendResult(interp, " ", v, NULL);
- }
+ if ((length & 0x1) && (v[length/2] == '-')
+ && (strncmp(v, v+((length+1)/2), length/2) == 0)) {
+ Tcl_AppendPrintfToObj(result, " exactly %s", v+((length+1)/2));
+ } else {
+ Tcl_AppendPrintfToObj(result, " %s", v);
}
}
}
@@ -1708,9 +1710,9 @@ AddRequirementsToDString(
Tcl_Obj *const reqv[]) /* 0 means to use the latest version
* available. */
{
- if (reqc > 0) {
- int i;
+ int i;
+ if (reqc > 0) {
for (i = 0; i < reqc; i++) {
TclDStringAppendLiteral(dsPtr, " ");
TclDStringAppendObj(dsPtr, reqv[i]);
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 537008c..933e7d2 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -152,22 +152,24 @@ Tcl_ProcObjCmd(
&nsPtr, &altNsPtr, &cxtNsPtr, &procName);
if (nsPtr == NULL) {
- Tcl_AppendResult(interp, "can't create procedure \"", fullName,
- "\": unknown namespace", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create procedure \"%s\": unknown namespace",
+ fullName));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
return TCL_ERROR;
}
if (procName == NULL) {
- Tcl_AppendResult(interp, "can't create procedure \"", fullName,
- "\": bad procedure name", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create procedure \"%s\": bad procedure name",
+ fullName));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
return TCL_ERROR;
}
if ((nsPtr != iPtr->globalNsPtr)
&& (procName != NULL) && (procName[0] == ':')) {
- Tcl_AppendResult(interp, "can't create procedure \"", procName,
- "\" in non-global namespace with name starting with \":\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't create procedure \"%s\" in non-global namespace with"
+ " name starting with \":\"", procName));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
return TCL_ERROR;
}
@@ -518,16 +520,17 @@ TclCreateProc(
}
if (fieldCount > 2) {
ckfree(fieldValues);
- Tcl_AppendResult(interp,
- "too many fields in argument specifier \"",
- argArray[i], "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "too many fields in argument specifier \"%s\"",
+ argArray[i]));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"FORMALARGUMENTFORMAT", NULL);
goto procError;
}
if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
ckfree(fieldValues);
- Tcl_AppendResult(interp, "argument with no name", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "argument with no name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"FORMALARGUMENTFORMAT", NULL);
goto procError;
@@ -553,16 +556,18 @@ TclCreateProc(
} while (*q != '\0');
q--;
if (*q == ')') { /* We have an array element. */
- Tcl_AppendResult(interp, "formal parameter \"",
- fieldValues[0], "\" is an array element", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "formal parameter \"%s\" is an array element",
+ fieldValues[0]));
ckfree(fieldValues);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"FORMALARGUMENTFORMAT", NULL);
goto procError;
}
} else if ((*p == ':') && (*(p+1) == ':')) {
- Tcl_AppendResult(interp, "formal parameter \"",
- fieldValues[0], "\" is not a simple name", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "formal parameter \"%s\" is not a simple name",
+ fieldValues[0]));
ckfree(fieldValues);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"FORMALARGUMENTFORMAT", NULL);
@@ -767,8 +772,7 @@ TclGetFrame(
return result;
levelError:
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad level \"", name, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
return -1;
}
@@ -900,8 +904,7 @@ TclObjGetFrame(
return result;
levelError:
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad level \"", name, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
return -1;
}
@@ -1879,10 +1882,9 @@ InterpProcNR2(
* transform to an error now.
*/
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "invoked \"",
- ((result == TCL_BREAK) ? "break" : "continue"),
- "\" outside of a loop", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invoked \"%s\" outside of a loop",
+ ((result == TCL_BREAK) ? "break" : "continue")));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED", NULL);
result = TCL_ERROR;
@@ -1999,8 +2001,8 @@ TclProcCompileProc(
if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
if ((Interp *) *codePtr->interpHandle != iPtr) {
- Tcl_AppendResult(interp,
- "a precompiled script jumped interps", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "a precompiled script jumped interps", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"CROSSINTERPBYTECODE", NULL);
return TCL_ERROR;
@@ -2932,8 +2934,8 @@ Tcl_DisassembleObjCmd(
procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));
if (procPtr == NULL) {
- Tcl_AppendResult(interp, "\"", TclGetString(objv[2]),
- "\" isn't a procedure", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't a procedure", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROC",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
@@ -2982,8 +2984,8 @@ Tcl_DisassembleObjCmd(
return TCL_ERROR;
}
if (oPtr->classPtr == NULL) {
- Tcl_AppendResult(interp, "\"", TclGetString(objv[2]),
- "\" is not a class", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" is not a class", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
@@ -3017,16 +3019,16 @@ Tcl_DisassembleObjCmd(
methodBody:
if (hPtr == NULL) {
unknownMethod:
- Tcl_AppendResult(interp, "unknown method \"",
- TclGetString(objv[3]), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown method \"%s\"", TclGetString(objv[3])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[3]), NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
if (procPtr == NULL) {
- Tcl_AppendResult(interp,
- "body not available for this kind of method", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "body not available for this kind of method", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
"METHODTYPE", NULL);
return TCL_ERROR;
@@ -3061,7 +3063,8 @@ Tcl_DisassembleObjCmd(
if (((ByteCode *) codeObjPtr->internalRep.otherValuePtr)->flags
& TCL_BYTECODE_PRECOMPILED) {
- Tcl_AppendResult(interp,"may not disassemble prebuilt bytecode",NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may not disassemble prebuilt bytecode", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
"BYTECODE", NULL);
return TCL_ERROR;
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index 53d7153..6c1dc08 100644
--- a/generic/tclRegexp.c
+++ b/generic/tclRegexp.c
@@ -714,14 +714,14 @@ TclRegError(
int status) /* Status code to report. */
{
char buf[100]; /* ample in practice */
- char cbuf[100]; /* lots in practice */
+ char cbuf[TCL_INTEGER_SPACE];
size_t n;
const char *p;
Tcl_ResetResult(interp);
n = TclReError(status, NULL, buf, sizeof(buf));
p = (n > sizeof(buf)) ? "..." : "";
- Tcl_AppendResult(interp, msg, buf, p, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s%s%s", msg, buf, p));
sprintf(cbuf, "%d", status);
(void) TclReError(REG_ITOA, NULL, cbuf, sizeof(cbuf));
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 4443cc1..17aac74 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -1390,10 +1390,9 @@ TclMergeReturnOptions(
* Value is not a legal dictionary.
*/
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad ", compare,
- " value: expected dictionary but got \"",
- TclGetString(objv[1]), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad %s value: expected dictionary but got \"%s\"",
+ compare, TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS",
NULL);
goto error;
@@ -1440,10 +1439,9 @@ TclMergeReturnOptions(
* Value is not a legal level.
*/
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad -level value: "
- "expected non-negative integer but got \"",
- TclGetString(valuePtr), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad -level value: expected non-negative integer but got"
+ " \"%s\"", TclGetString(valuePtr)));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_LEVEL", NULL);
goto error;
}
@@ -1462,10 +1460,10 @@ TclMergeReturnOptions(
/*
* Value is not a list, which is illegal for -errorcode.
*/
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad -errorcode value: "
- "expected a list but got \"",
- TclGetString(valuePtr), "\"", NULL);
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad -errorcode value: expected a list but got \"%s\"",
+ TclGetString(valuePtr)));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_ERRORCODE",
NULL);
goto error;
@@ -1484,10 +1482,10 @@ TclMergeReturnOptions(
/*
* Value is not a list, which is illegal for -errorstack.
*/
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad -errorstack value: "
- "expected a list but got \"", TclGetString(valuePtr),
- "\"", NULL);
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad -errorstack value: expected a list but got \"%s\"",
+ TclGetString(valuePtr)));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK",
NULL);
goto error;
@@ -1496,10 +1494,10 @@ TclMergeReturnOptions(
/*
* Errorstack must always be an even-sized list
*/
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp,
- "forbidden odd-sized list for -errorstack: \"",
- TclGetString(valuePtr), "\"", NULL);
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "forbidden odd-sized list for -errorstack: \"%s\"",
+ TclGetString(valuePtr)));
Tcl_SetErrorCode(interp, "TCL", "RESULT",
"ODDSIZEDLIST_ERRORSTACK", NULL);
goto error;
@@ -1650,9 +1648,8 @@ Tcl_SetReturnOptions(
Tcl_IncrRefCount(options);
if (TCL_ERROR == TclListObjGetElements(interp, options, &objc, &objv)
|| (objc % 2)) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "expected dict but got \"",
- TclGetString(options), "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected dict but got \"%s\"", TclGetString(options)));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS", NULL);
code = TCL_ERROR;
} else if (TCL_ERROR == TclMergeReturnOptions(interp, objc, objv,
diff --git a/generic/tclScan.c b/generic/tclScan.c
index d21bfaf..ef7eedf 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -261,6 +261,10 @@ ValidateFormat(
int objIndex, xpgSize, nspace = numVars;
int *nassign = TclStackAlloc(interp, nspace * sizeof(int));
char buf[TCL_UTF_MAX+1];
+ Tcl_Obj *errorMsg; /* Place to build an error messages. Note that
+ * these are messy operations because we do
+ * not want to use the formatting engine;
+ * we're inside there! */
/*
* Initialize an array that records the number of times a variable is
@@ -328,9 +332,9 @@ ValidateFormat(
gotSequential = 1;
if (gotXpg) {
mixedXPG:
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot mix \"%\" and \"%n$\" conversion specifiers",
- TCL_STATIC);
+ -1));
Tcl_SetErrorCode(interp, "TCL", "FORMAT", "MIXEDSPECTYPES", NULL);
goto error;
}
@@ -375,9 +379,9 @@ ValidateFormat(
switch (ch) {
case 'c':
if (flags & SCAN_WIDTH) {
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"field width may not be specified in %c conversion",
- TCL_STATIC);
+ -1));
Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADWIDTH", NULL);
goto error;
}
@@ -389,9 +393,11 @@ ValidateFormat(
if (flags & (SCAN_LONGER|SCAN_BIG)) {
invalidFieldSize:
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
- Tcl_AppendResult(interp,
- "field size modifier may not be specified in %", buf,
- " conversion", NULL);
+ errorMsg = Tcl_NewStringObj(
+ "field size modifier may not be specified in %", -1);
+ Tcl_AppendToObj(errorMsg, buf, -1);
+ Tcl_AppendToObj(errorMsg, " conversion", -1);
+ Tcl_SetObjResult(interp, errorMsg);
Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADSIZE", NULL);
goto error;
}
@@ -409,8 +415,8 @@ ValidateFormat(
break;
case 'u':
if (flags & SCAN_BIG) {
- Tcl_SetResult(interp,
- "unsigned bignum scans are invalid", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unsigned bignum scans are invalid", -1));
Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL);
goto error;
}
@@ -446,15 +452,18 @@ ValidateFormat(
}
break;
badSet:
- Tcl_SetResult(interp, "unmatched [ in format string",
- TCL_STATIC);
- Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BRACKET", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unmatched [ in format string", -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BRACKET", NULL);
goto error;
default:
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
- Tcl_AppendResult(interp, "bad scan conversion character \"", buf,
- "\"", NULL);
- Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL);
+ errorMsg = Tcl_NewStringObj(
+ "bad scan conversion character \"", -1);
+ Tcl_AppendToObj(errorMsg, buf, -1);
+ Tcl_AppendToObj(errorMsg, "\"", -1);
+ Tcl_SetObjResult(interp, errorMsg);
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL);
goto error;
}
if (!(flags & SCAN_SUPPRESS)) {
@@ -498,9 +507,9 @@ ValidateFormat(
}
for (i = 0; i < numVars; i++) {
if (nassign[i] > 1) {
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"variable is assigned by multiple \"%n$\" conversion specifiers",
- TCL_STATIC);
+ -1));
Tcl_SetErrorCode(interp, "TCL", "FORMAT", "POLYASSIGNED", NULL);
goto error;
} else if (!xpgSize && (nassign[i] == 0)) {
@@ -509,9 +518,9 @@ ValidateFormat(
* and/or numVars != 0), then too many vars were given
*/
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"variable is not assigned by any conversion specifiers",
- TCL_STATIC);
+ -1));
Tcl_SetErrorCode(interp, "TCL", "FORMAT", "UNASSIGNED", NULL);
goto error;
}
@@ -522,13 +531,13 @@ ValidateFormat(
badIndex:
if (gotXpg) {
- Tcl_SetResult(interp, "\"%n$\" argument index out of range",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "\"%n$\" argument index out of range", -1));
Tcl_SetErrorCode(interp, "TCL", "FORMAT", "INDEXRANGE", NULL);
} else {
- Tcl_SetResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"different numbers of variable names and field specifiers",
- TCL_STATIC);
+ -1));
Tcl_SetErrorCode(interp, "TCL", "FORMAT", "FIELDVARMISMATCH", NULL);
}
diff --git a/generic/tclTest.c b/generic/tclTest.c
index b4192b2..aa5a46d 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -16,7 +16,7 @@
*/
#ifndef _WIN64
-/* See [Bug 2935503]: file mtime sets wrong time */
+/* See [Bug 3354324]: file mtime sets wrong time */
# define _USE_32BIT_TIME_T
#endif
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index 36adaad..6b17825 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -829,8 +829,9 @@ Tcl_AfterObjCmd(
if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
const char *arg = Tcl_GetString(objv[1]);
- Tcl_AppendResult(interp, "bad argument \"", arg,
- "\": must be cancel, idle, info, or an integer", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad argument \"%s\": must be"
+ " cancel, idle, info, or an integer", arg));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument",
arg, NULL);
return TCL_ERROR;
@@ -968,8 +969,8 @@ Tcl_AfterObjCmd(
if (afterPtr == NULL) {
const char *eventStr = TclGetString(objv[2]);
- Tcl_AppendResult(interp, "event \"", eventStr, "\" doesn't exist",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "event \"%s\" doesn't exist", eventStr));
Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, NULL);
return TCL_ERROR;
} else {
diff --git a/generic/tclTomMathStubLib.c b/generic/tclTomMathStubLib.c
index e7e4aea..a3bc4b3 100644
--- a/generic/tclTomMathStubLib.c
+++ b/generic/tclTomMathStubLib.c
@@ -73,10 +73,10 @@ TclTomMathInitializeStubs(
tclTomMathStubsPtr = stubsPtr;
return actualVersion;
}
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "error loading ", packageName,
- " (requested version ", version, ", actual version ",
- actualVersion, "): ", errMsg, NULL);
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error loading %s (requested version %s, actual version %s): %s",
+ packageName, version, actualVersion, errMsg));
return NULL;
}
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 529c38a..519f201 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -366,8 +366,9 @@ Tcl_TraceObjCmd(
return TCL_OK;
badVarOps:
- Tcl_AppendResult(interp, "bad operations \"", flagOps,
- "\": should be one or more of rwua", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad operations \"%s\": should be one or more of rwua",
+ flagOps));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "BADOPS", NULL);
return TCL_ERROR;
}
@@ -434,9 +435,9 @@ TraceExecutionObjCmd(
return result;
}
if (listLen == 0) {
- Tcl_SetResult(interp, "bad operation list \"\": must be "
- "one or more of enter, leave, enterstep, or leavestep",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad operation list \"\": must be one or more of"
+ " enter, leave, enterstep, or leavestep", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
NULL);
return TCL_ERROR;
@@ -677,8 +678,9 @@ TraceCommandObjCmd(
return result;
}
if (listLen == 0) {
- Tcl_SetResult(interp, "bad operation list \"\": must be "
- "one or more of delete or rename", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad operation list \"\": must be one or more of"
+ " delete or rename", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
NULL);
return TCL_ERROR;
@@ -875,8 +877,9 @@ TraceVariableObjCmd(
return result;
}
if (listLen == 0) {
- Tcl_SetResult(interp, "bad operation list \"\": must be "
- "one or more of array, read, unset, or write", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad operation list \"\": must be one or more of"
+ " array, read, unset, or write", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
NULL);
return TCL_ERROR;
@@ -2715,7 +2718,8 @@ TclCallVarTraces(
if (disposeFlags & TCL_TRACE_RESULT_OBJECT) {
Tcl_SetObjResult((Tcl_Interp *)iPtr, (Tcl_Obj *) result);
} else {
- Tcl_SetResult((Tcl_Interp *)iPtr, result, TCL_STATIC);
+ Tcl_SetObjResult((Tcl_Interp *)iPtr,
+ Tcl_NewStringObj(result, -1));
}
Tcl_AddErrorInfo((Tcl_Interp *)iPtr, "");
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 63c9fb2..6d42080 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -655,16 +655,16 @@ TclFindElement(
if (p == limit) {
if (openBraces != 0) {
if (interp != NULL) {
- Tcl_SetResult(interp, "unmatched open brace in list",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unmatched open brace in list", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "BRACE",
NULL);
}
return TCL_ERROR;
} else if (inQuotes) {
if (interp != NULL) {
- Tcl_SetResult(interp, "unmatched open quote in list",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unmatched open quote in list", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "QUOTE",
NULL);
}
@@ -810,8 +810,8 @@ Tcl_SplitList(
if (i >= size) {
ckfree(argv);
if (interp != NULL) {
- Tcl_SetResult(interp, "internal error in Tcl_SplitList",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "internal error in Tcl_SplitList", -1));
Tcl_SetErrorCode(interp, "TCL", "INTERNAL", "Tcl_SplitList",
NULL);
}
@@ -3382,16 +3382,10 @@ TclGetIntForIndex(
parseError:
if (interp != NULL) {
- /*
- * The result might not be empty; this resets it which should be both
- * a cheap operation, and of little problem because this is an
- * error-generation path anyway.
- */
-
bytes = Tcl_GetString(objPtr);
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad index \"", bytes,
- "\": must be integer?[+-]integer? or end?[+-]integer?", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad index \"%s\": must be integer?[+-]integer? or"
+ " end?[+-]integer?", bytes));
if (!strncmp(bytes, "end-", 4)) {
bytes += 4;
}
@@ -3483,9 +3477,8 @@ SetEndOffsetFromAny(
if ((*bytes != 'e') || (strncmp(bytes, "end",
(size_t)((length > 3) ? 3 : length)) != 0)) {
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad index \"", bytes,
- "\": must be end?[+-]integer?", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad index \"%s\": must be end?[+-]integer?", bytes));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
}
return TCL_ERROR;
@@ -3519,9 +3512,8 @@ SetEndOffsetFromAny(
badIndexFormat:
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad index \"", bytes,
- "\": must be end?[+-]integer?", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad index \"%s\": must be end?[+-]integer?", bytes));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
}
return TCL_ERROR;
@@ -3597,8 +3589,8 @@ TclCheckBadOctal(
* be added to an existing error message as extra info.
*/
- Tcl_AppendResult(interp, " (looks like invalid octal number)",
- NULL);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ " (looks like invalid octal number)", -1);
}
return 1;
}
@@ -4214,7 +4206,7 @@ TclReToGlob(
invalidGlob:
if (interp != NULL) {
- Tcl_AppendResult(interp, msg, NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, NULL);
}
Tcl_DStringFree(dsPtr);
diff --git a/generic/tclVar.c b/generic/tclVar.c
index e92dc5f..e31e9cf 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -3065,7 +3065,8 @@ ArrayStartSearchCmd(
if ((varPtr == NULL) || !TclIsVarArray(varPtr)
|| TclIsVarUndefined(varPtr)) {
- Tcl_AppendResult(interp, "\"", varName, "\" isn't an array", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't an array", varName));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", varName, NULL);
return TCL_ERROR;
}
@@ -3160,8 +3161,8 @@ ArrayAnyMoreCmd(
if ((varPtr == NULL) || !TclIsVarArray(varPtr)
|| TclIsVarUndefined(varPtr)) {
- Tcl_AppendResult(interp, "\"", TclGetString(varNameObj),
- "\" isn't an array", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't an array", TclGetString(varNameObj)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
TclGetString(varNameObj), NULL);
return TCL_ERROR;
@@ -3266,8 +3267,8 @@ ArrayNextElementCmd(
if ((varPtr == NULL) || !TclIsVarArray(varPtr)
|| TclIsVarUndefined(varPtr)) {
- Tcl_AppendResult(interp, "\"", TclGetString(varNameObj),
- "\" isn't an array", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't an array", TclGetString(varNameObj)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
TclGetString(varNameObj), NULL);
return TCL_ERROR;
@@ -3376,8 +3377,8 @@ ArrayDoneSearchCmd(
if ((varPtr == NULL) || !TclIsVarArray(varPtr)
|| TclIsVarUndefined(varPtr)) {
- Tcl_AppendResult(interp, "\"", TclGetString(varNameObj),
- "\" isn't an array", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't an array", TclGetString(varNameObj)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
TclGetString(varNameObj), NULL);
return TCL_ERROR;
@@ -4019,8 +4020,8 @@ ArrayStatsCmd(
if ((varPtr == NULL) || !TclIsVarArray(varPtr)
|| TclIsVarUndefined(varPtr)) {
- Tcl_AppendResult(interp, "\"", TclGetString(varNameObj),
- "\" isn't an array", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" isn't an array", TclGetString(varNameObj)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
TclGetString(varNameObj), NULL);
return TCL_ERROR;
@@ -4028,7 +4029,8 @@ ArrayStatsCmd(
stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr);
if (stats == NULL) {
- Tcl_SetResult(interp, "error reading array statistics", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "error reading array statistics", -1));
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1));
@@ -4317,10 +4319,10 @@ ObjMakeUpvar(
|| (varFramePtr == NULL)
|| !HasLocalVars(varFramePtr)
|| (strstr(TclGetString(myNamePtr), "::") != NULL))) {
- Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
- TclGetString(myNamePtr), "\": upvar won't create "
+ Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
+ "bad variable name \"%s\": upvar won't create "
"namespace variable that refers to procedure variable",
- NULL);
+ TclGetString(myNamePtr)));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", NULL);
return TCL_ERROR;
}
@@ -4418,9 +4420,10 @@ TclPtrObjMakeUpvar(
* myName looks like an array reference.
*/
- Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
- myName, "\": upvar won't create a scalar variable "
- "that looks like an array element", NULL);
+ Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
+ "bad variable name \"%s\": upvar won't create a"
+ " scalar variable that looks like an array element",
+ myName));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT",
NULL);
return TCL_ERROR;
@@ -4447,15 +4450,15 @@ TclPtrObjMakeUpvar(
}
if (varPtr == otherPtr) {
- Tcl_SetResult((Tcl_Interp *) iPtr,
- "can't upvar from variable to itself", TCL_STATIC);
+ Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_NewStringObj(
+ "can't upvar from variable to itself", -1));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "SELF", NULL);
return TCL_ERROR;
}
if (TclIsVarTraced(varPtr)) {
- Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
- "\" has traces: can't use for upvar", NULL);
+ Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
+ "variable \"%s\" has traces: can't use for upvar", myName));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "TRACED", NULL);
return TCL_ERROR;
} else if (!TclIsVarUndefined(varPtr)) {
@@ -4469,8 +4472,8 @@ TclPtrObjMakeUpvar(
*/
if (!TclIsVarLink(varPtr)) {
- Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
- "\" already exists", NULL);
+ Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
+ "variable \"%s\" already exists", myName));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "EXISTS", NULL);
return TCL_ERROR;
}
@@ -4968,8 +4971,8 @@ Tcl_UpvarObjCmd(
* for this particular case.
*/
- Tcl_AppendResult(interp, "bad level \"", TclGetString(levelObj), "\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad level \"%s\"", TclGetString(levelObj)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "LEVEL", NULL);
return TCL_ERROR;
}
@@ -4978,8 +4981,8 @@ Tcl_UpvarObjCmd(
* We've now finished with parsing levels; skip to the variable names.
*/
- objc -= hasLevel+1;
- objv += hasLevel+1;
+ objc -= hasLevel + 1;
+ objv += hasLevel + 1;
/*
* Iterate over each (other variable, local variable) pair. Divide the
@@ -5060,8 +5063,8 @@ SetArraySearchObj(
return TCL_OK;
syntax:
- Tcl_AppendResult(interp, "illegal search identifier \"", string, "\"",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "illegal search identifier \"%s\"", string));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
return TCL_ERROR;
}
@@ -5126,10 +5129,9 @@ ParseSearchId(
*/
if (strcmp(string+offset, varName) != 0) {
- Tcl_AppendResult(interp, "search identifier \"", string,
- "\" isn't for variable \"", varName, "\"", NULL);
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string,
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "search identifier \"%s\" isn't for variable \"%s\"",
+ string, varName));
goto badLookup;
}
@@ -5153,7 +5155,8 @@ ParseSearchId(
}
}
}
- Tcl_AppendResult(interp, "couldn't find search \"", string, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't find search \"%s\"", string));
badLookup:
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
return NULL;
@@ -5894,8 +5897,8 @@ ObjFindNamespaceVar(
Tcl_DecrRefCount(simpleNamePtr);
}
if ((varPtr == NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "unknown variable \"", name, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown variable \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", name, NULL);
}
return (Tcl_Var) varPtr;
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index a799639..544fb6e 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -577,8 +577,8 @@ Tcl_ZlibStreamInit(
TclDStringAppendObj(&cmdname, Tcl_GetObjResult(interp));
if (Tcl_GetCommandInfo(interp, Tcl_DStringValue(&cmdname),
&cmdinfo) == 1) {
- Tcl_SetResult(interp,
- "BUG: Stream command name already exists", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "BUG: Stream command name already exists", -1));
Tcl_SetErrorCode(interp, "TCL", "BUG", "EXISTING_CMD", NULL);
Tcl_DStringFree(&cmdname);
goto error;
@@ -900,8 +900,8 @@ Tcl_ZlibStreamPut(
if (zshPtr->streamEnd) {
if (zshPtr->interp) {
- Tcl_SetResult(zshPtr->interp,
- "already past compressed stream end", TCL_STATIC);
+ Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj(
+ "already past compressed stream end", -1));
Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", NULL);
}
return TCL_ERROR;
@@ -1085,9 +1085,9 @@ Tcl_ZlibStreamGet(
if (zshPtr->stream.avail_in > 0) {
if (zshPtr->interp) {
- Tcl_SetResult(zshPtr->interp,
- "Unexpected zlib internal state during decompression",
- TCL_STATIC);
+ Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj(
+ "unexpected zlib internal state during"
+ " decompression", -1));
Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "STATE",
NULL);
}
@@ -1896,7 +1896,7 @@ ZlibCmd(
format = TCL_ZLIB_FORMAT_GZIP;
break;
default:
- Tcl_AppendResult(interp, "IMPOSSIBLE", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("impossible!", -1));
return TCL_ERROR;
}
@@ -1910,16 +1910,16 @@ ZlibCmd(
*/
if (mode == TCL_ZLIB_STREAM_DEFLATE && !(chanMode & TCL_WRITABLE)) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"compression may only be applied to writable channels",
- NULL);
+ -1));
Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNWRITABLE", NULL);
return TCL_ERROR;
}
if (mode == TCL_ZLIB_STREAM_INFLATE && !(chanMode & TCL_READABLE)) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"decompression may only be applied to readable channels",
- NULL);
+ -1));
Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNREADABLE", NULL);
return TCL_ERROR;
}
@@ -1937,8 +1937,8 @@ ZlibCmd(
switch ((enum pushOptions) option) {
case poHeader:
if (++i > objc-1) {
- Tcl_AppendResult(interp,
- "value missing for -header option", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "value missing for -header option", -1));
Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
return TCL_ERROR;
}
@@ -1950,8 +1950,8 @@ ZlibCmd(
break;
case poLevel:
if (++i > objc-1) {
- Tcl_AppendResult(interp,
- "value missing for -level option", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "value missing for -level option", -1));
Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
return TCL_ERROR;
}
@@ -1967,8 +1967,8 @@ ZlibCmd(
break;
case poLimit:
if (++i > objc-1) {
- Tcl_AppendResult(interp,
- "value missing for -limit option", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "value missing for -limit option", -1));
Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
return TCL_ERROR;
}
@@ -1996,14 +1996,15 @@ ZlibCmd(
return TCL_ERROR;
badLevel:
- Tcl_AppendResult(interp, "level must be 0 to 9", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL);
if (extraInfoStr) {
Tcl_AddErrorInfo(interp, extraInfoStr);
}
return TCL_ERROR;
badBuffer:
- Tcl_AppendResult(interp, "buffer size must be 32 to 65536", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "buffer size must be 32 to 65536", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL);
return TCL_ERROR;
}
@@ -2086,9 +2087,9 @@ ZlibStreamCmd(
break;
case ao_buffer: /* -buffer */
if (i == objc-2) {
- Tcl_AppendResult(interp, "\"-buffer\" option must be "
- "followed by integer decompression buffersize",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "\"-buffer\" option must be followed by integer"
+ " decompression buffersize", -1));
Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
return TCL_ERROR;
}
@@ -2097,8 +2098,8 @@ ZlibStreamCmd(
return TCL_ERROR;
}
if (buffersize < 1 || buffersize > 65536) {
- Tcl_AppendResult(interp,
- "buffer size must be 32 to 65536", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "buffer size must be 32 to 65536", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE",
NULL);
return TCL_ERROR;
@@ -2106,8 +2107,9 @@ ZlibStreamCmd(
}
if (flush == -2) {
- Tcl_AppendResult(interp, "\"-flush\", \"-fullflush\" and "
- "\"-finalize\" options are mutually exclusive", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "\"-flush\", \"-fullflush\" and \"-finalize\" options"
+ " are mutually exclusive", -1));
Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", NULL);
return TCL_ERROR;
}
@@ -2158,13 +2160,14 @@ ZlibStreamCmd(
}
break;
case ao_buffer:
- Tcl_AppendResult(interp,
- "\"-buffer\" option not supported here", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "\"-buffer\" option not supported here", -1));
return TCL_ERROR;
}
if (flush == -2) {
- Tcl_AppendResult(interp, "\"-flush\", \"-fullflush\" and "
- "\"-finalize\" options are mutually exclusive", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "\"-flush\", \"-fullflush\" and \"-finalize\" options"
+ " are mutually exclusive", -1));
Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", NULL);
return TCL_ERROR;
}
@@ -2314,9 +2317,9 @@ ZlibTransformClose(
* then interp may be NULL */
if (!TclInThreadExit()) {
if (interp) {
- Tcl_AppendResult(interp,
- "error while finalizing file: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error while finalizing file: %s",
+ Tcl_PosixError(interp)));
}
}
result = TCL_ERROR;
@@ -2581,8 +2584,9 @@ ZlibTransformSetOption( /* not used */
} else if (value[0] == 's' && strcmp(value, "sync") == 0) {
flushType = Z_SYNC_FLUSH;
} else {
- Tcl_AppendResult(interp, "unknown -flush type \"", value,
- "\": must be full or sync", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown -flush type \"%s\": must be full or sync",
+ value));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "FLUSH", NULL);
return TCL_ERROR;
}
@@ -2610,8 +2614,9 @@ ZlibTransformSetOption( /* not used */
if (Tcl_WriteRaw(cd->parent, cd->outBuffer,
cd->outStream.next_out - (Bytef *) cd->outBuffer) < 0) {
- Tcl_AppendResult(interp, "problem flushing channel: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "problem flushing channel: %s",
+ Tcl_PosixError(interp)));
return TCL_ERROR;
}
}
@@ -3152,7 +3157,7 @@ Tcl_ZlibStreamInit(
Tcl_Obj *dictObj,
Tcl_ZlibStream *zshandle)
{
- Tcl_SetResult(interp, "unimplemented", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
return TCL_ERROR;
}
@@ -3218,7 +3223,7 @@ Tcl_ZlibDeflate(
int level,
Tcl_Obj *gzipHeaderDictObj)
{
- Tcl_SetResult(interp, "unimplemented", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
return TCL_ERROR;
}
@@ -3231,7 +3236,7 @@ Tcl_ZlibInflate(
int bufferSize,
Tcl_Obj *gzipHeaderDictObj)
{
- Tcl_SetResult(interp, "unimplemented", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
return TCL_ERROR;
}