summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclIO.c125
-rw-r--r--generic/tclIOCmd.c152
-rw-r--r--generic/tclIOGT.c4
-rw-r--r--generic/tclIORChan.c129
-rw-r--r--generic/tclIORTrans.c111
-rw-r--r--generic/tclIOSock.c36
-rw-r--r--generic/tclIOUtil.c102
-rw-r--r--macosx/tclMacOSXFCmd.c57
-rw-r--r--unix/tclUnixChan.c75
-rw-r--r--unix/tclUnixFCmd.c81
-rw-r--r--unix/tclUnixFile.c13
-rw-r--r--unix/tclUnixPipe.c64
-rw-r--r--unix/tclUnixSock.c146
-rw-r--r--win/tclWinChan.c16
-rw-r--r--win/tclWinDde.c7
-rw-r--r--win/tclWinFCmd.c16
-rw-r--r--win/tclWinFile.c12
-rw-r--r--win/tclWinPipe.c37
-rw-r--r--win/tclWinReg.c33
-rw-r--r--win/tclWinSerial.c143
-rw-r--r--win/tclWinSock.c42
21 files changed, 730 insertions, 671 deletions
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 eeb11f9..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);
@@ -775,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
*
@@ -790,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
*
@@ -806,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;
@@ -868,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;
}
@@ -926,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;
}
@@ -938,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;
@@ -958,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.
@@ -966,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
@@ -1157,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);
@@ -1166,7 +1175,7 @@ ReflectClose(
}
#endif
- Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
+ Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
return EOK;
}
@@ -1178,7 +1187,7 @@ ReflectClose(
*/
if (rcPtr->methods == 0) {
- Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
+ Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
return EOK;
}
@@ -1193,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);
@@ -1241,7 +1253,7 @@ ReflectClose(
}
#endif
- Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
+ Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
#ifdef TCL_THREADS
}
#endif
@@ -1349,7 +1361,7 @@ ReflectInput(
*errorCodePtr = EOK;
if (bytec > 0) {
- memcpy(buf, bytev, (size_t)bytec);
+ memcpy(buf, bytev, (size_t) bytec);
}
stop:
@@ -1550,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;
}
@@ -1773,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;
}
}
@@ -2047,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;
}
@@ -2808,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
@@ -2979,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 */
/*
@@ -3024,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);
@@ -3064,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;
}
@@ -3076,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);
@@ -3116,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);
@@ -3167,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);
@@ -3187,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);
@@ -3202,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 ebf34dc..115c132 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -1573,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;
}
@@ -1623,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;
@@ -1635,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;
@@ -1649,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;
@@ -1662,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;
}
@@ -1722,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;
}
@@ -1764,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);
@@ -1778,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;
}
@@ -1853,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;
}
@@ -1895,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;
}
@@ -1910,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;
}
@@ -2247,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;
@@ -2266,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;
}
@@ -2685,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();
@@ -2761,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) {
@@ -3153,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;
}
@@ -3204,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
@@ -3224,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/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c
index 9193c1a..f266443 100644
--- a/macosx/tclMacOSXFCmd.c
+++ b/macosx/tclMacOSXFCmd.c
@@ -148,8 +148,9 @@ TclMacOSXGetFileAttribute(
result = TclpObjStat(fileName, &statBuf);
if (result != 0) {
- Tcl_AppendResult(interp, "could not read \"", TclGetString(fileName),
- "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -159,8 +160,8 @@ TclMacOSXGetFileAttribute(
*/
errno = EISDIR;
- Tcl_AppendResult(interp, "invalid attribute: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid attribute: %s", Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -175,8 +176,9 @@ TclMacOSXGetFileAttribute(
result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0);
if (result != 0) {
- Tcl_AppendResult(interp, "could not read attributes of \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read attributes of \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -199,10 +201,11 @@ TclMacOSXGetFileAttribute(
}
return TCL_OK;
#else
- Tcl_AppendResult(interp, "Mac OS X file attributes not supported", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Mac OS X file attributes not supported", -1));
Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
return TCL_ERROR;
-#endif
+#endif /* HAVE_GETATTRLIST */
}
/*
@@ -241,8 +244,9 @@ TclMacOSXSetFileAttribute(
result = TclpObjStat(fileName, &statBuf);
if (result != 0) {
- Tcl_AppendResult(interp, "could not read \"", TclGetString(fileName),
- "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -252,8 +256,8 @@ TclMacOSXSetFileAttribute(
*/
errno = EISDIR;
- Tcl_AppendResult(interp, "invalid attribute: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "invalid attribute: %s", Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -268,8 +272,9 @@ TclMacOSXSetFileAttribute(
result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0);
if (result != 0) {
- Tcl_AppendResult(interp, "could not read attributes of \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read attributes of \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
return TCL_ERROR;
}
@@ -306,9 +311,9 @@ TclMacOSXSetFileAttribute(
&finfo.data, sizeof(finfo.data), 0);
if (result != 0) {
- Tcl_AppendResult(interp, "could not set attributes of \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set attributes of \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
return TCL_ERROR;
}
} else {
@@ -328,8 +333,8 @@ TclMacOSXSetFileAttribute(
*/
if (newRsrcForkSize != 0) {
- Tcl_AppendResult(interp,
- "setting nonzero rsrclength not supported", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "setting nonzero rsrclength not supported", -1));
Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
return TCL_ERROR;
}
@@ -360,17 +365,17 @@ TclMacOSXSetFileAttribute(
Tcl_DStringFree(&ds);
if (result != 0) {
- Tcl_AppendResult(interp,
- "could not truncate resource fork of \"",
- TclGetString(fileName), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not truncate resource fork of \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
return TCL_ERROR;
}
}
}
return TCL_OK;
#else
- Tcl_AppendResult(interp, "Mac OS X file attributes not supported", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Mac OS X file attributes not supported", -1));
Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
return TCL_ERROR;
#endif
@@ -640,8 +645,8 @@ SetOSTypeFromAny(
if (Tcl_DStringLength(&ds) > 4) {
if (interp) {
- Tcl_AppendResult(interp, "expected Macintosh OS type but got \"",
- string, "\": ", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected Macintosh OS type but got \"%s\": ", string));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "MAC_OSTYPE", NULL);
}
result = TCL_ERROR;
diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c
index 3845c44..9ee37f1 100644
--- a/unix/tclUnixChan.c
+++ b/unix/tclUnixChan.c
@@ -136,10 +136,10 @@ typedef struct TtyAttrs {
#endif /* !SUPPORTS_TTY */
#define UNSUPPORTED_OPTION(detail) \
- if (interp) { \
- Tcl_AppendResult(interp, (detail), \
- " not supported for this platform", NULL); \
- Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL); \
+ if (interp) { \
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf( \
+ "%s not supported for this platform", (detail))); \
+ Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL); \
}
/*
@@ -697,9 +697,9 @@ TtySetOptionProc(
return TCL_ERROR;
} else {
if (interp) {
- Tcl_AppendResult(interp, "bad value for -handshake: "
- "must be one of xonxoff, rtscts, dtrdsr or none",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -handshake: must be one of"
+ " xonxoff, rtscts, dtrdsr or none", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
"VALUE", NULL);
}
@@ -720,8 +720,9 @@ TtySetOptionProc(
return TCL_ERROR;
} else if (argc != 2) {
if (interp) {
- Tcl_AppendResult(interp, "bad value for -xchar: "
- "should be a list of two elements", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -xchar: should be a list of"
+ " two elements", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
"VALUE", NULL);
}
@@ -773,8 +774,9 @@ TtySetOptionProc(
}
if ((argc % 2) == 1) {
if (interp) {
- Tcl_AppendResult(interp, "bad value for -ttycontrol: "
- "should be a list of signal,value pairs", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -ttycontrol: should be a list of"
+ " signal,value pairs", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
"VALUE", NULL);
}
@@ -822,9 +824,9 @@ TtySetOptionProc(
#endif /* SETBREAK */
} else {
if (interp) {
- Tcl_AppendResult(interp, "bad signal \"", argv[i],
- "\" for -ttycontrol: must be "
- "DTR, RTS or BREAK", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad signal \"%s\" for -ttycontrol: must be"
+ " DTR, RTS or BREAK", argv[i]));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
"VALUE", NULL);
}
@@ -1388,8 +1390,8 @@ TtyParseMode(
stopPtr, &end);
if ((i != 4) || (mode[end] != '\0')) {
if (interp != NULL) {
- Tcl_AppendResult(interp, bad, ": should be baud,parity,data,stop",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s: should be baud,parity,data,stop", bad));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
}
return TCL_ERROR;
@@ -1412,13 +1414,14 @@ TtyParseMode(
#endif /* PAREXT|USE_TERMIO */
== NULL) {
if (interp != NULL) {
- Tcl_AppendResult(interp, bad, " parity: should be ",
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s parity: should be %s", bad,
#if defined(PAREXT) || defined(USE_TERMIO)
- "n, o, e, m, or s",
+ "n, o, e, m, or s"
#else
- "n, o, or e",
+ "n, o, or e"
#endif /* PAREXT|USE_TERMIO */
- NULL);
+ ));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
}
return TCL_ERROR;
@@ -1426,15 +1429,16 @@ TtyParseMode(
*parityPtr = parity;
if ((*dataPtr < 5) || (*dataPtr > 8)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, bad, " data: should be 5, 6, 7, or 8",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s data: should be 5, 6, 7, or 8", bad));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
}
return TCL_ERROR;
}
if ((*stopPtr < 0) || (*stopPtr > 2)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, bad, " stop: should be 1 or 2", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s stop: should be 1 or 2", bad));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
}
return TCL_ERROR;
@@ -1583,8 +1587,9 @@ TclpOpenFileChannel(
if (fd < 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr),
- "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't open \"%s\": %s",
+ TclGetString(pathPtr), Tcl_PosixError(interp)));
}
return NULL;
}
@@ -1842,15 +1847,15 @@ Tcl_GetOpenFile(
if (chan == NULL) {
return TCL_ERROR;
}
- if ((forWriting) && ((chanMode & TCL_WRITABLE) == 0)) {
- Tcl_AppendResult(interp, "\"", chanID, "\" wasn't opened for writing",
- NULL);
+ if (forWriting && !(chanMode & TCL_WRITABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" wasn't opened for writing", chanID));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NOT_WRITABLE",
NULL);
return TCL_ERROR;
- } else if ((!forWriting) && ((chanMode & TCL_READABLE) == 0)) {
- Tcl_AppendResult(interp, "\"", chanID, "\" wasn't opened for reading",
- NULL);
+ } else if (!forWriting && !(chanMode & TCL_READABLE)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" wasn't opened for reading", chanID));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NOT_READABLE",
NULL);
return TCL_ERROR;
@@ -1881,8 +1886,8 @@ Tcl_GetOpenFile(
f = fdopen(fd, (forWriting ? "w" : "r"));
if (f == NULL) {
- Tcl_AppendResult(interp, "cannot get a FILE * for \"", chanID,
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot get a FILE * for \"%s\"", chanID));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL",
"FILE_FAILURE", NULL);
return TCL_ERROR;
@@ -1892,8 +1897,8 @@ Tcl_GetOpenFile(
}
}
- Tcl_AppendResult(interp, "\"", chanID,
- "\" cannot be used to get a FILE *", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" cannot be used to get a FILE *", chanID));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NO_DESCRIPTOR",
NULL);
return TCL_ERROR;
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index a695e9c..d3cc6bf 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -1320,9 +1320,9 @@ GetGroupAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(fileName), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1374,9 +1374,9 @@ GetOwnerAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(fileName), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1425,9 +1425,9 @@ GetPermissionsAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(fileName), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1478,9 +1478,10 @@ SetGroupAttribute(
if (groupPtr == NULL) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not set group for file \"",
- TclGetString(fileName), "\": group \"", string,
- "\" does not exist", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set group for file \"%s\":"
+ " group \"%s\" does not exist",
+ TclGetString(fileName), string));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SETGRP",
"NO_GROUP", NULL);
}
@@ -1494,9 +1495,9 @@ SetGroupAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not set group for file \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set group for file \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1544,9 +1545,10 @@ SetOwnerAttribute(
if (pwPtr == NULL) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not set owner for file \"",
- TclGetString(fileName), "\": user \"", string,
- "\" does not exist", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set owner for file \"%s\":"
+ " user \"%s\" does not exist",
+ TclGetString(fileName), string));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SETOWN",
"NO_USER", NULL);
}
@@ -1560,9 +1562,9 @@ SetOwnerAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not set owner for file \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set owner for file \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1630,9 +1632,9 @@ SetPermissionsAttribute(
result = TclpObjStat(fileName, &buf);
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(fileName), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1640,8 +1642,9 @@ SetPermissionsAttribute(
if (GetModeFromPermString(NULL, modeStringPtr, &newMode) != TCL_OK) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "unknown permission string format \"",
- modeStringPtr, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown permission string format \"%s\"",
+ modeStringPtr));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "PERMISSION", NULL);
}
return TCL_ERROR;
@@ -1652,9 +1655,9 @@ SetPermissionsAttribute(
result = chmod(native, newMode); /* INTL: Native. */
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not set permissions for file \"",
- TclGetString(fileName), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set permissions for file \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -2239,14 +2242,14 @@ GetReadOnlyAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
- *attributePtrPtr = Tcl_NewBooleanObj((statBuf.st_flags&UF_IMMUTABLE) != 0);
+ *attributePtrPtr = Tcl_NewBooleanObj(statBuf.st_flags&UF_IMMUTABLE);
return TCL_OK;
}
@@ -2286,9 +2289,9 @@ SetReadOnlyAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -2303,9 +2306,9 @@ SetReadOnlyAttribute(
result = chflags(native, statBuf.st_flags); /* INTL: Native. */
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not set flags for file \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set flags for file \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index c213050..01fc6fe 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -310,10 +310,9 @@ TclpMatchInDirectory(
if (d == NULL) {
Tcl_DStringFree(&ds);
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't read directory \"",
- Tcl_DStringValue(&dsOrig), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read directory \"%s\": %s",
+ Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp)));
}
Tcl_DStringFree(&dsOrig);
Tcl_DecrRefCount(fileNamePtr);
@@ -771,9 +770,9 @@ TclpGetCwd(
#endif
{
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)));
}
return NULL;
}
diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c
index 377b84b..654c9d8 100644
--- a/unix/tclUnixPipe.c
+++ b/unix/tclUnixPipe.c
@@ -267,35 +267,34 @@ TclpTempFileName(void)
}
/*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------------
*
* TclpTempFileNameForLibrary --
*
- * Constructs a file name in the native file system where a
- * dynamically loaded library may be placed.
+ * Constructs a file name in the native file system where a dynamically
+ * loaded library may be placed.
*
* Results:
- * Returns the constructed file name. If an error occurs,
- * returns NULL and leaves an error message in the interpreter
- * result.
+ * Returns the constructed file name. If an error occurs, returns NULL
+ * and leaves an error message in the interpreter result.
*
- * On Unix, it works to load a shared object from a file of any
- * name, so this function is merely a thin wrapper around
- * TclpTempFileName().
+ * On Unix, it works to load a shared object from a file of any name, so this
+ * function is merely a thin wrapper around TclpTempFileName().
*
- *-----------------------------------------------------------------------------
+ *----------------------------------------------------------------------------
*/
-Tcl_Obj*
-TclpTempFileNameForLibrary(Tcl_Interp* interp, /* Tcl interpreter */
- Tcl_Obj* path) /* Path name of the library
- * in the VFS */
+Tcl_Obj *
+TclpTempFileNameForLibrary(
+ Tcl_Interp *interp, /* Tcl interpreter. */
+ Tcl_Obj *path) /* Path name of the library in the VFS. */
{
- Tcl_Obj* retval;
- retval = TclpTempFileName();
+ Tcl_Obj *retval = TclpTempFileName();
+
if (retval == NULL) {
- Tcl_AppendResult(interp, "couldn't create temporary file: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't create temporary file: %s",
+ Tcl_PosixError(interp)));
}
return retval;
}
@@ -442,8 +441,8 @@ TclpCreateProcess(
*/
if (TclpCreatePipe(&errPipeIn, &errPipeOut) == 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;
}
@@ -463,8 +462,9 @@ TclpCreateProcess(
/*
* After vfork(), do not call code in the child that changes global state,
* because it is using the parent's memory space at that point and writes
- * might corrupt the parent: so ensure standard channels are initialized in
- * the parent, otherwise SetupStdFile() might initialize them in the child.
+ * might corrupt the parent: so ensure standard channels are initialized
+ * in the parent, otherwise SetupStdFile() might initialize them in the
+ * child.
*/
if (!inputFile) {
@@ -495,7 +495,7 @@ TclpCreateProcess(
|| (joinThisError &&
((dup2(1,2) == -1) || (fcntl(2, F_SETFD, 0) != 0)))) {
sprintf(errSpace,
- "%dforked process couldn't set up input/output: ", errno);
+ "%dforked process couldn't set up input/output", errno);
len = strlen(errSpace);
if (len != (size_t) write(fd, errSpace, len)) {
Tcl_Panic("TclpCreateProcess: unable to write to errPipeOut");
@@ -509,11 +509,11 @@ TclpCreateProcess(
RestoreSignals();
execvp(newArgv[0], newArgv); /* INTL: Native. */
- sprintf(errSpace, "%dcouldn't execute \"%.150s\": ", errno, argv[0]);
+ sprintf(errSpace, "%dcouldn't execute \"%.150s\"", errno, argv[0]);
len = strlen(errSpace);
- if (len != (size_t) write(fd, errSpace, len)) {
+ if (len != (size_t) write(fd, errSpace, len)) {
Tcl_Panic("TclpCreateProcess: unable to write to errPipeOut");
- }
+ }
_exit(1);
}
@@ -528,8 +528,8 @@ TclpCreateProcess(
TclStackFree(interp, dsArray);
if (pid == -1) {
- Tcl_AppendResult(interp, "couldn't fork child process: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't fork child process: %s", Tcl_PosixError(interp)));
goto error;
}
@@ -546,9 +546,11 @@ TclpCreateProcess(
count = read(fd, errSpace, (size_t) (sizeof(errSpace) - 1));
if (count > 0) {
char *end;
+
errSpace[count] = 0;
errno = strtol(errSpace, &end, 10);
- Tcl_AppendResult(interp, end, Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s: %s",
+ end, Tcl_PosixError(interp)));
goto error;
}
@@ -832,8 +834,8 @@ Tcl_CreatePipe(
int fileNums[2];
if (pipe(fileNums) < 0) {
- Tcl_AppendResult(interp, "pipe creation failed: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("pipe creation failed: %s",
+ Tcl_PosixError(interp)));
return TCL_ERROR;
}
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 1e9d4eb..102c620 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -21,10 +21,10 @@
#define CLEAR_BITS(var, bits) ((var) &= ~(bits))
/* "sock" + a pointer in hex + \0 */
-#define SOCK_CHAN_LENGTH 4 + sizeof(void*) * 2 + 1
-#define SOCK_TEMPLATE "sock%lx"
+#define SOCK_CHAN_LENGTH (4 + sizeof(void *) * 2 + 1)
+#define SOCK_TEMPLATE "sock%lx"
-#undef SOCKET /* Possible conflict with win32 SOCKET */
+#undef SOCKET /* Possible conflict with win32 SOCKET */
/*
* This is needed to comply with the strict aliasing rules of GCC, but it also
@@ -58,19 +58,23 @@ struct TcpState {
/*
* Only needed for server sockets
*/
- Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */
- ClientData acceptProcData; /* The data for the accept proc. */
+
+ Tcl_TcpAcceptProc *acceptProc;
+ /* Proc to call on accept. */
+ ClientData acceptProcData; /* The data for the accept proc. */
+
/*
* Only needed for client sockets
*/
- struct addrinfo *addrlist; /* addresses to connect to */
- struct addrinfo *addr; /* iterator over addrlist */
- struct addrinfo *myaddrlist; /* local address */
- struct addrinfo *myaddr; /* iterator over myaddrlist */
- int filehandlers; /* Caches FileHandlers that get set up while
- * an async socket is not yet connected */
- int status; /* Cache status of async socket */
- int cachedBlocking; /* Cache blocking mode of async socket */
+
+ struct addrinfo *addrlist; /* Addresses to connect to. */
+ struct addrinfo *addr; /* Iterator over addrlist. */
+ struct addrinfo *myaddrlist;/* Local address. */
+ struct addrinfo *myaddr; /* Iterator over myaddrlist. */
+ int filehandlers; /* Caches FileHandlers that get set up while
+ * an async socket is not yet connected. */
+ int status; /* Cache status of async socket. */
+ int cachedBlocking; /* Cache blocking mode of async socket. */
};
/*
@@ -90,9 +94,7 @@ struct TcpState {
#ifndef SOMAXCONN
# define SOMAXCONN 100
-#endif /* SOMAXCONN */
-
-#if (SOMAXCONN < 100)
+#elif (SOMAXCONN < 100)
# undef SOMAXCONN
# define SOMAXCONN 100
#endif /* SOMAXCONN < 100 */
@@ -217,7 +219,7 @@ InitializeHostName(
if (native == NULL) {
native = tclEmptyStringRep;
}
-#else
+#else /* !NO_UNAME */
/*
* Uname doesn't exist; try gethostname instead.
*
@@ -242,7 +244,7 @@ InitializeHostName(
if (gethostname(buffer, sizeof(buffer)) > -1) { /* INTL: Native. */
native = buffer;
}
-#endif
+#endif /* NO_UNAME */
*encodingPtr = Tcl_GetEncoding(NULL, NULL);
*lengthPtr = strlen(native);
@@ -344,7 +346,7 @@ TcpBlockModeProc(
* TCL_MODE_BLOCKING or
* TCL_MODE_NONBLOCKING. */
{
- TcpState *statePtr = (TcpState *) instanceData;
+ TcpState *statePtr = instanceData;
if (mode == TCL_MODE_BLOCKING) {
CLEAR_BITS(statePtr->flags, TCP_ASYNC_SOCKET);
@@ -443,7 +445,7 @@ TcpInputProc(
* buffer? */
int *errorCodePtr) /* Where to store error code. */
{
- TcpState *statePtr = (TcpState *) instanceData;
+ TcpState *statePtr = instanceData;
int bytesRead;
*errorCodePtr = 0;
@@ -493,7 +495,7 @@ TcpOutputProc(
int toWrite, /* How many bytes to write? */
int *errorCodePtr) /* Where to store error code. */
{
- TcpState *statePtr = (TcpState *) instanceData;
+ TcpState *statePtr = instanceData;
int written;
*errorCodePtr = 0;
@@ -532,7 +534,7 @@ TcpCloseProc(
ClientData instanceData, /* The socket to close. */
Tcl_Interp *interp) /* For error reporting - unused. */
{
- TcpState *statePtr = (TcpState *) instanceData;
+ TcpState *statePtr = instanceData;
int errorCode = 0;
TcpFdList *fds;
@@ -593,7 +595,7 @@ TcpClose2Proc(
Tcl_Interp *interp, /* For error reporting. */
int flags) /* Flags that indicate which side to close. */
{
- TcpState *statePtr = (TcpState *) instanceData;
+ TcpState *statePtr = instanceData;
int errorCode = 0;
int sd;
@@ -610,8 +612,8 @@ TcpClose2Proc(
break;
default:
if (interp) {
- Tcl_AppendResult(interp,
- "Socket close2proc called bidirectionally", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "socket close2proc called bidirectionally", -1));
}
return TCL_ERROR;
}
@@ -653,7 +655,7 @@ TcpGetOptionProc(
Tcl_DString *dsPtr) /* Where to store the computed value;
* initialized by caller. */
{
- TcpState *statePtr = (TcpState *) instanceData;
+ TcpState *statePtr = instanceData;
char host[NI_MAXHOST], port[NI_MAXSERV];
size_t len = 0;
int reverseDNS = 0;
@@ -670,7 +672,7 @@ TcpGetOptionProc(
if (statePtr->status == 0) {
ret = getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR,
- (char *)&err, &optlen);
+ (char *) &err, &optlen);
if (ret < 0) {
err = errno;
}
@@ -688,9 +690,8 @@ TcpGetOptionProc(
reverseDNS = NI_NUMERICHOST;
}
- if ((len == 0) ||
- ((len > 1) && (optionName[1] == 'p') &&
- (strncmp(optionName, "-peername", len) == 0))) {
+ if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
+ (strncmp(optionName, "-peername", len) == 0))) {
address peername;
socklen_t size = sizeof(peername);
@@ -721,16 +722,16 @@ TcpGetOptionProc(
if (len) {
if (interp) {
- Tcl_AppendResult(interp, "can't get peername: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get peername: %s",
+ Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
}
}
- if ((len == 0) ||
- ((len > 1) && (optionName[1] == 's') &&
+ if ((len == 0) || ((len > 1) && (optionName[1] == 's') &&
(strncmp(optionName, "-sockname", len) == 0))) {
TcpFdList *fds;
address sockname;
@@ -772,7 +773,7 @@ TcpGetOptionProc(
sockname.sa6.sin6_addr.s6_addr[15] == 0)) {
flags |= NI_NUMERICHOST;
}
-#endif
+#endif /* NEED_FAKE_RFC2553 */
}
getnameinfo(&sockname.sa, size, host, sizeof(host), port,
sizeof(port), flags);
@@ -787,8 +788,8 @@ TcpGetOptionProc(
Tcl_DStringEndSublist(dsPtr);
} else {
if (interp) {
- Tcl_AppendResult(interp, "can't get sockname: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get sockname: %s", Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -825,7 +826,7 @@ TcpWatchProc(
* TCL_READABLE, TCL_WRITABLE and
* TCL_EXCEPTION. */
{
- TcpState *statePtr = (TcpState *) instanceData;
+ TcpState *statePtr = instanceData;
if (statePtr->acceptProc != NULL) {
/*
@@ -842,8 +843,7 @@ TcpWatchProc(
statePtr->filehandlers = mask;
} else if (mask) {
Tcl_CreateFileHandler(statePtr->fds.fd, mask,
- (Tcl_FileProc *) Tcl_NotifyChannel,
- (ClientData) statePtr->channel);
+ (Tcl_FileProc *) Tcl_NotifyChannel, statePtr->channel);
} else {
Tcl_DeleteFileHandler(statePtr->fds.fd);
}
@@ -874,7 +874,7 @@ TcpGetHandleProc(
int direction, /* Not used. */
ClientData *handlePtr) /* Where to store the handle. */
{
- TcpState *statePtr = (TcpState *) instanceData;
+ TcpState *statePtr = instanceData;
*handlePtr = INT2PTR(statePtr->fds.fd);
return TCL_OK;
@@ -946,12 +946,11 @@ CreateClientSocket(
}
for (state->addr = state->addrlist; state->addr != NULL;
- state->addr = state->addr->ai_next) {
-
+ state->addr = state->addr->ai_next) {
status = -1;
for (state->myaddr = state->myaddrlist; state->myaddr != NULL;
- state->myaddr = state->myaddr->ai_next) {
+ state->myaddr = state->myaddr->ai_next) {
int reuseaddr;
/*
@@ -967,6 +966,7 @@ CreateClientSocket(
* Close the socket if it is still open from the last unsuccessful
* iteration.
*/
+
if (state->fds.fd >= 0) {
close(state->fds.fd);
state->fds.fd = -1;
@@ -991,7 +991,8 @@ CreateClientSocket(
TclSockMinimumBuffers(INT2PTR(state->fds.fd), SOCKET_BUFSIZE);
if (async) {
- status = TclUnixSetBlockingMode(state->fds.fd, TCL_MODE_NONBLOCKING);
+ status = TclUnixSetBlockingMode(state->fds.fd,
+ TCL_MODE_NONBLOCKING);
if (status < 0) {
continue;
}
@@ -1001,7 +1002,7 @@ CreateClientSocket(
(void) setsockopt(state->fds.fd, SOL_SOCKET, SO_REUSEADDR,
(char *) &reuseaddr, sizeof(reuseaddr));
status = bind(state->fds.fd, state->myaddr->ai_addr,
- state->myaddr->ai_addrlen);
+ state->myaddr->ai_addrlen);
if (status < 0) {
continue;
}
@@ -1014,24 +1015,25 @@ CreateClientSocket(
*/
status = connect(state->fds.fd, state->addr->ai_addr,
- state->addr->ai_addrlen);
+ state->addr->ai_addrlen);
if (status < 0 && errno == EINPROGRESS) {
Tcl_CreateFileHandler(state->fds.fd,
- TCL_WRITABLE | TCL_EXCEPTION,
- TcpAsyncCallback, state);
+ TCL_WRITABLE|TCL_EXCEPTION, TcpAsyncCallback, state);
return TCL_OK;
reenter:
Tcl_DeleteFileHandler(state->fds.fd);
+
/*
* Read the error state from the socket to see if the async
* connection has succeeded or failed. As this clears the
* error condition, we cache the status in the socket state
* struct for later retrieval by [fconfigure -error].
*/
+
optlen = sizeof(int);
getsockopt(state->fds.fd, SOL_SOCKET, SO_ERROR,
- (char *)&status, &optlen);
+ (char *) &status, &optlen);
state->status = status;
}
if (status == 0) {
@@ -1047,6 +1049,7 @@ out:
/*
* An asynchonous connection has finally succeeded or failed.
*/
+
TcpWatchProc(state, state->filehandlers);
TclUnixSetBlockingMode(state->fds.fd, state->cachedBlocking);
@@ -1058,17 +1061,18 @@ out:
* hurt that this is also called in the successful case and will save
* the event mechanism one roundtrip through select().
*/
- Tcl_NotifyChannel(state->channel, TCL_WRITABLE);
+ Tcl_NotifyChannel(state->channel, TCL_WRITABLE);
} else if (status != 0) {
/*
* Failure for either a synchronous connection, or an async one that
* failed before it could enter background mode, e.g. because an
* invalid -myaddr was given.
*/
+
if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't open socket: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't open socket: %s", Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1111,13 +1115,16 @@ Tcl_OpenTcpClient(
/*
* Do the name lookups for the local and remote addresses.
*/
- if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg) ||
- !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, &errorMsg)) {
+
+ if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg)
+ || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
+ &errorMsg)) {
if (addrlist != NULL) {
freeaddrinfo(addrlist);
}
if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't open socket: ", errorMsg, NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't open socket: %s", errorMsg));
}
return NULL;
}
@@ -1141,10 +1148,10 @@ Tcl_OpenTcpClient(
return NULL;
}
- sprintf(channelName, SOCK_TEMPLATE, (long)state);
+ sprintf(channelName, SOCK_TEMPLATE, (long) state);
- state->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- state, (TCL_READABLE | TCL_WRITABLE));
+ state->channel = Tcl_CreateChannel(&tcpChannelType, channelName, state,
+ (TCL_READABLE | TCL_WRITABLE));
if (Tcl_SetChannelOption(interp, state->channel, "-translation",
"auto crlf") == TCL_ERROR) {
Tcl_Close(NULL, state->channel);
@@ -1257,6 +1264,7 @@ Tcl_OpenTcpServer(
* Try to record and return the most meaningful error message, i.e. the
* one from the first socket that went the farthest before it failed.
*/
+
enum { LOOKUP, SOCKET, BIND, LISTEN } howfar = LOOKUP;
int my_errno = 0;
@@ -1267,7 +1275,7 @@ Tcl_OpenTcpServer(
for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
sock = socket(addrPtr->ai_family, addrPtr->ai_socktype,
- addrPtr->ai_protocol);
+ addrPtr->ai_protocol);
if (sock == -1) {
if (howfar < SOCKET) {
howfar = SOCKET;
@@ -1318,7 +1326,7 @@ Tcl_OpenTcpServer(
(void) setsockopt(sock, IPPROTO_IPV6, IPV6_V6ONLY,
&v6only, sizeof(v6only));
}
-#endif
+#endif /* IPV6_V6ONLY */
status = bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen);
if (status == -1) {
@@ -1360,7 +1368,7 @@ Tcl_OpenTcpServer(
memset(statePtr, 0, sizeof(TcpState));
statePtr->acceptProc = acceptProc;
statePtr->acceptProcData = acceptProcData;
- sprintf(channelName, SOCK_TEMPLATE, (long)statePtr);
+ sprintf(channelName, SOCK_TEMPLATE, (long) statePtr);
newfds = &statePtr->fds;
} else {
newfds = ckalloc(sizeof(TcpFdList));
@@ -1389,13 +1397,15 @@ Tcl_OpenTcpServer(
return statePtr->channel;
}
if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't open socket: ", NULL);
+ Tcl_Obj *errorObj = Tcl_NewStringObj("couldn't open socket: ", -1);
+
if (errorMsg == NULL) {
errno = my_errno;
- Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL);
+ Tcl_AppendToObj(errorObj, Tcl_PosixError(interp), -1);
} else {
- Tcl_AppendResult(interp, errorMsg, NULL);
+ Tcl_AppendToObj(errorObj, errorMsg, -1);
}
+ Tcl_SetObjResult(interp, errorObj);
}
if (sock != -1) {
close(sock);
@@ -1434,7 +1444,7 @@ TcpAccept(
char host[NI_MAXHOST], port[NI_MAXSERV];
len = sizeof(addr);
- newsock = accept(fds->fd, &(addr.sa), &len);
+ newsock = accept(fds->fd, &addr.sa, &len);
if (newsock < 0) {
return;
}
@@ -1451,7 +1461,7 @@ TcpAccept(
newSockState->flags = 0;
newSockState->fds.fd = newsock;
- sprintf(channelName, SOCK_TEMPLATE, (long)newSockState);
+ sprintf(channelName, SOCK_TEMPLATE, (long) newSockState);
newSockState->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
newSockState, (TCL_READABLE | TCL_WRITABLE));
@@ -1459,7 +1469,7 @@ TcpAccept(
"auto crlf");
if (fds->statePtr->acceptProc != NULL) {
- getnameinfo(&(addr.sa), len, host, sizeof(host), port, sizeof(port),
+ getnameinfo(&addr.sa, len, host, sizeof(host), port, sizeof(port),
NI_NUMERICHOST|NI_NUMERICSERV);
fds->statePtr->acceptProc(fds->statePtr->acceptProcData,
newSockState->channel, host, atoi(port));
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index 517aa20..bc233ea 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -940,8 +940,9 @@ TclpOpenFileChannel(
}
TclWinConvertError(err);
if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr),
- "\": ", Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't open \"%s\": %s",
+ TclGetString(pathPtr),, Tcl_PosixError(interp)));
}
return NULL;
}
@@ -959,9 +960,9 @@ TclpOpenFileChannel(
if (handle == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "couldn't reopen serial \"",
- TclGetString(pathPtr), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't reopen serial \"%s\": %s",
+ TclGetString(pathPtr), Tcl_PosixError(interp)));
}
return NULL;
}
@@ -995,8 +996,9 @@ TclpOpenFileChannel(
*/
channel = NULL;
- Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr),
- "\": bad file type", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't open \"%s\": bad file type",
+ TclGetString(pathPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "BAD_TYPE",
NULL);
break;
diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index 4d6e31b..e225989 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -157,7 +157,8 @@ Dde_Init(
#ifdef UNICODE
if (TclWinGetPlatformId() < VER_PLATFORM_WIN32_NT) {
- Tcl_AppendResult(interp, "Win32s and Windows 9x are not supported platforms", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Win32s and Windows 9x are not supported platforms", -1));
return TCL_ERROR;
}
#endif
@@ -947,8 +948,8 @@ MakeDdeConnection(
if (ddeConv == (HCONV) NULL) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "no registered server named \"",
- name, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "no registered server named \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL);
}
return TCL_ERROR;
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 77a5b82..80fad3e 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -1530,8 +1530,8 @@ StatError(
* error. */
{
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "could not read \"", TclGetString(fileName),
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
/*
@@ -1649,9 +1649,9 @@ ConvertFileNameFormat(
if (splitPath == NULL || pathc == 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- Tcl_GetString(fileName), "\": no such file or directory",
- (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": no such file or directory",
+ Tcl_GetString(fileName)));
errno = ENOENT;
Tcl_PosixError(interp);
}
@@ -1941,9 +1941,9 @@ CannotSetAttribute(
Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj *attributePtr) /* The new value of the attribute. */
{
- Tcl_AppendResult(interp, "cannot set attribute \"",
- tclpFileAttrStrings[objIndex], "\" for file \"",
- Tcl_GetString(fileName), "\": attribute is readonly", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "cannot set attribute \"%s\" for file \"%s\": attribute is readonly",
+ tclpFileAttrStrings[objIndex], Tcl_GetString(fileName)));
errno = EINVAL;
Tcl_PosixError(interp);
return TCL_ERROR;
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 1f56060..a44a257 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -1048,10 +1048,9 @@ TclpMatchInDirectory(
TclWinConvertError(err);
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't read directory \"",
- Tcl_DStringValue(&dsOrig), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read directory \"%s\": %s",
+ Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp)));
}
Tcl_DStringFree(&dsOrig);
return TCL_ERROR;
@@ -1866,8 +1865,9 @@ TclpGetCwd(
if (GetCurrentDirectory(MAX_PATH, buffer) == 0) {
TclWinConvertError(GetLastError());
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)));
}
return NULL;
}
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index db462f8..36ae58a 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -1030,8 +1030,9 @@ TclpCreateProcess(
}
if (startInfo.hStdInput == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "couldn't duplicate input handle: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't duplicate input handle: %s",
+ Tcl_PosixError(interp)));
goto end;
}
@@ -1065,8 +1066,9 @@ TclpCreateProcess(
}
if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "couldn't duplicate output handle: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't duplicate output handle: %s",
+ Tcl_PosixError(interp)));
goto end;
}
@@ -1084,8 +1086,9 @@ TclpCreateProcess(
}
if (startInfo.hStdError == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "couldn't duplicate error handle: ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't duplicate error handle: %s",
+ Tcl_PosixError(interp)));
goto end;
}
@@ -1129,9 +1132,9 @@ TclpCreateProcess(
}
if (applType == APPL_DOS) {
- Tcl_AppendResult(interp,
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"DOS application process not supported on this platform",
- (char *) NULL);
+ -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "DOS_APP",
NULL);
goto end;
@@ -1158,12 +1161,12 @@ TclpCreateProcess(
BuildCommandLine(execPath, argc, argv, &cmdLine);
- if (CreateProcess(NULL,
- (TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE,
- (DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) {
+ if (CreateProcess(NULL, (TCHAR *) Tcl_DStringValue(&cmdLine),
+ NULL, NULL, TRUE, (DWORD) createFlags, NULL, NULL, &startInfo,
+ &procInfo) == 0) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "couldn't execute \"", argv[0],
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s",
+ argv[0], Tcl_PosixError(interp)));
goto end;
}
@@ -1409,8 +1412,8 @@ ApplicationType(
if (applType == APPL_NONE) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "couldn't execute \"", originalName,
- "\": ", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s",
+ originalName, Tcl_PosixError(interp)));
return APPL_NONE;
}
@@ -1673,8 +1676,8 @@ Tcl_CreatePipe(
if (!CreatePipe(&readHandle, &writeHandle, &sec, 0)) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "pipe creation failed: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "pipe creation failed: %s", Tcl_PosixError(interp)));
return TCL_ERROR;
}
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index 9c08b0c..c4a89e6 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -172,7 +172,7 @@ Registry_Init(
{
Tcl_Command cmd;
- if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
return TCL_ERROR;
}
@@ -534,9 +534,9 @@ DeleteValue(
result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
if (result != ERROR_SUCCESS) {
- Tcl_AppendResult(interp, "unable to delete value \"",
- Tcl_GetString(valueNameObj), "\" from key \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unable to delete value \"%s\" from key \"%s\": ",
+ Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
AppendSystemError(interp, result);
result = TCL_ERROR;
} else {
@@ -574,7 +574,8 @@ GetKeyNames(
{
const char *pattern; /* Pattern being matched against subkeys */
HKEY key; /* Handle to the key being examined */
- TCHAR buffer[MAX_KEY_LENGTH]; /* Buffer to hold the subkey name */
+ TCHAR buffer[MAX_KEY_LENGTH];
+ /* Buffer to hold the subkey name */
DWORD bufSize; /* Size of the buffer */
DWORD index; /* Position of the current subkey */
char *name; /* Subkey name */
@@ -610,9 +611,9 @@ GetKeyNames(
if (result == ERROR_NO_MORE_ITEMS) {
result = TCL_OK;
} else {
- Tcl_SetObjResult(interp, Tcl_NewObj());
- Tcl_AppendResult(interp, "unable to enumerate subkeys of \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unable to enumerate subkeys of \"%s\": ",
+ Tcl_GetString(keyNameObj)));
AppendSystemError(interp, result);
result = TCL_ERROR;
}
@@ -693,9 +694,9 @@ GetType(
RegCloseKey(key);
if (result != ERROR_SUCCESS) {
- Tcl_AppendResult(interp, "unable to get type of value \"",
- Tcl_GetString(valueNameObj), "\" from key \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unable to get type of value \"%s\" from key \"%s\": ",
+ Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
AppendSystemError(interp, result);
return TCL_ERROR;
}
@@ -787,9 +788,9 @@ GetValue(
Tcl_DStringFree(&buf);
RegCloseKey(key);
if (result != ERROR_SUCCESS) {
- Tcl_AppendResult(interp, "unable to get value \"",
- Tcl_GetString(valueNameObj), "\" from key \"",
- Tcl_GetString(keyNameObj), "\": ", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unable to get value \"%s\" from key \"%s\": ",
+ Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
AppendSystemError(interp, result);
Tcl_DStringFree(&data);
return TCL_ERROR;
@@ -1110,8 +1111,8 @@ ParseKeyName(
rootName = name;
}
if (!rootName) {
- Tcl_AppendResult(interp, "bad key \"", name,
- "\": must start with a valid root", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad key \"%s\": must start with a valid root", name));
Tcl_SetErrorCode(interp, "WIN_REG", "NO_ROOT_KEY", NULL);
return TCL_ERROR;
}
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index 58a9eb4..fb7f69b 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -1673,12 +1673,7 @@ SerialSetOptionProc(
if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) {
if (!GetCommState(infoPtr->handle, &dcb)) {
- if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "can't get comm state: ",
- Tcl_PosixError(interp), NULL);
- }
- return TCL_ERROR;
+ goto getStateFailed;
}
native = Tcl_WinUtfToTChar(value, -1, &ds);
result = BuildCommDCB(native, &dcb);
@@ -1686,8 +1681,9 @@ SerialSetOptionProc(
if (result == FALSE) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "bad value \"", value,
- "\" for -mode: should be baud,parity,data,stop", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad value \"%s\" for -mode: should be baud,parity,data,stop",
+ value));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
}
return TCL_ERROR;
@@ -1703,12 +1699,7 @@ SerialSetOptionProc(
dcb.fAbortOnError = FALSE;
if (!SetCommState(infoPtr->handle, &dcb)) {
- if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "can't set comm state: ",
- Tcl_PosixError(interp), NULL);
- }
- return TCL_ERROR;
+ goto setStateFailed;
}
return TCL_OK;
}
@@ -1719,12 +1710,7 @@ SerialSetOptionProc(
if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) {
if (!GetCommState(infoPtr->handle, &dcb)) {
- if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "can't get comm state: ",
- Tcl_PosixError(interp), NULL);
- }
- return TCL_ERROR;
+ goto getStateFailed;
}
/*
@@ -1759,21 +1745,16 @@ SerialSetOptionProc(
dcb.fDtrControl = DTR_CONTROL_HANDSHAKE;
} else {
if (interp != NULL) {
- Tcl_AppendResult(interp, "bad value \"", value,
- "\" for -handshake: must be one of xonxoff, rtscts, "
- "dtrdsr or none", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad value \"%s\" for -handshake: must be one of"
+ " xonxoff, rtscts, dtrdsr or none", value));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "HANDSHAKE", NULL);
}
return TCL_ERROR;
}
if (!SetCommState(infoPtr->handle, &dcb)) {
- if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "can't set comm state: ",
- Tcl_PosixError(interp), NULL);
- }
- return TCL_ERROR;
+ goto setStateFailed;
}
return TCL_OK;
}
@@ -1784,12 +1765,7 @@ SerialSetOptionProc(
if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) {
if (!GetCommState(infoPtr->handle, &dcb)) {
- if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "can't get comm state: ",
- Tcl_PosixError(interp), NULL);
- }
- return TCL_ERROR;
+ goto getStateFailed;
}
if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
@@ -1798,9 +1774,9 @@ SerialSetOptionProc(
if (argc != 2) {
badXchar:
if (interp != NULL) {
- Tcl_AppendResult(interp, "bad value for -xchar: should be "
- "a list of two elements with each a single character",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "bad value for -xchar: should be a list of"
+ " two elements with each a single character", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL);
}
ckfree(argv);
@@ -1837,12 +1813,7 @@ SerialSetOptionProc(
ckfree(argv);
if (!SetCommState(infoPtr->handle, &dcb)) {
- if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "can't set comm state: ",
- Tcl_PosixError(interp), NULL);
- }
- return TCL_ERROR;
+ goto setStateFailed;
}
return TCL_OK;
}
@@ -1859,9 +1830,9 @@ SerialSetOptionProc(
}
if ((argc % 2) == 1) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "bad value \"", value,
- "\" for -ttycontrol: should be a list of "
- "signal,value pairs", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad value \"%s\" for -ttycontrol: should be "
+ "a list of signal,value pairs", value));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL);
}
ckfree(argv);
@@ -1877,7 +1848,8 @@ SerialSetOptionProc(
if (!EscapeCommFunction(infoPtr->handle,
(DWORD) (flag ? SETDTR : CLRDTR))) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't set DTR signal", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't set DTR signal", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION",
"FCONFIGURE", "TTY_SIGNAL", NULL);
}
@@ -1888,7 +1860,8 @@ SerialSetOptionProc(
if (!EscapeCommFunction(infoPtr->handle,
(DWORD) (flag ? SETRTS : CLRRTS))) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "can't set RTS signal", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't set RTS signal", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION",
"FCONFIGURE", "TTY_SIGNAL", NULL);
}
@@ -1899,7 +1872,8 @@ SerialSetOptionProc(
if (!EscapeCommFunction(infoPtr->handle,
(DWORD) (flag ? SETBREAK : CLRBREAK))) {
if (interp != NULL) {
- Tcl_AppendResult(interp,"can't set BREAK signal",NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't set BREAK signal", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION",
"FCONFIGURE", "TTY_SIGNAL", NULL);
}
@@ -1908,9 +1882,9 @@ SerialSetOptionProc(
}
} else {
if (interp != NULL) {
- Tcl_AppendResult(interp, "bad signal name \"", argv[i],
- "\" for -ttycontrol: must be DTR, RTS or BREAK",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad signal name \"%s\" for -ttycontrol: must be"
+ " DTR, RTS or BREAK", argv[i]));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTY_SIGNAL",
NULL);
}
@@ -1949,9 +1923,9 @@ SerialSetOptionProc(
if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "bad value \"", value,
- "\" for -sysbuffer: should be a list of one or two "
- "integers > 0", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad value \"%s\" for -sysbuffer: should be "
+ "a list of one or two integers > 0", value));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL);
}
return TCL_ERROR;
@@ -1960,8 +1934,9 @@ SerialSetOptionProc(
if (!SetupComm(infoPtr->handle, inSize, outSize)) {
if (interp != NULL) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "can't setup comm buffers: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't setup comm buffers: %s",
+ Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1974,22 +1949,12 @@ SerialSetOptionProc(
*/
if (!GetCommState(infoPtr->handle, &dcb)) {
- if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "can't get comm state: ",
- Tcl_PosixError(interp), NULL);
- }
- return TCL_ERROR;
+ goto getStateFailed;
}
dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2);
dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4);
if (!SetCommState(infoPtr->handle, &dcb)) {
- if (interp != NULL) {
- TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "can't set comm state: ",
- Tcl_PosixError(interp), NULL);
- }
- return TCL_ERROR;
+ goto setStateFailed;
}
return TCL_OK;
}
@@ -2020,8 +1985,9 @@ SerialSetOptionProc(
if (!SetCommTimeouts(infoPtr->handle, &tout)) {
if (interp != NULL) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "can't set comm timeouts: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't set comm timeouts: %s",
+ Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -2031,6 +1997,22 @@ SerialSetOptionProc(
return Tcl_BadChannelOption(interp, optionName,
"mode handshake pollinterval sysbuffer timeout ttycontrol xchar");
+
+ getStateFailed:
+ if (interp != NULL) {
+ TclWinConvertError(GetLastError());
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get comm state: ", Tcl_PosixError(interp)));
+ }
+ return TCL_ERROR;
+
+ setStateFailed:
+ if (interp != NULL) {
+ TclWinConvertError(GetLastError());
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't set comm state: ", Tcl_PosixError(interp)));
+ }
+ return TCL_ERROR;
}
/*
@@ -2089,8 +2071,8 @@ SerialGetOptionProc(
if (!GetCommState(infoPtr->handle, &dcb)) {
if (interp != NULL) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "can't get comm state: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get comm state: %s", Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -2159,8 +2141,8 @@ SerialGetOptionProc(
if (!GetCommState(infoPtr->handle, &dcb)) {
if (interp != NULL) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "can't get comm state: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get comm state: %s", Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -2237,8 +2219,8 @@ SerialGetOptionProc(
if (!GetCommModemStatus(infoPtr->handle, &status)) {
if (interp != NULL) {
TclWinConvertError(GetLastError());
- Tcl_AppendResult(interp, "can't get tty status: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get tty status: %s", Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -2248,10 +2230,9 @@ SerialGetOptionProc(
if (valid) {
return TCL_OK;
- } else {
- return Tcl_BadChannelOption(interp, optionName,
- "mode pollinterval lasterror queue sysbuffer ttystatus xchar");
}
+ return Tcl_BadChannelOption(interp, optionName,
+ "mode pollinterval lasterror queue sysbuffer ttystatus xchar");
}
/*
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 97b10a3..6986528 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -558,8 +558,8 @@ TclpHasSockets(
return TCL_OK;
}
if (interp != NULL) {
- Tcl_AppendResult(interp, "sockets are not available on this system",
- NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "sockets are not available on this system", -1));
}
return TCL_ERROR;
}
@@ -928,8 +928,8 @@ TcpClose2Proc(
break;
default:
if (interp) {
- Tcl_AppendResult(interp,
- "Socket close2proc called bidirectionally", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "Socket close2proc called bidirectionally", -1));
}
return TCL_ERROR;
}
@@ -1280,12 +1280,9 @@ CreateSocket(
}
if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't open socket: ", NULL);
- if (errorMsg == NULL) {
- Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL);
- } else {
- Tcl_AppendResult(interp, errorMsg, NULL);
- }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't open socket: %s",
+ (errorMsg ? errorMsg : Tcl_PosixError(interp)));
}
if (sock != INVALID_SOCKET) {
@@ -1929,7 +1926,8 @@ TcpSetOptionProc(
if (!SocketsEnabled()) {
if (interp) {
- Tcl_AppendResult(interp, "winsock is not initialized", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "winsock is not initialized", -1));
}
return TCL_ERROR;
}
@@ -1952,8 +1950,9 @@ TcpSetOptionProc(
if (rtn != 0) {
TclWinConvertError(WSAGetLastError());
if (interp) {
- Tcl_AppendResult(interp, "couldn't set socket option: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't set socket option: %s",
+ Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1973,8 +1972,9 @@ TcpSetOptionProc(
if (rtn != 0) {
TclWinConvertError(WSAGetLastError());
if (interp) {
- Tcl_AppendResult(interp, "couldn't set socket option: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't set socket option: %s",
+ Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -2032,7 +2032,8 @@ TcpGetOptionProc(
if (!SocketsEnabled()) {
if (interp) {
- Tcl_AppendResult(interp, "winsock is not initialized", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "winsock is not initialized", -1));
}
return TCL_ERROR;
}
@@ -2099,8 +2100,9 @@ TcpGetOptionProc(
if (len) {
TclWinConvertError((DWORD) WSAGetLastError());
if (interp) {
- Tcl_AppendResult(interp, "can't get peername: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get peername: %s",
+ Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -2164,8 +2166,8 @@ TcpGetOptionProc(
} else {
if (interp) {
TclWinConvertError((DWORD) WSAGetLastError());
- Tcl_AppendResult(interp, "can't get sockname: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get sockname: %s", Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
generated by cgit v0.12 at 2024-06-28 23:52:36 (GMT)