summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclInterp.c101
-rw-r--r--generic/tclLoad.c57
-rw-r--r--generic/tclNamesp.c64
-rw-r--r--generic/tclObj.c42
-rw-r--r--generic/tclPipe.c93
-rw-r--r--generic/tclPkg.c99
-rw-r--r--generic/tclProc.c71
-rw-r--r--generic/tclZlib.c62
-rw-r--r--tests/format.test7
9 files changed, 310 insertions, 286 deletions
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 f14cec0..3fead6f 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -224,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;
@@ -262,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;
@@ -320,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;
@@ -417,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;
@@ -428,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;
@@ -653,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;
@@ -665,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;
@@ -694,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;
@@ -710,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;
@@ -720,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;
@@ -860,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/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/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/tclPipe.c b/generic/tclPipe.c
index 56a1846..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;
}
@@ -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;
@@ -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 730efec..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;
@@ -1354,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;
}
@@ -1617,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;
}
@@ -1670,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);
}
}
}
@@ -1711,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/tclZlib.c b/generic/tclZlib.c
index 8a57a91..544fb6e 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -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;
@@ -2611,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;
}
}
diff --git a/tests/format.test b/tests/format.test
index 2d53eba..27eac31 100644
--- a/tests/format.test
+++ b/tests/format.test
@@ -549,10 +549,7 @@ test format-18.2 {do not demote existing numeric values} {wideBiggerThanInt} {
list [format %08x $a] [expr {$a == $b}]
} {aaaaaaab 1}
-test format-19.1 {
- regression test - tcl-core message by Brian Griffin on
- 26 0ctober 2004
-} -body {
+test format-19.1 {regression test - tcl-core message by Brian Griffin on 26 0ctober 2004} -body {
set x 0x8fedc654
list [expr { ~ $x }] [format %08x [expr { ~$x }]]
} -match regexp -result {-2414724693 f*701239ab}
@@ -569,7 +566,7 @@ test format-20.1 {Bug 2932421: plain %s caused intrep change of args} -body {
format %s $x
# After this, obj in $x should be a dict with a non-NULL bytes field
tcl::unsupported::representation $x
-} -match glob -result {value is a dict with *, string representation "*".}
+} -match glob -result {value is a dict with *, string representation "*"}
# cleanup
catch {unset a}
generated by cgit v0.12 at 2024-07-05 00:34:58 (GMT)