* More test improvements for async sockets.

  *  Advance async connections whenever the channel is touched (e.g. by [chan configure]).
  *  Add a noblock argument to WaitForConnect(), so that advancing async connections from [chan configure] doesn't block even on a blocking socket.

2 files changed, 47 insertions, 26 deletions

diff --git a/tests/socket.test b/tests/socket.test
index 6b072c2..61660cd 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -95,7 +95,7 @@ set lat1 [expr {($t2-$t1)*2}]; # doubled as a safety margin
 set t1 [clock milliseconds]
 catch {socket 127.0.0.1 [randport]}
 set t2 [clock milliseconds]
-set lat2 [expr {($t2-$t1)*2}]
+set lat2 [expr {($t2-$t1)*3}]
 
 # Use the maximum of the two latency calculations, but at least 100ms
 set latency [expr {$lat1 > $lat2 ? $lat1 : $lat2}]
@@ -1812,22 +1812,17 @@ test socket-14.1 {[socket -async] fileevent while still connecting} \
 test socket-14.2 {[socket -async] fileevent connection refused} \
     -constraints [list socket supported_any] \
     -body {
-        if {[catch {socket -async localhost [randport]} client]} {
-	    regexp {[^:]*: (.*)} $client -> x
-	} else {
-            fileevent $client writable {set x [fconfigure $client -error]}
-            set after [after $latency {set x timeout}]
-            vwait x
-	    after cancel $after
-            if {$x eq "timeout"} {
-                append x ": [fconfigure $client -error]"
-            }
-	    close $client
-	}
-        set x
+        set client [socket -async localhost [randport]]
+        fileevent $client writable {set x ok}
+        set after [after $latency {set x timeout}]
+        vwait x
+        after cancel $after
+        lappend x [fconfigure $client -error]
     } -cleanup {
-        unset x
-    } -result "connection refused"
+        after cancel $after
+        close $client
+        unset x after client
+    } -result {ok {connection refused}}
 test socket-14.3 {[socket -async] when server only listens on IPv6} \
     -constraints [list socket supported_any localhost_v6] \
     -setup {
@@ -2016,7 +2011,6 @@ test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IP
         fconfigure $sock -blocking 0
         for {set i 0} {$i < 50} {incr i } {
             if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
-            update
             after 200
         }
         set x
@@ -2043,7 +2037,6 @@ test socket-14.8.1 {pending [socket -async] and nonblocking [gets], server is IP
         fconfigure $sock -blocking 0
         for {set i 0} {$i < 50} {incr i } {
             if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
-            update
             after 200
         }
         set x
@@ -2060,7 +2053,6 @@ test socket-14.8.2 {pending [socket -async] and nonblocking [gets], no listener}
         fconfigure $sock -blocking 0
         for {set i 0} {$i < 50} {incr i } {
             if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
-            update
             after 200
         }
         fconfigure $sock -error
@@ -2191,7 +2183,22 @@ test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, f
         vwait x
         close $sock
     } -cleanup {
+        unset x
     } -result {broken pipe} -returnCodes 1
+test socket-14.12 {[socket -async] background progress triggered by [fconfigure -error]} \
+    -constraints {socket supported_inet supported_inet6} \
+    -body {
+        set s [socket -async localhost [randport]]
+        for {set i 0} {$i < 50} {incr i} {
+            set x [fconfigure $s -error]
+            if {$x != ""} break
+            after 200
+        }
+        set x
+    } -cleanup {
+        close $s
+        unset x s
+    } -result {connection refused}
 
 ::tcltest::cleanupTests
 flush stdout
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 8336bdb..b26d707 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -128,7 +128,8 @@ static int		TcpInputProc(ClientData instanceData, char *buf,
 static int		TcpOutputProc(ClientData instanceData,
 			    const char *buf, int toWrite, int *errorCode);
 static void		TcpWatchProc(ClientData instanceData, int mask);
-static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr);
+static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr,
+			    int noblock);
 
 /*
  * This structure describes the channel type structure for TCP socket
@@ -385,7 +386,8 @@ TcpBlockModeProc(
  *
  *	Wait for a connection on an asynchronously opened socket to be
  *	completed.  In nonblocking mode, just test if the connection
- *	has completed without blocking.
+ *	has completed without blocking. The noblock parameter allows to
+ *	enforce nonblocking behaviour even on sockets in blocking mode.
  *
  * Results:
  * 	0 if the connection has completed, -1 if still in progress
@@ -397,7 +399,8 @@ TcpBlockModeProc(
 static int
 WaitForConnect(
     TcpState *statePtr,		/* State of the socket. */
-    int *errorCodePtr)		/* Where to store errors? */
+    int *errorCodePtr,		/* Where to store errors? */
+    int noblock)		/* Don't wait, even for sockets in blocking mode */
 {
     int timeOut;		/* How long to wait. */
     int state;			/* Of calling TclWaitForFile. */
@@ -408,7 +411,7 @@ WaitForConnect(
      */
 
     if (statePtr->flags & TCP_ASYNC_CONNECT) {
-	if (statePtr->flags & TCP_ASYNC_SOCKET) {
+	if (noblock || statePtr->flags & TCP_ASYNC_SOCKET) {
 	    timeOut = 0;
 	} else {
 	    timeOut = -1;
@@ -417,7 +420,7 @@ WaitForConnect(
 	errno = 0;
 	state = TclUnixWaitForFile(statePtr->fds.fd,
 		TCL_WRITABLE | TCL_EXCEPTION, timeOut);
-        if (timeOut == -1 && state != 0) {
+        if (state != 0) {
             CreateClientSocket(NULL, statePtr);
         }
         if (statePtr->flags & TCP_ASYNC_CONNECT) {
@@ -468,7 +471,7 @@ TcpInputProc(
     int bytesRead;
 
     *errorCodePtr = 0;
-    if (WaitForConnect(statePtr, errorCodePtr) != 0) {
+    if (WaitForConnect(statePtr, errorCodePtr, 0) != 0) {
 	return -1;
     }
     bytesRead = recv(statePtr->fds.fd, buf, (size_t) bufSize, 0);
@@ -518,7 +521,7 @@ TcpOutputProc(
     int written;
 
     *errorCodePtr = 0;
-    if (WaitForConnect(statePtr, errorCodePtr) != 0) {
+    if (WaitForConnect(statePtr, errorCodePtr, 0) != 0) {
 	return -1;
     }
     written = send(statePtr->fds.fd, buf, (size_t) toWrite, 0);
@@ -745,6 +748,9 @@ TcpGetOptionProc(
 {
     TcpState *statePtr = instanceData;
     size_t len = 0;
+    int errorCode;
+
+    WaitForConnect(statePtr, &errorCode, 1);
 
     if (optionName != NULL) {
 	len = strlen(optionName);
@@ -772,6 +778,14 @@ TcpGetOptionProc(
 	return TCL_OK;
     }
 
+    if ((len > 1) && (optionName[1] == 'c') &&
+	    (strncmp(optionName, "-connecting", len) == 0)) {
+
+        Tcl_DStringAppend(dsPtr,
+                        (statePtr->flags & TCP_ASYNC_CONNECT) ? "1" : "0", -1);
+        return TCL_OK;
+    }
+
     if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
 	    (strncmp(optionName, "-peername", len) == 0))) {
         address peername;