--- tcl86.orig/ChangeLog	2010-03-09 10:55:38.000000000 -0800
+++ tcl86/ChangeLog	2010-03-09 11:37:18.000000000 -0800
@@ -1,3 +1,9 @@
+2010-03-09  Andreas Kupries  <andreask@activestate.com>
+
+	* generic/tclIORChan.c: [Bug 2936225]: Thanks to Alexandre Ferrieux
+	* doc/refchan.n: <ferrieux@users.sourceforge.net> for debugging and fixing
+	the problem. It is the write-side equivalent to the bug fixed 2009-08-06.
+
 2010-03-09  Don Porter  <dgp@users.sourceforge.net>
 
 	* library/tzdata/America/Matamoros: New locale
--- tcl86.orig/doc/refchan.n	2010-03-09 10:55:36.000000000 -0800
+++ tcl86/doc/refchan.n	2010-03-09 11:39:17.000000000 -0800
@@ -176,7 +176,41 @@
 greater than the number of bytes given to the handler, or zero, is
 forbidden and will cause the Tcl core to throw an error.
 .PP
-If the subcommand throws an error the command which caused its
+To signal that the channel is not able to accept data for writing
+right now, it is necessary to throw the error "EAGAIN", i.e. to either
+.PP
+.CS
+return -code error EAGAIN
+.CE
+or
+.CS
+error EAGAIN
+.CE
+.PP
+For extensibility any error whose value is a negative integer number
+will cause the higher layers to set the C-level variable "\fBerrno\fR"
+to the absolute value of this number, signaling a system error.
+However, note that the exact mapping between these error numbers and
+their meanings is operating system dependent.
+.PP
+For example, while on Linux both
+.PP
+.CS
+return -code error -11
+.CE
+and
+.CS
+error -11
+.CE
+.PP
+are equivalent to the examples above, using the more readable string "EAGAIN",
+this is not true for BSD, where the equivalent number is -35.
+.PP
+The symbolic string however is the same across systems, and internally
+translated to the correct number. No other error value has such a mapping
+to a symbolic string.
+.PP
+If the subcommand throws any other error the command which caused its
 invocation (usually \fBputs\fR) will appear to have thrown this error.
 Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR, etc.) is treated
 as and converted to an error.
--- tcl86.orig/generic/tclIORChan.c	2010-03-09 10:55:38.000000000 -0800
+++ tcl86/generic/tclIORChan.c	2010-03-09 12:55:18.000000000 -0800
@@ -1331,8 +1331,13 @@
 	ForwardOpToOwnerThread(rcPtr, ForwardedOutput, &p);
 
 	if (p.base.code != TCL_OK) {
+	    if (p.base.code < 0) {
+		/* No error message, this is an errno signal. */
+		*errorCodePtr = -p.base.code;
+	    } else {
 	    PassReceivedError(rcPtr->chan, &p);
 	    *errorCodePtr = EINVAL;
+            }
 	    p.output.toWrite = -1;
 	} else {
 	    *errorCodePtr = EOK;
@@ -1347,6 +1352,14 @@
 
     bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
     if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+	int code = ErrnoReturn(rcPtr, resObj);
+
+	if (code < 0) {
+	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
+	    *errorCodePtr = -code;
+	    return -1;
+	}
+
 	Tcl_SetChannelError(rcPtr->chan, resObj);
 	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
 	*errorCodePtr = EINVAL;
@@ -2295,8 +2308,8 @@
  *	None.
  *
  * Users:
- *	Currently only ReflectInput(), to enable the signaling of EAGAIN.
- *	by non-blocking channels at buffer-empty, but not EOF.
+ *	ReflectInput/Output(), to enable the signaling of EAGAIN
+ *	on 0-sized short reads/writes.
  *
  *----------------------------------------------------------------------
  */
@@ -2857,7 +2870,13 @@
 		paramPtr->output.buf, paramPtr->output.toWrite);
 
 	if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+	    int code = ErrnoReturn(rcPtr, resObj);
+
+	    if (code < 0) {
+		paramPtr->base.code = code;
+	    } else {
 	    ForwardSetObjError(paramPtr, resObj);
+	    }
 	    paramPtr->output.toWrite = -1;
 	} else {
 	    /*
@@ -3099,5 +3118,7 @@
  * mode: c
  * c-basic-offset: 4
  * fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
  * End:
  */
--- tcl86.orig/tests/ioCmd.test	2010-03-09 10:55:37.000000000 -0800
+++ tcl86/tests/ioCmd.test	2010-03-09 12:56:34.000000000 -0800
@@ -1190,6 +1190,40 @@
     rename foo {}
     set res
 } -result {{write rc* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "write"*}}
+test iocmd-24.14 {chan write, no EAGAIN means that writing is allowed at this time, bug 2936225} -match glob -setup {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return 3
+    }
+    set c [chan create {r w} foo]
+} -body {
+    note [puts -nonewline $c ABC ; flush $c]
+    set res
+} -cleanup {
+    close $c
+    rename foo {}
+    unset res
+} -result {{write rc* ABC} {}}
+test iocmd-24.15 {chan write, EAGAIN means that writing is not allowed at this time, bug 2936225} -match glob -setup {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	# Note: The EAGAIN signals that the channel cannot accept
+	# write requests right now, this in turn causes the IO core to
+	# request the generation of writable events (see expected
+	# result below, and compare to case 24.14 above).
+	error EAGAIN
+    }
+    set c [chan create {r w} foo]
+} -body {
+    note [puts -nonewline $c ABC ; flush $c]
+    set res
+} -cleanup {
+    close $c
+    rename foo {}
+    unset res
+} -result {{write rc* ABC} {watch rc* write} {}}
 
 # --- === *** ###########################
 # method cgetall
@@ -2507,6 +2541,48 @@
     set res
 } -result {{write rc* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "write"*}} \
     -constraints {testchannel testthread}
+test iocmd.tf-24.14 {chan write, no EAGAIN means that writing is allowed at this time, bug 2936225} -match glob -setup {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return 3
+    }
+    set c [chan create {r w} foo]
+} -body {
+    notes [inthread $c {
+	note [puts -nonewline $c ABC ; flush $c]
+	close $c
+	notes
+    } c]
+    set res
+} -cleanup {
+    rename foo {}
+    unset res
+} -result {{write rc* ABC} {}} \
+    -constraints {testchannel testthread}
+test iocmd.tf-24.15 {chan write, EAGAIN means that writing is not allowed at this time, bug 2936225} -match glob -setup {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	# Note: The EAGAIN signals that the channel cannot accept
+	# write requests right now, this in turn causes the IO core to
+	# request the generation of writable events (see expected
+	# result below, and compare to case 24.14 above).
+	error EAGAIN
+    }
+    set c [chan create {r w} foo]
+} -body {
+    notes [inthread $c {
+	note [puts -nonewline $c ABC ; flush $c]
+	close $c
+	notes
+    } c]
+    set res
+} -cleanup {
+    rename foo {}
+    unset res
+} -result {{write rc* ABC} {watch rc* write} {}} \
+    -constraints {testchannel testthread}
 
 # --- === *** ###########################
 # method cgetall
