From 870ed20799fc0d228ffcf6e7add98824b0182950 Mon Sep 17 00:00:00 2001 From: ferrieux Date: Mon, 24 Mar 2014 21:42:56 +0000 Subject: Add test io-53.12 to verify proper unbuffered sync-fcopy [Bug #3096275] --- tests/io.test | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/tests/io.test b/tests/io.test index 19cd9a5..d3f249c 100644 --- a/tests/io.test +++ b/tests/io.test @@ -7450,6 +7450,25 @@ test io-53.11 {Bug 2895565} -setup { removeFile out removeFile in } -result {40 bytes copied} +test io-53.12 {CopyData: foreground short reads, aka bug 3096275} {stdio unix openpipe fcopy} { + file delete $path(pipe) + set f1 [open $path(pipe) w] + puts -nonewline $f1 { + fconfigure stdin -translation binary -blocking 0 + fconfigure stdout -buffering none -translation binary + fcopy stdin stdout + } + close $f1 + set f1 [open "|[list [interpreter] $path(pipe)]" r+] + fconfigure $f1 -translation binary -buffering none + puts -nonewline $f1 A + after 2000 {set ::done timeout} + fileevent $f1 readable {set ::done ok} + vwait ::done + set ch [read $f1 1] + close $f1 + list $::done $ch +} {ok A} test io-54.1 {Recursive channel events} {socket fileevent} { # This test checks to see if file events are delivered during recursive -- cgit v0.12 From 4b6ab47efdc71922068677ef074031e180f359d9 Mon Sep 17 00:00:00 2001 From: oehhar Date: Fri, 4 Apr 2014 16:27:39 +0000 Subject: Avoid multiple returns of connect errors --- win/tclWinSock.c | 146 +++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 103 insertions(+), 43 deletions(-) diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 036f3b9..ed9fa32 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -172,7 +172,7 @@ struct TcpState { struct addrinfo *addr; /* Iterator over addrlist. */ struct addrinfo *myaddrlist;/* Local address. */ struct addrinfo *myaddr; /* Iterator over myaddrlist. */ - int status; /* Cache status of async socket. */ + int error; /* Cache status of async socket. */ int cachedBlocking; /* Cache blocking mode of async socket. */ volatile int connectError; /* Async connect error set by notifier thread. * Set by notifier thread, access must be @@ -255,8 +255,7 @@ static LRESULT CALLBACK SocketProc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam); static int SocketsEnabled(void); static void TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr); -static int WaitForConnect(TcpState *statePtr, int *errorCodePtr, - int noblock); +static int WaitForConnect(TcpState *statePtr, int *errorCodePtr); static int WaitForSocketEvent(TcpState *statePtr, int events, int *errorCodePtr); static void AddSocketInfoFd(TcpState *statePtr, SOCKET socket); @@ -573,8 +572,13 @@ TcpBlockModeProc( static int WaitForConnect( TcpState *statePtr, /* State of the socket. */ - int *errorCodePtr, /* Where to store errors? */ - int noblock) /* Don't wait, even for sockets in blocking mode */ + int *errorCodePtr) /* Where to store errors? + * A passed null-pointer activates background mode. + * In this case, an eventual error is stored in + * statePtr->error. + * In addition, we do never block and allow a next + * processing cycle to happen. + */ { int result; int oldMode; @@ -605,10 +609,11 @@ WaitForConnect( statePtr->readyEvents &= ~(FD_CONNECT); /* - * For blocking sockets disable async connect - * as we continue now synchoneously + * For blocking sockets and foreground processing + * disable async connect as we continue now synchoneously */ - if ( !(noblock || (statePtr->flags & TCP_ASYNC_SOCKET)) ) { + if ( errorCodePtr != NULL && + ! (statePtr->flags & TCP_ASYNC_SOCKET) ) { CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT); } @@ -624,13 +629,19 @@ WaitForConnect( /* Succesfully connected or async connect restarted */ if (result == TCL_OK) { if ( statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING ) { - *errorCodePtr = EWOULDBLOCK; + if (errorCodePtr != NULL) { + *errorCodePtr = EWOULDBLOCK; + } return -1; } return 0; } /* error case */ - *errorCodePtr = Tcl_GetErrno(); + if (errorCodePtr != NULL) { + *errorCodePtr = Tcl_GetErrno(); + } else { + statePtr->error = Tcl_GetErrno(); + } return -1; } @@ -641,7 +652,11 @@ WaitForConnect( * A non blocking socket waiting for an asyncronous connect * returns directly an error */ - if ( noblock || (statePtr->flags & TCP_ASYNC_SOCKET) ) { + if ( errorCodePtr == NULL ) { + /* Backround operation */ + return -1; + } else if (statePtr->flags & TCP_ASYNC_SOCKET) { + /* foreground operation but non blocking socket */ *errorCodePtr = EWOULDBLOCK; return -1; } @@ -715,7 +730,7 @@ TcpInputProc( * For a non blocking socket return EWOULDBLOCK if connect not terminated */ - if (WaitForConnect(statePtr, errorCodePtr, 0) != 0) { + if (WaitForConnect(statePtr, errorCodePtr) != 0) { return -1; } @@ -844,7 +859,7 @@ TcpOutputProc( * For a non blocking socket return EWOULDBLOCK if connect not terminated */ - if (WaitForConnect(statePtr, errorCodePtr, 0) != 0) { + if (WaitForConnect(statePtr, errorCodePtr) != 0) { return -1; } @@ -1184,7 +1199,7 @@ TcpGetOptionProc( char host[NI_MAXHOST], port[NI_MAXSERV]; SOCKET sock; size_t len = 0; - int errorCode; + int errorCode = 0; int reverseDNS = 0; #define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS" @@ -1202,8 +1217,11 @@ TcpGetOptionProc( return TCL_ERROR; } - /* Go one step in async connect */ - WaitForConnect(statePtr, &errorCode, 1); + /* + * Go one step in async connect + * If any error is thrown save it as backround error to report eventually below + */ + WaitForConnect(statePtr, NULL); sock = statePtr->sockets->fd; if (optionName != NULL) { @@ -1216,30 +1234,52 @@ TcpGetOptionProc( /* * Do not return any errors if async connect is running */ - if (! (statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING) ) { - int optlen; - int ret; - DWORD err; + if ( ! (statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING) ) { - /* - * Populater the err Variable with a possix error - */ - optlen = sizeof(int); - ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR, - (char *)&err, &optlen); - /* - * The error was not returned directly but should be - * taken from WSA - */ - if (ret == SOCKET_ERROR) { - err = WSAGetLastError(); - } - /* - * Return error message - */ - if (err) { - TclWinConvertError(err); - Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1); + + if ( statePtr->flags & TCP_ASYNC_CONNECT_FAILED ) { + + /* + * In case of a failed async connect, eventually report the + * connect error only once. + * Do not report the system error, as this comes again and again. + */ + + if ( statePtr->error != 0 ) { + Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(statePtr->error), -1); + statePtr->error = 0; + } + + } else { + + /* + * Report an eventual last error of the socket system + */ + + int optlen; + int ret; + DWORD err; + + /* + * Populater the err Variable with a possix error + */ + optlen = sizeof(int); + ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR, + (char *)&err, &optlen); + /* + * The error was not returned directly but should be + * taken from WSA + */ + if (ret == SOCKET_ERROR) { + err = WSAGetLastError(); + } + /* + * Return error message + */ + if (err) { + TclWinConvertError(err); + Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1); + } } } return TCL_OK; @@ -2555,16 +2595,36 @@ SocketEventProc( return 1; } + /* + * Clear flag that (this) event is pending + */ + statePtr->flags &= ~SOCKET_PENDING; - /* Continue async connect if pending and ready */ + /* + * Continue async connect if pending and ready + */ + if ( statePtr->readyEvents & FD_CONNECT ) { - statePtr->readyEvents &= ~(FD_CONNECT); if ( statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING ) { + + /* + * Do one step and save eventual connect error + */ + + SetEvent(tsdPtr->socketListLock); + WaitForConnect(statePtr,NULL); + + } else { + + /* + * No async connect reenter pending. Just clear event. + */ + + statePtr->readyEvents &= ~(FD_CONNECT); SetEvent(tsdPtr->socketListLock); - CreateClientSocket(NULL, statePtr); - return 1; } + return 1; } /* -- cgit v0.12 From 77113c6828286012fe17288e3132811cb24f6fe3 Mon Sep 17 00:00:00 2001 From: oehhar Date: Mon, 7 Apr 2014 12:34:18 +0000 Subject: Return async connect error by first following read or write operation. --- win/tclWinSock.c | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/win/tclWinSock.c b/win/tclWinSock.c index ed9fa32..b05dc32 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -585,11 +585,22 @@ WaitForConnect( ThreadSpecificData *tsdPtr; /* + * Check if an async connect error is not jet reported. + * If yes, report it now. + */ + + if ( errorCodePtr != NULL && statePtr->error != 0 ) { + *errorCodePtr = statePtr->error; + statePtr->error = 0; + return -1; + } + + /* * Check if an async connect is running. If not return ok */ if ( !(statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING) ) return 0; - + /* * Be sure to disable event servicing so we are truly modal. */ -- cgit v0.12 From 6ab79205ac7597fa0c7b84ef86c9e341b99bc8b6 Mon Sep 17 00:00:00 2001 From: oehhar Date: Mon, 7 Apr 2014 15:08:31 +0000 Subject: Renamed function CreateClientSocket to TcpConnect and variable error to connectError --- win/tclWinSock.c | 51 ++++++++++++++++++++++++++++----------------------- 1 file changed, 28 insertions(+), 23 deletions(-) diff --git a/win/tclWinSock.c b/win/tclWinSock.c index b05dc32..7593396 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -172,11 +172,10 @@ struct TcpState { struct addrinfo *addr; /* Iterator over addrlist. */ struct addrinfo *myaddrlist;/* Local address. */ struct addrinfo *myaddr; /* Iterator over myaddrlist. */ - int error; /* Cache status of async socket. */ + int connectError; /* Cache status of async socket. */ int cachedBlocking; /* Cache blocking mode of async socket. */ volatile int connectError; /* Async connect error set by notifier thread. - * Set by notifier thread, access must be - * protected by semaphore */ + * Access must be protected by semaphore */ struct TcpState *nextPtr; /* The next socket on the per-thread socket * list. */ }; @@ -193,7 +192,7 @@ struct TcpState { #define SOCKET_PENDING (1<<3) /* A message has been sent for this * socket */ #define TCP_ASYNC_CONNECT_REENTER_PENDING (1<<4) - /* CreateClientSocket was called to + /* TcpConnect was called to * process an async connect. This * flag indicates that reentry is * still pending */ @@ -246,7 +245,7 @@ static WNDCLASS windowClass; * Static routines for this file: */ -static int CreateClientSocket(Tcl_Interp *interp, +static int TcpConnect(Tcl_Interp *interp, TcpState *state); static void InitSockets(void); static TcpState * NewSocketInfo(SOCKET socket); @@ -553,10 +552,14 @@ TcpBlockModeProc( * * WaitForConnect -- * - * Wait for a connection on an asynchronously opened socket to be - * completed. In nonblocking mode, just test if the connection - * has completed without blocking. The noblock parameter allows to - * enforce nonblocking behaviour even on sockets in blocking mode. + * Check the state of an async connect process. If a connection + * attempt terminated, process it, which may finalize it or may + * start the next attempt. + * There are two modes of operation, defined by errorCodePtr: + * * non-NULL: Called by explicite read/write command. block if + * socket is blocking. Return a possible error and clear it. + * * Null: Called by a backround operation. Never block and + * save eventual error in statePtr->connectError. * * Results: * 0 if the connection has completed, -1 if still in progress @@ -574,9 +577,9 @@ WaitForConnect( TcpState *statePtr, /* State of the socket. */ int *errorCodePtr) /* Where to store errors? * A passed null-pointer activates background mode. - * In this case, an eventual error is stored in - * statePtr->error. - * In addition, we do never block and allow a next + * In this case, a possible error is stored in + * statePtr->connectError. + * In addition, we do never block and allow the next * processing cycle to happen. */ { @@ -589,15 +592,16 @@ WaitForConnect( * If yes, report it now. */ - if ( errorCodePtr != NULL && statePtr->error != 0 ) { - *errorCodePtr = statePtr->error; - statePtr->error = 0; + if ( errorCodePtr != NULL && statePtr->connectError != 0 ) { + *errorCodePtr = statePtr->connectError; + statePtr->connectError = 0; return -1; } /* * Check if an async connect is running. If not return ok */ + if ( !(statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING) ) return 0; @@ -632,7 +636,7 @@ WaitForConnect( SetEvent(tsdPtr->socketListLock); /* continue connect */ - result = CreateClientSocket(NULL, statePtr); + result = TcpConnect(NULL, statePtr); /* Restore event service mode */ (void) Tcl_SetServiceMode(oldMode); @@ -651,7 +655,7 @@ WaitForConnect( if (errorCodePtr != NULL) { *errorCodePtr = Tcl_GetErrno(); } else { - statePtr->error = Tcl_GetErrno(); + statePtr->connectError = Tcl_GetErrno(); } return -1; } @@ -1256,9 +1260,10 @@ TcpGetOptionProc( * Do not report the system error, as this comes again and again. */ - if ( statePtr->error != 0 ) { - Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(statePtr->error), -1); - statePtr->error = 0; + if ( statePtr->connectError != 0 ) { + Tcl_DStringAppend(dsPtr, + Tcl_ErrnoMsg(statePtr->connectError), -1); + statePtr->connectError = 0; } } else { @@ -1558,7 +1563,7 @@ TcpGetHandleProc( /* *---------------------------------------------------------------------- * - * CreateClientSocket -- + * TcpConnect -- * * This function opens a new socket in client mode. * @@ -1592,7 +1597,7 @@ TcpGetHandleProc( */ static int -CreateClientSocket( +TcpConnect( Tcl_Interp *interp, /* For error reporting; can be NULL. */ TcpState *statePtr) { @@ -1904,7 +1909,7 @@ Tcl_OpenTcpClient( /* * Create a new client socket and wrap it in a channel. */ - if (CreateClientSocket(interp, statePtr) != TCL_OK) { + if (TcpConnect(interp, statePtr) != TCL_OK) { TcpCloseProc(statePtr, NULL); return NULL; } -- cgit v0.12 From f83f7d140e5150b79aa714c448879448d51f5bf5 Mon Sep 17 00:00:00 2001 From: max Date: Mon, 7 Apr 2014 15:11:32 +0000 Subject: Rename CreateClientSocket to TcpConnect --- unix/tclUnixSock.c | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index d4b7b62..f428811 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -110,7 +110,7 @@ struct TcpState { * Static routines for this file: */ -static int CreateClientSocket(Tcl_Interp *interp, +static int TcpConnect(Tcl_Interp *interp, TcpState *state); static void TcpAccept(ClientData data, int mask); static int TcpBlockModeProc(ClientData data, int mode); @@ -409,13 +409,13 @@ WaitForConnect( if (noblock || (statePtr->flags & TCP_ASYNC_SOCKET)) { if (TclUnixWaitForFile(statePtr->fds.fd, TCL_WRITABLE | TCL_EXCEPTION, 0) != 0) { - CreateClientSocket(NULL, statePtr); + TcpConnect(NULL, statePtr); } } else { while (statePtr->flags & TCP_ASYNC_CONNECT) { if (TclUnixWaitForFile(statePtr->fds.fd, TCL_WRITABLE | TCL_EXCEPTION, -1) != 0) { - CreateClientSocket(NULL, statePtr); + TcpConnect(NULL, statePtr); } } } @@ -936,7 +936,7 @@ TcpGetHandleProc( * * TcpAsyncCallback -- * - * Called by the event handler that CreateClientSocket sets up + * Called by the event handler that TcpConnect sets up * internally for [socket -async] to get notified when the * asyncronous connection attempt has succeeded or failed. * @@ -949,13 +949,13 @@ TcpAsyncCallback( * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ { - CreateClientSocket(NULL, clientData); + TcpConnect(NULL, clientData); } /* *---------------------------------------------------------------------- * - * CreateClientSocket -- + * TcpConnect -- * * This function opens a new socket in client mode. * @@ -983,7 +983,7 @@ TcpAsyncCallback( */ static int -CreateClientSocket( +TcpConnect( Tcl_Interp *interp, /* For error reporting; can be NULL. */ TcpState *statePtr) { @@ -1198,7 +1198,7 @@ Tcl_OpenTcpClient( /* * Create a new client socket and wrap it in a channel. */ - if (CreateClientSocket(interp, statePtr) != TCL_OK) { + if (TcpConnect(interp, statePtr) != TCL_OK) { TcpCloseProc(statePtr, NULL); return NULL; } -- cgit v0.12 From 7d53615f6beb67b4bdc2b0ad35b62c4667a1ab99 Mon Sep 17 00:00:00 2001 From: max Date: Mon, 7 Apr 2014 15:18:09 +0000 Subject: Rename error to connectError in struct TcpState. --- unix/tclUnixSock.c | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index f428811..adc6243 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -73,7 +73,7 @@ struct TcpState { struct addrinfo *myaddr; /* Iterator over myaddrlist. */ int filehandlers; /* Caches FileHandlers that get set up while * an async socket is not yet connected. */ - int error; /* Cache SO_ERROR of async socket. */ + int connectError; /* Cache SO_ERROR of async socket. */ int cachedBlocking; /* Cache blocking mode of async socket. */ }; @@ -420,7 +420,7 @@ WaitForConnect( } } } - if (statePtr->error != 0) { + if (statePtr->connectError != 0) { return -1; } else { return 0; @@ -463,8 +463,8 @@ TcpInputProc( *errorCodePtr = 0; if (WaitForConnect(statePtr, 0) != 0) { - *errorCodePtr = statePtr->error; - statePtr->error = 0; + *errorCodePtr = statePtr->connectError; + statePtr->connectError = 0; return -1; } bytesRead = recv(statePtr->fds.fd, buf, (size_t) bufSize, 0); @@ -515,8 +515,8 @@ TcpOutputProc( *errorCodePtr = 0; if (WaitForConnect(statePtr, 0) != 0) { - *errorCodePtr = statePtr->error; - statePtr->error = 0; + *errorCodePtr = statePtr->connectError; + statePtr->connectError = 0; return -1; } written = send(statePtr->fds.fd, buf, (size_t) toWrite, 0); @@ -757,9 +757,9 @@ TcpGetOptionProc( if (statePtr->flags & TCP_ASYNC_CONNECT) { /* Suppress errors as long as we are not done */ errno = 0; - } else if (statePtr->error != 0) { - errno = statePtr->error; - statePtr->error = 0; + } else if (statePtr->connectError != 0) { + errno = statePtr->connectError; + statePtr->connectError = 0; } else { int err; getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, @@ -1070,7 +1070,7 @@ TcpConnect( if (ret < 0 && errno == EINPROGRESS) { Tcl_CreateFileHandler(statePtr->fds.fd, TCL_WRITABLE|TCL_EXCEPTION, TcpAsyncCallback, statePtr); - statePtr->error = errno = EWOULDBLOCK; + statePtr->connectError = errno = EWOULDBLOCK; return TCL_OK; reenter: @@ -1096,7 +1096,7 @@ TcpConnect( } out: - statePtr->error = error; + statePtr->connectError = error; CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT); if (async_callback) { /* -- cgit v0.12 From 207329f22a7bf020db137dc4e6d9b9b82d7a4f67 Mon Sep 17 00:00:00 2001 From: oehhar Date: Tue, 8 Apr 2014 14:40:20 +0000 Subject: Changed error report logic, that an async connect error is only reported by 'fconfigure -error' and not by a possible last command terminating the async connect. The terminating command always returns "socket is not connected" on connect error. In addition, some flags were renamed: TCP_ASYNC_SOCKET to TCP_NONBLOCKING and also the new state flags. --- tests/socket.test | 12 ++--- win/tclWinPort.h | 6 +++ win/tclWinSock.c | 146 +++++++++++++++++++++++++++++++++++------------------- 3 files changed, 106 insertions(+), 58 deletions(-) diff --git a/tests/socket.test b/tests/socket.test index d36d2b3..648ade5 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -1981,10 +1981,10 @@ test socket-14.7.2 {pending [socket -async] and blocking [gets], no listener} \ -body { set sock [socket -async localhost [randport]] catch {gets $sock} x - list $x [fconfigure $sock -error] + list $x [fconfigure $sock -error] [fconfigure $sock -error] } -cleanup { close $sock - } -match glob -result {{error reading "sock*": connection refused} {}} + } -match glob -result {{error reading "sock*": socket is not connected} {connection refused} {}} test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IPv4} \ -constraints {socket supported_inet supported_inet6} \ -setup { @@ -2046,10 +2046,10 @@ test socket-14.8.2 {pending [socket -async] and nonblocking [gets], no listener} if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break after 200 } - list $x [fconfigure $sock -error] + list $x [fconfigure $sock -error] [fconfigure $sock -error] } -cleanup { close $sock - } -match glob -result {{error reading "sock*": connection refused} {}} + } -match glob -result {{error reading "sock*": socket is not connected} {connection refused} {}} test socket-14.9.0 {pending [socket -async] and blocking [puts], server is IPv4} \ -constraints {socket supported_inet supported_inet6} \ -setup { @@ -2164,7 +2164,7 @@ test socket-14.11.0 {pending [socket -async] and blocking [puts], no listener, n } -cleanup { catch {close $sock} unset x - } -result {connection refused} -returnCodes 1 + } -result {socket is not connected} -returnCodes 1 test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, flush} \ -constraints {socket supported_inet supported_inet6} \ -body { @@ -2178,7 +2178,7 @@ test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, f } -cleanup { catch {close $sock} unset x - } -result {connection refused} -returnCodes 1 + } -result {socket is not connected} -returnCodes 1 test socket-14.12 {[socket -async] background progress triggered by [fconfigure -error]} \ -constraints {socket supported_inet supported_inet6} \ -body { diff --git a/win/tclWinPort.h b/win/tclWinPort.h index 61f149b..1104b53 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -532,6 +532,12 @@ typedef DWORD_PTR * PDWORD_PTR; * The following defines map from standard socket names to our internal * wrappers that redirect through the winSock function table (see the * file tclWinSock.c). + * + * Warning: + * This check was useful in times of Windows98 where WinSock may + * not be available. This is not the case any more. + * This function may be removed with TCL 9.0 + * */ #define getservbyname TclWinGetServByName diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 7593396..dc67c4b 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -174,7 +174,9 @@ struct TcpState { struct addrinfo *myaddr; /* Iterator over myaddrlist. */ int connectError; /* Cache status of async socket. */ int cachedBlocking; /* Cache blocking mode of async socket. */ - volatile int connectError; /* Async connect error set by notifier thread. + volatile int notifierConnectError; + /* Async connect error set by notifier thread. + * This error is still a windows error code. * Access must be protected by semaphore */ struct TcpState *nextPtr; /* The next socket on the per-thread socket * list. */ @@ -185,19 +187,17 @@ struct TcpState { * structure. */ -#define TCP_ASYNC_SOCKET (1<<0) /* Asynchronous socket. */ +#define TCP_NONBLOCKING (1<<0) /* Socket with non-blocking I/O */ #define TCP_ASYNC_CONNECT (1<<1) /* Async connect in progress. */ #define SOCKET_EOF (1<<2) /* A zero read happened on the * socket. */ #define SOCKET_PENDING (1<<3) /* A message has been sent for this * socket */ -#define TCP_ASYNC_CONNECT_REENTER_PENDING (1<<4) - /* TcpConnect was called to +#define TCP_ASYNC_PENDING (1<<4) /* TcpConnect was called to * process an async connect. This * flag indicates that reentry is * still pending */ -#define TCP_ASYNC_CONNECT_FAILED (1<<5) - /* An async connect finally failed */ +#define TCP_ASYNC_FAILED (1<<5) /* An async connect finally failed */ /* * The following structure is what is added to the Tcl event queue when a @@ -540,9 +540,9 @@ TcpBlockModeProc( TcpState *statePtr = instanceData; if (mode == TCL_MODE_NONBLOCKING) { - statePtr->flags |= TCP_ASYNC_SOCKET; + statePtr->flags |= TCP_NONBLOCKING; } else { - statePtr->flags &= ~(TCP_ASYNC_SOCKET); + statePtr->flags &= ~(TCP_NONBLOCKING); } return 0; } @@ -554,12 +554,19 @@ TcpBlockModeProc( * * Check the state of an async connect process. If a connection * attempt terminated, process it, which may finalize it or may - * start the next attempt. + * start the next attempt. If a connect error occures, it is saved + * in statePtr->connectError to be reported by 'fconfigure -error'. + * * There are two modes of operation, defined by errorCodePtr: * * non-NULL: Called by explicite read/write command. block if - * socket is blocking. Return a possible error and clear it. - * * Null: Called by a backround operation. Never block and - * save eventual error in statePtr->connectError. + * socket is blocking. + * May return two error codes: + * * EWOULDBLOCK: if connect is still in progress + * * ENOTCONN: if connect failed. This would be the error + * message of a rect or sendto syscall so this is + * emulated here. + * * Null: Called by a backround operation. Do not block and + * don't return any error code. * * Results: * 0 if the connection has completed, -1 if still in progress @@ -577,10 +584,6 @@ WaitForConnect( TcpState *statePtr, /* State of the socket. */ int *errorCodePtr) /* Where to store errors? * A passed null-pointer activates background mode. - * In this case, a possible error is stored in - * statePtr->connectError. - * In addition, we do never block and allow the next - * processing cycle to happen. */ { int result; @@ -588,21 +591,21 @@ WaitForConnect( ThreadSpecificData *tsdPtr; /* - * Check if an async connect error is not jet reported. - * If yes, report it now. + * Check if an async connect failed already and error reporting is demanded, + * return the error ENOTCONN */ - if ( errorCodePtr != NULL && statePtr->connectError != 0 ) { - *errorCodePtr = statePtr->connectError; - statePtr->connectError = 0; + if ( errorCodePtr != NULL && + (statePtr->flags & TCP_ASYNC_FAILED) ) { + *errorCodePtr = ENOTCONN; return -1; } /* * Check if an async connect is running. If not return ok */ - - if ( !(statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING) ) + + if ( !(statePtr->flags & TCP_ASYNC_PENDING) ) return 0; /* @@ -611,6 +614,10 @@ WaitForConnect( oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE); + /* + * Loop in the blocking case until the connect signal is present + */ + while (1) { /* get statePtr lock */ @@ -628,22 +635,32 @@ WaitForConnect( * disable async connect as we continue now synchoneously */ if ( errorCodePtr != NULL && - ! (statePtr->flags & TCP_ASYNC_SOCKET) ) { + ! (statePtr->flags & TCP_NONBLOCKING) ) { CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT); } /* Free list lock */ SetEvent(tsdPtr->socketListLock); - /* continue connect */ + /* + * Continue connect. + * If switched to synchroneous connect, the connect is terminated. + */ result = TcpConnect(NULL, statePtr); /* Restore event service mode */ (void) Tcl_SetServiceMode(oldMode); - /* Succesfully connected or async connect restarted */ + /* + * Check for Succesfull connect or async connect restart + */ + if (result == TCL_OK) { - if ( statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING ) { + /* + * Check for async connect restart + * (not possible for foreground blocking operation) + */ + if ( statePtr->flags & TCP_ASYNC_PENDING ) { if (errorCodePtr != NULL) { *errorCodePtr = EWOULDBLOCK; } @@ -651,11 +668,14 @@ WaitForConnect( } return 0; } - /* error case */ + + /* + * Connect finally failed. + * For foreground operation return ENOTCONN. + */ + if (errorCodePtr != NULL) { - *errorCodePtr = Tcl_GetErrno(); - } else { - statePtr->connectError = Tcl_GetErrno(); + *errorCodePtr = ENOTCONN; } return -1; } @@ -664,14 +684,20 @@ WaitForConnect( SetEvent(tsdPtr->socketListLock); /* - * A non blocking socket waiting for an asyncronous connect - * returns directly an error + * Background operation returns with no action as there was no connect + * event */ + if ( errorCodePtr == NULL ) { - /* Backround operation */ return -1; - } else if (statePtr->flags & TCP_ASYNC_SOCKET) { - /* foreground operation but non blocking socket */ + } + + /* + * A non blocking socket waiting for an asyncronous connect + * returns directly the error EWOULDBLOCK + */ + + if (statePtr->flags & TCP_NONBLOCKING) { *errorCodePtr = EWOULDBLOCK; return -1; } @@ -803,7 +829,7 @@ TcpInputProc( * Check for error condition or underflow in non-blocking case. */ - if ((statePtr->flags & TCP_ASYNC_SOCKET) || (error != WSAEWOULDBLOCK)) { + if ((statePtr->flags & TCP_NONBLOCKING) || (error != WSAEWOULDBLOCK)) { TclWinConvertError(error); *errorCodePtr = Tcl_GetErrno(); bytesRead = -1; @@ -908,7 +934,7 @@ TcpOutputProc( error = WSAGetLastError(); if (error == WSAEWOULDBLOCK) { statePtr->readyEvents &= ~(FD_WRITE); - if (statePtr->flags & TCP_ASYNC_SOCKET) { + if (statePtr->flags & TCP_NONBLOCKING) { *errorCodePtr = EWOULDBLOCK; written = -1; break; @@ -1249,10 +1275,10 @@ TcpGetOptionProc( /* * Do not return any errors if async connect is running */ - if ( ! (statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING) ) { + if ( ! (statePtr->flags & TCP_ASYNC_PENDING) ) { - if ( statePtr->flags & TCP_ASYNC_CONNECT_FAILED ) { + if ( statePtr->flags & TCP_ASYNC_FAILED ) { /* * In case of a failed async connect, eventually report the @@ -1280,7 +1306,7 @@ TcpGetOptionProc( * Populater the err Variable with a possix error */ optlen = sizeof(int); - ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR, + ret = getsockopt(sock, SOL_SOCKET, SO_ERROR, (char *)&err, &optlen); /* * The error was not returned directly but should be @@ -1305,7 +1331,7 @@ TcpGetOptionProc( (strncmp(optionName, "-connecting", len) == 0)) { Tcl_DStringAppend(dsPtr, - (statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING) + (statePtr->flags & TCP_ASYNC_PENDING) ? "1" : "0", -1); return TCL_OK; } @@ -1645,7 +1671,7 @@ TcpConnect( /* * Reset last error from last try */ - statePtr->connectError = 0; + statePtr->notifierConnectError = 0; Tcl_SetErrno(0); statePtr->sockets->fd = socket(statePtr->myaddr->ai_family, SOCK_STREAM, 0); @@ -1747,7 +1773,7 @@ TcpConnect( /* * Remember that we jump back behind this next round */ - statePtr->flags |= TCP_ASYNC_CONNECT_REENTER_PENDING; + statePtr->flags |= TCP_ASYNC_PENDING; return TCL_OK; reenter: @@ -1757,11 +1783,11 @@ TcpConnect( * * Clear the reenter flag */ - statePtr->flags &= ~(TCP_ASYNC_CONNECT_REENTER_PENDING); + statePtr->flags &= ~(TCP_ASYNC_PENDING); /* get statePtr lock */ WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* Get signaled connect error */ - Tcl_SetErrno(statePtr->connectError); + TclWinConvertError((DWORD) statePtr->notifierConnectError); /* Clear eventual connect flag */ statePtr->selectEvents &= ~(FD_CONNECT); /* Free list lock */ @@ -1819,7 +1845,9 @@ out: /* Signal ready readable and writable events */ statePtr->readyEvents |= FD_WRITE | FD_READ; /* Flag error to event routine */ - statePtr->flags |= TCP_ASYNC_CONNECT_FAILED; + statePtr->flags |= TCP_ASYNC_FAILED; + /* Save connect error to be reported by 'fconfigure -error' */ + statePtr->connectError = Tcl_GetErrno(); /* Free list lock */ SetEvent(tsdPtr->socketListLock); } @@ -2260,6 +2288,12 @@ TcpAccept( * * Assumes socketMutex is held. * + * Warning: + * This check was useful in times of Windows98 where WinSock may + * not be available. This is not the case any more. + * This function may be removed with TCL 9.0. + * Any failures may be reported as panics. + * * Results: * None. * @@ -2393,6 +2427,11 @@ InitSockets(void) * * Check that the WinSock was successfully initialized. * + * Warning: + * This check was useful in times of Windows98 where WinSock may + * not be available. This is not the case any more. + * This function may be removed with TCL 9.0 + * * Results: * 1 if it is. * @@ -2622,7 +2661,7 @@ SocketEventProc( */ if ( statePtr->readyEvents & FD_CONNECT ) { - if ( statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING ) { + if ( statePtr->flags & TCP_ASYNC_PENDING ) { /* * Do one step and save eventual connect error @@ -2735,7 +2774,7 @@ SocketEventProc( * Throw the readable event if an async connect failed. */ - if ( statePtr->flags & TCP_ASYNC_CONNECT_FAILED ) { + if ( statePtr->flags & TCP_ASYNC_FAILED ) { mask |= TCL_READABLE; @@ -2928,7 +2967,7 @@ WaitForSocketEvent( } /* Exit loop if event did not occur but this is a non-blocking channel */ - if (statePtr->flags & TCP_ASYNC_SOCKET) { + if (statePtr->flags & TCP_NONBLOCKING) { *errorCodePtr = EWOULDBLOCK; result = 0; break; @@ -3122,8 +3161,7 @@ SocketProc( * connection failures. */ if (error != ERROR_SUCCESS) { - TclWinConvertError((DWORD) error); - statePtr->connectError = Tcl_GetErrno(); + statePtr->notifierConnectError = error; } } /* @@ -3203,6 +3241,10 @@ FindFDInList( * dynamically so we can run on systems that don't have the wsock32.dll. * We need wrappers for these interfaces because they are called from the * generic Tcl code. + * Those functions are exported by the stubs table. + * + * Warning: + * Those functions are depreciated and will be removed with TCL 9.0. * * Results: * As defined for each function. -- cgit v0.12 From bf345d6be59f6f513be07b6465487f137b9ac820 Mon Sep 17 00:00:00 2001 From: oehhar Date: Tue, 8 Apr 2014 15:15:31 +0000 Subject: Beautify check for async connect reentry --- win/tclWinSock.c | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/win/tclWinSock.c b/win/tclWinSock.c index dc67c4b..de4c519 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -595,8 +595,7 @@ WaitForConnect( * return the error ENOTCONN */ - if ( errorCodePtr != NULL && - (statePtr->flags & TCP_ASYNC_FAILED) ) { + if (errorCodePtr != NULL && (statePtr->flags & TCP_ASYNC_FAILED)) { *errorCodePtr = ENOTCONN; return -1; } @@ -605,8 +604,9 @@ WaitForConnect( * Check if an async connect is running. If not return ok */ - if ( !(statePtr->flags & TCP_ASYNC_PENDING) ) + if (!(statePtr->flags & TCP_ASYNC_CONNECT)) { return 0; + } /* * Be sure to disable event servicing so we are truly modal. @@ -1635,7 +1635,7 @@ TcpConnect( */ int async_connect = statePtr->flags & TCP_ASYNC_CONNECT; /* We were called by the event procedure and continue our loop */ - int async_callback = statePtr->sockets->fd != INVALID_SOCKET; + int async_callback = statePtr->flags & TCP_ASYNC_PENDING; ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); if (async_callback) { @@ -1811,6 +1811,12 @@ out: * Socket connected or connection failed */ + /* + * Async connect terminated + */ + + CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT); + if ( Tcl_GetErrno() == 0 ) { /* * Succesfully connected -- cgit v0.12 From 9e4cc53c71c3d5416cb1e33bc5b47688ba631853 Mon Sep 17 00:00:00 2001 From: max Date: Tue, 8 Apr 2014 18:00:35 +0000 Subject: * Give clearer names to some of the state flags and sync them with Windows where it makes sense. * Rework WaitForConnect once more to always report ENOTCONN on I/O operations on failed async sockets. * Fix synchronous connections to a server that only listens on IPv6 (or whatever comes later in the list returned by getaddrinfo(), socket-15.*) * Fix spurious writable event on async sockets (socket-14.15). --- tests/socket.test | 34 ++++++++++++++ unix/tclUnixSock.c | 131 ++++++++++++++++++++++++++++++++++++----------------- 2 files changed, 124 insertions(+), 41 deletions(-) diff --git a/tests/socket.test b/tests/socket.test index 648ade5..5ff2109 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -2225,6 +2225,40 @@ test socket-14.14 {testing fileevent readable on failed async socket connect} -c after cancel $a1 } -result readable +test socket-14.15 {blocking read on async socket should not trigger event handlers} \ + -constraints socket -body { + set s [socket -async localhost [randport]] + set x ok + fileevent $s writable {set x fail} + catch {read $s} + set x + } -result ok + +set num 0 +foreach servip {127.0.0.1 ::1 localhost} { + foreach cliip {127.0.0.1 ::1 localhost} { + if {$servip eq $cliip || "localhost" in [list $servip $cliip]} { + set result {-result "sock*" -match glob} + } else { + set result { + -result {couldn't open socket: connection refused} + -returnCodes 1 + } + } + test socket-15.1.$num "Connect to $servip from $cliip" \ + -constraints {socket supported_inet supported_inet6} -setup { + set server [socket -server accept -myaddr $servip 0] + proc accept {s h p} { close $s } + set port [lindex [fconfigure $server -sockname] 2] + } -body { + set s [socket $cliip $port] + } -cleanup { + close $server + catch {close $s} + } {*}$result + incr num + } +} ::tcltest::cleanupTests flush stdout diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index adc6243..08a14d3 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -82,8 +82,13 @@ struct TcpState { * structure. */ -#define TCP_ASYNC_SOCKET (1<<0) /* Asynchronous socket. */ +#define TCP_NONBLOCKING (1<<0) /* Socket with non-blocking I/O */ #define TCP_ASYNC_CONNECT (1<<1) /* Async connect in progress. */ +#define TCP_ASYNC_PENDING (1<<4) /* TcpConnect was called to + * process an async connect. This + * flag indicates that reentry is + * still pending */ +#define TCP_ASYNC_FAILED (1<<5) /* An async connect finally failed */ /* * The following defines the maximum length of the listen queue. This is the @@ -128,7 +133,7 @@ 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 noblock); +static int WaitForConnect(TcpState *statePtr, int *errorCodePtr); /* * This structure describes the channel type structure for TCP socket @@ -364,9 +369,9 @@ TcpBlockModeProc( TcpState *statePtr = instanceData; if (mode == TCL_MODE_BLOCKING) { - CLEAR_BITS(statePtr->flags, TCP_ASYNC_SOCKET); + CLEAR_BITS(statePtr->flags, TCP_NONBLOCKING); } else { - SET_BITS(statePtr->flags, TCP_ASYNC_SOCKET); + SET_BITS(statePtr->flags, TCP_NONBLOCKING); } if (statePtr->flags & TCP_ASYNC_CONNECT) { statePtr->cachedBlocking = mode; @@ -383,48 +388,82 @@ TcpBlockModeProc( * * WaitForConnect -- * - * Wait for a connection on an asynchronously opened socket to be - * completed. In nonblocking mode, just test if the connection - * has completed without blocking. The noblock parameter allows to - * enforce nonblocking behaviour even on sockets in blocking mode. + * Check the state of an async connect process. If a connection + * attempt terminated, process it, which may finalize it or may + * start the next attempt. If a connect error occures, it is saved + * in statePtr->connectError to be reported by 'fconfigure -error'. + * + * There are two modes of operation, defined by errorCodePtr: + * * non-NULL: Called by explicite read/write command. block if + * socket is blocking. + * May return two error codes: + * * EWOULDBLOCK: if connect is still in progress + * * ENOTCONN: if connect failed. This would be the error + * message of a rect or sendto syscall so this is + * emulated here. + * * NULL: Called by a backround operation. Do not block and + * don't return any error code. * * Results: * 0 if the connection has completed, -1 if still in progress * or there is an error. * + * Side effects: + * Processes socket events off the system queue. + * May process asynchroneous connect. + * *---------------------------------------------------------------------- */ static int WaitForConnect( TcpState *statePtr, /* State of the socket. */ - int noblock) /* Don't wait, even for sockets in blocking mode */ + int *errorCodePtr) { + int timeout; + /* - * If an asynchronous connect is in progress, attempt to wait for it to - * complete before reading. + * Check if an async connect failed already and error reporting is demanded, + * return the error ENOTCONN */ - if (statePtr->flags & TCP_ASYNC_CONNECT) { - if (noblock || (statePtr->flags & TCP_ASYNC_SOCKET)) { - if (TclUnixWaitForFile(statePtr->fds.fd, - TCL_WRITABLE | TCL_EXCEPTION, 0) != 0) { - TcpConnect(NULL, statePtr); - } - } else { - while (statePtr->flags & TCP_ASYNC_CONNECT) { - if (TclUnixWaitForFile(statePtr->fds.fd, - TCL_WRITABLE | TCL_EXCEPTION, -1) != 0) { - TcpConnect(NULL, statePtr); - } - } - } + if (errorCodePtr != NULL && (statePtr->flags & TCP_ASYNC_FAILED)) { + *errorCodePtr = ENOTCONN; + return -1; + } + + /* + * Check if an async connect is running. If not return ok + */ + + if (!(statePtr->flags & TCP_ASYNC_PENDING)) { + return 0; } - if (statePtr->connectError != 0) { - return -1; + + if (errorCodePtr == NULL || (statePtr->flags & TCP_NONBLOCKING)) { + timeout = 0; } else { - return 0; + timeout = -1; + } + do { + if (TclUnixWaitForFile(statePtr->fds.fd, + TCL_WRITABLE | TCL_EXCEPTION, timeout) != 0) { + TcpConnect(NULL, statePtr); + } + /* Do this only once in the nonblocking case and repeat it until the + * socket is final when blocking */ + } while (timeout == -1 && statePtr->flags & TCP_ASYNC_CONNECT); + + if (errorCodePtr != NULL) { + if (statePtr->flags & TCP_ASYNC_PENDING) { + *errorCodePtr = EAGAIN; + return -1; + } else if (statePtr->connectError != 0) { + *errorCodePtr = ENOTCONN; + return -1; + } } + return 0; } /* @@ -462,9 +501,7 @@ TcpInputProc( int bytesRead; *errorCodePtr = 0; - if (WaitForConnect(statePtr, 0) != 0) { - *errorCodePtr = statePtr->connectError; - statePtr->connectError = 0; + if (WaitForConnect(statePtr, errorCodePtr) != 0) { return -1; } bytesRead = recv(statePtr->fds.fd, buf, (size_t) bufSize, 0); @@ -514,9 +551,7 @@ TcpOutputProc( int written; *errorCodePtr = 0; - if (WaitForConnect(statePtr, 0) != 0) { - *errorCodePtr = statePtr->connectError; - statePtr->connectError = 0; + if (WaitForConnect(statePtr, errorCodePtr) != 0) { return -1; } written = send(statePtr->fds.fd, buf, (size_t) toWrite, 0); @@ -744,7 +779,7 @@ TcpGetOptionProc( TcpState *statePtr = instanceData; size_t len = 0; - WaitForConnect(statePtr, 1); + WaitForConnect(statePtr, NULL); if (optionName != NULL) { len = strlen(optionName); @@ -888,7 +923,7 @@ TcpWatchProc( return; } - if (statePtr->flags & TCP_ASYNC_CONNECT) { + if (statePtr->flags & TCP_ASYNC_PENDING) { /* Async sockets use a FileHandler internally while connecting, so we * need to cache this request until the connection has succeeded. */ statePtr->filehandlers = mask; @@ -988,8 +1023,8 @@ TcpConnect( TcpState *statePtr) { socklen_t optlen; - int async_callback = (statePtr->addr != NULL); - int ret = -1, error = 0; + int async_callback = statePtr->flags & TCP_ASYNC_PENDING; + int ret = -1, error; int async = statePtr->flags & TCP_ASYNC_CONNECT; if (async_callback) { @@ -998,9 +1033,10 @@ TcpConnect( for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL; statePtr->addr = statePtr->addr->ai_next) { + for (statePtr->myaddr = statePtr->myaddrlist; statePtr->myaddr != NULL; statePtr->myaddr = statePtr->myaddr->ai_next) { - int reuseaddr; + int reuseaddr = 1; /* * No need to try combinations of local and remote addresses of @@ -1047,7 +1083,10 @@ TcpConnect( } } - reuseaddr = 1; + /* Gotta reset the error variable here, before we use it for the + * first time in this iteration. */ + error = 0; + (void) setsockopt(statePtr->fds.fd, SOL_SOCKET, SO_REUSEADDR, (char *) &reuseaddr, sizeof(reuseaddr)); ret = bind(statePtr->fds.fd, statePtr->myaddr->ai_addr, @@ -1070,10 +1109,12 @@ TcpConnect( if (ret < 0 && errno == EINPROGRESS) { Tcl_CreateFileHandler(statePtr->fds.fd, TCL_WRITABLE|TCL_EXCEPTION, TcpAsyncCallback, statePtr); - statePtr->connectError = errno = EWOULDBLOCK; + errno = EWOULDBLOCK; + SET_BITS(statePtr->flags, TCP_ASYNC_PENDING); return TCL_OK; reenter: + CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING); Tcl_DeleteFileHandler(statePtr->fds.fd); /* @@ -1106,6 +1147,10 @@ out: TcpWatchProc(statePtr, statePtr->filehandlers); TclUnixSetBlockingMode(statePtr->fds.fd, statePtr->cachedBlocking); + if (error != 0) { + SET_BITS(statePtr->flags, TCP_ASYNC_FAILED); + } + /* * We need to forward the writable event that brought us here, bcasue * upon reading of getsockopt(SO_ERROR), at least some OSes clear the @@ -1115,7 +1160,11 @@ out: * the event mechanism one roundtrip through select(). */ + /* Note: disabling this for now as it causes spurious event triggering + * under Linux (see test socket-14.15). */ +#if 0 Tcl_NotifyChannel(statePtr->channel, TCL_WRITABLE); +#endif } if (error != 0) { /* -- cgit v0.12 From 60ed1a9051fbb233b229facc524d7a2aed49a18b Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 2 May 2014 15:19:57 +0000 Subject: Fixup restacking tests to expect the right results. --- tests/ioTrans.test | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/tests/ioTrans.test b/tests/ioTrans.test index 3bbd170..7f4f7f0 100644 --- a/tests/ioTrans.test +++ b/tests/ioTrans.test @@ -539,7 +539,7 @@ test iortrans-4.8 {chan read, read, bug 2921116} -setup { tempdone rename foo {} } -result {{read rt* {test data -}} file*} +}} {}} test iortrans-4.8.1 {chan read, bug 721ec69271} -setup { set res {} } -match glob -body { @@ -557,8 +557,8 @@ test iortrans-4.8.1 {chan read, bug 721ec69271} -setup { } -cleanup { tempdone rename foo {} -} -result {{read rt* {test data -}} file*} +} -result {{read rt* te} {read rt* st} {read rt* { d}} {read rt* at} {read rt* {a +}} {}} test iortrans-4.8.2 {chan read, bug 721ec69271} -setup { set res {} } -match glob -body { @@ -577,8 +577,8 @@ test iortrans-4.8.2 {chan read, bug 721ec69271} -setup { } -cleanup { tempdone rename foo {} -} -result {{read rt* {test data -}} file*} +} -result {{read rt* t} {read rt* e} {read rt* s} {read rt* t} {read rt* { }} {read rt* d} {read rt* a} {read rt* t} {read rt* a} {read rt* { +}} {}} test iortrans-4.9 {chan read, gets, bug 2921116} -setup { set res {} } -match glob -body { @@ -596,7 +596,7 @@ test iortrans-4.9 {chan read, gets, bug 2921116} -setup { tempdone rename foo {} } -result {{read rt* {test data -}} file*} +}} {}} # --- === *** ########################### # method write (via puts) -- cgit v0.12 From 4a18366f17a69027323e8f2c479aab89a9f6ae81 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 2 May 2014 15:35:14 +0000 Subject: Re-apply [3010352], bringing back the symbol exports of shared libraries as it was in 8.6.0/8.6.1. --- generic/tcl.h | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/generic/tcl.h b/generic/tcl.h index b93b3ac..e557290 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2433,9 +2433,15 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); /* * Include platform specific public function declarations that are accessible - * via the stubs table. + * via the stubs table. Make all TclOO symbols MODULE_SCOPE (which only + * has effect on building it as a shared library). See ticket [3010352]. */ +#if defined(BUILD_tcl) +# undef TCLAPI +# define TCLAPI MODULE_SCOPE +#endif + #include "tclPlatDecls.h" /* -- cgit v0.12 From d9866626fadb0a1c94f0317d07cb7dcb5dfd7c86 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 6 May 2014 11:17:28 +0000 Subject: Start working on [3389978]. Appears to work, but some clean-up needed. --- tests/winFCmd.test | 4 ++-- win/tclWinFile.c | 32 ++++++++++++++++++++++++++++++-- 2 files changed, 32 insertions(+), 4 deletions(-) diff --git a/tests/winFCmd.test b/tests/winFCmd.test index bd50328..28257c6 100644 --- a/tests/winFCmd.test +++ b/tests/winFCmd.test @@ -1385,10 +1385,10 @@ test winFCmd-19.5 {Windows extended path names} -constraints nt -setup { list [catch { set f [open $tmpfile [list WRONLY CREAT]] close $f - } res] errormsg ;#$res + } res] $res } -cleanup { catch {file delete $tmpfile} -} -result [list 1 errormsg] +} -result [list 0 {}] test winFCmd-19.6 {Windows extended path names} -constraints nt -setup { set tmpfile [file join $::env(TEMP) tcl[string repeat x 248].tmp] set tmpfile //?/[file normalize $tmpfile] diff --git a/win/tclWinFile.c b/win/tclWinFile.c index fc0ac9e..e32cd94 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -2930,8 +2930,36 @@ TclNativeCreateNativeRep( Tcl_WinUtfToTChar(str, len, &ds); len = Tcl_DStringLength(&ds) + sizeof(WCHAR); wp = (WCHAR *) Tcl_DStringValue(&ds); - for (i=sizeof(WCHAR); i|", *wp) ){ + i=sizeof(WCHAR); + if ((wp[0]=='/'||wp[0]=='\\') && (wp[1]=='/'||wp[1]=='\\')) { + if (wp[2]=='?'){ + /* Extended path prefix: convert slashes but not the '?' */ + wp[0] = wp[1] = wp[3] = '\\'; + i += 8; wp+=4; + if (((wp[0]>='A'&&wp[0]<='Z') || (wp[0]>='a'&&wp[0]<='z')) + && (wp[1]==':') && (wp[2]=='/' || wp[2]=='\\')) { + /* With drive, don't convert the ':' */ + i += 4; wp+=2; + } + } + } else { + if (((wp[0]>='A'&&wp[0]<='Z') || (wp[0]>='a'&&wp[0]<='z')) + && (wp[1]==':') && (wp[2]=='/' || wp[2]=='\\')) { + /* With drive, don't convert the ':' */ + i += 4; wp+=2; + if (len > (MAX_PATH * sizeof(WCHAR))){ + /* Path is too long, needs an extended path prefix. */ + Tcl_DStringSetLength(&ds, len+=8); + Tcl_DStringSetLength(&ds, len+1); /* Must end with two NUL bytes */ + wp = (WCHAR *) Tcl_DStringValue(&ds); /* wp might be re-allocated */ + memmove(wp+4, wp, len-8); + memcpy(wp, L"\\\\?\\", 8); + i+=12; wp += 6; + } + } + } + for (; i?|", *wp) ){ if (!*wp){ /* See bug [3118489]: NUL in filenames */ Tcl_DecrRefCount(validPathPtr); -- cgit v0.12 From e3ee9f9e15df60c47593c2b50c17fefef1909e1d Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 6 May 2014 15:23:43 +0000 Subject: Add Panic call to better identify where iogt-2.5 goes wrong. --- generic/tclIO.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/generic/tclIO.c b/generic/tclIO.c index 58c7b3c..6bf28a1 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -2311,6 +2311,9 @@ static void PreserveChannelBuffer( ChannelBuffer *bufPtr) { + if (bufPtr->refCount == 0) { + Tcl_Panic("Reuse of ChannelBuffer!"); + } bufPtr->refCount++; } -- cgit v0.12 From 6c0d722a0a6753769d3f933a724a37667f176638 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 6 May 2014 17:33:55 +0000 Subject: Symptom relief. Make test stop panicking. This is not the proper final answer. ChannelBuffer management in FlushChannel is simply not robustly correct yet. --- generic/tclIO.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 6bf28a1..dd4d489 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -2713,8 +2713,11 @@ FlushChannel( statePtr->outQueueTail = NULL; } RecycleBuffer(statePtr, bufPtr, 0); + bufPtr = NULL; + } + if (bufPtr) { + ReleaseChannelBuffer(bufPtr); } - ReleaseChannelBuffer(bufPtr); } /* Closes "while (1)". */ /* -- cgit v0.12 From b622ae7f2419b531a196cd2fe0ac570f195bf030 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 7 May 2014 22:22:02 +0000 Subject: Corrected description of where tcl_platform(user) comes from on Unix. --- doc/tclvars.n | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/tclvars.n b/doc/tclvars.n index 9d7a4ce..48ab83a 100644 --- a/doc/tclvars.n +++ b/doc/tclvars.n @@ -347,8 +347,8 @@ was compiled with threads enabled. . This identifies the current user based on the login information available on the platform. -This comes from the USER or LOGNAME environment variable on Unix, -and the value from GetUserName on Windows. +This value comes from the getuid() and getpwuid() system calls on Unix, +and the value from the GetUserName() system call on Windows. .TP \fBwordSize\fR . -- cgit v0.12 From 435b75fc24a85e806029ac4159863e6bf87b6412 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 8 May 2014 12:46:47 +0000 Subject: More efficient/robust implementation of function TclNativeCreateNativeRep(). - No more intermediate results in a Tcl_DString, just allocate space directly. - Let MultiByteToWideChar() do all the difficult work, inclusive checking for invalid byte sequences. - Handled extended win32 paths, inclusive UNC paths. Implementation for a great deal taken over from fossil. --- win/tclWinFile.c | 109 ++++++++++++++++++++++++++++++++----------------------- 1 file changed, 63 insertions(+), 46 deletions(-) diff --git a/win/tclWinFile.c b/win/tclWinFile.c index e32cd94..5761eeb 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -2897,10 +2897,10 @@ ClientData TclNativeCreateNativeRep( Tcl_Obj *pathPtr) { - char *nativePathPtr, *str; - Tcl_DString ds; + WCHAR *nativePathPtr; + const char *str; Tcl_Obj *validPathPtr; - int len, i = 2; + int len; WCHAR *wp; if (TclFSCwdIsNative()) { @@ -2927,55 +2927,72 @@ TclNativeCreateNativeRep( } str = Tcl_GetStringFromObj(validPathPtr, &len); - Tcl_WinUtfToTChar(str, len, &ds); - len = Tcl_DStringLength(&ds) + sizeof(WCHAR); - wp = (WCHAR *) Tcl_DStringValue(&ds); - i=sizeof(WCHAR); - if ((wp[0]=='/'||wp[0]=='\\') && (wp[1]=='/'||wp[1]=='\\')) { - if (wp[2]=='?'){ - /* Extended path prefix: convert slashes but not the '?' */ - wp[0] = wp[1] = wp[3] = '\\'; - i += 8; wp+=4; - if (((wp[0]>='A'&&wp[0]<='Z') || (wp[0]>='a'&&wp[0]<='z')) - && (wp[1]==':') && (wp[2]=='/' || wp[2]=='\\')) { - /* With drive, don't convert the ':' */ - i += 4; wp+=2; - } - } - } else { - if (((wp[0]>='A'&&wp[0]<='Z') || (wp[0]>='a'&&wp[0]<='z')) - && (wp[1]==':') && (wp[2]=='/' || wp[2]=='\\')) { - /* With drive, don't convert the ':' */ - i += 4; wp+=2; - if (len > (MAX_PATH * sizeof(WCHAR))){ - /* Path is too long, needs an extended path prefix. */ - Tcl_DStringSetLength(&ds, len+=8); - Tcl_DStringSetLength(&ds, len+1); /* Must end with two NUL bytes */ - wp = (WCHAR *) Tcl_DStringValue(&ds); /* wp might be re-allocated */ - memmove(wp+4, wp, len-8); - memcpy(wp, L"\\\\?\\", 8); - i+=12; wp += 6; - } + + if (strlen(str)!=len) { + /* String contains NUL-bytes. This is invalid. */ + return 0; + } + /* Let MultiByteToWideChar check for other invalid sequences, like + * 0xC0 0x80 (== overlong NUL). See bug [3118489]: NUL in filenames */ + len = MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, 0, 0); + if (len==0) { + return 0; + } + /* Overallocate 6 chars, making some room for extended paths */ + wp = nativePathPtr = ckalloc( (len+6) * sizeof(WCHAR) ); + if (nativePathPtr==0) { + return 0; + } + MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr, len); + /* + ** If path starts with "//?/" or "\\?\" (extended path), translate + ** any slashes to backslashes but leave the '?' intact + */ + if ((str[0]=='\\' || str[0]=='/') && (str[1]=='\\' || str[1]=='/') + && str[2]=='?' && (str[3]=='\\' || str[3]=='/')) { + wp[0] = wp[1] = wp[3] = '\\'; + str += 4; + wp += 4; + } + /* + ** If there is no "\\?\" prefix but there is a drive or UNC + ** path prefix and the path is larger than MAX_PATH chars, + ** no Win32 API function can handle that unless it is + ** prefixed with the extended path prefix. See: + ** + **/ + if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z')) + && str[1]==':' && (str[2]=='\\' || str[2]=='/')) { + if (wp==nativePathPtr && len>MAX_PATH) { + memmove(wp+4, wp, len*sizeof(WCHAR)); + memcpy(wp, L"\\\\?\\", 4*sizeof(WCHAR)); + wp += 4; } + /* + ** If (remainder of) path starts with ":/" or ":\", + ** leave the ':' intact but translate the backslash to a slash. + */ + wp[2] = '\\'; + wp += 3; + } else if (wp==nativePathPtr && len>MAX_PATH + && (str[0]=='\\' || str[0]=='/') + && (str[1]=='\\' || str[1]=='/') && str[2]!='?') { + memmove(wp+6, wp, len*sizeof(WCHAR)); + memcpy(wp, L"\\\\?\\UNC", 7*sizeof(WCHAR)); + wp += 7; } - for (; i?|", *wp) ){ - if (!*wp){ - /* See bug [3118489]: NUL in filenames */ - Tcl_DecrRefCount(validPathPtr); - Tcl_DStringFree(&ds); - return NULL; - } + /* + ** In the remainder of the path, translate invalid characters to + ** characters in the Unicode private use area. + */ + while (*wp != '\0') { + if ((*wp < ' ') || wcschr(L"\"*:<>?|", *wp)) { *wp |= 0xF000; - }else if (*wp=='/') { + } else if (*wp == '/') { *wp = '\\'; } + ++wp; } - Tcl_DecrRefCount(validPathPtr); - nativePathPtr = ckalloc(len); - memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len); - - Tcl_DStringFree(&ds); return nativePathPtr; } -- cgit v0.12 From 882794a48ef4c92e617a0c6bec02c14ec64d63cf Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 8 May 2014 13:01:47 +0000 Subject: Revert the iogt-2.5 fix. For now one panic is better than widespread memory leaks. --- generic/tclIO.c | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index d69a3d9..678dc4b 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -2716,11 +2716,8 @@ FlushChannel( statePtr->outQueueTail = NULL; } RecycleBuffer(statePtr, bufPtr, 0); - bufPtr = NULL; - } - if (bufPtr) { - ReleaseChannelBuffer(bufPtr); } + ReleaseChannelBuffer(bufPtr); } /* Closes "while (1)". */ /* -- cgit v0.12 From 4f9f25fc55b73b0eb82e118bb35b6e41ce173a27 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 8 May 2014 16:03:50 +0000 Subject: Fix the panic in iogt-2.5. Back in 2011, Bugs 3384654 and 3393276 first noticed troubles with ChannelBuffer sharing, but the magnitude of the problem wasn't truly grasped. A fix was applied that turned out to be more of a band-aid workaround. Now that the real fix is in place, the band-aid is actually preventing it working properly in thie case. Rip it off! --- generic/tclIO.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 678dc4b..8dd9218 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -2312,7 +2312,7 @@ PreserveChannelBuffer( ChannelBuffer *bufPtr) { if (bufPtr->refCount == 0) { - Tcl_Panic("Reuse of ChannelBuffer!"); + Tcl_Panic("Reuse of ChannelBuffer! %p", bufPtr); } bufPtr->refCount++; } @@ -2702,9 +2702,7 @@ FlushChannel( wroteSome = 1; } - if (!IsBufferEmpty(bufPtr)) { - bufPtr->nextRemoved += written; - } + bufPtr->nextRemoved += written; /* * If this buffer is now empty, recycle it. -- cgit v0.12 From 501a64ea84e7ed50d4b814d335b41475cc535754 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 8 May 2014 16:21:12 +0000 Subject: silence compiler warning --- generic/tclIORChan.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 12fa4a0..0b462c4 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -1111,7 +1111,7 @@ ReflectClose( ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in * this interp */ Tcl_HashEntry *hPtr; /* Entry in the above map */ - Tcl_ChannelType *tctPtr; + const Tcl_ChannelType *tctPtr; if (TclInThreadExit()) { /* @@ -2881,7 +2881,7 @@ ForwardProc( * No parameters/results. */ - Tcl_ChannelType *tctPtr; + const Tcl_ChannelType *tctPtr; if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) { ForwardSetObjError(paramPtr, resObj); -- cgit v0.12 From f3283e67a3037b34b0a3811bab9e09333c13d8f4 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 9 May 2014 17:46:45 +0000 Subject: Repair another "impossible" test and the segfault it reveals. --- generic/tclIORTrans.c | 2 ++ tests/ioTrans.test | 10 +++++----- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 1de635f..1dff4b3 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -2010,6 +2010,7 @@ InvokeTclMethod( sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */); Tcl_Preserve(rtPtr); + Tcl_Preserve(rtPtr->interp); result = Tcl_EvalObjv(rtPtr->interp, cmdc, rtPtr->argv, TCL_EVAL_GLOBAL); /* @@ -2054,6 +2055,7 @@ InvokeTclMethod( Tcl_IncrRefCount(resObj); } Tcl_RestoreInterpState(rtPtr->interp, sr); + Tcl_Release(rtPtr->interp); Tcl_Release(rtPtr); /* diff --git a/tests/ioTrans.test b/tests/ioTrans.test index 7f4f7f0..c40621b 100644 --- a/tests/ioTrans.test +++ b/tests/ioTrans.test @@ -1034,7 +1034,7 @@ test iortrans-11.1 {origin interpreter of moved transform destroyed during acces # Magic to get the test* commands in the slaves load {} Tcltest $ida load {} Tcltest $idb -} -constraints {testchannel impossible} -match glob -body { +} -constraints {testchannel} -match glob -body { # Set up channel in thread set chan [interp eval $ida $helperscript] set chan [interp eval $ida { @@ -1042,14 +1042,14 @@ test iortrans-11.1 {origin interpreter of moved transform destroyed during acces handle.initialize clear drain flush limit? read write handle.finalize lappend ::res $args - # Destroy interpreter during channel access. Actually not - # possible for an interp to destroy itself. - interp delete {} - return} + # Destroy interpreter during channel access. + suicide + } set chan [chan push [tempchan] foo] fconfigure $chan -buffering none set chan }] + interp alias $ida suicide {} interp delete $ida # Move channel to 2nd thread, transform goes with it. interp eval $ida [list testchannel cut $chan] interp eval $idb [list testchannel splice $chan] -- cgit v0.12 From f779f4219c9a9bdc0c7cd766fbb0e9564936bdd9 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 11 May 2014 10:39:14 +0000 Subject: [6d2f249a01] Handle a failure to comprehend half-way through the compilation of a chain of compileable ensembles. --- generic/tclEnsemble.c | 24 +++++++++++++++++------- tests/namespace.test | 4 ++++ 2 files changed, 21 insertions(+), 7 deletions(-) diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 9bb7a0c..022dafa 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -2751,13 +2751,6 @@ TclCompileEnsemble( const char *word; Tcl_IncrRefCount(replaced); - - /* - * This is where we return to if we are parsing multiple nested compiled - * ensembles. [info object] is such a beast. - */ - - checkNextWord: if (parsePtr->numWords < depth + 1) { goto failed; } @@ -2769,6 +2762,12 @@ TclCompileEnsemble( goto failed; } + /* + * This is where we return to if we are parsing multiple nested compiled + * ensembles. [info object] is such a beast. + */ + + checkNextWord: word = tokenPtr[1].start; numBytes = tokenPtr[1].size; @@ -2979,6 +2978,17 @@ TclCompileEnsemble( if (cmdPtr->compileProc == TclCompileEnsemble) { tokenPtr = TokenAfter(tokenPtr); + if (parsePtr->numWords < depth + 1 + || tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + /* + * Too hard because the user has done something unpleasant like + * omitting the sub-ensemble's command name or used a non-constant + * name for a sub-ensemble's command name; we respond by bailing + * out completely (this is a rare case). [Bug 6d2f249a01] + */ + + goto cleanup; + } ensemble = (Tcl_Command) cmdPtr; goto checkNextWord; } diff --git a/tests/namespace.test b/tests/namespace.test index fab0040..cded1f4 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -2949,6 +2949,10 @@ test namespace-54.1 {leak on namespace deletion} -constraints {memory} \ rename getbytes {} unset i ns start end } -result 0 + +test namespace-55.1 {compiled ensembles inside compiled ensembles: Bug 6d2f249a01} { + info class [format %s constructor] oo::object +} "" # cleanup catch {rename cmd1 {}} -- cgit v0.12 From ec5c5c277f107a8e3cd0e40160019687d18f001b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 12 May 2014 13:09:00 +0000 Subject: Possible fix for [47d66253c92197d30bff280b02e0a9e62f07cee2|47d66253c9]: "lsearch -sorted -integer" on 64bit system --- generic/tclCmdIL.c | 29 +++++++++++++++-------------- generic/tclExecute.c | 24 ------------------------ generic/tclInt.h | 24 ++++++++++++++++++++++++ 3 files changed, 39 insertions(+), 38 deletions(-) diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 41c1eb6..db216e5 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -29,7 +29,7 @@ typedef struct SortElement { union { /* The value that we sorting by. */ const char *strValuePtr; - long intValue; + Tcl_WideInt wideValue; double doubleValue; Tcl_Obj *objValuePtr; } collationKey; @@ -2893,7 +2893,8 @@ Tcl_LsearchObjCmd( { const char *bytes, *patternBytes; int i, match, index, result, listc, length, elemLen, bisect; - int dataType, isIncreasing, lower, upper, patInt, objInt, offset; + int dataType, isIncreasing, lower, upper, offset; + Tcl_WideInt patWide, objWide; int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase; double patDouble, objDouble; SortInfo sortInfo; @@ -3212,7 +3213,7 @@ Tcl_LsearchObjCmd( patternBytes = TclGetStringFromObj(patObj, &length); break; case INTEGER: - result = TclGetIntFromObj(interp, patObj, &patInt); + result = TclGetWideIntFromObj(interp, patObj, &patWide); if (result != TCL_OK) { goto done; } @@ -3281,13 +3282,13 @@ Tcl_LsearchObjCmd( match = DictionaryCompare(patternBytes, bytes); break; case INTEGER: - result = TclGetIntFromObj(interp, itemPtr, &objInt); + result = TclGetWideIntFromObj(interp, itemPtr, &objWide); if (result != TCL_OK) { goto done; } - if (patInt == objInt) { + if (patWide == objWide) { match = 0; - } else if (patInt < objInt) { + } else if (patWide < objWide) { match = -1; } else { match = 1; @@ -3400,14 +3401,14 @@ Tcl_LsearchObjCmd( break; case INTEGER: - result = TclGetIntFromObj(interp, itemPtr, &objInt); + result = TclGetWideIntFromObj(interp, itemPtr, &objWide); if (result != TCL_OK) { if (listPtr != NULL) { Tcl_DecrRefCount(listPtr); } goto done; } - match = (objInt == patInt); + match = (objWide == patWide); break; case REAL: @@ -3971,13 +3972,13 @@ Tcl_LsortObjCmd( if (sortMode == SORTMODE_ASCII) { elementArray[i].collationKey.strValuePtr = TclGetString(indexPtr); } else if (sortMode == SORTMODE_INTEGER) { - long a; + Tcl_WideInt a; - if (TclGetLongFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) { + if (TclGetWideIntFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) { sortInfo.resultCode = TCL_ERROR; goto done1; } - elementArray[i].collationKey.intValue = a; + elementArray[i].collationKey.wideValue = a; } else if (sortMode == SORTMODE_REAL) { double a; @@ -4226,10 +4227,10 @@ SortCompare( order = DictionaryCompare(elemPtr1->collationKey.strValuePtr, elemPtr2->collationKey.strValuePtr); } else if (infoPtr->sortMode == SORTMODE_INTEGER) { - long a, b; + Tcl_WideInt a, b; - a = elemPtr1->collationKey.intValue; - b = elemPtr2->collationKey.intValue; + a = elemPtr1->collationKey.wideValue; + b = elemPtr2->collationKey.wideValue; order = ((a >= b) - (a <= b)); } else if (infoPtr->sortMode == SORTMODE_REAL) { double a, b; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 4ecca5b..d8c5935 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -556,30 +556,6 @@ VarHashCreateVar( : Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr))) /* - * Macro used in this file to save a function call for common uses of - * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is: - * - * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - * Tcl_WideInt *wideIntPtr); - */ - -#ifdef TCL_WIDE_INT_IS_LONG -#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ - (((objPtr)->typePtr == &tclIntType) \ - ? (*(wideIntPtr) = (Tcl_WideInt) \ - ((objPtr)->internalRep.longValue), TCL_OK) : \ - Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) -#else /* !TCL_WIDE_INT_IS_LONG */ -#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ - (((objPtr)->typePtr == &tclWideIntType) \ - ? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) : \ - ((objPtr)->typePtr == &tclIntType) \ - ? (*(wideIntPtr) = (Tcl_WideInt) \ - ((objPtr)->internalRep.longValue), TCL_OK) : \ - Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) -#endif /* TCL_WIDE_INT_IS_LONG */ - -/* * Macro used to make the check for type overflow more mnemonic. This works by * comparing sign bits; the rest of the word is irrelevant. The ANSI C * "prototype" (where inttype_t is any integer type) is: diff --git a/generic/tclInt.h b/generic/tclInt.h index d775a4a..b1a368e 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2453,6 +2453,30 @@ typedef struct List { #endif /* + * Macro used to save a function call for common uses of + * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is: + * + * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, + * Tcl_WideInt *wideIntPtr); + */ + +#ifdef TCL_WIDE_INT_IS_LONG +#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ + (((objPtr)->typePtr == &tclIntType) \ + ? (*(wideIntPtr) = (Tcl_WideInt) \ + ((objPtr)->internalRep.longValue), TCL_OK) : \ + Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) +#else /* !TCL_WIDE_INT_IS_LONG */ +#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ + (((objPtr)->typePtr == &tclWideIntType) \ + ? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) : \ + ((objPtr)->typePtr == &tclIntType) \ + ? (*(wideIntPtr) = (Tcl_WideInt) \ + ((objPtr)->internalRep.longValue), TCL_OK) : \ + Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) +#endif /* TCL_WIDE_INT_IS_LONG */ + +/* * Flag values for TclTraceDictPath(). * * DICT_PATH_READ indicates that all entries on the path must exist but no -- cgit v0.12 From 19b4d8d7fb173813c59f7281e52922921ef9f3cb Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 12 May 2014 17:19:16 +0000 Subject: Have the [chan push] machinery ReadRaw() directly into the argument to be passed to the read method of the channel transformation command. Save a copy. --- generic/tclIORTrans.c | 34 ++++++++++++++++++++-------------- 1 file changed, 20 insertions(+), 14 deletions(-) diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 1dff4b3..b9dd1d6 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -457,8 +457,7 @@ static void TimerKill(ReflectedTransform *rtPtr); static void TimerSetup(ReflectedTransform *rtPtr); static void TimerRun(ClientData clientData); static int TransformRead(ReflectedTransform *rtPtr, - int *errorCodePtr, unsigned char *buf, - int toRead); + int *errorCodePtr, Tcl_Obj *bufObj); static int TransformWrite(ReflectedTransform *rtPtr, int *errorCodePtr, unsigned char *buf, int toWrite); @@ -1063,6 +1062,7 @@ ReflectInput( { ReflectedTransform *rtPtr = clientData; int gotBytes, copied, readBytes; + Tcl_Obj *bufObj; /* * The following check can be done before thread redirection, because we @@ -1078,6 +1078,9 @@ ReflectInput( Tcl_Preserve(rtPtr); + /* TODO: Consider a more appropriate buffer size. */ + bufObj = Tcl_NewByteArrayObj(NULL, toRead); + Tcl_IncrRefCount(bufObj); gotBytes = 0; while (toRead > 0) { /* @@ -1129,7 +1132,9 @@ ReflectInput( goto stop; } - readBytes = Tcl_ReadRaw(rtPtr->parent, buf, toRead); + + readBytes = Tcl_ReadRaw(rtPtr->parent, + (char *) Tcl_SetByteArrayLength(bufObj, toRead), toRead); if (readBytes < 0) { /* * Report errors to caller. The state of the seek system is @@ -1213,12 +1218,20 @@ ReflectInput( * iteration will put it into the result. */ - if (!TransformRead(rtPtr, errorCodePtr, UCHARP(buf), readBytes)) { + Tcl_SetByteArrayLength(bufObj, readBytes); + if (!TransformRead(rtPtr, errorCodePtr, bufObj)) { goto error; } + if (Tcl_IsShared(bufObj)) { + Tcl_DecrRefCount(bufObj); + bufObj = Tcl_NewObj(); + Tcl_IncrRefCount(bufObj); + } + Tcl_SetByteArrayLength(bufObj, 0); } /* while toRead > 0 */ stop: + Tcl_DecrRefCount(bufObj); Tcl_Release(rtPtr); return gotBytes; @@ -3067,10 +3080,8 @@ static int TransformRead( ReflectedTransform *rtPtr, int *errorCodePtr, - unsigned char *buf, - int toRead) + Tcl_Obj *bufObj) { - Tcl_Obj *bufObj; Tcl_Obj *resObj; int bytec; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ @@ -3083,8 +3094,8 @@ TransformRead( if (rtPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; - p.transform.buf = (char *) buf; - p.transform.size = toRead; + p.transform.buf = (char *) Tcl_GetByteArrayFromObj(bufObj, + &(p.transform.size)); ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p); @@ -3104,12 +3115,8 @@ TransformRead( /* ASSERT: rtPtr->method & FLAG(METH_READ) */ /* ASSERT: rtPtr->mode & TCL_READABLE */ - bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toRead); - Tcl_IncrRefCount(bufObj); - if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) { Tcl_SetChannelError(rtPtr->chan, resObj); - Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ *errorCodePtr = EINVAL; return 0; @@ -3118,7 +3125,6 @@ TransformRead( bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); ResultAdd(&rtPtr->result, bytev, bytec); - Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ return 1; } -- cgit v0.12 From e14f3688ed41e7bcae1a5448ba213d5d8d063ecf Mon Sep 17 00:00:00 2001 From: ferrieux Date: Fri, 16 May 2014 21:33:41 +0000 Subject: Let the generated Makefile be emacs-friendly by avoiding spurious empty lines and misplaced tabs. Useful e.g. to just set CFLAGS to debug and save. --- unix/Makefile.in | 2 ++ unix/configure | 3 +++ unix/configure.in | 3 +++ win/Makefile.in | 2 ++ 4 files changed, 10 insertions(+) diff --git a/unix/Makefile.in b/unix/Makefile.in index 69dd14f..f151ebb 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -2089,9 +2089,11 @@ alldist: dist html: ${NATIVE_TCLSH} $(BUILD_HTML) @EXTRA_BUILD_HTML@ + html-tcl: ${NATIVE_TCLSH} $(BUILD_HTML) --tcl @EXTRA_BUILD_HTML@ + html-tk: ${NATIVE_TCLSH} $(BUILD_HTML) --tk @EXTRA_BUILD_HTML@ diff --git a/unix/configure b/unix/configure index ce5db6a..bd85ba4 100755 --- a/unix/configure +++ b/unix/configure @@ -1338,6 +1338,9 @@ TCL_MINOR_VERSION=6 TCL_PATCH_LEVEL=".1" VERSION=${TCL_VERSION} +EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} +EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"} + #------------------------------------------------------------------------ # Setup configure arguments for bundled packages #------------------------------------------------------------------------ diff --git a/unix/configure.in b/unix/configure.in index 61ad30f..cb6cf82 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -28,6 +28,9 @@ TCL_MINOR_VERSION=6 TCL_PATCH_LEVEL=".1" VERSION=${TCL_VERSION} +EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} +EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"} + #------------------------------------------------------------------------ # Setup configure arguments for bundled packages #------------------------------------------------------------------------ diff --git a/win/Makefile.in b/win/Makefile.in index fd80010..67cf66a 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -850,8 +850,10 @@ TOOL_DIR=$(ROOT_DIR)/tools HTML_INSTALL_DIR=$(ROOT_DIR)/html html: $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS)" + html-tcl: $(TCLSH) $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tcl" + html-tk: $(TCLSH) $(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tk" -- cgit v0.12 From c0033298fb580b7384b19cd188887af3ca9de2ba Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 16 May 2014 23:17:15 +0000 Subject: Merge flag changes. - Wow, no trouble with [chan push] demonstrated. --- generic/tclIO.c | 76 ++++++++++++++++++++++++++++----------------------------- 1 file changed, 37 insertions(+), 39 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index fd1ce4f..8d9d3d8 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -421,6 +421,11 @@ ChanRead( */ assert(dstSize > 0); + /* + * Each read op must set the blocked and eof states anew, not let + * the effect of prior reads leak through. + */ + ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF); if (WillRead(chanPtr) < 0) { return -1; } @@ -4598,6 +4603,7 @@ Tcl_GetsObj( Tcl_SetObjLength(objPtr, oldLength); CommonGetsCleanup(chanPtr); copiedTotal = -1; + ResetFlag(statePtr, CHANNEL_BLOCKED); goto done; } goto gotEOL; @@ -4801,11 +4807,9 @@ TclGetsObjBinary( * device. Side effect is to allocate another channel buffer. */ - if (GotFlag(statePtr, CHANNEL_BLOCKED)) { - if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) { - goto restore; - } - ResetFlag(statePtr, CHANNEL_BLOCKED); + if (GotFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_NONBLOCKING) + == (CHANNEL_BLOCKED|CHANNEL_NONBLOCKING)) { + goto restore; } if (GetInput(chanPtr) != 0) { goto restore; @@ -4868,6 +4872,7 @@ TclGetsObjBinary( byteArray = Tcl_SetByteArrayLength(objPtr, oldLength); CommonGetsCleanup(chanPtr); copiedTotal = -1; + ResetFlag(statePtr, CHANNEL_BLOCKED); goto done; } goto gotEOL; @@ -5071,14 +5076,6 @@ FilterInputBytes( */ read: - if (GotFlag(statePtr, CHANNEL_BLOCKED)) { - if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) { - gsPtr->charsWrote = 0; - gsPtr->rawRead = 0; - return -1; - } - ResetFlag(statePtr, CHANNEL_BLOCKED); - } if (GetInput(chanPtr) != 0) { gsPtr->charsWrote = 0; gsPtr->rawRead = 0; @@ -5166,9 +5163,15 @@ FilterInputBytes( } else { /* * There are no more cached raw bytes left. See if we can get - * some more. + * some more, but avoid blocking on a non-blocking channel. */ + if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED) + == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) { + gsPtr->charsWrote = 0; + gsPtr->rawRead = 0; + return -1; + } goto read; } } else { @@ -5596,6 +5599,8 @@ DoReadChars( } } + /* Must clear the BLOCKED flag here since we check before reading */ + ResetFlag(statePtr, CHANNEL_BLOCKED); for (copied = 0; (unsigned) toRead > 0; ) { copiedNow = -1; if (statePtr->inQueueHead != NULL) { @@ -5625,11 +5630,9 @@ DoReadChars( if (GotFlag(statePtr, CHANNEL_EOF)) { break; } - if (GotFlag(statePtr, CHANNEL_BLOCKED)) { - if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) { - break; - } - ResetFlag(statePtr, CHANNEL_BLOCKED); + if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED) + == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) { + break; } result = GetInput(chanPtr); if (chanPtr != statePtr->topChanPtr) { @@ -6503,6 +6506,18 @@ GetInput( return EINVAL; } + /* + * For a channel at EOF do not bother allocating buffers; there's + * nothing more to read. Avoid calling the driver inputproc in + * case some of them do not react well to additional calls after + * they've reported an eof state.. + * TODO: Candidate for a can't happen panic. + */ + + if (GotFlag(statePtr, CHANNEL_EOF)) { + return 0; + } + /* * First check for more buffers in the pushback area of the topmost * channel in the stack and use them. They can be the result of a @@ -6567,16 +6582,6 @@ GetInput( statePtr->inQueueTail = bufPtr; } - /* - * TODO - consider escape before buffer alloc - * If EOF is set, we should avoid calling the driver because on some - * platforms it is impossible to read from a device after EOF. - */ - - if (GotFlag(statePtr, CHANNEL_EOF)) { - return 0; - } - PreserveChannelBuffer(bufPtr); nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead); @@ -7048,12 +7053,7 @@ CheckChannelErrors( } if (direction == TCL_READABLE) { - /* - * Clear the BLOCKED bit. We want to discover this condition - * anew in each operation. - */ - - ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA); + ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA); } return 0; @@ -9248,9 +9248,7 @@ DoRead( while (bufPtr == NULL || !IsBufferFull(bufPtr)) { int code; - ResetFlag(statePtr, CHANNEL_BLOCKED); moreData: - code = GetInput(chanPtr); bufPtr = statePtr->inQueueHead; @@ -9353,8 +9351,8 @@ DoRead( RecycleBuffer(statePtr, bufPtr, 0); } - if ((statePtr->flags & CHANNEL_NONBLOCKING || allowShortReads) - && statePtr->flags & CHANNEL_BLOCKED) { + if ((GotFlag(statePtr, CHANNEL_NONBLOCKING) || allowShortReads) + && GotFlag(statePtr, CHANNEL_BLOCKED)) { break; } } -- cgit v0.12 From acbdb9cde6294dbbac2559014328039d3cf8839e Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 17 May 2014 03:05:36 +0000 Subject: Revise results of tests iogt-2.[123] to account for EOF flags no longer leaking across channel stacks. --- tests/iogt.test | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tests/iogt.test b/tests/iogt.test index dd58df0..6cc0542 100644 --- a/tests/iogt.test +++ b/tests/iogt.test @@ -480,6 +480,7 @@ query/maxRead read query/maxRead flush/read +query/maxRead delete/read -------- create/write @@ -526,6 +527,7 @@ read { } query/maxRead {} -1 flush/read {} {} +query/maxRead {} -1 delete/read {} *ignored* -------- create/write {} *ignored* @@ -577,6 +579,7 @@ write %^&*()_+-= %^&*()_+-= write { } { } +query/maxRead {} -1 delete/read {} *ignored* flush/write {} {} delete/write {} *ignored*} -- cgit v0.12 From 055e5320555047ffa7b6a3c635374020ffbcd3ac Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 17 May 2014 03:38:28 +0000 Subject: Simplify the inputProc of [testchannel transform]. --- generic/tclIOGT.c | 41 ++++++++++++++++++----------------------- 1 file changed, 18 insertions(+), 23 deletions(-) diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index 6cc33eb..9c4347d 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -683,39 +683,34 @@ TransformInputProc( read = Tcl_ReadRaw(downChan, buf, toRead); if (read < 0) { - /* - * Report errors to caller. EAGAIN is a special situation. If we - * had some data before we report that instead of the request to - * re-try. - */ - int error = Tcl_GetErrno(); + if (Tcl_InputBlocked(downChan) && (gotBytes > 0)) { + /* + * Zero bytes available from downChan because blocked. + * But nonzero bytes already copied, so total is a + * valid blocked short read. Return to caller. + */ - if ((error == EAGAIN) && (gotBytes > 0)) { break; } - *errorCodePtr = error; + /* + * Either downChan is not blocked (there's a real error). + * or it is and there are no bytes copied yet. In either + * case we want to pass the "error" along to the caller, + * either to report an error, or to signal to the caller + * that zero bytes are available because blocked. + */ + + *errorCodePtr = Tcl_GetErrno(); gotBytes = -1; break; } else if (read == 0) { + /* - * Check wether we hit on EOF in the underlying channel or not. If - * not differentiate between blocking and non-blocking modes. In - * non-blocking mode we ran temporarily out of data. Signal this - * to the caller via EWOULDBLOCK and error return (-1). In the - * other cases we simply return what we got and let the caller - * wait for more. On the other hand, if we got an EOF we have to - * convert and flush all waiting partial data. + * Zero returned from Tcl_ReadRaw() always indicates EOF + * on the down channel. */ - if (!Tcl_Eof(downChan)) { - if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) { - *errorCodePtr = EWOULDBLOCK; - gotBytes = -1; - } - break; - } - if (dataPtr->readIsFlushed) { /* * Already flushed, nothing to do anymore. -- cgit v0.12 From fae66563f5f7dc9c3633a4f4d2e46e46c4ca7afc Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 19 May 2014 18:08:05 +0000 Subject: Simplify ReflectInput(). Also stop intruding on channel internals with direct clearing of CHANNEL_EOF flag. --- generic/tclIORTrans.c | 52 ++++++++++++++++----------------------------------- 1 file changed, 16 insertions(+), 36 deletions(-) diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index b9dd1d6..e6e552f 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -1136,50 +1136,36 @@ ReflectInput( readBytes = Tcl_ReadRaw(rtPtr->parent, (char *) Tcl_SetByteArrayLength(bufObj, toRead), toRead); if (readBytes < 0) { - /* - * Report errors to caller. The state of the seek system is - * unchanged! - */ + if (Tcl_InputBlocked(rtPtr->parent) && (gotBytes > 0)) { - if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) { /* - * EAGAIN is a special situation. If we had some data before - * we report that instead of the request to re-try. + * Down channel is blocked and offers zero additional bytes. + * The nonzero gotBytes already returned makes the total + * operation a valid short read. Return to caller. */ goto stop; } + /* + * Either the down channel is not blocked (a real error) + * or it is and there are gotBytes==0 byte copied so far. + * In either case, pass up the error, so we either report + * any real error, or do not mistakenly signal EOF by + * returning 0 to the caller. + */ + *errorCodePtr = Tcl_GetErrno(); goto error; } if (readBytes == 0) { + /* - * Check wether we hit on EOF in 'parent' or not. If not - * differentiate between blocking and non-blocking modes. In - * non-blocking mode we ran temporarily out of data. Signal this - * to the caller via EWOULDBLOCK and error return (-1). In the - * other cases we simply return what we got and let the caller - * wait for more. On the other hand, if we got an EOF we have to - * convert and flush all waiting partial data. + * Zero returned from Tcl_ReadRaw() always indicates EOF + * on the down channel. */ - - if (!Tcl_Eof(rtPtr->parent)) { - /* - * The state of the seek system is unchanged! - */ - - if ((gotBytes == 0) && rtPtr->nonblocking) { - *errorCodePtr = EWOULDBLOCK; - goto error; - } - goto stop; - } else { - /* - * Eof in parent. - */ - + if (rtPtr->readIsDrained) { goto stop; } @@ -1203,13 +1189,7 @@ ReflectInput( goto stop; } - /* - * Reset eof, force caller to drain result buffer. - */ - - ((Channel *) rtPtr->parent)->state->flags &= ~CHANNEL_EOF; continue; /* at: while (toRead > 0) */ - } } /* readBytes == 0 */ /* -- cgit v0.12 From ab71a62c9e9b8c57834e4b4deb60b59596ad9586 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 19 May 2014 18:29:26 +0000 Subject: Same improvements to the zlib transform operations. --- generic/tclZlib.c | 45 +++++---------------------------------------- 1 file changed, 5 insertions(+), 40 deletions(-) diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 9bceb4c..2e27303 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -2994,47 +2994,18 @@ ZlibTransformInput( */ if (readBytes < 0) { - /* - * Report errors to caller. The state of the seek system is - * unchanged! - */ - - if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) { - /* - * EAGAIN is a special situation. If we had some data before - * we report that instead of the request to re-try. - */ + /* See ReflectInput() in tclIORTrans.c */ + if (Tcl_InputBlocked(cd->parent) && (gotBytes > 0)) { return gotBytes; } *errorCodePtr = Tcl_GetErrno(); return -1; - } else if (readBytes == 0) { - /* - * Check wether we hit on EOF in 'parent' or not. If not, - * differentiate between blocking and non-blocking modes. In - * non-blocking mode we ran temporarily out of data. Signal this - * to the caller via EWOULDBLOCK and error return (-1). In the - * other cases we simply return what we got and let the caller - * wait for more. On the other hand, if we got an EOF we have to - * convert and flush all waiting partial data. - */ - - if (!Tcl_Eof(cd->parent)) { - /* - * The state of the seek system is unchanged! - */ - - if ((gotBytes == 0) && (cd->flags & ASYNC)) { - *errorCodePtr = EWOULDBLOCK; - return -1; - } - return gotBytes; - } - + } + if (readBytes == 0) { /* - * (Semi-)Eof in parent. + * Eof in parent. * * Now this is a bit different. The partial data waiting is * converted and returned. @@ -3052,12 +3023,6 @@ ZlibTransformInput( return gotBytes; } - - /* - * Reset eof, force caller to drain result buffer. - */ - - ((Channel *) cd->parent)->state->flags &= ~CHANNEL_EOF; } else /* readBytes > 0 */ { /* * Transform the read chunk, which was not empty. Anything we get -- cgit v0.12 From 69c75114013bbd847b7956f6bf3cd1e432760c18 Mon Sep 17 00:00:00 2001 From: max Date: Wed, 21 May 2014 10:37:10 +0000 Subject: Fix c&p errors in test descriptions --- tests/socket.test | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/socket.test b/tests/socket.test index 5ff2109..5c5b7c3 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -2098,7 +2098,7 @@ test socket-14.9.1 {pending [socket -async] and blocking [puts], server is IPv6} close $sock close $fd } -result {{} ok} -test socket-14.10.0 {pending [socket -async] and blocking [puts], server is IPv4} \ +test socket-14.10.0 {pending [socket -async] and nonblocking [puts], server is IPv4} \ -constraints {socket supported_inet supported_inet6} \ -setup { makeFile { @@ -2125,7 +2125,7 @@ test socket-14.10.0 {pending [socket -async] and blocking [puts], server is IPv4 close $sock close $fd } -result {{} ok} -test socket-14.10.1 {pending [socket -async] and blocking [puts], server is IPv6} \ +test socket-14.10.1 {pending [socket -async] and nonblocking [puts], server is IPv6} \ -constraints {socket supported_inet supported_inet6} \ -setup { makeFile { @@ -2152,7 +2152,7 @@ test socket-14.10.1 {pending [socket -async] and blocking [puts], server is IPv6 close $sock close $fd } -result {{} ok} -test socket-14.11.0 {pending [socket -async] and blocking [puts], no listener, no flush} \ +test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener, no flush} \ -constraints {socket supported_inet supported_inet6} \ -body { set sock [socket -async localhost [randport]] @@ -2165,7 +2165,7 @@ test socket-14.11.0 {pending [socket -async] and blocking [puts], no listener, n catch {close $sock} unset x } -result {socket is not connected} -returnCodes 1 -test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, flush} \ +test socket-14.11.1 {pending [socket -async] and nonblocking [puts], no listener, flush} \ -constraints {socket supported_inet supported_inet6} \ -body { set sock [socket -async localhost [randport]] -- cgit v0.12 From 550f78e490719e4b5eaab09efdf219df2330be20 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 21 May 2014 14:37:57 +0000 Subject: Fix gcc warning (signed-unsigned compare) --- generic/tclIO.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index c6bb5e3..0c13bc0 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -5797,7 +5797,7 @@ ReadChars( * for sizing receiving buffers. */ - int toRead = ((unsigned) charsToRead > srcLen) ? srcLen : charsToRead; + int toRead = ((charsToRead<0)||(charsToRead > srcLen)) ? srcLen : charsToRead; /* * 'factor' is how much we guess that the bytes in the source buffer will -- cgit v0.12 From b54496ebcaeecd111e6aa8bbcb5b07518838b25f Mon Sep 17 00:00:00 2001 From: andy Date: Wed, 21 May 2014 21:32:44 +0000 Subject: Update dict man page to state that [dict set] returns the updated dictionary value. --- doc/dict.n | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/dict.n b/doc/dict.n index 77c460b..a75d8fb 100644 --- a/doc/dict.n +++ b/doc/dict.n @@ -202,7 +202,7 @@ This operation takes the name of a variable containing a dictionary value and places an updated dictionary value in that variable containing a mapping from the given key to the given value. When multiple keys are present, this operation creates or updates a chain -of nested dictionaries. +of nested dictionaries. The updated dictionary value is returned. .TP \fBdict size \fIdictionaryValue\fR . -- cgit v0.12 From 1e2ced92480ce68bbf628c8848e0d41bd18521e2 Mon Sep 17 00:00:00 2001 From: andy Date: Wed, 21 May 2014 21:40:09 +0000 Subject: Ditto [dict unset]. --- doc/dict.n | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/doc/dict.n b/doc/dict.n index a75d8fb..32d7ea8 100644 --- a/doc/dict.n +++ b/doc/dict.n @@ -216,7 +216,8 @@ dictionary value in that variable that does not contain a mapping for the given key. Where multiple keys are present, this describes a path through nested dictionaries to the mapping to remove. At least one key must be specified, but the last key on the key-path need not exist. -All other components on the path must exist. +All other components on the path must exist. The updated dictionary +value is returned. .TP \fBdict update \fIdictionaryVariable key varName \fR?\fIkey varName ...\fR? \fIbody\fR . -- cgit v0.12 From 165042b1e0a2ca0d5acee8dbfdbf151978998ea4 Mon Sep 17 00:00:00 2001 From: andy Date: Wed, 21 May 2014 22:00:52 +0000 Subject: Ditto [dict append], [dict incr], and [dict lappend]. Update description of [dict create] to explicitly state that it returns the new dictionary. --- doc/dict.n | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/doc/dict.n b/doc/dict.n index 32d7ea8..3bb5465 100644 --- a/doc/dict.n +++ b/doc/dict.n @@ -25,11 +25,12 @@ below for a description), depending on \fIoption\fR. The legal This appends the given string (or strings) to the value that the given key maps to in the dictionary value contained in the given variable, writing the resulting dictionary value back to that variable. -Non-existent keys are treated as if they map to an empty string. +Non-existent keys are treated as if they map to an empty string. The +updated dictionary value is returned. .TP \fBdict create \fR?\fIkey value ...\fR? . -Create a new dictionary that contains each of the key/value mappings +Return a new dictionary that contains each of the key/value mappings listed as arguments (keys and values alternating, with each key being followed by its associated value.) .TP @@ -121,7 +122,8 @@ not specified) to the value that the given key maps to in the dictionary value contained in the given variable, writing the resulting dictionary value back to that variable. Non-existent keys are treated as if they map to 0. It is an error to increment a value -for an existing key if that value is not an integer. +for an existing key if that value is not an integer. The updated +dictionary value is returned. .TP \fBdict info \fIdictionaryValue\fR . @@ -145,7 +147,8 @@ to in the dictionary value contained in the given variable, writing the resulting dictionary value back to that variable. Non-existent keys are treated as if they map to an empty list, and it is legal for there to be no items to append to the list. It is an error for the -value that the key maps to to not be representable as a list. +value that the key maps to to not be representable as a list. The +updated dictionary value is returned. .TP \fBdict map \fR{\fIkeyVar valueVar\fR} \fIdictionaryValue body\fR . -- cgit v0.12 From a7c63b96168422c0fa7abd8e16091739acf350a5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 23 May 2014 14:59:03 +0000 Subject: eliminate two unused variables. --- win/tclWinSock.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 28dfef0..f343f82 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -1233,7 +1233,6 @@ TcpGetOptionProc( char host[NI_MAXHOST], port[NI_MAXSERV]; SOCKET sock; size_t len = 0; - int errorCode = 0; int reverseDNS = 0; #define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS" @@ -1621,7 +1620,6 @@ TcpConnect( TcpState *statePtr) { DWORD error; - u_long flag = 1; /* Indicates nonblocking mode. */ /* * We are started with async connect and the connect notification * was not jet received -- cgit v0.12 From ea994aa1957bd3faea8f4cdf2ae290d102ae1fe8 Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 31 May 2014 02:30:53 +0000 Subject: Correct the interest masks in the Tcl_CreateFileHandler() calls in PipeWatchProc(). When we are interested in both readable and writable events of a command pipeline channel, we only want the readable from the read end of the pipe, and the writable from the write end of the pipe. --- generic/tclIO.c | 17 ++++++++++++----- tests/io.test | 6 ------ unix/tclUnixPipe.c | 4 ++-- 3 files changed, 14 insertions(+), 13 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 0716074..1c4a5b3 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -2694,11 +2694,18 @@ FlushChannel( (chanPtr->typePtr->watchProc)(chanPtr->instanceData, statePtr->interestMask); } else { - /* TODO: If code reaches this point, it means a writable - * event is being handled on the channel, but the channel - * could not in fact be written to. This ought not happen, - * but Unix pipes appear to act this way (see io-53.4). - * Also can imagine broken reflected channels. */ + + /* + * When we are calledFromAsyncFlush, that means a writable + * state on the channel triggered the call, so we should be + * able to write something. Either we did write something + * and wroteSome should be set, or there was nothing left to + * write in this call, and we've completed the BG flush. + * These are the two cases above. If we get here, that means + * there is some kind failure in the writable event machinery. + */ + + assert(!calledFromAsyncFlush); } } diff --git a/tests/io.test b/tests/io.test index f1248b9..2296986 100644 --- a/tests/io.test +++ b/tests/io.test @@ -7120,17 +7120,12 @@ test io-53.4 {CopyData: background write overflow} {stdio unix openpipe fileeven for {set x 0} {$x < 12} {incr x} { append big $big } -# file delete $path(test1) file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 { puts ready fcopy stdin stdout -command { set x } vwait x -# set f [open $path(test1) w] -# fconfigure $f -translation lf -# puts $f "done" -# close $f } close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] @@ -7138,7 +7133,6 @@ test io-53.4 {CopyData: background write overflow} {stdio unix openpipe fileeven fconfigure $f1 -blocking 0 puts $f1 $big flush $f1 - after 500 set result "" fileevent $f1 read [namespace code { append result [read $f1 1024] diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index d0a5e53..57be08f 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -1125,7 +1125,7 @@ PipeWatchProc( if (psPtr->inFile) { newmask = mask & (TCL_READABLE | TCL_EXCEPTION); if (newmask) { - Tcl_CreateFileHandler(GetFd(psPtr->inFile), mask, + Tcl_CreateFileHandler(GetFd(psPtr->inFile), newmask, (Tcl_FileProc *) Tcl_NotifyChannel, (ClientData) psPtr->channel); } else { @@ -1135,7 +1135,7 @@ PipeWatchProc( if (psPtr->outFile) { newmask = mask & (TCL_WRITABLE | TCL_EXCEPTION); if (newmask) { - Tcl_CreateFileHandler(GetFd(psPtr->outFile), mask, + Tcl_CreateFileHandler(GetFd(psPtr->outFile), newmask, (Tcl_FileProc *) Tcl_NotifyChannel, (ClientData) psPtr->channel); } else { -- cgit v0.12 From c564e71550c301b91656eb54602bb8c1ece62f01 Mon Sep 17 00:00:00 2001 From: max Date: Mon, 2 Jun 2014 10:57:38 +0000 Subject: Improve robustness of the socket tests against systems that support IPv6, but don't resolve localhost to ::1 (and vice versa for IPv4 and 127.0.0.1). --- tests/socket.test | 135 ++++++++++++++++++++++++++++++------------------------ 1 file changed, 75 insertions(+), 60 deletions(-) diff --git a/tests/socket.test b/tests/socket.test index 5c5b7c3..88d8767 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -99,7 +99,7 @@ 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}] -set latency [expr {$latency > 100 ? $latency : 100}] +set latency [expr {$latency > 100 ? $latency : 1000}] unset t1 t2 s1 s2 lat1 lat2 server # If remoteServerIP or remoteServerPort are not set, check in the environment @@ -137,7 +137,6 @@ foreach {af localhost} { testConstraint supported_$af [expr {![catch {socket -server foo -myaddr $localhost 0} sock]}] catch {close $sock} } -testConstraint supported_any [expr {[testConstraint supported_inet] || [testConstraint supported_inet6]}] set sock [socket -server foo -myaddr localhost 0] set sockname [fconfigure $sock -sockname] @@ -151,6 +150,9 @@ foreach {af localhost} { inet 127.0.0.1 inet6 ::1 } { + if {![testConstraint supported_$af]} { + continue + } set ::tcl::unsupported::socketAF $af # # Check if we're supposed to do tests against the remote server @@ -1728,7 +1730,7 @@ catch {close $remoteProcChan} } unset ::tcl::unsupported::socketAF test socket-14.0.0 {[socket -async] when server only listens on IPv4} \ - -constraints [list socket supported_any localhost_v4] \ + -constraints {socket supported_inet localhost_v4} \ -setup { proc accept {s a p} { global x @@ -1750,7 +1752,7 @@ test socket-14.0.0 {[socket -async] when server only listens on IPv4} \ unset x } -result ok test socket-14.0.1 {[socket -async] when server only listens on IPv6} \ - -constraints [list socket supported_any localhost_v6] \ + -constraints {socket supported_inet6 localhost_v6} \ -setup { proc accept {s a p} { global x @@ -1772,7 +1774,7 @@ test socket-14.0.1 {[socket -async] when server only listens on IPv6} \ unset x } -result ok test socket-14.1 {[socket -async] fileevent while still connecting} \ - -constraints [list socket supported_any] \ + -constraints {socket} \ -setup { proc accept {s a p} { global x @@ -1801,7 +1803,7 @@ test socket-14.1 {[socket -async] fileevent while still connecting} \ unset x } -result {{} ok} test socket-14.2 {[socket -async] fileevent connection refused} \ - -constraints [list socket supported_any] \ + -constraints {socket} \ -body { set client [socket -async localhost [randport]] fileevent $client writable {set x ok} @@ -1815,7 +1817,7 @@ test socket-14.2 {[socket -async] fileevent connection refused} \ 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] \ + -constraints {socket supported_inet6 localhost_v6} \ -setup { proc accept {s a p} { global x @@ -1837,7 +1839,7 @@ test socket-14.3 {[socket -async] when server only listens on IPv6} \ unset x } -result ok test socket-14.4 {[socket -async] and both, readdable and writable fileevents} \ - -constraints [list socket supported_any] \ + -constraints {socket} \ -setup { proc accept {s a p} { puts $s bye @@ -1864,8 +1866,9 @@ test socket-14.4 {[socket -async] and both, readdable and writable fileevents} \ close $server unset x } -result {{} bye} +# FIXME: we should also have an IPv6 counterpart of this test socket-14.5 {[socket -async] which fails before any connect() can be made} \ - -constraints [list socket supported_any] \ + -constraints {socket supported_inet} \ -body { # address from rfc5737 socket -async -myaddr 192.0.2.42 127.0.0.1 [randport] @@ -1873,7 +1876,7 @@ test socket-14.5 {[socket -async] which fails before any connect() can be made} -returnCodes 1 \ -result {couldn't open socket: cannot assign requested address} test socket-14.6.0 {[socket -async] with no event loop and server listening on IPv4} \ - -constraints [list socket supported_inet supported_inet6] \ + -constraints {socket supported_inet localhost_v4} \ -setup { proc accept {s a p} { global x @@ -1904,7 +1907,7 @@ test socket-14.6.0 {[socket -async] with no event loop and server listening on I } \ -result {ok bye} test socket-14.6.1 {[socket -async] with no event loop and server listening on IPv6} \ - -constraints [list socket supported_inet supported_inet6] \ + -constraints {socket supported_inet6 localhost_v6} \ -setup { proc accept {s a p} { global x @@ -1935,9 +1938,10 @@ test socket-14.6.1 {[socket -async] with no event loop and server listening on I } \ -result {ok bye} test socket-14.7.0 {pending [socket -async] and blocking [gets], server is IPv4} \ - -constraints {socket supported_inet supported_inet6} \ + -constraints {socket supported_inet localhost_v4} \ -setup { makeFile { + fileevent stdin readable exit set server [socket -server accept -myaddr 127.0.0.1 0] proc accept {s h p} {puts $s ok; close $s; set ::x 1} puts [lindex [fconfigure $server -sockname] 2] @@ -1950,15 +1954,14 @@ test socket-14.7.0 {pending [socket -async] and blocking [gets], server is IPv4} set sock [socket -async localhost $port] list [fconfigure $sock -error] [gets $sock] [fconfigure $sock -error] } -cleanup { - # make sure the server exits - catch {socket 127.0.0.1 $port} - close $sock close $fd + close $sock } -result {{} ok {}} test socket-14.7.1 {pending [socket -async] and blocking [gets], server is IPv6} \ - -constraints {socket supported_inet supported_inet6} \ + -constraints {socket supported_inet6 localhost_v6} \ -setup { makeFile { + fileevent stdin readable exit set server [socket -server accept -myaddr ::1 0] proc accept {s h p} {puts $s ok; close $s; set ::x 1} puts [lindex [fconfigure $server -sockname] 2] @@ -1971,13 +1974,11 @@ test socket-14.7.1 {pending [socket -async] and blocking [gets], server is IPv6} set sock [socket -async localhost $port] list [fconfigure $sock -error] [gets $sock] [fconfigure $sock -error] } -cleanup { - # make sure the server exits - catch {socket ::1 $port} - close $sock close $fd + close $sock } -result {{} ok {}} test socket-14.7.2 {pending [socket -async] and blocking [gets], no listener} \ - -constraints {socket supported_inet supported_inet6} \ + -constraints {socket} \ -body { set sock [socket -async localhost [randport]] catch {gets $sock} x @@ -1986,9 +1987,10 @@ test socket-14.7.2 {pending [socket -async] and blocking [gets], no listener} \ close $sock } -match glob -result {{error reading "sock*": socket is not connected} {connection refused} {}} test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IPv4} \ - -constraints {socket supported_inet supported_inet6} \ + -constraints {socket supported_inet localhost_v4} \ -setup { makeFile { + fileevent stdin readable exit set server [socket -server accept -myaddr 127.0.0.1 0] proc accept {s h p} {puts $s ok; close $s; set ::x 1} puts [lindex [fconfigure $server -sockname] 2] @@ -2006,15 +2008,14 @@ test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IP } set x } -cleanup { - # make sure the server exits - catch {socket 127.0.0.1 $port} - close $sock close $fd + close $sock } -result {ok} test socket-14.8.1 {pending [socket -async] and nonblocking [gets], server is IPv6} \ - -constraints {socket supported_inet supported_inet6} \ + -constraints {socket supported_inet6 localhost_v6} \ -setup { makeFile { + fileevent stdin readable exit set server [socket -server accept -myaddr ::1 0] proc accept {s h p} {puts $s ok; close $s; set ::x 1} puts [lindex [fconfigure $server -sockname] 2] @@ -2032,13 +2033,11 @@ test socket-14.8.1 {pending [socket -async] and nonblocking [gets], server is IP } set x } -cleanup { - # make sure the server exits - catch {socket ::1 $port} - close $sock close $fd + close $sock } -result {ok} test socket-14.8.2 {pending [socket -async] and nonblocking [gets], no listener} \ - -constraints {socket supported_inet supported_inet6} \ + -constraints {socket} \ -body { set sock [socket -async localhost [randport]] fconfigure $sock -blocking 0 @@ -2051,9 +2050,10 @@ test socket-14.8.2 {pending [socket -async] and nonblocking [gets], no listener} close $sock } -match glob -result {{error reading "sock*": socket is not connected} {connection refused} {}} test socket-14.9.0 {pending [socket -async] and blocking [puts], server is IPv4} \ - -constraints {socket supported_inet supported_inet6} \ + -constraints {socket supported_inet localhost_v4} \ -setup { makeFile { + fileevent stdin readable exit set server [socket -server accept -myaddr 127.0.0.1 0] proc accept {s h p} {set ::x $s} puts [lindex [fconfigure $server -sockname] 2] @@ -2069,15 +2069,14 @@ test socket-14.9.0 {pending [socket -async] and blocking [puts], server is IPv4} flush $sock list [fconfigure $sock -error] [gets $fd] } -cleanup { - # make sure the server exits - catch {socket 127.0.0.1 $port} - close $sock close $fd + close $sock } -result {{} ok} test socket-14.9.1 {pending [socket -async] and blocking [puts], server is IPv6} \ - -constraints {socket supported_inet supported_inet6} \ + -constraints {socket supported_inet6 localhost_v6} \ -setup { makeFile { + fileevent stdin readable exit set server [socket -server accept -myaddr ::1 0] proc accept {s h p} {set ::x $s} puts [lindex [fconfigure $server -sockname] 2] @@ -2093,15 +2092,14 @@ test socket-14.9.1 {pending [socket -async] and blocking [puts], server is IPv6} flush $sock list [fconfigure $sock -error] [gets $fd] } -cleanup { - # make sure the server exits - catch {socket ::1 $port} - close $sock close $fd + close $sock } -result {{} ok} test socket-14.10.0 {pending [socket -async] and nonblocking [puts], server is IPv4} \ - -constraints {socket supported_inet supported_inet6} \ + -constraints {socket supported_inet localhost_v4} \ -setup { makeFile { + fileevent stdin readable exit set server [socket -server accept -myaddr 127.0.0.1 0] proc accept {s h p} {set ::x $s} puts [lindex [fconfigure $server -sockname] 2] @@ -2120,15 +2118,14 @@ test socket-14.10.0 {pending [socket -async] and nonblocking [puts], server is I vwait x list [fconfigure $sock -error] [gets $fd] } -cleanup { - # make sure the server exits - catch {socket 127.0.0.1 $port} - close $sock close $fd + close $sock } -result {{} ok} test socket-14.10.1 {pending [socket -async] and nonblocking [puts], server is IPv6} \ - -constraints {socket supported_inet supported_inet6} \ + -constraints {socket supported_inet6 localhost_v6} \ -setup { makeFile { + fileevent stdin readable exit set server [socket -server accept -myaddr ::1 0] proc accept {s h p} {set ::x $s} puts [lindex [fconfigure $server -sockname] 2] @@ -2147,13 +2144,11 @@ test socket-14.10.1 {pending [socket -async] and nonblocking [puts], server is I vwait x list [fconfigure $sock -error] [gets $fd] } -cleanup { - # make sure the server exits - catch {socket ::1 $port} - close $sock close $fd + close $sock } -result {{} ok} test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener, no flush} \ - -constraints {socket supported_inet supported_inet6} \ + -constraints {socket} \ -body { set sock [socket -async localhost [randport]] fconfigure $sock -blocking 0 @@ -2166,7 +2161,7 @@ test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener unset x } -result {socket is not connected} -returnCodes 1 test socket-14.11.1 {pending [socket -async] and nonblocking [puts], no listener, flush} \ - -constraints {socket supported_inet supported_inet6} \ + -constraints {socket knownBug} \ -body { set sock [socket -async localhost [randport]] fconfigure $sock -blocking 0 @@ -2177,10 +2172,10 @@ test socket-14.11.1 {pending [socket -async] and nonblocking [puts], no listener close $sock } -cleanup { catch {close $sock} - unset x + catch {unset x} } -result {socket is not connected} -returnCodes 1 test socket-14.12 {[socket -async] background progress triggered by [fconfigure -error]} \ - -constraints {socket supported_inet supported_inet6} \ + -constraints {socket} \ -body { set s [socket -async localhost [randport]] for {set i 0} {$i < 50} {incr i} { @@ -2194,7 +2189,9 @@ test socket-14.12 {[socket -async] background progress triggered by [fconfigure unset x s } -result {connection refused} -test socket-14.13 {testing writable event when quick failure} -constraints {socket win supported_inet} -body { +test socket-14.13 {testing writable event when quick failure} \ + -constraints {socket win supported_inet} \ + -body { # Test for bug 336441ed59 where a quick background fail was ignored # Test only for windows as socket -async 255.255.255.255 fails @@ -2211,7 +2208,8 @@ test socket-14.13 {testing writable event when quick failure} -constraints {sock after cancel $a1 } -result writable -test socket-14.14 {testing fileevent readable on failed async socket connect} -constraints [list socket] -body { +test socket-14.14 {testing fileevent readable on failed async socket connect} \ + -constraints {socket} -body { # Test for bug 581937ab1e set a1 [after 5000 {set x timeout}] @@ -2235,18 +2233,35 @@ test socket-14.15 {blocking read on async socket should not trigger event handle } -result ok set num 0 -foreach servip {127.0.0.1 ::1 localhost} { - foreach cliip {127.0.0.1 ::1 localhost} { - if {$servip eq $cliip || "localhost" in [list $servip $cliip]} { - set result {-result "sock*" -match glob} - } else { - set result { - -result {couldn't open socket: connection refused} - -returnCodes 1 + +set x {localhost {socket} 127.0.0.1 {supported_inet} ::1 {supported_inet6}} +set resultok {-result "sock*" -match glob} +set resulterr { + -result {couldn't open socket: connection refused} + -returnCodes 1 +} +foreach {servip sc} $x { + foreach {cliip cc} $x { + set constraints socket + lappend constraints $sc $cc + set result $resulterr + switch -- [lsort -unique [list $servip $cliip]] { + localhost - 127.0.0.1 - ::1 { + set result $resultok + } + {127.0.0.1 localhost} { + if {[testConstraint localhost_v4]} { + set result $resultok + } + } + {::1 localhost} { + if {[testConstraint localhost_v6]} { + set result $resultok + } } } test socket-15.1.$num "Connect to $servip from $cliip" \ - -constraints {socket supported_inet supported_inet6} -setup { + -constraints $constraints -setup { set server [socket -server accept -myaddr $servip 0] proc accept {s h p} { close $s } set port [lindex [fconfigure $server -sockname] 2] -- cgit v0.12 From abb4df1befac97bab990b6aefbbb6c21d330eb08 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 2 Jun 2014 20:03:14 +0000 Subject: These edits make the tests socket-14.11.[01] stop hanging, but also introduce a whole raft of test failures. WIP. --- generic/tclIO.c | 18 ++++++++++++------ tests/socket.test | 2 +- unix/tclUnixSock.c | 8 +++----- 3 files changed, 16 insertions(+), 12 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 7d94037..5552329 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -3288,10 +3288,15 @@ Tcl_Close( stickyError = 0; if ((statePtr->encoding != NULL) - && !(statePtr->outputEncodingFlags & TCL_ENCODING_START) - && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) { - statePtr->outputEncodingFlags |= TCL_ENCODING_END; - if (WriteChars(chanPtr, "", 0) < 0) { + && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)) { + + int code = CheckChannelErrors(statePtr, TCL_WRITABLE); + + if (code == 0) { + statePtr->outputEncodingFlags |= TCL_ENCODING_END; + code = WriteChars(chanPtr, "", 0); + } + if (code < 0) { stickyError = Tcl_GetErrno(); } @@ -8034,8 +8039,9 @@ Tcl_NotifyChannel( */ if (GotFlag(statePtr, BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) { - FlushChannel(NULL, chanPtr, 1); - mask &= ~TCL_WRITABLE; + if (0 == FlushChannel(NULL, chanPtr, 1)) { + mask &= ~TCL_WRITABLE; + } } /* diff --git a/tests/socket.test b/tests/socket.test index 88d8767..0c9320a 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -2161,7 +2161,7 @@ test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener unset x } -result {socket is not connected} -returnCodes 1 test socket-14.11.1 {pending [socket -async] and nonblocking [puts], no listener, flush} \ - -constraints {socket knownBug} \ + -constraints {socket} \ -body { set sock [socket -async localhost [randport]] fconfigure $sock -blocking 0 diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index 08a14d3..47d0681 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -1160,11 +1160,9 @@ out: * the event mechanism one roundtrip through select(). */ - /* Note: disabling this for now as it causes spurious event triggering - * under Linux (see test socket-14.15). */ -#if 0 - Tcl_NotifyChannel(statePtr->channel, TCL_WRITABLE); -#endif + if (statePtr->cachedBlocking == TCL_MODE_NONBLOCKING) { + Tcl_NotifyChannel(statePtr->channel, TCL_WRITABLE); + } } if (error != 0) { /* -- cgit v0.12 From 531a58872c0aaacf53b20fb75d45687d144ec6e8 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 3 Jun 2014 02:26:07 +0000 Subject: These edits make all tests outside of socket-14.* pass on OSX Mavericks. Several socket-14.* tests failing there, and those that pass are very slow about it. Firewall or poor networking configuration may be playing a role. --- generic/tclIO.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 5552329..998fe5e 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -3287,7 +3287,7 @@ Tcl_Close( stickyError = 0; - if ((statePtr->encoding != NULL) + if (GotFlag(statePtr, TCL_WRITABLE) && (statePtr->encoding != NULL) && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)) { int code = CheckChannelErrors(statePtr, TCL_WRITABLE); @@ -3295,6 +3295,8 @@ Tcl_Close( if (code == 0) { statePtr->outputEncodingFlags |= TCL_ENCODING_END; code = WriteChars(chanPtr, "", 0); + statePtr->outputEncodingFlags &= ~TCL_ENCODING_END; + statePtr->outputEncodingFlags |= TCL_ENCODING_START; } if (code < 0) { stickyError = Tcl_GetErrno(); -- cgit v0.12