diff options
author | dgp <dgp@users.sourceforge.net> | 2017-04-11 14:14:05 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2017-04-11 14:14:05 (GMT) |
commit | b84f5f3a45069293685516738b37cbfdcb5553a1 (patch) | |
tree | 72af08cb803c98359747f491a103cb4282b777d3 /generic | |
parent | 7c7bcbe9b76380874ac83600562b042efb49f254 (diff) | |
parent | 90ca2f4448e5aba75ffe9b71d877b557264a90a0 (diff) | |
download | tcl-b84f5f3a45069293685516738b37cbfdcb5553a1.zip tcl-b84f5f3a45069293685516738b37cbfdcb5553a1.tar.gz tcl-b84f5f3a45069293685516738b37cbfdcb5553a1.tar.bz2 |
merge trunk
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tcl.h | 13 | ||||
-rw-r--r-- | generic/tclIO.c | 729 | ||||
-rw-r--r-- | generic/tclIOCmd.c | 40 | ||||
-rw-r--r-- | generic/tclIORChan.c | 57 | ||||
-rw-r--r-- | generic/tclIOSock.c | 27 | ||||
-rw-r--r-- | generic/tclIOUtil.c | 51 | ||||
-rw-r--r-- | generic/tclStubInit.c | 20 | ||||
-rw-r--r-- | generic/tclTest.c | 85 | ||||
-rw-r--r-- | generic/tclTimer.c | 12 |
9 files changed, 627 insertions, 407 deletions
diff --git a/generic/tcl.h b/generic/tcl.h index 1952176..409762d 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -419,10 +419,6 @@ typedef TCL_WIDE_INT_TYPE Tcl_WideInt; typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; #ifdef TCL_WIDE_INT_IS_LONG -# define Tcl_WideAsLong(val) ((long)(val)) -# define Tcl_LongAsWide(val) ((long)(val)) -# define Tcl_WideAsDouble(val) ((double)((long)(val))) -# define Tcl_DoubleAsWide(val) ((long)((double)(val))) # ifndef TCL_LL_MODIFIER # define TCL_LL_MODIFIER "l" # endif /* !TCL_LL_MODIFIER */ @@ -434,12 +430,13 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; # ifndef TCL_LL_MODIFIER # define TCL_LL_MODIFIER "ll" # endif /* !TCL_LL_MODIFIER */ -# define Tcl_WideAsLong(val) ((long)((Tcl_WideInt)(val))) -# define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val))) -# define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val))) -# define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val))) #endif /* TCL_WIDE_INT_IS_LONG */ +#define Tcl_WideAsLong(val) ((long)((Tcl_WideInt)(val))) +#define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val))) +#define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val))) +#define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val))) + #if defined(_WIN32) # ifdef __BORLANDC__ typedef struct stati64 Tcl_StatBuf; diff --git a/generic/tclIO.c b/generic/tclIO.c index c4e960c..28d09d4 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -321,7 +321,7 @@ static int WillRead(Channel *chanPtr); typedef struct ResolvedChanName { ChannelState *statePtr; /* The saved lookup result */ Tcl_Interp *interp; /* The interp in which the lookup was done. */ - size_t epoch; /* The epoch of the channel when the lookup + size_t epoch; /* The epoch of the channel when the lookup * was done. Use to verify validity. */ size_t refCount; /* Share this struct among many Tcl_Obj. */ } ResolvedChanName; @@ -397,20 +397,20 @@ ChanCloseHalf( * * ChanRead -- * - * Read up to dstSize bytes using the inputProc of chanPtr, store - * them at dst, and return the number of bytes stored. + * Read up to dstSize bytes using the inputProc of chanPtr, store them at + * dst, and return the number of bytes stored. * * Results: * The return value of the driver inputProc, * - number of bytes stored at dst, ot - * - -1 on error, with a Posix error code available to the - * caller by calling Tcl_GetErrno(). + * - -1 on error, with a Posix error code available to the caller by + * calling Tcl_GetErrno(). * * Side effects: - * The CHANNEL_BLOCKED and CHANNEL_EOF flags of the channel state are - * set as appropriate. - * On EOF, the inputEncodingFlags are set to perform ending operations - * on decoding. + * The CHANNEL_BLOCKED and CHANNEL_EOF flags of the channel state are set + * as appropriate. On EOF, the inputEncodingFlags are set to perform + * ending operations on decoding. + * * TODO - Is this really the right place for that? * *--------------------------------------------------------------------------- @@ -424,15 +424,17 @@ ChanRead( int bytesRead, result; /* - * If the caller asked for zero bytes, we'd force the inputProc - * to return zero bytes, and then misinterpret that as EOF. + * If the caller asked for zero bytes, we'd force the inputProc to return + * zero bytes, and then misinterpret that as EOF. */ + assert(dstSize > 0); /* * Each read op must set the blocked and eof states anew, not let * the effect of prior reads leak through. */ + if (GotFlag(chanPtr->state, CHANNEL_EOF)) { chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START; } @@ -445,7 +447,10 @@ ChanRead( bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData, dst, dstSize, &result); - /* Stop any flag leakage through stacked channel levels */ + /* + * Stop any flag leakage through stacked channel levels. + */ + if (GotFlag(chanPtr->state, CHANNEL_EOF)) { chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START; } @@ -453,10 +458,10 @@ ChanRead( chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END; if (bytesRead > 0) { /* - * If we get a short read, signal up that we may be BLOCKED. - * We should avoid calling the driver because on some - * platforms we will block in the low level reading code even - * though the channel is set into nonblocking mode. + * If we get a short read, signal up that we may be BLOCKED. We should + * avoid calling the driver because on some platforms we will block in + * the low level reading code even though the channel is set into + * nonblocking mode. */ if (bytesRead < dstSize) { @@ -590,7 +595,10 @@ TclFinalizeIOSubsystem(void) int active = 1; /* Flag == 1 while there's still work to do */ int doflushnb; - /* Fetch the pre-TIP#398 compatibility flag */ + /* + * Fetch the pre-TIP#398 compatibility flag. + */ + { const char *s; Tcl_DString ds; @@ -635,18 +643,20 @@ TclFinalizeIOSubsystem(void) */ if (active) { - TclChannelPreserve((Tcl_Channel)chanPtr); + /* - * TIP #398: by default, we no longer set the channel back into - * blocking mode. To restore the old blocking behavior, the - * environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT must be set + * TIP #398: by default, we no longer set the channel back into + * blocking mode. To restore the old blocking behavior, the + * environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT must be set * and not be "0". */ + if (doflushnb) { - /* Set the channel back into blocking mode to ensure that we wait - * for all data to flush out. - */ + /* + * Set the channel back into blocking mode to ensure that we + * wait for all data to flush out. + */ (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, "-blocking", "on"); @@ -1527,8 +1537,10 @@ TclGetChannelFromObj( if ((resPtr->interp == interp) /* Same interp context */ /* No epoch change in channel since lookup */ && (resPtr->epoch == statePtr->epoch)) { + /* + * Have a valid saved lookup. Jump to end to return it. + */ - /* Have a valid saved lookup. Jump to end to return it. */ goto valid; } } @@ -1543,7 +1555,10 @@ TclGetChannelFromObj( } if (resPtr && resPtr->refCount == 1) { - /* Re-use the ResolvedCmdName struct */ + /* + * Re-use the ResolvedCmdName struct. + */ + Tcl_Release((ClientData) resPtr->statePtr); } else { resPtr = (ResolvedChanName *) ckalloc(sizeof(ResolvedChanName)); @@ -1683,7 +1698,7 @@ Tcl_CreateChannel( * Set the channel up initially in AUTO input translation mode to accept * "\n", "\r" and "\r\n". Output translation mode is set to a platform * specific default value. The eofChar is set to 0 for both input and - * output, so that Tcl does not look for an in-file EOF indicator (e.g. + * output, so that Tcl does not look for an in-file EOF indicator (e.g., * ^Z) and does not append an EOF indicator to files. */ @@ -1911,7 +1926,6 @@ Tcl_StackChannel( */ if (((mask & TCL_READABLE) != 0) && (statePtr->inQueueHead != NULL)) { - /* * When statePtr->inQueueHead is not NULL, we know * prevChanPtr->inQueueHead must be NULL. @@ -2043,9 +2057,7 @@ Tcl_UnstackChannel( * of registered channels we wind down the state of the * transformation, and then restore the state of underlying channel * into the old structure. - */ - - /* + * * TODO: Figure out how to handle the situation where the chan * operations called below by this unstacking operation cause * another unstacking recursively. In that case the downChanPtr @@ -2523,6 +2535,7 @@ RecycleBuffer( /* * Do we have to free the buffer to the OS? */ + if (IsShared(bufPtr)) { mustDiscard = 1; } @@ -2533,9 +2546,8 @@ RecycleBuffer( } /* - * Only save buffers which have the requested buffersize for the - * channel. This is to honor dynamic changes of the buffersize - * made by the user. + * Only save buffers which have the requested buffersize for the channel. + * This is to honor dynamic changes of the buffersize made by the user. */ if ((bufPtr->bufLength - BUFFER_PADDING) != statePtr->bufSize) { @@ -2705,14 +2717,18 @@ FlushChannel( /* * Should we shift the current output buffer over to the output queue? * First check that there are bytes in it. If so then... - * If the output queue is empty, then yes, trusting the caller called - * us only when written bytes ought to be flushed. - * If the current output buffer is full, then yes, so we can meet - * the post-condition that on a successful return to caller we've - * left space in the current output buffer for more writing (the flush - * call was to make new room). - * If the channel is blocking, then yes, so we guarantee that - * blocking flushes actually flush all pending data. + * + * If the output queue is empty, then yes, trusting the caller called us + * only when written bytes ought to be flushed. + * + * If the current output buffer is full, then yes, so we can meet the + * post-condition that on a successful return to caller we've left space + * in the current output buffer for more writing (the flush call was to + * make new room). + * + * If the channel is blocking, then yes, so we guarantee that blocking + * flushes actually flush all pending data. + * * Otherwise, no. Keep the current output buffer where it is so more * can be written to it, possibly filling it, to promote more efficient * buffer usage. @@ -2806,8 +2822,8 @@ FlushChannel( /* * TIP #219, Tcl Channel Reflection API. * When defering the error copy a message from the bypass into - * the unreported area. Or discard it if the new error is to be - * ignored in favor of an earlier defered error. + * the unreported area. Or discard it if the new error is to + * be ignored in favor of an earlier defered error. */ Tcl_Obj *msg = statePtr->chanMsg; @@ -2859,8 +2875,11 @@ FlushChannel( ReleaseChannelBuffer(bufPtr); break; } else { - /* TODO: Consider detecting and reacting to short writes - * on blocking channels. Ought not happen. See iocmd-24.2. */ + /* + * TODO: Consider detecting and reacting to short writes on + * blocking channels. Ought not happen. See iocmd-24.2. + */ + wroteSome = 1; } @@ -2894,7 +2913,6 @@ FlushChannel( ResetFlag(statePtr, BG_FLUSH_SCHEDULED); ChanWatch(chanPtr, statePtr->interestMask); } else { - /* * When we are calledFromAsyncFlush, that means a writable * state on the channel triggered the call, so we should be @@ -2939,7 +2957,8 @@ FlushChannel( (statePtr->outQueueHead == NULL) && ((statePtr->curOutPtr == NULL) || IsBufferEmpty(statePtr->curOutPtr))) { - errorCode = CloseChannelPart(interp, chanPtr, errorCode, TCL_CLOSE_WRITE); + errorCode = CloseChannelPart(interp, chanPtr, errorCode, + TCL_CLOSE_WRITE); goto done; } @@ -3410,7 +3429,6 @@ Tcl_Close( if (GotFlag(statePtr, TCL_WRITABLE) && (statePtr->encoding != NULL) && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)) { - int code = CheckChannelErrors(statePtr, TCL_WRITABLE); if (code == 0) { @@ -3500,12 +3518,14 @@ Tcl_Close( } return TCL_ERROR; } + /* * Bug 97069ea11a: set error message if a flush code is set and no error * message set up to now. */ + if (flushcode != 0 && interp != NULL - && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp)) ) { + && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp))) { Tcl_SetErrno(flushcode); Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp), -1)); @@ -3600,8 +3620,8 @@ Tcl_CloseEx( } /* - * A user may try to call half-close from within a channel close - * handler. That won't do. + * A user may try to call half-close from within a channel close handler. + * That won't do. */ if (statePtr->flags & CHANNEL_INCLOSE) { @@ -3672,9 +3692,12 @@ CloseWrite( * closed. May still be used by some * interpreter */ { - /* Notes: clear-channel-handlers - write side only ? or keep around, just - * not called. */ - /* No close cllbacks are run - channel is still open (read side) */ + /* + * Notes: clear-channel-handlers - write side only ? or keep around, just + * not called. + * + * No close callbacks are run - channel is still open (read side) + */ ChannelState *statePtr = chanPtr->state; /* State of real IO channel. */ @@ -3699,9 +3722,9 @@ CloseWrite( * Notes: Due to the assertion of CHANNEL_CLOSEDWRITE in the flags * FlushChannel() has called CloseChannelPart(). While we can still access * "chan" (no structures were freed), the only place which may still - * contain a message is the interpreter itself, and "CloseChannelPart" made - * sure to lift any channel message it generated into it. Hence the NULL - * argument in the call below. + * contain a message is the interpreter itself, and "CloseChannelPart" + * made sure to lift any channel message it generated into it. Hence the + * NULL argument in the call below. */ if (TclChanCaughtErrorBypass(interp, NULL)) { @@ -3925,10 +3948,10 @@ Tcl_ClearChannelHandlers( StopCopy(statePtr->csPtrW); /* - * Must set the interest mask now to 0, otherwise infinite loops - * will occur if Tcl_DoOneEvent is called before the channel is - * finally deleted in FlushChannel. This can happen if the channel - * has a background flush active. + * Must set the interest mask now to 0, otherwise infinite loops will + * occur if Tcl_DoOneEvent is called before the channel is finally deleted + * in FlushChannel. This can happen if the channel has a background flush + * active. */ statePtr->interestMask = 0; @@ -4197,22 +4220,24 @@ WillRead( Channel *chanPtr) { if (chanPtr->typePtr == NULL) { - /* Prevent read attempts on a closed channel */ + /* + * Prevent read attempts on a closed channel. + */ + DiscardInputQueued(chanPtr->state, 0); Tcl_SetErrno(EINVAL); return -1; } if ((chanPtr->typePtr->seekProc != NULL) && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) { - /* - * CAVEAT - The assumption here is that FlushChannel() will - * push out the bytes of any writes that are in progress. - * Since this is a seekable channel, we assume it is not one - * that can block and force bg flushing. Channels we know that - * can do that -- sockets, pipes -- are not seekable. If the - * assumption is wrong, more drastic measures may be required here - * like temporarily setting the channel into blocking mode. + * CAVEAT - The assumption here is that FlushChannel() will push out + * the bytes of any writes that are in progress. Since this is a + * seekable channel, we assume it is not one that can block and force + * bg flushing. Channels we know that can do that - sockets, pipes - + * are not seekable. If the assumption is wrong, more drastic measures + * may be required here like temporarily setting the channel into + * blocking mode. */ if (FlushChannel(NULL, chanPtr, 0) != 0) { @@ -4304,11 +4329,17 @@ Write( &statePtr->outputEncodingState, dst, dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL); - /* See chan-io-1.[89]. Tcl Bug 506297. */ + /* + * See chan-io-1.[89]. Tcl Bug 506297. + */ + statePtr->outputEncodingFlags &= ~TCL_ENCODING_START; if ((result != TCL_OK) && (srcRead + dstWrote == 0)) { - /* We're reading from invalid/incomplete UTF-8 */ + /* + * We're reading from invalid/incomplete UTF-8. + */ + ReleaseChannelBuffer(bufPtr); if (total == 0) { Tcl_SetErrno(EINVAL); @@ -4348,11 +4379,10 @@ Write( } result |= Tcl_UtfToExternal(NULL, encoding, nl, nlLen, - statePtr->outputEncodingFlags, - &statePtr->outputEncodingState, dst, - dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL); - - assert (srcRead == nlLen); + statePtr->outputEncodingFlags, + &statePtr->outputEncodingState, dst, + dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL); + assert(srcRead == nlLen); bufPtr->nextAdded += dstWrote; src++; @@ -4366,11 +4396,11 @@ Write( if (IsBufferOverflowing(bufPtr)) { /* - * When translating from UTF-8 to external encoding, we - * allowed the translation to produce a character that crossed - * the end of the output buffer, so that we would get a - * completely full buffer before flushing it. The extra bytes - * will be moved to the beginning of the next buffer. + * When translating from UTF-8 to external encoding, we allowed + * the translation to produce a character that crossed the end of + * the output buffer, so that we would get a completely full + * buffer before flushing it. The extra bytes will be moved to the + * beginning of the next buffer. */ saved = -SpaceLeft(bufPtr); @@ -4390,15 +4420,16 @@ Write( flushed += statePtr->bufSize; /* - * We just flushed. So if we have needNlFlush set to record - * that we need to flush because theres a (translated) newline - * in the buffer, that's likely not true any more. But there - * is a tricky exception. If we have saved bytes that did not - * really get flushed and those bytes came from a translation - * of a newline as the last thing taken from the src array, - * then needNlFlush needs to remain set to flag that the - * next buffer still needs a newline flush. + * We just flushed. So if we have needNlFlush set to record that + * we need to flush because theres a (translated) newline in the + * buffer, that's likely not true any more. But there is a tricky + * exception. If we have saved bytes that did not really get + * flushed and those bytes came from a translation of a newline as + * the last thing taken from the src array, then needNlFlush needs + * to remain set to flag that the next buffer still needs a + * newline flush. */ + if (needNlFlush && (saved == 0 || src[-1] != '\n')) { needNlFlush = 0; } @@ -4504,8 +4535,8 @@ Tcl_GetsObj( if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) { SetFlag(statePtr, CHANNEL_EOF); - assert( statePtr->inputEncodingFlags & TCL_ENCODING_END ); - assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) ); + assert(statePtr->inputEncodingFlags & TCL_ENCODING_END); + assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR)); /* TODO: Do we need this? */ UpdateInterest(chanPtr); @@ -4845,17 +4876,17 @@ Tcl_GetsObj( */ done: - assert(!GotFlag(statePtr, CHANNEL_EOF) - || GotFlag(statePtr, CHANNEL_STICKY_EOF) - || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); - - assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) - == (CHANNEL_EOF|CHANNEL_BLOCKED)) ); + assert(!GotFlag(statePtr, CHANNEL_EOF) + || GotFlag(statePtr, CHANNEL_STICKY_EOF) + || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); + assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) + == (CHANNEL_EOF|CHANNEL_BLOCKED))); /* * Regenerate the top channel, in case it was changed due to * self-modifying reflected transforms. */ + if (chanPtr != statePtr->topChanPtr) { TclChannelRelease((Tcl_Channel)chanPtr); chanPtr = statePtr->topChanPtr; @@ -4875,10 +4906,9 @@ Tcl_GetsObj( * end-of-line or end-of-file has been seen. Bytes read from the input * channel return as a ByteArray obj. * - * WARNING! The notion of "binary" used here is different from - * notions of "binary" used in other places. In particular, this - * "binary" routine may be called when an -eofchar is set on the - * channel. + * WARNING! The notion of "binary" used here is different from notions + * of "binary" used in other places. In particular, this "binary" routine + * may be called when an -eofchar is set on the channel. * * Results: * Number of characters accumulated in the object or -1 if error, @@ -4944,8 +4974,8 @@ TclGetsObjBinary( ResetFlag(statePtr, CHANNEL_BLOCKED); while (1) { /* - * Subtract the number of bytes that were removed from channel - * buffer during last call. + * Subtract the number of bytes that were removed from channel buffer + * during last call. */ if (bufPtr != NULL) { @@ -4957,10 +4987,11 @@ TclGetsObjBinary( if ((bufPtr == NULL) || (bufPtr->nextAdded == BUFFER_PADDING)) { /* - * All channel buffers were exhausted and the caller still - * hasn't seen EOL. Need to read more bytes from the channel - * device. Side effect is to allocate another channel buffer. + * All channel buffers were exhausted and the caller still hasn't + * seen EOL. Need to read more bytes from the channel device. Side + * effect is to allocate another channel buffer. */ + if (GetInput(chanPtr) != 0) { goto restore; } @@ -4970,15 +5001,15 @@ TclGetsObjBinary( } } else { /* - * Incoming CHANNEL_STICKY_EOF is filtered out on entry. - * A new CHANNEL_STICKY_EOF set in this routine leads to - * return before coming back here. When we are not dealing - * with CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an - * empty buffer. Here the buffer is non-empty so we know - * we're a non-EOF */ + * Incoming CHANNEL_STICKY_EOF is filtered out on entry. A new + * CHANNEL_STICKY_EOF set in this routine leads to return before + * coming back here. When we are not dealing with + * CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an empty buffer. + * Here the buffer is non-empty so we know we're a non-EOF. + */ - assert ( !GotFlag(statePtr, CHANNEL_STICKY_EOF) ); - assert ( !GotFlag(statePtr, CHANNEL_EOF) ); + assert(!GotFlag(statePtr, CHANNEL_STICKY_EOF)); + assert(!GotFlag(statePtr, CHANNEL_EOF)); } dst = (unsigned char *) RemovePoint(bufPtr); @@ -5045,8 +5076,8 @@ TclGetsObjBinary( } /* - * Copy bytes from the channel buffer to the ByteArray. - * This may realloc space, so keep track of result. + * Copy bytes from the channel buffer to the ByteArray. This may + * realloc space, so keep track of result. */ rawLen = dstEnd - dst; @@ -5130,11 +5161,11 @@ TclGetsObjBinary( */ done: - assert(!GotFlag(statePtr, CHANNEL_EOF) - || GotFlag(statePtr, CHANNEL_STICKY_EOF) - || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); - assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) - == (CHANNEL_EOF|CHANNEL_BLOCKED)) ); + assert(!GotFlag(statePtr, CHANNEL_EOF) + || GotFlag(statePtr, CHANNEL_STICKY_EOF) + || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); + assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) + == (CHANNEL_EOF|CHANNEL_BLOCKED))); UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); return copiedTotal; @@ -5267,15 +5298,15 @@ FilterInputBytes( } } else { /* - * Incoming CHANNEL_STICKY_EOF is filtered out on entry. - * A new CHANNEL_STICKY_EOF set in this routine leads to - * return before coming back here. When we are not dealing - * with CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an - * empty buffer. Here the buffer is non-empty so we know - * we're a non-EOF */ + * Incoming CHANNEL_STICKY_EOF is filtered out on entry. A new + * CHANNEL_STICKY_EOF set in this routine leads to return before + * coming back here. When we are not dealing with CHANNEL_STICKY_EOF, + * a CHANNEL_EOF implies an empty buffer. Here the buffer is + * non-empty so we know we're a non-EOF. + */ - assert ( !GotFlag(statePtr, CHANNEL_STICKY_EOF) ); - assert ( !GotFlag(statePtr, CHANNEL_EOF) ); + assert(!GotFlag(statePtr, CHANNEL_STICKY_EOF)); + assert(!GotFlag(statePtr, CHANNEL_EOF)); } /* @@ -5605,7 +5636,9 @@ Tcl_ReadRaw( return -1; } - /* First read bytes from the push-back buffers. */ + /* + * First read bytes from the push-back buffers. + */ while (chanPtr->inQueueHead && bytesToRead > 0) { ChannelBuffer *bufPtr = chanPtr->inQueueHead; @@ -5613,7 +5646,9 @@ Tcl_ReadRaw( int toCopy = (bytesInBuffer < bytesToRead) ? bytesInBuffer : bytesToRead; - /* Copy the current chunk into the read buffer. */ + /* + * Copy the current chunk into the read buffer. + */ memcpy(readBuf, RemovePoint(bufPtr), (size_t) toCopy); bufPtr->nextRemoved += toCopy; @@ -5621,7 +5656,9 @@ Tcl_ReadRaw( readBuf += toCopy; bytesToRead -= toCopy; - /* If the current buffer is empty recycle it. */ + /* + * If the current buffer is empty recycle it. + */ if (IsBufferEmpty(bufPtr)) { chanPtr->inQueueHead = bufPtr->nextPtr; @@ -5633,37 +5670,40 @@ Tcl_ReadRaw( } /* - * Go to the driver only if we got nothing from pushback. - * Have to do it this way to avoid EOF mis-timings when we - * consider the ability that EOF may not be a permanent - * condition in the driver, and in that case we have to - * synchronize. + * Go to the driver only if we got nothing from pushback. Have to do it + * this way to avoid EOF mis-timings when we consider the ability that EOF + * may not be a permanent condition in the driver, and in that case we + * have to synchronize. */ if (copied) { return copied; } - /* This test not needed. */ - if (bytesToRead > 0) { + /* + * This test not needed. + */ + if (bytesToRead > 0) { int nread = ChanRead(chanPtr, readBuf, bytesToRead); if (nread > 0) { - /* Successful read (short is OK) - add to bytes copied */ + /* + * Successful read (short is OK) - add to bytes copied. + */ + copied += nread; } else if (nread < 0) { /* - * An error signaled. If CHANNEL_BLOCKED, then the error - * is not real, but an indication of blocked state. In - * that case, retain the flag and let caller receive the - * short read of copied bytes from the pushback. - * HOWEVER, if copied==0 bytes from pushback then repeat - * signalling the blocked state as an error to caller so - * there is no false report of an EOF. - * When !CHANNEL_BLOCKED, the error is real and passes on - * to caller. + * An error signaled. If CHANNEL_BLOCKED, then the error is not + * real, but an indication of blocked state. In that case, retain + * the flag and let caller receive the short read of copied bytes + * from the pushback. HOWEVER, if copied==0 bytes from pushback + * then repeat signalling the blocked state as an error to caller + * so there is no false report of an EOF. When !CHANNEL_BLOCKED, + * the error is real and passes on to caller. */ + if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) { copied = -1; } @@ -5800,21 +5840,23 @@ DoReadChars( /* * Early out when next read will see eofchar. * - * NOTE: See DoRead for argument that it's a bug (one we're keeping) - * to have this escape before the one for zero-char read request. + * NOTE: See DoRead for argument that it's a bug (one we're keeping) to + * have this escape before the one for zero-char read request. */ if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) { SetFlag(statePtr, CHANNEL_EOF); - assert( statePtr->inputEncodingFlags & TCL_ENCODING_END ); - assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) ); + assert(statePtr->inputEncodingFlags & TCL_ENCODING_END); + assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR)); /* TODO: We don't need this call? */ UpdateInterest(chanPtr); return 0; } - /* Special handling for zero-char read request. */ + /* + * Special handling for zero-char read request. + */ if (toRead == 0) { if (GotFlag(statePtr, CHANNEL_EOF)) { statePtr->inputEncodingFlags |= TCL_ENCODING_START; @@ -5833,7 +5875,10 @@ DoReadChars( chanPtr = statePtr->topChanPtr; TclChannelPreserve((Tcl_Channel)chanPtr); - /* Must clear the BLOCKED|EOF flags here since we check before reading */ + /* + * Must clear the BLOCKED|EOF flags here since we check before reading. + */ + if (GotFlag(statePtr, CHANNEL_EOF)) { statePtr->inputEncodingFlags |= TCL_ENCODING_START; } @@ -5891,10 +5936,11 @@ DoReadChars( } /* - * Failure to fill a channel buffer may have left channel reporting - * a "blocked" state, but so long as we fulfilled the request here, - * the caller does not consider us blocked. + * Failure to fill a channel buffer may have left channel reporting a + * "blocked" state, but so long as we fulfilled the request here, the + * caller does not consider us blocked. */ + if (toRead == 0) { ResetFlag(statePtr, CHANNEL_BLOCKED); } @@ -5903,6 +5949,7 @@ DoReadChars( * Regenerate the top channel, in case it was changed due to * self-modifying reflected transforms. */ + if (chanPtr != statePtr->topChanPtr) { TclChannelRelease((Tcl_Channel)chanPtr); chanPtr = statePtr->topChanPtr; @@ -5913,11 +5960,12 @@ DoReadChars( * Update the notifier state so we don't block while there is still data * in the buffers. */ - assert(!GotFlag(statePtr, CHANNEL_EOF) - || GotFlag(statePtr, CHANNEL_STICKY_EOF) - || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); - assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) - == (CHANNEL_EOF|CHANNEL_BLOCKED)) ); + + assert(!GotFlag(statePtr, CHANNEL_EOF) + || GotFlag(statePtr, CHANNEL_STICKY_EOF) + || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); + assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) + == (CHANNEL_EOF|CHANNEL_BLOCKED))); UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); return copied; @@ -6034,11 +6082,10 @@ ReadChars( int numBytes, srcLen = BytesLeft(bufPtr); /* - * One src byte can yield at most one character. So when the - * number of src bytes we plan to read is less than the limit on - * character count to be read, clearly we will remain within that - * limit, and we can use the value of "srcLen" as a tighter limit - * for sizing receiving buffers. + * One src byte can yield at most one character. So when the number of + * src bytes we plan to read is less than the limit on character count to + * be read, clearly we will remain within that limit, and we can use the + * value of "srcLen" as a tighter limit for sizing receiving buffers. */ int toRead = ((charsToRead<0)||(charsToRead > srcLen)) ? srcLen : charsToRead; @@ -6056,6 +6103,7 @@ ReadChars( Tcl_AppendToObj(objPtr, NULL, dstLimit); if (toRead == srcLen) { unsigned int size; + dst = TclGetStringStorage(objPtr, &size) + numBytes; dstLimit = size - numBytes; } else { @@ -6063,19 +6111,18 @@ ReadChars( } /* - * This routine is burdened with satisfying several constraints. - * It cannot append more than 'charsToRead` chars onto objPtr. - * This is measured after encoding and translation transformations - * are completed. There is no precise number of src bytes that can - * be associated with the limit. Yet, when we are done, we must know - * precisely the number of src bytes that were consumed to produce - * the appended chars, so that all subsequent bytes are left in - * the buffers for future read operations. + * This routine is burdened with satisfying several constraints. It cannot + * append more than 'charsToRead` chars onto objPtr. This is measured + * after encoding and translation transformations are completed. There is + * no precise number of src bytes that can be associated with the limit. + * Yet, when we are done, we must know precisely the number of src bytes + * that were consumed to produce the appended chars, so that all + * subsequent bytes are left in the buffers for future read operations. * - * The consequence is that we have no choice but to implement a - * "trial and error" approach, where in general we may need to - * perform transformations and copies multiple times to achieve - * a consistent set of results. This takes the shape of a loop. + * The consequence is that we have no choice but to implement a "trial and + * error" approach, where in general we may need to perform + * transformations and copies multiple times to achieve a consistent set + * of results. This takes the shape of a loop. */ while (1) { @@ -6088,18 +6135,17 @@ ReadChars( } /* - * Perform the encoding transformation. Read no more than - * srcLen bytes, write no more than dstLimit bytes. + * Perform the encoding transformation. Read no more than srcLen + * bytes, write no more than dstLimit bytes. * - * Some trickiness with encoding flags here. We do not want - * the end of a buffer to be treated as the end of all input - * when the presence of bytes in a next buffer are already - * known to exist. This is checked with an assert() because - * so far no test case causing the assertion to be false has - * been created. The normal operations of channel reading - * appear to cause EOF and TCL_ENCODING_END setting to appear - * only in situations where there are no further bytes in - * any buffers. + * Some trickiness with encoding flags here. We do not want the end + * of a buffer to be treated as the end of all input when the presence + * of bytes in a next buffer are already known to exist. This is + * checked with an assert() because so far no test case causing the + * assertion to be false has been created. The normal operations of + * channel reading appear to cause EOF and TCL_ENCODING_END setting to + * appear only in situations where there are no further bytes in any + * buffers. */ assert(bufPtr->nextPtr == NULL || BytesLeft(bufPtr->nextPtr) == 0 @@ -6110,10 +6156,10 @@ ReadChars( dst, dstLimit, &srcRead, &dstDecoded, &numChars); /* - * Perform the translation transformation in place. Read no more - * than the dstDecoded bytes the encoding transformation actually - * produced. Capture the number of bytes written in dstWrote. - * Capture the number of bytes actually consumed in dstRead. + * Perform the translation transformation in place. Read no more than + * the dstDecoded bytes the encoding transformation actually produced. + * Capture the number of bytes written in dstWrote. Capture the number + * of bytes actually consumed in dstRead. */ dstWrote = dstLimit; @@ -6121,11 +6167,9 @@ ReadChars( TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead); if (dstRead < dstDecoded) { - /* - * The encoding transformation produced bytes that the - * translation transformation did not consume. Why did - * this happen? + * The encoding transformation produced bytes that the translation + * transformation did not consume. Why did this happen? */ if (statePtr->inEofChar && dst[dstRead] == statePtr->inEofChar) { @@ -6134,40 +6178,38 @@ ReadChars( * we saw it and stopped translating at that point. * * NOTE the bizarre spec of TranslateInputEOL in this case. - * Clearly the eof char had to be read in order to account - * for the stopping, but the value of dstRead does not - * include it. + * Clearly the eof char had to be read in order to account for + * the stopping, but the value of dstRead does not include it. * - * Also rather bizarre, our caller can only notice an - * EOF condition if we return the value -1 as the number - * of chars read. This forces us to perform a 2-call - * dance where the first call can read all the chars - * up to the eof char, and the second call is solely - * for consuming the encoded eof char then pointed at - * by src so that we can return that magic -1 value. - * This seems really wasteful, especially since - * the first decoding pass of each call is likely to - * decode many bytes beyond that eof char that's all we - * care about. + * Also rather bizarre, our caller can only notice an EOF + * condition if we return the value -1 as the number of chars + * read. This forces us to perform a 2-call dance where the + * first call can read all the chars up to the eof char, and + * the second call is solely for consuming the encoded eof + * char then pointed at by src so that we can return that + * magic -1 value. This seems really wasteful, especially + * since the first decoding pass of each call is likely to + * decode many bytes beyond that eof char that's all we care + * about. */ if (dstRead == 0) { /* - * Curious choice in the eof char handling. We leave - * the eof char in the buffer. So, no need to compute - * a proper srcRead value. At this point, there - * are no chars before the eof char in the buffer. + * Curious choice in the eof char handling. We leave the + * eof char in the buffer. So, no need to compute a proper + * srcRead value. At this point, there are no chars before + * the eof char in the buffer. */ + Tcl_SetObjLength(objPtr, numBytes); return -1; } { /* - * There are chars leading the buffer before the eof - * char. Adjust the dstLimit so we go back and read - * only those and do not encounter the eof char this - * time. + * There are chars leading the buffer before the eof char. + * Adjust the dstLimit so we go back and read only those + * and do not encounter the eof char this time. */ dstLimit = dstRead - 1 + TCL_UTF_MAX; @@ -6179,10 +6221,9 @@ ReadChars( } /* - * 2) The other way to read fewer bytes than are decoded - * is when the final byte is \r and we're in a CRLF - * translation mode so we cannot decide whether to - * record \r or \n yet. + * 2) The other way to read fewer bytes than are decoded is when + * the final byte is \r and we're in a CRLF translation mode so + * we cannot decide whether to record \r or \n yet. */ assert(dst[dstRead] == '\r'); @@ -6190,10 +6231,10 @@ ReadChars( if (dstWrote > 0) { /* - * There are chars we can read before we hit the bare cr. - * Go back with a smaller dstLimit so we get them in the - * next pass, compute a matching srcRead, and don't end - * up back here in this call. + * There are chars we can read before we hit the bare CR. Go + * back with a smaller dstLimit so we get them in the next + * pass, compute a matching srcRead, and don't end up back + * here in this call. */ dstLimit = dstRead - 1 + TCL_UTF_MAX; @@ -6207,9 +6248,9 @@ ReadChars( assert(dstRead == 0); /* - * We decoded only the bare cr, and we cannot read a - * translated char from that alone. We have to know what's - * next. So why do we only have the one decoded char? + * We decoded only the bare CR, and we cannot read a translated + * char from that alone. We have to know what's next. So why do + * we only have the one decoded char? */ if (code != TCL_OK) { @@ -6250,10 +6291,9 @@ ReadChars( } } else if (statePtr->flags & CHANNEL_EOF) { - /* - * The bare \r is the only char and we will never read - * a subsequent char to make the determination. + * The bare \r is the only char and we will never read a + * subsequent char to make the determination. */ dst[0] = '\r'; @@ -6263,8 +6303,8 @@ ReadChars( } /* - * Revise the dstRead value so that the numChars calc - * below correctly computes zero characters read. + * Revise the dstRead value so that the numChars calc below + * correctly computes zero characters read. */ dstRead = numChars; @@ -6273,9 +6313,9 @@ ReadChars( } /* - * The translation transformation can only reduce the number - * of chars when it converts \r\n into \n. The reduction in - * the number of chars is the difference in bytes read and written. + * The translation transformation can only reduce the number of chars + * when it converts \r\n into \n. The reduction in the number of chars + * is the difference in bytes read and written. */ numChars -= (dstRead - dstWrote); @@ -6285,10 +6325,9 @@ ReadChars( /* * TODO: This cannot happen anymore. * - * We read more chars than allowed. Reset limits to - * prevent that and try again. Don't forget the extra - * padding of TCL_UTF_MAX bytes demanded by the - * Tcl_ExternalToUtf() call! + * We read more chars than allowed. Reset limits to prevent that + * and try again. Don't forget the extra padding of TCL_UTF_MAX + * bytes demanded by the Tcl_ExternalToUtf() call! */ dstLimit = Tcl_UtfAtIndex(dst, charsToRead) - 1 + TCL_UTF_MAX - dst; @@ -6301,18 +6340,19 @@ ReadChars( if (dstWrote == 0) { ChannelBuffer *nextPtr; - /* We were not able to read any chars. */ + /* + * We were not able to read any chars. + */ - assert (numChars == 0); + assert(numChars == 0); /* - * There is one situation where this is the correct final - * result. If the src buffer contains only a single \n - * byte, and we are in TCL_TRANSLATE_AUTO mode, and - * when the translation pass was made the INPUT_SAW_CR - * flag was set on the channel. In that case, the - * correct behavior is to consume that \n and produce the - * empty string. + * There is one situation where this is the correct final result. + * If the src buffer contains only a single \n byte, and we are in + * TCL_TRANSLATE_AUTO mode, and when the translation pass was made + * the INPUT_SAW_CR flag was set on the channel. In that case, the + * correct behavior is to consume that \n and produce the empty + * string. */ if (dstRead == 1 && dst[0] == '\n') { @@ -6321,12 +6361,13 @@ ReadChars( goto consume; } - /* Otherwise, reading zero characters indicates there's - * something incomplete at the end of the src buffer. - * Maybe there were not enough src bytes to decode into - * a char. Maybe a lone \r could not be translated (crlf - * mode). Need to combine any unused src bytes we have - * in the first buffer with subsequent bytes to try again. + /* + * Otherwise, reading zero characters indicates there's something + * incomplete at the end of the src buffer. Maybe there were not + * enough src bytes to decode into a char. Maybe a lone \r could + * not be translated (crlf mode). Need to combine any unused src + * bytes we have in the first buffer with subsequent bytes to try + * again. */ nextPtr = bufPtr->nextPtr; @@ -6341,15 +6382,15 @@ ReadChars( /* * Space is made at the beginning of the buffer to copy the - * previous unused bytes there. Check first if the buffer we - * are using actually has enough space at its beginning for - * the data we are copying. Because if not we will write over - * the buffer management information, especially the 'nextPtr'. + * previous unused bytes there. Check first if the buffer we are + * using actually has enough space at its beginning for the data + * we are copying. Because if not we will write over the buffer + * management information, especially the 'nextPtr'. * - * Note that the BUFFER_PADDING (See AllocChannelBuffer) is - * used to prevent exactly this situation. I.e. it should never - * happen. Therefore it is ok to panic should it happen despite - * the precautions. + * Note that the BUFFER_PADDING (See AllocChannelBuffer) is used + * to prevent exactly this situation. I.e. it should never happen. + * Therefore it is ok to panic should it happen despite the + * precautions. */ if (nextPtr->nextRemoved - srcLen < 0) { @@ -6368,10 +6409,12 @@ ReadChars( consume: bufPtr->nextRemoved += srcRead; + /* - * If this read contained multibyte characters, revise factorPtr - * so the next read will allocate bigger buffers. + * If this read contained multibyte characters, revise factorPtr so + * the next read will allocate bigger buffers. */ + if (numChars && numChars < srcRead) { *factorPtr = srcRead * UTF_EXPANSION_FACTOR / numChars; } @@ -6419,22 +6462,27 @@ TranslateInputEOL( int inEofChar = statePtr->inEofChar; /* - * Depending on the translation mode in use, there's no need - * to scan more srcLen bytes at srcStart than can possibly transform - * to dstLen bytes. This keeps the scan for eof char below from - * being pointlessly long. + * Depending on the translation mode in use, there's no need to scan more + * srcLen bytes at srcStart than can possibly transform to dstLen bytes. + * This keeps the scan for eof char below from being pointlessly long. */ switch (statePtr->inputTranslation) { case TCL_TRANSLATE_LF: case TCL_TRANSLATE_CR: if (srcLen > dstLen) { - /* In these modes, each src byte become a dst byte. */ + /* + * In these modes, each src byte become a dst byte. + */ + srcLen = dstLen; } break; default: - /* In other modes, at most 2 src bytes become a dst byte. */ + /* + * In other modes, at most 2 src bytes become a dst byte. + */ + if (srcLen/2 > dstLen) { srcLen = 2 * dstLen; } @@ -6767,7 +6815,7 @@ GetInput( * eofchar. */ - assert( !GotFlag(statePtr, CHANNEL_STICKY_EOF) ); + assert(!GotFlag(statePtr, CHANNEL_STICKY_EOF)); /* * Prevent reading from a dead channel -- a channel that has been closed @@ -6781,24 +6829,21 @@ GetInput( } /* - * WARNING: There was once a comment here claiming that it was - * a bad idea to make another call to the inputproc of a channel - * driver when EOF has already been detected on the channel. Through - * much of Tcl's history, this warning was then completely negated - * by having all (most?) read paths clear the EOF setting before - * reaching here. So we had a guard that was never triggered. + * WARNING: There was once a comment here claiming that it was a bad idea + * to make another call to the inputproc of a channel driver when EOF has + * already been detected on the channel. Through much of Tcl's history, + * this warning was then completely negated by having all (most?) read + * paths clear the EOF setting before reaching here. So we had a guard + * that was never triggered. + * + * Don't be tempted to restore the guard. Even if EOF is set on the + * channel, continue through and call the inputproc again. This is the + * way to enable the ability to [read] again beyond the EOF, which seems a + * strange thing to do, but for which use cases exist [Tcl Bug 5adc350683] + * and which may even be essential for channels representing things like + * ttys or other devices where the stream might take the logical form of a + * series of 'files' separated by an EOF condition. * - * Don't be tempted to restore the guard. Even if EOF is set on - * the channel, continue through and call the inputproc again. This - * is the way to enable the ability to [read] again beyond the EOF, - * which seems a strange thing to do, but for which use cases exist - * [Tcl Bug 5adc350683] and which may even be essential for channels - * representing things like ttys or other devices where the stream - * might take the logical form of a series of 'files' separated by - * an EOF condition. - */ - - /* * First check for more buffers in the pushback area of the topmost * channel in the stack and use them. They can be the result of a * transformation which went away without reading all the information @@ -6806,7 +6851,6 @@ GetInput( */ if (chanPtr->inQueueHead != NULL) { - /* TODO: Tests to cover this. */ assert(statePtr->inQueueHead == NULL); @@ -6836,8 +6880,9 @@ GetInput( /* * Check the actual buffersize against the requested buffersize. - * Saved buffers of the wrong size are squashed. This is done - * to honor dynamic changes of the buffersize made by the user. + * Saved buffers of the wrong size are squashed. This is done to honor + * dynamic changes of the buffersize made by the user. + * * TODO: Tests to cover this. */ @@ -7144,7 +7189,7 @@ Tcl_Tell( * Truncate a channel to the given length. * * Results: - * TCL_OK on success, TCL_ERROR if the operation failed (e.g. is not + * TCL_OK on success, TCL_ERROR if the operation failed (e.g., is not * supported by the type of channel, or the underlying OS operation * failed in some way). * @@ -9504,7 +9549,10 @@ CopyData( } if (size == 0) { if (!GotFlag(inStatePtr, CHANNEL_NONBLOCKING)) { - /* We allowed a short read. Keep trying. */ + /* + * We allowed a short read. Keep trying. + */ + continue; } if (bufObj != NULL) { @@ -9718,7 +9766,7 @@ DoRead( ChannelState *statePtr = chanPtr->state; char *p = dst; - assert (bytesToRead >= 0); + assert(bytesToRead >= 0); /* * Early out when we know a read will get the eofchar. @@ -9734,15 +9782,18 @@ DoRead( if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) { SetFlag(statePtr, CHANNEL_EOF); - assert( statePtr->inputEncodingFlags & TCL_ENCODING_END ); - assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) ); + assert(statePtr->inputEncodingFlags & TCL_ENCODING_END); + assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR)); /* TODO: Don't need this call */ UpdateInterest(chanPtr); return 0; } - /* Special handling for zero-char read request. */ + /* + * Special handling for zero-char read request. + */ + if (bytesToRead == 0) { if (GotFlag(statePtr, CHANNEL_EOF)) { statePtr->inputEncodingFlags |= TCL_ENCODING_START; @@ -9757,8 +9808,8 @@ DoRead( TclChannelPreserve((Tcl_Channel)chanPtr); while (bytesToRead) { /* - * Each pass through the loop is intended to process up to - * one channel buffer. + * Each pass through the loop is intended to process up to one channel + * buffer. */ int bytesRead, bytesWritten; @@ -9770,33 +9821,39 @@ DoRead( while (!bufPtr || /* We got no buffer! OR */ (!IsBufferFull(bufPtr) && /* Our buffer has room AND */ - (BytesLeft(bufPtr) < bytesToRead) ) ) { - /* Not enough bytes in it - * yet to fill the dst */ + (BytesLeft(bufPtr) < bytesToRead))) { + /* Not enough bytes in it yet + * to fill the dst */ int code; moreData: code = GetInput(chanPtr); bufPtr = statePtr->inQueueHead; - assert (bufPtr != NULL); + assert(bufPtr != NULL); if (GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)) { - /* Further reads cannot do any more */ + /* + * Further reads cannot do any more. + */ + break; } if (code) { - /* Read error */ + /* + * Read error + */ + UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); return -1; } - assert (IsBufferFull(bufPtr)); + assert(IsBufferFull(bufPtr)); } - assert (bufPtr != NULL); + assert(bufPtr != NULL); bytesRead = BytesLeft(bufPtr); bytesWritten = bytesToRead; @@ -9811,8 +9868,8 @@ DoRead( /* * Buffer is not empty. How can that be? * - * 0) We stopped early because we got all the bytes - * we were seeking. That's fine. + * 0) We stopped early because we got all the bytes we were + * seeking. That's fine. */ if (bytesToRead == 0) { @@ -9828,8 +9885,8 @@ DoRead( } /* - * 2) The buffer holds a \r while in CRLF translation, - * followed by the end of the buffer. + * 2) The buffer holds a \r while in CRLF translation, followed by + * the end of the buffer. */ assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF); @@ -9837,26 +9894,38 @@ DoRead( assert(BytesLeft(bufPtr) == 1); if (bufPtr->nextPtr == NULL) { - /* There's no more buffered data.... */ + /* + * There's no more buffered data... + */ if (statePtr->flags & CHANNEL_EOF) { - /* ...and there never will be. */ + /* + * ...and there never will be. + */ *p++ = '\r'; bytesToRead--; bufPtr->nextRemoved++; } else if (statePtr->flags & CHANNEL_BLOCKED) { - /* ...and we cannot get more now. */ + /* + * ...and we cannot get more now. + */ + SetFlag(statePtr, CHANNEL_NEED_MORE_DATA); break; } else { - /* ... so we need to get some. */ + /* + * ...so we need to get some. + */ + goto moreData; } } if (bufPtr->nextPtr) { - /* There's a next buffer. Shift orphan \r to it. */ + /* + * There's a next buffer. Shift orphan \r to it. + */ ChannelBuffer *nextPtr = bufPtr->nextPtr; @@ -9881,8 +9950,8 @@ DoRead( } /* - * When there's no buffered data to read, and we're at EOF, - * escape to the caller. + * When there's no buffered data to read, and we're at EOF, escape to + * the caller. */ if (GotFlag(statePtr, CHANNEL_EOF) @@ -9894,11 +9963,11 @@ DoRead( ResetFlag(statePtr, CHANNEL_BLOCKED); } - assert(!GotFlag(statePtr, CHANNEL_EOF) - || GotFlag(statePtr, CHANNEL_STICKY_EOF) - || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); - assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) - == (CHANNEL_EOF|CHANNEL_BLOCKED)) ); + assert(!GotFlag(statePtr, CHANNEL_EOF) + || GotFlag(statePtr, CHANNEL_STICKY_EOF) + || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); + assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) + == (CHANNEL_EOF|CHANNEL_BLOCKED))); UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); return (int)(p - dst); diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 1bd3fe7..e52200d 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -1618,19 +1618,34 @@ Tcl_SocketObjCmd( return TCL_ERROR; } - // Set the options to their default value if the user didn't override their - // value. - if (reusep == -1) reusep = 0; - if (reusea == -1) reusea = 1; + /* + * Set the options to their default value if the user didn't override + * their value. + */ - // Build the bitset with the flags values. - if (reusea) + if (reusep == -1) { + reusep = 0; + } + if (reusea == -1) { + reusea = 1; + } + + /* + * Build the bitset with the flags values. + */ + + if (reusea) { flags |= TCL_TCPSERVER_REUSEADDR; - if (reusep) + } + if (reusep) { flags |= TCL_TCPSERVER_REUSEPORT; + } + + /* + * All the arguments should have been parsed by now, 'a' points to the + * last one, the port number. + */ - // All the arguments should have been parsed by now, 'a' points to the last - // one, the port number. if (a != objc-1) { goto wrongNumArgs; } @@ -1638,15 +1653,14 @@ Tcl_SocketObjCmd( port = TclGetString(objv[a]); if (server) { - AcceptCallback *acceptCallbackPtr = - ckalloc(sizeof(AcceptCallback)); + AcceptCallback *acceptCallbackPtr = ckalloc(sizeof(AcceptCallback)); Tcl_IncrRefCount(script); acceptCallbackPtr->script = script; acceptCallbackPtr->interp = interp; - chan = Tcl_OpenTcpServerEx(interp, port, host, flags, AcceptCallbackProc, - acceptCallbackPtr); + chan = Tcl_OpenTcpServerEx(interp, port, host, flags, + AcceptCallbackProc, acceptCallbackPtr); if (chan == NULL) { Tcl_DecrRefCount(script); ckfree(acceptCallbackPtr); diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 2fed3f4..433fb6f 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -851,11 +851,12 @@ TclChanPostEventObjCmd( } /* - * Note that the search above subsumes several of the older checks, namely: + * Note that the search above subsumes several of the older checks, + * namely: * - * (1) Does the channel handle refer to a reflected channel ? + * (1) Does the channel handle refer to a reflected channel? * (2) Is the post event issued from the interpreter holding the handler - * of the reflected channel ? + * of the reflected channel? * * A successful search answers yes to both. Because the map holds only * handles of reflected channels, and only of such whose handler is @@ -939,7 +940,8 @@ TclChanPostEventObjCmd( (void) GetThreadReflectedChannelMap(); - /* XXX Race condition !! + /* + * XXX Race condition !! * XXX The destination thread may not exist anymore already. * XXX (Delayed postevent executed after channel got removed). * XXX Can we detect this ? (check the validity of the owner threadid ?) @@ -1221,8 +1223,8 @@ ReflectClose( #endif tctPtr = ((Channel *)rcPtr->chan)->typePtr; if (tctPtr && tctPtr != &tclRChannelType) { - ckfree(tctPtr); - ((Channel *)rcPtr->chan)->typePtr = NULL; + ckfree(tctPtr); + ((Channel *)rcPtr->chan)->typePtr = NULL; } Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); return (result == TCL_OK) ? EOK : EINVAL; @@ -1272,7 +1274,10 @@ ReflectInput( if (p.base.code != TCL_OK) { if (p.base.code < 0) { - /* No error message, this is an errno signal. */ + /* + * No error message, this is an errno signal. + */ + *errorCodePtr = -p.base.code; } else { PassReceivedError(rcPtr->chan, &p); @@ -1375,7 +1380,10 @@ ReflectOutput( if (p.base.code != TCL_OK) { if (p.base.code < 0) { - /* No error message, this is an errno signal. */ + /* + * No error message, this is an errno signal. + */ + *errorCodePtr = -p.base.code; } else { PassReceivedError(rcPtr->chan, &p); @@ -1426,8 +1434,8 @@ ReflectOutput( if ((written == 0) && (toWrite > 0)) { /* - * The handler claims to have written nothing of what it was - * given. That is bad. + * The handler claims to have written nothing of what it was given. + * That is bad. */ SetChannelErrorStr(rcPtr->chan, msg_write_nothing); @@ -2373,8 +2381,8 @@ InvokeTclMethod( * None. * * Users: - * ReflectInput/Output(), to enable the signaling of EAGAIN - * on 0-sized short reads/writes. + * ReflectInput/Output(), to enable the signaling of EAGAIN on 0-sized + * short reads/writes. * *---------------------------------------------------------------------- */ @@ -2560,7 +2568,10 @@ DeleteReflectedChannelMap( evPtr = resultPtr->evPtr; - /* Basic crash safety until this routine can get revised [3411310] */ + /* + * Basic crash safety until this routine can get revised [3411310] + */ + if (evPtr == NULL) { continue; } @@ -2675,8 +2686,8 @@ DeleteThreadReflectedChannelMap( /* * Go through the list of pending results and cancel all whose events were - * destined for this thread. While this is in progress we block any - * other access to the list of pending results. + * destined for this thread. While this is in progress we block any other + * access to the list of pending results. */ Tcl_MutexLock(&rcForwardMutex); @@ -2707,7 +2718,10 @@ DeleteThreadReflectedChannelMap( evPtr = resultPtr->evPtr; - /* Basic crash safety until this routine can get revised [3411310] */ + /* + * Basic crash safety until this routine can get revised [3411310] + */ + if (evPtr == NULL ) { continue; } @@ -2761,8 +2775,8 @@ ForwardOpToHandlerThread( const void *param) /* Arguments */ { /* - * Core of the communication from OWNER to HANDLER thread. - * The receiver is ForwardProc() below. + * Core of the communication from OWNER to HANDLER thread. The receiver is + * ForwardProc() below. */ Tcl_ThreadId dst = rcPtr->thread; @@ -2812,7 +2826,10 @@ ForwardOpToHandlerThread( */ TclSpliceIn(resultPtr, forwardList); - /* Do not unlock here. That is done by the ConditionWait */ + + /* + * Do not unlock here. That is done by the ConditionWait. + */ /* * Ensure cleanup of the event if the origin thread exits while this event @@ -2888,7 +2905,7 @@ ForwardProc( * Notes regarding access to the referenced data. * * In principle the data belongs to the originating thread (see - * evPtr->src), however this thread is currently blocked at (*), i.e. + * evPtr->src), however this thread is currently blocked at (*), i.e., * quiescent. Because of this we can treat the data as belonging to us, * without fear of race conditions. I.e. we can read and write as we like. * diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index 8ad268a..82d2fc1 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -12,7 +12,9 @@ #include "tclInt.h" #if defined(_WIN32) && defined(UNICODE) -/* On Windows, we need to do proper Unicode->UTF-8 conversion. */ +/* + * On Windows, we need to do proper Unicode->UTF-8 conversion. + */ typedef struct ThreadSpecificData { int initialized; @@ -21,7 +23,10 @@ typedef struct ThreadSpecificData { static Tcl_ThreadDataKey dataKey; #undef gai_strerror -static const char *gai_strerror(int code) { +static const char * +gai_strerror( + int code) +{ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->initialized) { @@ -126,7 +131,7 @@ TclSockMinimumBuffers( } len = sizeof(int); getsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_RCVBUF, - (char *) ¤t, &len); + (char *) ¤t, &len); if (current < size) { len = sizeof(int); setsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_RCVBUF, @@ -215,7 +220,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 - * using AI_ADDRCONFIG in situations where it works, is probably low, + * using AI_ADDRCONFIG is probably low even in situations where it works, * we'll leave it out for now. After all, it is just an optimisation. * * Missing on: OpenBSD, NetBSD. @@ -300,16 +305,20 @@ TclCreateSocketAddress( * *---------------------------------------------------------------------- */ -Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port, - const char *host, Tcl_TcpAcceptProc *acceptProc, - ClientData callbackData) + +Tcl_Channel +Tcl_OpenTcpServer( + Tcl_Interp *interp, + int port, + const char *host, + Tcl_TcpAcceptProc *acceptProc, + ClientData callbackData) { char portbuf[TCL_INTEGER_SPACE]; TclFormatInt(portbuf, port); - return Tcl_OpenTcpServerEx(interp, portbuf, host, TCL_TCPSERVER_REUSEADDR, - acceptProc, callbackData); + acceptProc, callbackData); } /* diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index de5d62d..5f79e6e 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -611,6 +611,7 @@ FsRecacheFilesystemList(void) while (toFree) { FilesystemRecord *next = toFree->nextPtr; + toFree->fsPtr = NULL; ckfree(toFree); toFree = next; @@ -672,7 +673,6 @@ TclFSEpoch(void) return tsdPtr->filesystemEpoch; } - /* * If non-NULL, clientData is owned by us and must be freed later. @@ -784,7 +784,9 @@ TclFinalizeFilesystem(void) while (fsRecPtr != NULL) { FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr; - /* The native filesystem is static, so we don't free it. */ + /* + * The native filesystem is static, so we don't free it. + */ if (fsRecPtr != &nativeFilesystemRecord) { ckfree(fsRecPtr); @@ -947,7 +949,7 @@ Tcl_FSRegister( int Tcl_FSUnregister( - const Tcl_Filesystem *fsPtr) /* The filesystem record to remove. */ + const Tcl_Filesystem *fsPtr)/* The filesystem record to remove. */ { int retVal = TCL_ERROR; FilesystemRecord *fsRecPtr; @@ -1233,7 +1235,7 @@ FsAddMountsToGlobResult( len--; } - len++; /* account for '/' in the mElt [Bug 1602539] */ + len++; /* account for '/' in the mElt [Bug 1602539] */ mElt = TclNewFSPathObj(pathPtr, mount + len, mlen - len); Tcl_ListObjAppendElement(NULL, resultPtr, mElt); } @@ -1403,7 +1405,7 @@ TclFSNormalizeToUniquePath( * Call each of the "normalise path" functions in succession. This is a * special case, in which if we have a native filesystem handler, we call * it first. This is because the root of Tcl's filesystem is always a - * native filesystem (i.e. '/' on unix is native). + * native filesystem (i.e., '/' on unix is native). */ firstFsRecPtr = FsGetFirstFilesystem(); @@ -1525,7 +1527,7 @@ TclGetOpenModeEx( #define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR) /* - * Check for the simpler fopen-like access modes (e.g. "r"). They are + * Check for the simpler fopen-like access modes (e.g., "r"). They are * distinguished from the POSIX access modes by the presence of a * lower-case first letter. */ @@ -2671,6 +2673,7 @@ Tcl_FSGetCwd( fsRecPtr = fsRecPtr->nextPtr) { ClientData retCd; TclFSGetCwdProc2 *proc2; + if (fsRecPtr->fsPtr->getCwdProc == NULL) { continue; } @@ -3143,8 +3146,8 @@ Tcl_FSLoadFile( * Workaround for issue with modern HPUX which do allow the unlink (no ETXTBSY * error) yet somehow trash some internal data structures which prevents the * second and further shared libraries from getting properly loaded. Only the - * first is ok. We try to get around the issue by not unlinking, - * i.e. emulating the behaviour of the older HPUX which denied removal. + * first is ok. We try to get around the issue by not unlinking, i.e., + * emulating the behaviour of the older HPUX which denied removal. * * Doing the unlink is also an issue within docker containers, whose AUFS * bungles this as well, see @@ -3162,28 +3165,30 @@ Tcl_FSLoadFile( */ int -TclSkipUnlink (Tcl_Obj* shlibFile) +TclSkipUnlink( + Tcl_Obj *shlibFile) { - /* Order of testing: + /* + * Order of testing: * 1. On hpux we generally want to skip unlink in general * * Outside of hpux then: - * 2. For a general user request (TCL_TEMPLOAD_NO_UNLINK present, non-empty, => int) + * 2. For a general user request (TCL_TEMPLOAD_NO_UNLINK present, + * non-empty, => int) * 3. For general AUFS environment (statfs, if available). * * Ad 2: This variable can disable/override the AUFS detection, i.e. for - * testing if a newer AUFS does not have the bug any more. + * testing if a newer AUFS does not have the bug any more. * - * Ad 3: This is conditionally compiled in. Condition currently must be set manually. - * This part needs proper tests in the configure(.in). + * Ad 3: This is conditionally compiled in. Condition currently must be + * set manually. This part needs proper tests in the configure(.in). */ #ifdef hpux return 1; #else - char* skipstr; + char *skipstr = getenv("TCL_TEMPLOAD_NO_UNLINK"); - skipstr = getenv ("TCL_TEMPLOAD_NO_UNLINK"); if (skipstr && (skipstr[0] != '\0')) { return atoi(skipstr); } @@ -3192,7 +3197,8 @@ TclSkipUnlink (Tcl_Obj* shlibFile) #ifndef NO_FSTATFS { struct statfs fs; - /* Have fstatfs. May not have the AUFS super magic ... Indeed our build + /* + * Have fstatfs. May not have the AUFS super magic ... Indeed our build * box is too old to have it directly in the headers. Define taken from * http://mooon.googlecode.com/svn/trunk/linux_include/linux/aufs_type.h * http://aufs.sourceforge.net/ @@ -3209,8 +3215,10 @@ TclSkipUnlink (Tcl_Obj* shlibFile) #endif /* ... NO_FSTATFS */ #endif /* ... TCL_TEMPLOAD_NO_UNLINK */ - /* Fallback: !hpux, no EV override, no AUFS (detection, nor detected): - * Don't skip */ + /* + * Fallback: !hpux, no EV override, no AUFS (detection, nor detected): + * Don't skip + */ return 0; #endif /* hpux */ } @@ -3415,9 +3423,8 @@ Tcl_LoadFile( * avoids any worries about leaving the copy laying around on exit. */ - if ( - !TclSkipUnlink (copyToPtr) && - (Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) { + if (!TclSkipUnlink(copyToPtr) && + (Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) { Tcl_DecrRefCount(copyToPtr); /* diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index d6c559b..91ec0c5 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -41,15 +41,15 @@ #undef Tcl_FindExecutable #undef TclpGetPid #undef TclSockMinimumBuffers -#define TclBackgroundException Tcl_BackgroundException #undef Tcl_SetIntObj #undef TclpInetNtoa #undef TclWinGetServByName #undef TclWinGetSockOpt #undef TclWinSetSockOpt +#undef TclWinNToHS /* See bug 510001: TclSockMinimumBuffers needs plat imp */ -#ifdef _WIN64 +#if defined(_WIN64) || defined(TCL_NO_DEPRECATED) # define TclSockMinimumBuffersOld 0 #else #define TclSockMinimumBuffersOld sockMinimumBuffersOld @@ -59,6 +59,17 @@ static int TclSockMinimumBuffersOld(int sock, int size) } #endif +#if defined(TCL_NO_DEPRECATED) +# define TclSetStartupScriptPath 0 +# define TclGetStartupScriptPath 0 +# define TclSetStartupScriptFileName 0 +# define TclGetStartupScriptFileName 0 +# define TclpInetNtoa 0 +# define TclWinGetServByName 0 +# define TclWinGetSockOpt 0 +# define TclWinSetSockOpt 0 +# define TclWinNToHS 0 +#else #define TclSetStartupScriptPath setStartupScriptPath static void TclSetStartupScriptPath(Tcl_Obj *path) { @@ -92,6 +103,7 @@ static unsigned short TclWinNToHS(unsigned short ns) { return ntohs(ns); } #endif +#endif /* TCL_NO_DEPRECATED */ #ifdef _WIN32 # define TclUnixWaitForFile 0 @@ -343,6 +355,9 @@ static int formatInt(char *buffer, int n){ # define Tcl_EvalObj 0 # undef Tcl_GlobalEvalObj # define Tcl_GlobalEvalObj 0 +# define TclBackgroundException 0 +# undef TclpReaddir +# define TclpReaddir 0 # undef TclpGetDate # define TclpGetDate 0 # undef TclpLocaltime @@ -354,6 +369,7 @@ static int formatInt(char *buffer, int n){ #else /* TCL_NO_DEPRECATED */ # define Tcl_SeekOld seekOld # define Tcl_TellOld tellOld +# define TclBackgroundException Tcl_BackgroundException # define TclpLocaltime_unix TclpLocaltime # define TclpGmtime_unix TclpGmtime diff --git a/generic/tclTest.c b/generic/tclTest.c index e87af0f..54deaea 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -67,6 +67,18 @@ typedef struct TestAsyncHandler { /* Next is list of handlers. */ } TestAsyncHandler; +/* + * Start of the socket driver state structure to acces field testFlags + */ + +typedef struct TcpState TcpState; + +struct TcpState { + Tcl_Channel channel; /* Channel associated with this socket. */ + int testFlags; /* bit field for tests. Is set by testsocket + * test procedure */ +}; + TCL_DECLARE_MUTEX(asyncTestMutex) static TestAsyncHandler *firstHandler = NULL; @@ -364,6 +376,8 @@ static int TestChannelCmd(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); static int TestChannelEventCmd(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); +static int TestSocketCmd(ClientData clientData, + Tcl_Interp *interp, int argc, const char **argv); static int TestFilesystemObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -676,6 +690,8 @@ Tcltest_Init( TestNumUtfCharsCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd, NULL, NULL); + Tcl_CreateCommand(interp, "testsocket", TestSocketCmd, + NULL, NULL); Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd, NULL, NULL); Tcl_CreateCommand(interp, "testtranslatefilename", @@ -6081,6 +6097,75 @@ TestChannelEventCmd( /* *---------------------------------------------------------------------- * + * TestSocketCmd -- + * + * Implements the Tcl "testsocket" debugging command and its + * subcommands. This is part of the testing environment. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +TestSocketCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Interpreter for result. */ + int argc, /* Count of additional args. */ + const char **argv) /* Additional arg strings. */ +{ + const char *cmdName; /* Sub command. */ + size_t len; /* Length of subcommand string. */ + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " subcommand ?additional args..?\"", NULL); + return TCL_ERROR; + } + cmdName = argv[1]; + len = strlen(cmdName); + + if ((cmdName[0] == 't') && (strncmp(cmdName, "testflags", len) == 0)) { + Tcl_Channel hChannel; + int modePtr; + TcpState *statePtr; + /* Set test value in the socket driver + */ + /* Check for argument "channel name" + */ + if (argc < 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " testflags channel flags\"", NULL); + return TCL_ERROR; + } + hChannel = Tcl_GetChannel(interp, argv[2], &modePtr); + if ( NULL == hChannel ) { + Tcl_AppendResult(interp, "unknown channel:", argv[2], NULL); + return TCL_ERROR; + } + statePtr = (TcpState *)Tcl_GetChannelInstanceData(hChannel); + if ( NULL == statePtr) { + Tcl_AppendResult(interp, "No channel instance data:", argv[2], + NULL); + return TCL_ERROR; + } + statePtr->testFlags = atoi(argv[3]); + return TCL_OK; + } + + Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be " + "testflags", NULL); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * * TestWrongNumArgsObjCmd -- * * Test the Tcl_WrongNumArgs function. diff --git a/generic/tclTimer.c b/generic/tclTimer.c index edab8da..ef7a095 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -1047,11 +1047,17 @@ AfterDelay( if (diff > TCL_TIME_MAXIMUM_SLICE) { diff = TCL_TIME_MAXIMUM_SLICE; } - if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) diff = 1; + if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) { + diff = 1; + } if (diff > 0) { Tcl_Sleep((long) diff); - if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) break; - } else break; + if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) { + break; + } + } else { + break; + } } else { diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now); #ifndef TCL_WIDE_INT_IS_LONG |