* tclIO.c: Fixed [SF Tcl Bug 943274]. This is the same problem as

	* tclIO.h: [SF Tcl Bug 462317], see ChangeLog entry
	           2001-09-26. The fix done at that time is incomplete. It
	           is possible to get around it if the actual read
	           operation is defered and not executed in the event
	           handler itself. Instead of tracking if we are in an
	           read caused by a synthesized fileevent we now track if
	           the OS has delivered a true event = actual data and
	           bypass the driver if a read finds that there is no
	           actual data waiting. The flag is cleared by a short or
	           full read.

3 files changed, 122 insertions, 7 deletions

diff --git a/ChangeLog b/ChangeLog
index f34990d..74ae073 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2004-05-19  Andreas Kupries  <andreask@activestate.com>
+
+	* tclIO.c: Fixed [SF Tcl Bug 943274]. This is the same problem as
+	* tclIO.h: [SF Tcl Bug 462317], see ChangeLog entry
+	           2001-09-26. The fix done at that time is incomplete. It
+	           is possible to get around it if the actual read
+	           operation is defered and not executed in the event
+	           handler itself. Instead of tracking if we are in an
+	           read caused by a synthesized fileevent we now track if
+	           the OS has delivered a true event = actual data and
+	           bypass the driver if a read finds that there is no
+	           actual data waiting. The flag is cleared by a short or
+	           full read.
+
 2004-05-18  Kevin B. Kenny  <kennykb@acm.org>
 
 	* compat/strftime.c (_fmt, ISO8601Week):
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 2e10b99..a689ca9 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.61.2.4 2004/04/23 23:40:58 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.61.2.5 2004/05/19 19:16:21 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -4225,8 +4225,18 @@ Tcl_ReadRaw(chan, bufPtr, bytesToRead)
                 statePtr->flags &= (~(CHANNEL_BLOCKED));
             }
 
