From 0f97712d765005441870b6e919297456e986be02 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 5 Aug 2012 12:09:12 +0000 Subject: Final part of result generation conversion (modulo any minor blunders) --- generic/tclIO.c | 125 +++++++++++++++++++++------------------- generic/tclIOCmd.c | 152 +++++++++++++++++++++++++------------------------ generic/tclIOGT.c | 4 +- generic/tclIORChan.c | 129 ++++++++++++++++++++++------------------- generic/tclIORTrans.c | 111 +++++++++++++++++++----------------- generic/tclIOSock.c | 36 ++++++------ generic/tclIOUtil.c | 102 ++++++++++++++++++--------------- macosx/tclMacOSXFCmd.c | 57 ++++++++++--------- unix/tclUnixChan.c | 75 ++++++++++++------------ unix/tclUnixFCmd.c | 81 +++++++++++++------------- unix/tclUnixFile.c | 13 ++--- unix/tclUnixPipe.c | 64 +++++++++++---------- unix/tclUnixSock.c | 146 +++++++++++++++++++++++++---------------------- win/tclWinChan.c | 16 +++--- win/tclWinDde.c | 7 ++- win/tclWinFCmd.c | 16 +++--- win/tclWinFile.c | 12 ++-- win/tclWinPipe.c | 37 ++++++------ win/tclWinReg.c | 33 +++++------ win/tclWinSerial.c | 143 ++++++++++++++++++++-------------------------- win/tclWinSock.c | 42 +++++++------- 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 *)¤t, &len); + getsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_SNDBUF, + (char *) ¤t, &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 *)¤t, &len); + getsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_RCVBUF, + (char *) ¤t, &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; } -- cgit v0.12