* doc/refchan.n [Bug 2827000]: Extended the implementation of

	* generic/tclIORChan.c: reflective channels (TIP 219, method
	* tests/ioCmd.test: 'read'), enabling handlers to signal EAGAIN to
	indicate 'no data, but not at EOF either', and other system
	errors. Updated documentation, extended testsuite (New test cases
	iocmd*-23.{9,10}).

4 files changed, 184 insertions, 7 deletions

diff --git a/ChangeLog b/ChangeLog
index 04def18..ed72cc4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2009-08-06  Andreas Kupries  <andreask@activestate.com>
+
+	* doc/refchan.n [Bug 2827000]: Extended the implementation of
+	* generic/tclIORChan.c: reflective channels (TIP 219, method
+	* tests/ioCmd.test: 'read'), enabling handlers to signal EAGAIN to
+	indicate 'no data, but not at EOF either', and other system
+	errors. Updated documentation, extended testsuite (New test cases
+	iocmd*-23.{9,10}).
+
 2009-08-02  Donal K. Fellows  <dkf@users.sf.net>
 
 	* unix/tclUnixFCmd.c (GetOwnerAttribute, SetOwnerAttribute)
diff --git a/doc/refchan.n b/doc/refchan.n
index d007c0f..42e5588 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 2008/03/26 09:59:22 dkf Exp $
+'\" RCS: @(#) $Id: refchan.n,v 1.11.2.1 2009/08/06 22:28:44 andreas_kupries Exp $
 .so man.macros
 .TH refchan n 8.5 Tcl "Tcl Built-In Commands"
 .BS
@@ -116,7 +116,36 @@ an error will be signaled and later thrown by the command which
 performed the read (usually \fBgets\fR or \fBread\fR). However,
 returning fewer bytes than requested is acceptable.
 .PP
-If the subcommand throws an error, the command which caused its
+Note that returning nothing (0 bytes) is a signal to the higher layers
+that \fBEOF\fR has been reached on the channel. To signal that the
+channel is out of data right now, but has not yet reached \fBEOF\fR,
+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. This
+means that 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".
+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 \fBgets\fR, or \fBread\fR) will appear to have
 thrown this error. Any exception beyond \fIerror\fR, (e.g.
 \fIbreak\fR, etc.) is treated as and converted to an error.
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index c9a294b..3d14ec6 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.6 2009/01/22 00:05:14 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclIORChan.c,v 1.28.2.7 2009/08/06 22:28:44 andreas_kupries Exp $
  */
 
 #include <tclInt.h>
@@ -447,6 +447,7 @@ static int		InvokeTclMethod(ReflectedChannel *rcPtr,
 static ReflectedChannelMap *	GetReflectedChannelMap(Tcl_Interp *interp);
 static void		DeleteReflectedChannelMap(ClientData clientData,
 			    Tcl_Interp *interp);
+static int              ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj* resObj);
 
 /*
  * Global constant strings (messages). ==================
@@ -1218,8 +1219,13 @@ ReflectInput(
 	ForwardOpToOwnerThread(rcPtr, ForwardedInput, &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.input.toRead = -1;
 	} else {
 	    *errorCodePtr = EOK;
@@ -1234,6 +1240,14 @@ ReflectInput(
 
     toReadObj = Tcl_NewIntObj(toRead);
     if (InvokeTclMethod(rcPtr, "read", toReadObj, 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;
@@ -2266,6 +2280,53 @@ InvokeTclMethod(
 /*
  *----------------------------------------------------------------------
  *
+ * ErrnoReturn --
+ *
+ *	Checks a method error result if it returned an 'errno'.
+ *
+ * Results:
+ *	The negative errno found in the error result, or 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ * Users:
+ *	Currently only ReflectInput(), to enable the signaling of EAGAIN.
+ *	by non-blocking channels at buffer-empty, but not EOF.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj* resObj)
+{
+    int code;
+    Tcl_InterpState sr;		/* State of handler interp */
+
+    if (!rcPtr->interp) {
+	return 0;
+    }
+
+    sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
+    UnmarshallErrorResult(rcPtr->interp, resObj);
+
+    resObj = Tcl_GetObjResult(rcPtr->interp);
+
+    if (((Tcl_GetIntFromObj(rcPtr->interp, resObj, &code) != TCL_OK) || (code >= 0))) {
+	if (strcmp ("EAGAIN",Tcl_GetString(resObj)) == 0) {
+	    code = -11;
+	} else {
+	    code = 0;
+	}
+    }
+
+    Tcl_RestoreInterpState(rcPtr->interp, sr);
+    return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * GetReflectedChannelMap --
  *
  *	Gets and potentially initializes the reflected channel map for an
@@ -2749,7 +2810,13 @@ ForwardProc(
 	Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead);
 
 	if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK){
-	    ForwardSetObjError(paramPtr, resObj);
+	    int code = ErrnoReturn (rcPtr, resObj);
+
+	    if (code < 0) {
+		paramPtr->base.code = code;
+	    } else {
+		ForwardSetObjError(paramPtr, resObj);
+	    }
 	    paramPtr->input.toRead = -1;
 	} else {
 	    /*
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index fa5d058..f27d2a0 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.5 2008/04/24 18:50:42 andreas_kupries Exp $
+# RCS: @(#) $Id: ioCmd.test,v 1.36.2.6 2009/08/06 22:28:44 andreas_kupries Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -980,6 +980,38 @@ test iocmd-23.8 {chan read, level is squashed} -match glob -body {
     rename foo {}
     set res
 } -result {{read rc* 4096} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}}
+test iocmd-23.9 {chan read, no data means eof} -match glob -setup {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return ""
+    }
+    set c [chan create {r w} foo]
+} -body {
+    note [read $c 2]
+    note [eof $c]
+    set res
+} -cleanup {
+    close $c
+    rename foo {}
+    unset res
+} -result {{read rc* 4096} {} 1}
+test iocmd-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glob -setup {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	error EAGAIN
+    }
+    set c [chan create {r w} foo]
+} -body {
+    note [read $c 2]
+    note [eof $c]
+    set res
+} -cleanup {
+    close $c
+    rename foo {}
+    unset res
+} -result {{read rc* 4096} {} 0}
 
 # --- === *** ###########################
 # method write
@@ -2211,6 +2243,46 @@ test iocmd.tf-23.8 {chan read, level is squashed} -match glob -body {
     set res
 } -result {{read rc* 4096} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}} \
     -constraints {testchannel testthread}
+test iocmd.tf-23.9 {chan read, no data means eof} -match glob -setup {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return ""
+    }
+    set c [chan create {r w} foo]
+} -body {
+    notes [inthread $c {
+	note [read $c 2]
+	note [eof $c]
+	close $c
+	notes
+    } c]
+    set res
+} -cleanup {
+    rename foo {}
+    unset res
+} -result {{read rc* 4096} {} 1} \
+    -constraints {testchannel testthread}
+test iocmd.tf-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glob -setup {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	error EAGAIN
+    }
+    set c [chan create {r w} foo]
+} -body {
+    notes [inthread $c {
+	note [read $c 2]
+	note [eof $c]
+	close $c
+	notes
+    } c]
+    set res
+} -cleanup {
+    rename foo {}
+    unset res
+} -result {{read rc* 4096} {} 0} \
+    -constraints {testchannel testthread}
 
 # --- === *** ###########################
 # method write