diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | generic/tclIO.c | 324 | ||||
| -rw-r--r-- | generic/tclIO.h | 6 | ||||
| -rw-r--r-- | generic/tclIOCmd.c | 130 |
4 files changed, 352 insertions, 116 deletions
@@ -1,3 +1,11 @@ +2007-12-05 Jeff Hobbs <jeffh@ActiveState.com> + + * generic/tclIO.h: Create Tcl_Obj for Tcl channels to reduce + * generic/tclIO.c: overhead in lookup by Tcl_GetChannel. New + * generic/tclIOCmd.c: TclGetChannelFromObj for internal use. + * generic/tclIO.c (WriteBytes, WriteChars): add opt check to avoid + EOL translation when not linebuffered or using lf. [Bug 1845092] + 2007-12-05 Miguel Sofer <msofer@users.sf.net> * tests/stack.test: made the tests for stack overflow not care diff --git a/generic/tclIO.c b/generic/tclIO.c index 5acef55..0e8346d 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIO.c,v 1.132 2007/11/28 16:04:31 dgp Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.133 2007/12/05 21:47:26 hobbs Exp $ */ #include "tclInt.h" @@ -195,6 +195,32 @@ static void CutChannel(Tcl_Channel chan); #define HaveOpt(minLength, nameString) \ ((len > (minLength)) && (optionName[1] == (nameString)[1]) \ && (strncmp(optionName, (nameString), len) == 0)) + +/* + * The ChannelObjType type. We actually store the ChannelState structure + * as that lives longest and we want to return the bottomChanPtr when + * requested (consistent with Tcl_GetChannel). The setFromAny and + * updateString can be NULL as they should not be called. + */ + +static void DupChannelIntRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); +static int SetChannelFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +static void UpdateStringOfChannel(Tcl_Obj *objPtr); +static void FreeChannelIntRep(Tcl_Obj *objPtr); + +Tcl_ObjType tclChannelType = { + "channel", /* name for this type */ + FreeChannelIntRep, /* freeIntRepProc */ + DupChannelIntRep, /* dupIntRepProc */ + NULL, /* updateStringProc UpdateStringOfChannel */ + NULL /* setFromAnyProc SetChannelFromAny */ +}; + +#define GET_CHANNELSTATE(objPtr) \ + ((ChannelState *) (objPtr)->internalRep.otherValuePtr) +#define SET_CHANNELSTATE(objPtr, storePtr) \ + ((objPtr)->internalRep.otherValuePtr = (void *) (storePtr)) + /* *--------------------------------------------------------------------------- @@ -673,6 +699,7 @@ DeleteChannelTable( */ Tcl_DeleteHashEntry(hPtr); + SetFlag(statePtr, CHANNEL_TAINTED); statePtr->refCount--; if (statePtr->refCount <= 0) { if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) { @@ -1021,6 +1048,7 @@ DetachChannel( return TCL_ERROR; } Tcl_DeleteHashEntry(hPtr); + SetFlag(statePtr, CHANNEL_TAINTED); /* * Remove channel handlers that refer to this interpreter, so that @@ -1121,6 +1149,54 @@ Tcl_GetChannel( } /* + *--------------------------------------------------------------------------- + * + * TclGetChannelFromObj -- + * + * Finds an existing Tcl_Channel structure by name in a given + * interpreter. This function is public because it is used by + * channel-type-specific functions. + * + * Results: + * A Tcl_Channel or NULL on failure. If failed, interp's result object + * contains an error message. *modePtr is filled with the modes in which + * the channel was opened. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +int +TclGetChannelFromObj( + Tcl_Interp *interp, /* Interpreter in which to find or create the + * channel. */ + Tcl_Obj *objPtr, + Tcl_Channel *channelPtr, + int *modePtr, /* Where to store the mode in which the + * channel was opened? Will contain an ORed + * combination of TCL_READABLE and + * TCL_WRITABLE, if non-NULL. */ + int flags) +{ + ChannelState *statePtr; + + if (SetChannelFromAny(interp, objPtr) != TCL_OK) { + return TCL_ERROR; + } + + statePtr = GET_CHANNELSTATE(objPtr); + *channelPtr = (Tcl_Channel) (statePtr->bottomChanPtr); + + if (modePtr != NULL) { + *modePtr = (statePtr->flags & (TCL_READABLE|TCL_WRITABLE)); + } + + return TCL_OK; +} + +/* *---------------------------------------------------------------------- * * Tcl_CreateChannel -- @@ -3337,11 +3413,13 @@ WriteBytes( /* State info for channel */ ChannelBuffer *bufPtr; char *dst; - int dstMax, sawLF, savedLF, total, dstLen, toWrite; + int dstMax, sawLF, savedLF, total, dstLen, toWrite, translate; total = 0; sawLF = 0; savedLF = 0; + translate = (statePtr->flags & CHANNEL_LINEBUFFERED) + || (statePtr->outputTranslation != TCL_TRANSLATE_LF); /* * Loop over all bytes in src, storing them in output buffer with proper @@ -3363,27 +3441,32 @@ WriteBytes( toWrite = srcLen; } - if (savedLF) { - /* - * A '\n' was left over from last call to TranslateOutputEOL() and - * we need to store it in this buffer. If the channel is - * line-based, we will need to flush it. - */ + if (translate) { + if (savedLF) { + /* + * A '\n' was left over from last call to TranslateOutputEOL() + * and we need to store it in this buffer. If the channel is + * line-based, we will need to flush it. + */ - *dst++ = '\n'; - dstLen--; - sawLF++; - } - if (TranslateOutputEOL(statePtr, dst, src, &dstLen, &toWrite)) { - sawLF++; + *dst++ = '\n'; + dstLen--; + sawLF++; + } + if (TranslateOutputEOL(statePtr, dst, src, &dstLen, &toWrite)) { + sawLF++; + } + dstLen += savedLF; + savedLF = 0; + if (dstLen > dstMax) { + savedLF = 1; + dstLen = dstMax; + } + } else { + memcpy(dst, src, toWrite); + dstLen = toWrite; } - dstLen += savedLF; - savedLF = 0; - if (dstLen > dstMax) { - savedLF = 1; - dstLen = dstMax; - } bufPtr->nextAdded += dstLen; if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) { return -1; @@ -3429,7 +3512,7 @@ WriteChars( char *dst, *stage; int saved, savedLF, sawLF, total, dstLen, stageMax, dstWrote; int stageLen, toWrite, stageRead, endEncoding, result; - int consumedSomething; + int consumedSomething, translate; Tcl_Encoding encoding; char safe[BUFFER_PADDING]; @@ -3445,6 +3528,9 @@ WriteChars( endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0); + translate = (statePtr->flags & CHANNEL_LINEBUFFERED) + || (statePtr->outputTranslation != TCL_TRANSLATE_LF); + /* * Loop over all UTF-8 characters in src, storing them in staging buffer * with proper EOL translation. @@ -3462,29 +3548,34 @@ WriteChars( toWrite = srcLen; } - if (savedLF) { - /* - * A '\n' was left over from last call to TranslateOutputEOL() and - * we need to store it in the staging buffer. If the channel is - * line-based, we will need to flush the output buffer (after - * translating the staging buffer). - */ + if (translate) { + if (savedLF) { + /* + * A '\n' was left over from last call to TranslateOutputEOL() + * and we need to store it in the staging buffer. If the channel + * is line-based, we will need to flush the output buffer (after + * translating the staging buffer). + */ - *stage++ = '\n'; - stageLen--; - sawLF++; - } - if (TranslateOutputEOL(statePtr, stage, src, &stageLen, &toWrite)) { - sawLF++; - } + *stage++ = '\n'; + stageLen--; + sawLF++; + } + if (TranslateOutputEOL(statePtr, stage, src, &stageLen, &toWrite)) { + sawLF++; + } - stage -= savedLF; - stageLen += savedLF; - savedLF = 0; + stage -= savedLF; + stageLen += savedLF; + savedLF = 0; - if (stageLen > stageMax) { - savedLF = 1; - stageLen = stageMax; + if (stageLen > stageMax) { + savedLF = 1; + stageLen = stageMax; + } + } else { + memcpy(stage, src, toWrite); + stageLen = toWrite; } src += toWrite; srcLen -= toWrite; @@ -10456,6 +10547,157 @@ Tcl_ChannelTruncateProc( } } +/* + *---------------------------------------------------------------------- + * + * DupChannelIntRep -- + * + * Initialize the internal representation of a new Tcl_Obj to a copy of + * the internal representation of an existing string object. + * + * Results: + * None. + * + * Side effects: + * copyPtr's internal rep is set to a copy of srcPtr's internal + * representation. + * + *---------------------------------------------------------------------- + */ + +static void +DupChannelIntRep( + register Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have + * an internal rep of type "Channel". */ + register Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not + * currently have an internal rep.*/ +{ + ChannelState *statePtr = GET_CHANNELSTATE(srcPtr); + SET_CHANNELSTATE(copyPtr, statePtr); + Tcl_Preserve((ClientData) statePtr); + copyPtr->typePtr = &tclChannelType; +} + +/* + *---------------------------------------------------------------------- + * + * SetChannelFromAny -- + * + * Create an internal representation of type "Channel" for an object. + * + * Results: + * This operation always succeeds and returns TCL_OK. + * + * Side effects: + * Any old internal reputation for objPtr is freed and the internal + * representation is set to "Channel". + * + *---------------------------------------------------------------------- + */ + +static int +SetChannelFromAny( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + register Tcl_Obj *objPtr) /* The object to convert. */ +{ + ChannelState *statePtr; + + if (objPtr->typePtr == &tclChannelType) { + /* + * The channel is valid until any call to DetachChannel occurs. + * Ensure consistency checks are done. + */ + statePtr = GET_CHANNELSTATE(objPtr); + if (statePtr->flags & (CHANNEL_TAINTED|CHANNEL_CLOSED)) { + ResetFlag(statePtr, CHANNEL_TAINTED); + Tcl_Release((ClientData) statePtr); + UpdateStringOfChannel(objPtr); + objPtr->typePtr = NULL; + } + } + if (objPtr->typePtr != &tclChannelType) { + Tcl_Channel chan; + + if (objPtr->typePtr != NULL) { + if (objPtr->bytes == NULL) { + objPtr->typePtr->updateStringProc(objPtr); + } + TclFreeIntRep(objPtr); + } + + chan = Tcl_GetChannel(interp, objPtr->bytes, NULL); + if (chan == NULL) { + return TCL_ERROR; + } + + statePtr = ((Channel *)chan)->state; + Tcl_Preserve((ClientData) statePtr); + SET_CHANNELSTATE(objPtr, statePtr); + objPtr->typePtr = &tclChannelType; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * UpdateStringOfChannel -- + * + * Update the string representation for an object whose internal + * representation is "Channel". + * + * Results: + * None. + * + * Side effects: + * The object's string may be set by converting its Unicode represention + * to UTF format. + * + *---------------------------------------------------------------------- + */ + +static void +UpdateStringOfChannel( + Tcl_Obj *objPtr) /* Object with string rep to update. */ +{ + if (objPtr->bytes == NULL) { + ChannelState *statePtr = GET_CHANNELSTATE(objPtr); + const char *name = statePtr->channelName; + if (name) { + size_t len = strlen(name); + objPtr->bytes = (char *) ckalloc(len + 1); + objPtr->length = len; + memcpy(objPtr->bytes, name, len); + } else { + objPtr->bytes = tclEmptyStringRep; + objPtr->length = 0; + } + } +} + +/* + *---------------------------------------------------------------------- + * + * FreeChannelIntRep -- + * + * Release statePtr storage. + * + * Results: + * None. + * + * Side effects: + * May cause state to be freed. + * + *---------------------------------------------------------------------- + */ + +static void +FreeChannelIntRep( + Tcl_Obj *objPtr) /* Object with internal rep to free. */ +{ + Tcl_Release((ClientData) GET_CHANNELSTATE(objPtr)); +} + #if 0 /* * For future debugging work, a simple function to print the flags of a diff --git a/generic/tclIO.h b/generic/tclIO.h index f7afdc5..2b4fd63 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIO.h,v 1.9 2005/10/13 00:56:59 dkf Exp $ + * RCS: @(#) $Id: tclIO.h,v 1.10 2007/12/05 21:47:27 hobbs Exp $ */ /* @@ -334,6 +334,10 @@ typedef struct ChannelState { * usable, but it may not be closed * again from within the close * handler. */ +#define CHANNEL_TAINTED (1<<20) /* Channel stack structure has changed. + * Used by Channel Tcl_Obj type to + * determine if we have to revalidate + * the channel. */ /* * For each channel handler registered in a call to Tcl_CreateChannelHandler, diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index ceed522..44b3b1d 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOCmd.c,v 1.47 2007/11/19 14:50:55 dkf Exp $ + * RCS: @(#) $Id: tclIOCmd.c,v 1.48 2007/12/05 21:47:27 hobbs Exp $ */ #include "tclInt.h" @@ -64,6 +64,7 @@ Tcl_PutsObjCmd( { Tcl_Channel chan; /* The channel to puts on. */ Tcl_Obj *string; /* String to write. */ + Tcl_Obj *chanObjPtr = NULL; /* channel object. */ int newline; /* Add a newline at end? */ const char *channelId; /* Name of channel for puts. */ int result; /* Result of puts operation. */ @@ -83,6 +84,7 @@ Tcl_PutsObjCmd( } else { newline = 1; channelId = TclGetString(objv[1]); + chanObjPtr = objv[1]; } string = objv[2]; break; @@ -90,6 +92,7 @@ Tcl_PutsObjCmd( case 4: /* [puts -nonewline $chan $x] or [puts $chan $x nonewline] */ if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) { channelId = TclGetString(objv[2]); + chanObjPtr = objv[2]; string = objv[3]; } else { /* @@ -109,6 +112,7 @@ Tcl_PutsObjCmd( return TCL_ERROR; } channelId = TclGetString(objv[1]); + chanObjPtr = objv[1]; string = objv[2]; } newline = 0; @@ -120,9 +124,16 @@ Tcl_PutsObjCmd( return TCL_ERROR; } - chan = Tcl_GetChannel(interp, channelId, &mode); - if (chan == NULL) { - return TCL_ERROR; + if (chanObjPtr != NULL) { + if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) + != TCL_OK) { + return TCL_ERROR; + } + } else { + chan = Tcl_GetChannel(interp, channelId, &mode); + if (chan == NULL) { + return TCL_ERROR; + } } if ((mode & TCL_WRITABLE) == 0) { Tcl_AppendResult(interp, "channel \"", channelId, @@ -182,21 +193,20 @@ Tcl_FlushObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { + Tcl_Obj *chanObjPtr; Tcl_Channel chan; /* The channel to flush on. */ - char *channelId; int mode; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channelId"); return TCL_ERROR; } - channelId = TclGetString(objv[1]); - chan = Tcl_GetChannel(interp, channelId, &mode); - if (chan == NULL) { + chanObjPtr = objv[1]; + if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if ((mode & TCL_WRITABLE) == 0) { - Tcl_AppendResult(interp, "channel \"", channelId, + Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr), "\" wasn't opened for writing", NULL); return TCL_ERROR; } @@ -210,7 +220,8 @@ Tcl_FlushObjCmd( */ if (!TclChanCaughtErrorBypass(interp, chan)) { - Tcl_AppendResult(interp, "error flushing \"", channelId, "\": ", + Tcl_AppendResult(interp, "error flushing \"", + TclGetString(chanObjPtr), "\": ", Tcl_PosixError(interp), NULL); } return TCL_ERROR; @@ -246,20 +257,18 @@ Tcl_GetsObjCmd( Tcl_Channel chan; /* The channel to read from. */ int lineLen; /* Length of line just read. */ int mode; /* Mode in which channel is opened. */ - char *name; - Tcl_Obj *linePtr; + Tcl_Obj *linePtr, *chanObjPtr; if ((objc != 2) && (objc != 3)) { Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?"); return TCL_ERROR; } - name = TclGetString(objv[1]); - chan = Tcl_GetChannel(interp, name, &mode); - if (chan == NULL) { + chanObjPtr = objv[1]; + if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if ((mode & TCL_READABLE) == 0) { - Tcl_AppendResult(interp, "channel \"", name, + Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr), "\" wasn't opened for reading", NULL); return TCL_ERROR; } @@ -279,7 +288,8 @@ Tcl_GetsObjCmd( if (!TclChanCaughtErrorBypass(interp, chan)) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "error reading \"", name, "\": ", + Tcl_AppendResult(interp, "error reading \"", + TclGetString(chanObjPtr), "\": ", Tcl_PosixError(interp), NULL); } return TCL_ERROR; @@ -329,8 +339,7 @@ Tcl_ReadObjCmd( int toRead; /* How many bytes to read? */ int charactersRead; /* How many characters were read? */ int mode; /* Mode in which channel is opened. */ - char *name; - Tcl_Obj *resultPtr; + Tcl_Obj *resultPtr, *chanObjPtr; if ((objc != 2) && (objc != 3)) { Interp *iPtr; @@ -361,13 +370,12 @@ Tcl_ReadObjCmd( goto argerror; } - name = TclGetString(objv[i]); - chan = Tcl_GetChannel(interp, name, &mode); - if (chan == NULL) { + chanObjPtr = objv[i]; + if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if ((mode & TCL_READABLE) == 0) { - Tcl_AppendResult(interp, "channel \"", name, + Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr), "\" wasn't opened for reading", NULL); return TCL_ERROR; } @@ -409,7 +417,8 @@ Tcl_ReadObjCmd( if (!TclChanCaughtErrorBypass(interp, chan)) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "error reading \"", name, "\": ", + Tcl_AppendResult(interp, "error reading \"", + TclGetString(chanObjPtr), "\": ", Tcl_PosixError(interp), NULL); } Tcl_DecrRefCount(resultPtr); @@ -464,7 +473,6 @@ Tcl_SeekObjCmd( Tcl_WideInt offset; /* Where to seek? */ int mode; /* How to seek? */ Tcl_WideInt result; /* Of calling Tcl_Seek. */ - char *chanName; int optionIndex; static const char *originOptions[] = { "start", "current", "end", NULL @@ -475,9 +483,7 @@ Tcl_SeekObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "channelId offset ?origin?"); return TCL_ERROR; } - chanName = TclGetString(objv[1]); - chan = Tcl_GetChannel(interp, chanName, NULL); - if (chan == NULL) { + if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetWideIntFromObj(interp, objv[2], &offset) != TCL_OK) { @@ -501,8 +507,9 @@ Tcl_SeekObjCmd( * regular message if nothing was found in the bypass. */ if (!TclChanCaughtErrorBypass(interp, chan)) { - Tcl_AppendResult(interp, "error during seek on \"", chanName, - "\": ", Tcl_PosixError(interp), NULL); + Tcl_AppendResult(interp, "error during seek on \"", + TclGetString(objv[1]), "\": ", + Tcl_PosixError(interp), NULL); } return TCL_ERROR; } @@ -535,7 +542,6 @@ Tcl_TellObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; /* The channel to tell on. */ - char *chanName; Tcl_WideInt newLoc; if (objc != 2) { @@ -548,9 +554,7 @@ Tcl_TellObjCmd( * channel table of this interpreter. */ - chanName = TclGetString(objv[1]); - chan = Tcl_GetChannel(interp, chanName, NULL); - if (chan == NULL) { + if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } @@ -596,16 +600,13 @@ Tcl_CloseObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; /* The channel to close. */ - char *arg; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channelId"); return TCL_ERROR; } - arg = TclGetString(objv[1]); - chan = Tcl_GetChannel(interp, arg, NULL); - if (chan == NULL) { + if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } @@ -664,7 +665,7 @@ Tcl_FconfigureObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - char *chanName, *optionName, *valueName; + char *optionName, *valueName; Tcl_Channel chan; /* The channel to set a mode on. */ int i; /* Iterate over arg-value pairs. */ @@ -674,9 +675,7 @@ Tcl_FconfigureObjCmd( return TCL_ERROR; } - chanName = TclGetString(objv[1]); - chan = Tcl_GetChannel(interp, chanName, NULL); - if (chan == NULL) { + if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } @@ -744,17 +743,13 @@ Tcl_EofObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; - int dummy; - char *arg; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channelId"); return TCL_ERROR; } - arg = TclGetString(objv[1]); - chan = Tcl_GetChannel(interp, arg, &dummy); - if (chan == NULL) { + if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } @@ -963,20 +958,17 @@ Tcl_FblockedObjCmd( { Tcl_Channel chan; int mode; - char *arg; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channelId"); return TCL_ERROR; } - arg = TclGetString(objv[1]); - chan = Tcl_GetChannel(interp, arg, &mode); - if (chan == NULL) { + if (TclGetChannelFromObj(interp, objv[1], &chan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if ((mode & TCL_READABLE) == 0) { - Tcl_AppendResult(interp, "channel \"", arg, + Tcl_AppendResult(interp, "channel \"", TclGetString(objv[1]), "\" wasn't opened for reading", NULL); return TCL_ERROR; } @@ -1559,7 +1551,6 @@ Tcl_FcopyObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel inChan, outChan; - const char *arg; int mode, i, toRead, index; Tcl_Obj *cmdPtr; static const char* switches[] = { "-size", "-command", NULL }; @@ -1576,23 +1567,19 @@ Tcl_FcopyObjCmd( * writable, as appropriate. */ - arg = TclGetString(objv[1]); - inChan = Tcl_GetChannel(interp, arg, &mode); - if (inChan == NULL) { + if (TclGetChannelFromObj(interp, objv[1], &inChan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if ((mode & TCL_READABLE) == 0) { - Tcl_AppendResult(interp, "channel \"", arg, + Tcl_AppendResult(interp, "channel \"", TclGetString(objv[1]), "\" wasn't opened for reading", NULL); return TCL_ERROR; } - arg = TclGetString(objv[2]); - outChan = Tcl_GetChannel(interp, arg, &mode); - if (outChan == NULL) { + if (TclGetChannelFromObj(interp, objv[2], &outChan, &mode, 0) != TCL_OK) { return TCL_ERROR; } if ((mode & TCL_WRITABLE) == 0) { - Tcl_AppendResult(interp, "channel \"", arg, + Tcl_AppendResult(interp, "channel \"", TclGetString(objv[2]), "\" wasn't opened for writing", NULL); return TCL_ERROR; } @@ -1648,7 +1635,6 @@ TclChanPendingObjCmd( { Tcl_Channel chan; int index, mode; - char *arg; static const char *options[] = {"input", "output", NULL}; enum options {PENDING_INPUT, PENDING_OUTPUT}; @@ -1662,9 +1648,7 @@ TclChanPendingObjCmd( return TCL_ERROR; } - arg = TclGetString(objv[2]); - chan = Tcl_GetChannel(interp, arg, &mode); - if (chan == NULL) { + if (TclGetChannelFromObj(interp, objv[2], &chan, &mode, 0) != TCL_OK) { return TCL_ERROR; } @@ -1712,17 +1696,13 @@ TclChanTruncateObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; - int mode; Tcl_WideInt length; - char *chanName; if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "channelId ?length?"); return TCL_ERROR; } - chanName = TclGetString(objv[1]); - chan = Tcl_GetChannel(interp, chanName, &mode); - if (chan == NULL) { + if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } @@ -1747,15 +1727,17 @@ TclChanTruncateObjCmd( length = Tcl_Tell(chan); if (length == Tcl_WideAsLong(-1)) { Tcl_AppendResult(interp, - "could not determine current location in \"", chanName, - "\": ", Tcl_PosixError(interp), NULL); + "could not determine current location in \"", + TclGetString(objv[1]), "\": ", + Tcl_PosixError(interp), NULL); return TCL_ERROR; } } if (Tcl_TruncateChannel(chan, length) != TCL_OK) { - Tcl_AppendResult(interp, "error during truncate on \"", chanName, - "\": ", Tcl_PosixError(interp), NULL); + Tcl_AppendResult(interp, "error during truncate on \"", + TclGetString(objv[1]), "\": ", + Tcl_PosixError(interp), NULL); return TCL_ERROR; } |