-	    if ((statePtr->flags & CHANNEL_TIMER_FEV) &&
-		(statePtr->flags & CHANNEL_NONBLOCKING)) {
+	    /* [SF Tcl Bug 943274]. Better emulation of non-blocking
+	     * channels for channels without BlockModeProc, by keeping
+	     * track of true fileevents generated by the OS == Data
+	     * waiting and reading if and only if we are sure to have
+	     * data.
+	     */
+
+	    if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
+		(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
+		!(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
+
+	        /* We bypass the driver, it would block, as no data is available */
 	        nread  = -1;
 	        result = EWOULDBLOCK;
 	    } else {
@@ -4254,6 +4264,12 @@ Tcl_ReadRaw(chan, bufPtr, bytesToRead)
 	        if (nread < (bytesToRead - copied)) {
 		    statePtr->flags |= CHANNEL_BLOCKED;
 		}
+
+	        if (nread <= (bytesToRead - copied)) {
+		    /* [SF Tcl Bug 943274] We have read the available
+		     * data, clear flag */
+		    statePtr->flags &= ~CHANNEL_HAS_MORE_DATA;
+		}
 	    } else if (nread == 0) {
 	        statePtr->flags |= CHANNEL_EOF;
 		statePtr->inputEncodingFlags |= TCL_ENCODING_END;
@@ -4378,7 +4394,7 @@ DoReadChars(chanPtr, objPtr, toRead, appendFlag)
     int offset, factor, copied, copiedNow, result;
     Tcl_Encoding encoding;
 #define UTF_EXPANSION_FACTOR	1024
-    
+
     /*
      * This operation should occur at the top of a channel stack.
      */
@@ -5294,11 +5310,22 @@ GetInput(chanPtr)
 	return 0;
     }
 
-    if ((statePtr->flags & CHANNEL_TIMER_FEV) &&
-	(statePtr->flags & CHANNEL_NONBLOCKING)) {
+    /* [SF Tcl Bug 943274]. Better emulation of non-blocking channels
+     * for channels without BlockModeProc, by keeping track of true
+     * fileevents generated by the OS == Data waiting and reading if
+     * and only if we are sure to have data.
+     */
+
+    if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
+	(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
+	!(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
+
+        /* Bypass the driver, it would block, as no data is available */
         nread = -1;
         result = EWOULDBLOCK;
     } else {
+        statePtr->flags &= ~CHANNEL_HAS_MORE_DATA;
+
         nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
 		    bufPtr->buf + bufPtr->nextAdded, toRead, &result);
     }
@@ -5316,6 +5343,13 @@ GetInput(chanPtr)
 	if (nread < toRead) {
 	    statePtr->flags |= CHANNEL_BLOCKED;
 	}
+
+	if (nread <= toRead) {
+	  /* [SF Tcl Bug 943274] We have read the available data,
+	   * clear flag */
+	  statePtr->flags &= ~CHANNEL_HAS_MORE_DATA;
+	}
+
     } else if (nread == 0) {
 	statePtr->flags |= CHANNEL_EOF;
 	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
@@ -6708,6 +6742,20 @@ Tcl_NotifyChannel(channel, mask)
     Channel* upChanPtr;
     Tcl_ChannelType* upTypePtr;
 
+    /* [SF Tcl Bug 943274]
+     * For a non-blocking channel without blockmodeproc we keep track
+     * of actual input coming from the OS so that we can do a credible
+     * imitation of non-blocking behaviour.
+     */
+
+    if ((mask & TCL_READABLE) &&
+	(statePtr->flags & CHANNEL_NONBLOCKING) &&
+	(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
+	!(statePtr->flags & CHANNEL_TIMER_FEV)) {
+
+        statePtr->flags |= CHANNEL_HAS_MORE_DATA;
+    }
+
     /*
      * In contrast to the other API functions this procedure walks towards
      * the top of a stack and not down from it.
@@ -9164,3 +9212,40 @@ Tcl_ChannelWideSeekProc(chanTypePtr)
 	return NULL;
     }
 }
+
+#if 0
+/* For future debugging work, a simple function to print the flags of
+ * a channel in semi-readable form.
+ */
+
+static int
+DumpFlags (str, flags)
+     char* str;
+     int flags;
+{
+  char buf [20];
+  int i = 0;
+
+  if (flags & TCL_READABLE)           {buf[i] = 'r';} else {buf [i]='_';}; i++;
+  if (flags & TCL_WRITABLE)           {buf[i] = 'w';} else {buf [i]='_';}; i++;
+  if (flags & CHANNEL_NONBLOCKING)    {buf[i] = 'n';} else {buf [i]='_';}; i++;
+  if (flags & CHANNEL_LINEBUFFERED)   {buf[i] = 'l';} else {buf [i]='_';}; i++;
+  if (flags & CHANNEL_UNBUFFERED)     {buf[i] = 'u';} else {buf [i]='_';}; i++;
+  if (flags & BUFFER_READY)           {buf[i] = 'R';} else {buf [i]='_';}; i++;
+  if (flags & BG_FLUSH_SCHEDULED)     {buf[i] = 'F';} else {buf [i]='_';}; i++;
+  if (flags & CHANNEL_CLOSED)         {buf[i] = 'c';} else {buf [i]='_';}; i++;
+  if (flags & CHANNEL_EOF)            {buf[i] = 'E';} else {buf [i]='_';}; i++;
+  if (flags & CHANNEL_STICKY_EOF)     {buf[i] = 'S';} else {buf [i]='_';}; i++;
+  if (flags & CHANNEL_BLOCKED)        {buf[i] = 'B';} else {buf [i]='_';}; i++;
+  if (flags & INPUT_SAW_CR)           {buf[i] = '/';} else {buf [i]='_';}; i++;
+  if (flags & INPUT_NEED_NL)          {buf[i] = '*';} else {buf [i]='_';}; i++;
+  if (flags & CHANNEL_DEAD)           {buf[i] = 'D';} else {buf [i]='_';}; i++;
+  if (flags & CHANNEL_RAW_MODE)       {buf[i] = 'R';} else {buf [i]='_';}; i++;
+  if (flags & CHANNEL_TIMER_FEV)      {buf[i] = 'T';} else {buf [i]='_';}; i++;
+  if (flags & CHANNEL_HAS_MORE_DATA)  {buf[i] = 'H';} else {buf [i]='_';}; i++;
+  buf [i] ='\0';
+
+  fprintf (stderr,"%s: %s\n", str, buf); fflush(stderr);
+  return 0;
+}
+#endif
diff --git a/generic/tclIO.h b/generic/tclIO.h
index 9a9c826..7f2c421 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.5 2002/01/15 17:55:30 dgp Exp $
+ * RCS: @(#) $Id: tclIO.h,v 1.5.4.1 2004/05/19 19:16:24 andreas_kupries Exp $
  */
 
 /*
@@ -307,6 +307,22 @@ typedef struct ChannelState {
 					 * routines will simulate a
 					 * short read (0 characters
 					 * read) */
+#define CHANNEL_HAS_MORE_DATA   (1<<18) /* Set by NotifyChannel for a
+					 * channel if and only if the
+					 * channel is configured
+					 * non-blocking, the driver
+					 * for said channel has no
+					 * blockmodeproc, and data has
+					 * arrived for reading at the
+					 * OS level). A GetInput will
+					 * pass reading from the
+					 * driver if the channel is
+					 * non-blocking, without
+					 * blockmode proc and the flag
+					 * has not been set. A read
+					 * will be performed if the
+					 * flag is set. This will
+					 * reset the flag as well. */
 
 /*
  * For each channel handler registered in a call to Tcl_CreateChannelHandler,