summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog7
-rw-r--r--doc/refchan.n40
-rw-r--r--generic/tclIORChan.c33
-rw-r--r--tests/ioCmd.test78
4 files changed, 148 insertions, 10 deletions
diff --git a/ChangeLog b/ChangeLog
index aeb4e44..58581c8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+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
+ * tests/ioCmd.test: 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
diff --git a/doc/refchan.n b/doc/refchan.n
index 42e5588..b2bcabb 100644
--- a/doc/refchan.n
+++ b/doc/refchan.n
@@ -4,7 +4,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: refchan.n,v 1.11.2.1 2009/08/06 22:28:44 andreas_kupries Exp $
+'\" RCS: @(#) $Id: refchan.n,v 1.11.2.2 2010/03/09 21:13:13 andreas_kupries Exp $
.so man.macros
.TH refchan n 8.5 Tcl "Tcl Built-In Commands"
.BS
@@ -168,9 +168,43 @@ negative value implies that the write failed. Returning a value
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 \fIerror\fR (e.g. \fIbreak\fR, etc.) is treated
+Any exception beyond \fIerror\fR (e.g.\ \fIbreak\fR, etc.) is treated
as and converted to an error.
.RE
.TP
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 305b3ad..f483870 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIORChan.c,v 1.28.2.8 2009/10/07 17:11:40 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclIORChan.c,v 1.28.2.9 2010/03/09 21:13:13 andreas_kupries Exp $
*/
#include <tclInt.h>
@@ -1327,8 +1327,13 @@ ReflectOutput(
ForwardOpToOwnerThread(rcPtr, ForwardedOutput, &p);
if (p.base.code != TCL_OK) {
- PassReceivedError(rcPtr->chan, &p);
- *errorCodePtr = EINVAL;
+ 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;
@@ -1343,6 +1348,14 @@ ReflectOutput(
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;
@@ -2291,8 +2304,8 @@ InvokeTclMethod(
* 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.
*
*----------------------------------------------------------------------
*/
@@ -2846,7 +2859,13 @@ ForwardProc(
paramPtr->output.buf, paramPtr->output.toWrite);
if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
- ForwardSetObjError(paramPtr, resObj);
+ int code = ErrnoReturn(rcPtr, resObj);
+
+ if (code < 0) {
+ paramPtr->base.code = code;
+ } else {
+ ForwardSetObjError(paramPtr, resObj);
+ }
paramPtr->output.toWrite = -1;
} else {
/*
@@ -3088,5 +3107,7 @@ ForwardSetObjError(
* mode: c
* c-basic-offset: 4
* fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
* End:
*/
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 4dde148..999e25c 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -13,7 +13,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: ioCmd.test,v 1.36.2.7 2010/02/11 15:25:25 dkf Exp $
+# RCS: @(#) $Id: ioCmd.test,v 1.36.2.8 2010/03/09 21:13:13 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -1155,6 +1155,40 @@ test iocmd-24.13 {chan write, failed write, level is ignored} -match glob -body
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
@@ -2472,6 +2506,48 @@ test iocmd.tf-24.13 {chan write, failed write, level is ignored} -match glob -bo
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