From 5a8572af1f72090ba2d223c007d9803397958c14 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Mon, 18 Nov 2013 12:35:58 +0000
Subject: To prepare for completion of the [socket -async] implementation on
 Windows [13d3af3ad5]:   *  Move the server code from CreateSocket to
 Tcl_OpenTcpServer.   *  Rename CreateSocket to CreateClientSocket.   *  Unify
 the naming convention of socket channels with Unix (sock + hex representation
 of the state/info structure).

---
 win/tclWinSock.c | 368 ++++++++++++++++++++++++++++++-------------------------
 1 file changed, 203 insertions(+), 165 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 5ac8f47..bd993fa 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -74,6 +74,10 @@
 #undef getsockopt
 #undef setsockopt
 
+/* "sock" + a pointer in hex + \0 */
+#define SOCK_CHAN_LENGTH        (4 + sizeof(void *) * 2 + 1)
+#define SOCK_TEMPLATE           "sock%lx"
+
 /*
  * The following variable is used to tell whether this module has been
  * initialized.  If 1, initialization of sockets was successful, if -1 then
@@ -210,8 +214,8 @@ static WNDCLASS windowClass;
  * Static functions defined in this file.
  */
 
-static SocketInfo *	CreateSocket(Tcl_Interp *interp, int port,
-			    const char *host, int server, const char *myaddr,
+static SocketInfo *	CreateClientSocket(Tcl_Interp *interp, int port,
+			    const char *host, const char *myaddr,
 			    int myport, int async);
 static void		InitSockets(void);
 static SocketInfo *	NewSocketInfo(SOCKET socket);
@@ -1101,10 +1105,10 @@ NewSocketInfo(
 /*
  *----------------------------------------------------------------------
  *
- * CreateSocket --
+ * CreateClientSocket --
  *
- *	This function opens a new socket and initializes the SocketInfo
- *	structure.
+ *	This function opens a new client socket and initializes the
+ *	SocketInfo structure.
  *
  * Results:
  *	Returns a new SocketInfo, or NULL with an error in interp.
@@ -1116,12 +1120,10 @@ NewSocketInfo(
  */
 
 static SocketInfo *
-CreateSocket(
+CreateClientSocket(
     Tcl_Interp *interp,		/* For error reporting; can be NULL. */
     int port,			/* Port number to open. */
     const char *host,		/* Name of host on which to open port. */
-    int server,			/* 1 if socket should be a server socket, else
-				 * 0 for a client socket. */
     const char *myaddr,		/* Optional client-side address */
     int myport,			/* Optional client-side port */
     int async)			/* If nonzero, connect client socket
@@ -1155,7 +1157,7 @@ CreateSocket(
      * Construct the addresses for each end of the socket.
      */
 
-    if (!TclCreateSocketAddress(interp, &addrlist, host, port, server,
+    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0,
 	    &errorMsg)) {
 	goto error;
     }
@@ -1164,10 +1166,20 @@ CreateSocket(
 	goto error;
     }
 
-    if (server) {
+    for (addrPtr = addrlist; addrPtr != NULL;
+	 addrPtr = addrPtr->ai_next) {
+	for (myaddrPtr = myaddrlist; myaddrPtr != NULL;
+	     myaddrPtr = myaddrPtr->ai_next) {
+	    /*
+	     * No need to try combinations of local and remote addresses
+	     * of different families.
+	     */
 
-	for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
-	    sock = socket(addrPtr->ai_family, SOCK_STREAM, 0);
+	    if (myaddrPtr->ai_family != addrPtr->ai_family) {
+		continue;
+	    }
+
+	    sock = socket(myaddrPtr->ai_family, SOCK_STREAM, 0);
 	    if (sock == INVALID_SOCKET) {
 		TclWinConvertError((DWORD) WSAGetLastError());
 		continue;
@@ -1187,158 +1199,52 @@ CreateSocket(
 	    TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE);
 
 	    /*
-	     * Make sure we use the same port when opening two server sockets
-	     * for IPv4 and IPv6.
-	     *
-	     * As sockaddr_in6 uses the same offset and size for the port
-	     * member as sockaddr_in, we can handle both through the IPv4 API.
+	     * Try to bind to a local port.
 	     */
 
-	    if (port == 0 && chosenport != 0) {
-		((struct sockaddr_in *) addrPtr->ai_addr)->sin_port =
-			htons(chosenport);
+	    if (bind(sock, myaddrPtr->ai_addr, myaddrPtr->ai_addrlen)
+		== SOCKET_ERROR) {
+		TclWinConvertError((DWORD) WSAGetLastError());
+		goto looperror;
 	    }
-
 	    /*
-	     * Bind to the specified port. Note that we must not call
-	     * setsockopt with SO_REUSEADDR because Microsoft allows addresses
-	     * to be reused even if they are still in use.
-	     *
-	     * Bind should not be affected by the socket having already been
-	     * set into nonblocking mode. If there is trouble, this is one
-	     * place to look for bugs.
+	     * Set the socket into nonblocking mode if the connect should
+	     * be done in the background.
 	     */
-
-	    if (bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
-		    == SOCKET_ERROR) {
+	    if (async && ioctlsocket(sock, (long) FIONBIO, &flag)
+		== SOCKET_ERROR) {
 		TclWinConvertError((DWORD) WSAGetLastError());
-		closesocket(sock);
-		continue;
-	    }
-	    if (port == 0 && chosenport == 0) {
-		address sockname;
-		socklen_t namelen = sizeof(sockname);
-
-		/*
-		 * Synchronize port numbers when binding to port 0 of multiple
-		 * addresses.
-		 */
-
-		if (getsockname(sock, &sockname.sa, &namelen) >= 0) {
-		    chosenport = ntohs(sockname.sa4.sin_port);
-		}
+		goto looperror;
 	    }
 
 	    /*
-	     * Set the maximum number of pending connect requests to the max
-	     * value allowed on each platform (Win32 and Win32s may be
-	     * different, and there may be differences between TCP/IP stacks).
+	     * Attempt to connect to the remote socket.
 	     */
 
-	    if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
-		TclWinConvertError((DWORD) WSAGetLastError());
-		closesocket(sock);
-		continue;
-	    }
-
-	    if (infoPtr == NULL) {
-		/*
-		 * Add this socket to the global list of sockets.
-		 */
-
-		infoPtr = NewSocketInfo(sock);
-
-		/*
-		 * Set up the select mask for connection request events.
-		 */
-
-		infoPtr->selectEvents = FD_ACCEPT;
-		infoPtr->watchEvents |= FD_ACCEPT;
-
-	    } else {
-		AddSocketInfoFd( infoPtr, sock );
-	    }
-	}
-    } else {
-	for (addrPtr = addrlist; addrPtr != NULL;
-		addrPtr = addrPtr->ai_next) {
-	    for (myaddrPtr = myaddrlist; myaddrPtr != NULL;
-		    myaddrPtr = myaddrPtr->ai_next) {
-		/*
-		 * No need to try combinations of local and remote addresses
-		 * of different families.
-		 */
-
-		if (myaddrPtr->ai_family != addrPtr->ai_family) {
-		    continue;
-		}
-
-		sock = socket(myaddrPtr->ai_family, SOCK_STREAM, 0);
-		if (sock == INVALID_SOCKET) {
-		    TclWinConvertError((DWORD) WSAGetLastError());
-		    continue;
-		}
-
-		/*
-		 * Win-NT has a misfeature that sockets are inherited in child
-		 * processes by default. Turn off the inherit bit.
-		 */
-
-		SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);
-
-		/*
-		 * Set kernel space buffering
-		 */
-
-		TclSockMinimumBuffers((void *) sock, TCP_BUFFER_SIZE);
-
-		/*
-		 * Try to bind to a local port.
-		 */
-
-		if (bind(sock, myaddrPtr->ai_addr, myaddrPtr->ai_addrlen)
-			== SOCKET_ERROR) {
-		    TclWinConvertError((DWORD) WSAGetLastError());
+	    if (connect(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
+		== SOCKET_ERROR) {
+		DWORD error = (DWORD) WSAGetLastError();
+		if (error != WSAEWOULDBLOCK) {
+		    TclWinConvertError(error);
 		    goto looperror;
 		}
+		
 		/*
-		 * Set the socket into nonblocking mode if the connect should
-		 * be done in the background.
+		 * The connection is progressing in the background.
 		 */
-		if (async && ioctlsocket(sock, (long) FIONBIO, &flag)
-			== SOCKET_ERROR) {
-		    TclWinConvertError((DWORD) WSAGetLastError());
-		    goto looperror;
-		}
-
-		/*
-		 * Attempt to connect to the remote socket.
-		 */
-
-		if (connect(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
-			== SOCKET_ERROR) {
-		    DWORD error = (DWORD) WSAGetLastError();
-		    if (error != WSAEWOULDBLOCK) {
-			TclWinConvertError(error);
-			goto looperror;
-		    }
-
-		    /*
-		     * The connection is progressing in the background.
-		     */
 
-		    asyncConnect = 1;
-		}
-		goto connected;
-
-	    looperror:
-		if (sock != INVALID_SOCKET) {
-		    closesocket(sock);
-		    sock = INVALID_SOCKET;
-		}
+		asyncConnect = 1;
+	    }
+	    goto connected;
+	    
+	looperror:
+	    if (sock != INVALID_SOCKET) {
+		closesocket(sock);
+		sock = INVALID_SOCKET;
 	    }
 	}
-	goto error;
+    }
+    goto error;
 
     connected:
 	/*
@@ -1357,7 +1263,6 @@ CreateSocket(
 	    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
 	    infoPtr->selectEvents |= FD_CONNECT;
 	}
-    }
 
   error:
     if (addrlist != NULL) {
@@ -1496,12 +1401,12 @@ Tcl_OpenTcpClient(
      * Create a new client socket and wrap it in a channel.
      */
 
-    infoPtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
+    infoPtr = CreateClientSocket(interp, port, host, myaddr, myport, async);
     if (infoPtr == NULL) {
 	return NULL;
     }
 
-    sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd);
+    sprintf(channelName, SOCK_TEMPLATE, infoPtr);
 
     infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
 	    infoPtr, (TCL_READABLE | TCL_WRITABLE));
@@ -1564,7 +1469,7 @@ Tcl_MakeTcpClientChannel(
     infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
     SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr);
 
-    sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd);
+    sprintf(channelName, SOCK_TEMPLATE, infoPtr);
     infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
 	    infoPtr, (TCL_READABLE | TCL_WRITABLE));
     Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
@@ -1598,36 +1503,169 @@ Tcl_OpenTcpServer(
 				 * clients. */
     ClientData acceptProcData)	/* Data for the callback. */
 {
-    SocketInfo *infoPtr;
-    char channelName[16 + TCL_INTEGER_SPACE];
+    SOCKET sock = INVALID_SOCKET;
+    unsigned short chosenport = 0;
+    struct addrinfo *addrPtr;	/* Socket address to listen on. */
+    SocketInfo *infoPtr = NULL;	/* The returned value. */
+    void *addrlist = NULL;
+    char channelName[SOCK_CHAN_LENGTH];
+    u_long flag = 1;		/* Indicates nonblocking mode. */
+    const char *errorMsg = NULL;
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 
     if (TclpHasSockets(interp) != TCL_OK) {
 	return NULL;
     }
 
     /*
-     * Create a new client socket and wrap it in a channel.
+     * Check that WinSock is initialized; do not call it if not, to prevent
+     * system crashes. This can happen at exit time if the exit handler for
+     * WinSock ran before other exit handlers that want to use sockets.
      */
 
-    infoPtr = CreateSocket(interp, port, host, 1, NULL, 0, 0);
-    if (infoPtr == NULL) {
+    if (!SocketsEnabled()) {
 	return NULL;
     }
 
-    infoPtr->acceptProc = acceptProc;
-    infoPtr->acceptProcData = acceptProcData;
+    /*
+     * Construct the addresses for each end of the socket.
+     */
 
-    sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) infoPtr->sockets->fd);
+    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 1, &errorMsg)) {
+	goto error;
+    }
 
-    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
-	    infoPtr, 0);
-    if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "")
+    for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
+	sock = socket(addrPtr->ai_family, addrPtr->ai_socktype,
+                addrPtr->ai_protocol);
+	if (sock == INVALID_SOCKET) {
+	    TclWinConvertError((DWORD) WSAGetLastError());
+	    continue;
+	}
+	
+	/*
+	 * Win-NT has a misfeature that sockets are inherited in child
+	 * processes by default. Turn off the inherit bit.
+	 */
+	
+	SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);
+	
+	/*
+	 * Set kernel space buffering
+	 */
+	
+	TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE);
+	
+	/*
+	 * Make sure we use the same port when opening two server sockets
+	 * for IPv4 and IPv6.
+	 *
+	 * As sockaddr_in6 uses the same offset and size for the port
+	 * member as sockaddr_in, we can handle both through the IPv4 API.
+	 */
+	
+	if (port == 0 && chosenport != 0) {
+	    ((struct sockaddr_in *) addrPtr->ai_addr)->sin_port =
+		htons(chosenport);
+	}
+	
+	/*
+	 * Bind to the specified port. Note that we must not call
+	 * setsockopt with SO_REUSEADDR because Microsoft allows addresses
+	 * to be reused even if they are still in use.
+	 *
+	 * Bind should not be affected by the socket having already been
+	 * set into nonblocking mode. If there is trouble, this is one
+	 * place to look for bugs.
+	 */
+	
+	if (bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
+	    == SOCKET_ERROR) {
+	    TclWinConvertError((DWORD) WSAGetLastError());
+	    closesocket(sock);
+	    continue;
+	}
+	if (port == 0 && chosenport == 0) {
+	    address sockname;
+	    socklen_t namelen = sizeof(sockname);
+	    
+	    /*
+	     * Synchronize port numbers when binding to port 0 of multiple
+	     * addresses.
+	     */
+	    
+	    if (getsockname(sock, &sockname.sa, &namelen) >= 0) {
+		chosenport = ntohs(sockname.sa4.sin_port);
+	    }
+	}
+	
+	/*
+	 * Set the maximum number of pending connect requests to the max
+	 * value allowed on each platform (Win32 and Win32s may be
+	 * different, and there may be differences between TCP/IP stacks).
+	 */
+	
+	if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
+	    TclWinConvertError((DWORD) WSAGetLastError());
+	    closesocket(sock);
+	    continue;
+	}
+	
+	if (infoPtr == NULL) {
+	    /*
+	     * Add this socket to the global list of sockets.
+	     */
+	    infoPtr = NewSocketInfo(sock);
+	} else {
+	    AddSocketInfoFd( infoPtr, sock );
+	}
+    }
+
+error:
+     if (addrlist != NULL) {
+	freeaddrinfo(addrlist);
+    }
+
+    if (infoPtr != NULL) {
+
+	infoPtr->acceptProc = acceptProc;
+	infoPtr->acceptProcData = acceptProcData;
+	sprintf(channelName, SOCK_TEMPLATE, infoPtr);
+	infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+					    infoPtr, 0);	
+	/*
+	 * Set up the select mask for connection request events.
+	 */
+	
+	infoPtr->selectEvents = FD_ACCEPT;
+	infoPtr->watchEvents |= FD_ACCEPT;
+	
+	/*
+	 * Register for interest in events in the select mask. Note that this
+	 * automatically places the socket into non-blocking mode.
+	 */
+
+	ioctlsocket(sock, (long) FIONBIO, &flag);
+	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+		    (LPARAM) infoPtr);
+	if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "")
 	    == TCL_ERROR) {
-	Tcl_Close(NULL, infoPtr->channel);
-	return NULL;
+	    Tcl_Close(NULL, infoPtr->channel);
+	    return NULL;
+	}
+	return infoPtr->channel;
     }
 
-    return infoPtr->channel;
+    if (interp != NULL) {
+        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"couldn't open socket: %s",
+		(errorMsg ? errorMsg : Tcl_PosixError(interp))));
+    }
+
+    if (sock != INVALID_SOCKET) {
+	closesocket(sock);
+    }
+    return NULL;
 }
 
 /*
@@ -1682,7 +1720,7 @@ TcpAccept(
     SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
 	    (LPARAM) newInfoPtr);
 
-    sprintf(channelName, "sock%" TCL_I_MODIFIER "u", (size_t) newInfoPtr->sockets->fd);
+    sprintf(channelName, SOCK_TEMPLATE, newInfoPtr);
     newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
 	    newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
     if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
-- 
cgit v0.12


From 7460f22cc7e783b1dd480c2fbf8ef6fc90a0360c Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 21 Jan 2014 21:32:53 +0000
Subject: Backport of bytearray append machinery to support bug fixes in
 ReadBytes.

---
 generic/tclBinary.c | 92 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 generic/tclIO.c     | 17 +++-------
 generic/tclInt.h    |  2 ++
 3 files changed, 98 insertions(+), 13 deletions(-)

diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index dbb296b..68289f2 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -549,6 +549,98 @@ UpdateStringOfByteArray(
 /*
  *----------------------------------------------------------------------
  *
+ * TclAppendBytesToByteArray --
+ *
+ *	This function appends an array of bytes to a byte array object. Note
+ *	that the object *must* be unshared, and the array of bytes *must not*
+ *	refer to the object being appended to.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Allocates enough memory for an array of bytes of the requested total
+ *	size, or possibly larger. [Bug 2992970]
+ *
+ *----------------------------------------------------------------------
+ */
+
+#define TCL_MIN_GROWTH 1024
+void
+TclAppendBytesToByteArray(
+    Tcl_Obj *objPtr,
+    const unsigned char *bytes,
+    int len)
+{
+    ByteArray *byteArrayPtr;
+    int needed;
+
+    if (Tcl_IsShared(objPtr)) {
+	Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
+    }
+    if (len < 0) {
+	Tcl_Panic("%s must be called with definite number of bytes to append",
+		"TclAppendBytesToByteArray");
+    }
+    if (len == 0) {
+	/* Append zero bytes is a no-op. */
+	return;
+    }
+    if (objPtr->typePtr != &tclByteArrayType) {
+	SetByteArrayFromAny(NULL, objPtr);
+    }
+    byteArrayPtr = GET_BYTEARRAY(objPtr);
+
+    if (len > INT_MAX - byteArrayPtr->used) {
+	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+    }
+
+    needed = byteArrayPtr->used + len;
+    /*
+     * If we need to, resize the allocated space in the byte array.
+     */
+
+    if (needed > byteArrayPtr->allocated) {
+	ByteArray *ptr = NULL;
+	int attempt;
+
+	if (needed <= INT_MAX/2) {
+	    /* Try to allocate double the total space that is needed. */
+	    attempt = 2 * needed;
+	    ptr = (ByteArray *) attemptckrealloc((void *) byteArrayPtr,
+		    BYTEARRAY_SIZE(attempt));
+	}
+	if (ptr == NULL) {
+	    /* Try to allocate double the increment that is needed (plus). */
+	    unsigned int limit = INT_MAX - needed;
+	    unsigned int extra = len + TCL_MIN_GROWTH;
+	    int growth = (int) ((extra > limit) ? limit : extra);
+
+	    attempt = needed + growth;
+	    ptr = (ByteArray *) attemptckrealloc((void *) byteArrayPtr,
+		    BYTEARRAY_SIZE(attempt));
+	}
+	if (ptr == NULL) {
+	    /* Last chance: Try to allocate exactly what is needed. */
+	    attempt = needed;
+	    ptr = (ByteArray *) ckrealloc((void *)byteArrayPtr,
+		    BYTEARRAY_SIZE(attempt));
+	}
+	byteArrayPtr = ptr;
+	byteArrayPtr->allocated = attempt;
+	SET_BYTEARRAY(objPtr, byteArrayPtr);
+    }
+
+    if (bytes) {
+	memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
+    }
+    byteArrayPtr->used += len;
+    TclInvalidateStringRep(objPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_BinaryObjCmd --
  *
  *	This procedure implements the "binary" Tcl command.
diff --git a/generic/tclIO.c b/generic/tclIO.c
index f1d8909..c1b7ee9 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5586,20 +5586,8 @@ ReadBytes(
 	toRead = srcLen;
     }
 
+    TclAppendBytesToByteArray(objPtr, NULL, toRead);
     dst = (char *) Tcl_GetByteArrayFromObj(objPtr, &length);
-    if (toRead > length - offset - 1) {
-	/*
-	 * Double the existing size of the object or make enough room to hold
-	 * all the characters we may get from the source buffer, whichever is
-	 * larger.
-	 */
-
-	length = offset * 2;
-	if (offset < toRead) {
-	    length = offset + toRead + 1;
-	}
-	dst = (char *) Tcl_SetByteArrayLength(objPtr, length);
-    }
     dst += offset;
 
     if (statePtr->flags & INPUT_NEED_NL) {
@@ -5607,6 +5595,7 @@ ReadBytes(
 	if ((srcLen == 0) || (*src != '\n')) {
 	    *dst = '\r';
 	    *offsetPtr += 1;
+	    Tcl_SetByteArrayLength(objPtr, *offsetPtr);
 	    return 1;
 	}
 	*dst++ = '\n';
@@ -5619,11 +5608,13 @@ ReadBytes(
     dstWrote = toRead;
     if (TranslateInputEOL(statePtr, dst, src, &dstWrote, &srcRead) != 0) {
 	if (dstWrote == 0) {
+	    Tcl_SetByteArrayLength(objPtr, *offsetPtr);
 	    return -1;
 	}
     }
     bufPtr->nextRemoved += srcRead;
     *offsetPtr += dstWrote;
+    Tcl_SetByteArrayLength(objPtr, *offsetPtr);
     return dstWrote;
 }
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index dc28b97..64d39a0 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2477,6 +2477,8 @@ MODULE_SCOPE char	tclEmptyString;
  *----------------------------------------------------------------
  */
 
+MODULE_SCOPE void	TclAppendBytesToByteArray(Tcl_Obj *objPtr,
+			    const unsigned char *bytes, int len);
 MODULE_SCOPE void       TclAdvanceContinuations(int* line, int** next, int loc);
 MODULE_SCOPE void       TclAdvanceLines(int *line, const char *start,
 			    const char *end);
-- 
cgit v0.12


From abe23bfb4ef65eb899170e5ae7c4efc030294b31 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 21 Jan 2014 22:08:16 +0000
Subject: There is no need for ReadBytes() or its caller(s) to track how many
 bytes are actually stored in objPtr.  The ByteArray Tcl_ObjType already has
 the machinery to take care of this.

---
 generic/tclIO.c | 47 ++++++++++++++++++-----------------------------
 1 file changed, 18 insertions(+), 29 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index c1b7ee9..4a5d8f1 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -208,7 +208,7 @@ static int		HaveVersion(const Tcl_ChannelType *typePtr,
 static void		PeekAhead(Channel *chanPtr, char **dstEndPtr,
 			    GetsState *gsPtr);
 static int		ReadBytes(ChannelState *statePtr, Tcl_Obj *objPtr,
-			    int charsLeft, int *offsetPtr);
+			    int charsLeft);
 static int		ReadChars(ChannelState *statePtr, Tcl_Obj *objPtr,
 			    int charsLeft, int *offsetPtr, int *factorPtr);
 static void		RecycleBuffer(ChannelState *statePtr,
@@ -5448,12 +5448,10 @@ DoReadChars(
 	     */
 
 	    TclGetString(objPtr);
+	    offset = 0;
 	}
-	offset = 0;
     } else {
-	if (encoding == NULL) {
-	    Tcl_GetByteArrayFromObj(objPtr, &offset);
-	} else {
+	if (encoding) {
 	    TclGetStringFromObj(objPtr, &offset);
 	}
     }
@@ -5462,7 +5460,7 @@ DoReadChars(
 	copiedNow = -1;
 	if (statePtr->inQueueHead != NULL) {
 	    if (encoding == NULL) {
-		copiedNow = ReadBytes(statePtr, objPtr, toRead, &offset);
+		copiedNow = ReadBytes(statePtr, objPtr, toRead);
 	    } else {
 		copiedNow = ReadChars(statePtr, objPtr, toRead, &offset,
 			&factor);
@@ -5510,9 +5508,7 @@ DoReadChars(
     }
 
     ResetFlag(statePtr, CHANNEL_BLOCKED);
-    if (encoding == NULL) {
-	Tcl_SetByteArrayLength(objPtr, offset);
-    } else {
+    if (encoding) {
 	Tcl_SetObjLength(objPtr, offset);
     }
 
@@ -5540,13 +5536,11 @@ DoReadChars(
  *	allocated to hold data read from the channel as needed.
  *
  * Results:
- *	The return value is the number of bytes appended to the object and
- *	*offsetPtr is filled with the total number of bytes in the object
- *	(greater than the return value if there were already bytes in the
- *	object).
+ *	The return value is the number of bytes appended to the object, or
+ *	-1 to indicate that zero bytes were read due to an EOF.
  *
  * Side effects:
- *	None.
+ *	The storage of bytes in objPtr can cause (re-)allocation of memory.
  *
  *---------------------------------------------------------------------------
  */
@@ -5559,24 +5553,18 @@ ReadBytes(
 				 * been allocated to hold data, not how many
 				 * bytes of data have been stored in the
 				 * object. */
-    int bytesToRead,		/* Maximum number of bytes to store, or < 0 to
+    int bytesToRead)		/* Maximum number of bytes to store, or < 0 to
 				 * get all available bytes. Bytes are obtained
 				 * from the first buffer in the queue - even
 				 * if this number is larger than the number of
 				 * bytes available in the first buffer, only
 				 * the bytes from the first buffer are
 				 * returned. */
-    int *offsetPtr)		/* On input, contains how many bytes of objPtr
-				 * have been used to hold data. On output,
-				 * filled with how many bytes are now being
-				 * used. */
 {
-    int toRead, srcLen, offset, length, srcRead, dstWrote;
+    int toRead, srcLen, length, srcRead, dstWrote;
     ChannelBuffer *bufPtr;
     char *src, *dst;
 
-    offset = *offsetPtr;
-
     bufPtr = statePtr->inQueueHead;
     src = RemovePoint(bufPtr);
     srcLen = BytesLeft(bufPtr);
@@ -5586,16 +5574,17 @@ ReadBytes(
 	toRead = srcLen;
     }
 
+    (void) Tcl_GetByteArrayFromObj(objPtr, &length);
     TclAppendBytesToByteArray(objPtr, NULL, toRead);
-    dst = (char *) Tcl_GetByteArrayFromObj(objPtr, &length);
-    dst += offset;
+    dst = (char *) Tcl_GetByteArrayFromObj(objPtr, NULL);
+    dst += length;
 
     if (statePtr->flags & INPUT_NEED_NL) {
 	ResetFlag(statePtr, INPUT_NEED_NL);
 	if ((srcLen == 0) || (*src != '\n')) {
 	    *dst = '\r';
-	    *offsetPtr += 1;
-	    Tcl_SetByteArrayLength(objPtr, *offsetPtr);
+	    length += 1;
+	    Tcl_SetByteArrayLength(objPtr, length);
 	    return 1;
 	}
 	*dst++ = '\n';
@@ -5608,13 +5597,13 @@ ReadBytes(
     dstWrote = toRead;
     if (TranslateInputEOL(statePtr, dst, src, &dstWrote, &srcRead) != 0) {
 	if (dstWrote == 0) {
-	    Tcl_SetByteArrayLength(objPtr, *offsetPtr);
+	    Tcl_SetByteArrayLength(objPtr, length);
 	    return -1;
 	}
     }
     bufPtr->nextRemoved += srcRead;
-    *offsetPtr += dstWrote;
-    Tcl_SetByteArrayLength(objPtr, *offsetPtr);
+    length += dstWrote;
+    Tcl_SetByteArrayLength(objPtr, length);
     return dstWrote;
 }
 
-- 
cgit v0.12


From 8703cd164100a81207d646099206dcc3acdf05bb Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 27 Jan 2014 17:35:27 +0000
Subject: Revise the Tcl_Append* machinery to tolerate NULL bytes to append.
 Then have ReadChars() use that machinery to resize buffer receiving input,
 rather than invent its own version.  Simplify ReadChars() callers.

---
 generic/tclIO.c        | 67 +++++++++++---------------------------------------
 generic/tclStringObj.c | 29 ++++++++++++++--------
 2 files changed, 34 insertions(+), 62 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 972cbd8..40573d7 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -210,7 +210,7 @@ static void		PeekAhead(Channel *chanPtr, char **dstEndPtr,
 static int		ReadBytes(ChannelState *statePtr, Tcl_Obj *objPtr,
 			    int charsLeft);
 static int		ReadChars(ChannelState *statePtr, Tcl_Obj *objPtr,
-			    int charsLeft, int *offsetPtr, int *factorPtr);
+			    int charsLeft, int *factorPtr);
 static void		RecycleBuffer(ChannelState *statePtr,
 			    ChannelBuffer *bufPtr, int mustDiscard);
 static int		StackSetBlockMode(Channel *chanPtr, int mode);
@@ -5425,7 +5425,7 @@ DoReadChars(
     ChannelState *statePtr = chanPtr->state;
 				/* State info for channel */
     ChannelBuffer *bufPtr;
-    int offset, factor, copied, copiedNow, result;
+    int factor, copied, copiedNow, result;
     Tcl_Encoding encoding;
 #define UTF_EXPANSION_FACTOR	1024
 
@@ -5447,14 +5447,11 @@ DoReadChars(
 	     * We're going to access objPtr->bytes directly, so we must ensure
 	     * that this is actually a string object (otherwise it might have
 	     * been pure Unicode).
+	     *
+	     * Probably not needed anymore.
 	     */
 
 	    TclGetString(objPtr);
-	    offset = 0;
-	}
-    } else {
-	if (encoding) {
-	    TclGetStringFromObj(objPtr, &offset);
 	}
     }
 
@@ -5464,8 +5461,7 @@ DoReadChars(
 	    if (encoding == NULL) {
 		copiedNow = ReadBytes(statePtr, objPtr, toRead);
 	    } else {
-		copiedNow = ReadChars(statePtr, objPtr, toRead, &offset,
-			&factor);
+		copiedNow = ReadChars(statePtr, objPtr, toRead, &factor);
 	    }
 
 	    /*
@@ -5510,9 +5506,6 @@ DoReadChars(
     }
 
     ResetFlag(statePtr, CHANNEL_BLOCKED);
-    if (encoding) {
-	Tcl_SetObjLength(objPtr, offset);
-    }
 
     /*
      * Update the notifier state so we don't block while there is still data
@@ -5651,17 +5644,13 @@ ReadChars(
 				 * available in the first buffer, only the
 				 * characters from the first buffer are
 				 * returned. */
-    int *offsetPtr,		/* On input, contains how many bytes of objPtr
-				 * have been used to hold data. On output,
-				 * filled with how many bytes are now being
-				 * used. */
     int *factorPtr)		/* On input, contains a guess of how many
 				 * bytes need to be allocated to hold the
 				 * result of converting N source bytes to
 				 * UTF-8. On output, contains another guess
 				 * based on the data seen so far. */
 {
-    int toRead, factor, offset, spaceLeft, srcLen, dstNeeded;
+    int toRead, factor, srcLen, dstNeeded, numBytes;
     int srcRead, dstWrote, numChars, dstRead;
     ChannelBuffer *bufPtr;
     char *src, *dst;
@@ -5669,7 +5658,6 @@ ReadChars(
     int encEndFlagSuppressed = 0;
 
     factor = *factorPtr;
-    offset = *offsetPtr;
 
     bufPtr = statePtr->inQueueHead;
     src = RemovePoint(bufPtr);
@@ -5687,37 +5675,9 @@ ReadChars(
      */
 
     dstNeeded = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
-    spaceLeft = objPtr->length - offset;
-
-    if (dstNeeded > spaceLeft) {
-	/*
-	 * Double the existing size of the object or make enough room to hold
-	 * all the characters we want from the source buffer, whichever is
-	 * larger.
-	 */
-
-	int length = offset + ((offset < dstNeeded) ? dstNeeded : offset);
-
-	if (Tcl_AttemptSetObjLength(objPtr, length) == 0) {
-	    length = offset + dstNeeded;
-	    if (Tcl_AttemptSetObjLength(objPtr, length) == 0) {
-		dstNeeded = TCL_UTF_MAX - 1 + toRead;
-		length = offset + dstNeeded;
-		Tcl_SetObjLength(objPtr, length);
-	    }
-	}
-	spaceLeft = length - offset;
-    }
-    if (toRead == srcLen) {
-	/*
-	 * Want to convert the whole buffer in one pass. If we have enough
-	 * space, convert it using all available space in object rather than
-	 * using the factor.
-	 */
-
-	dstNeeded = spaceLeft;
-    }
-    dst = objPtr->bytes + offset;
+    (void) TclGetStringFromObj(objPtr, &numBytes);
+    Tcl_AppendToObj(objPtr, NULL, dstNeeded);
+    dst = TclGetString(objPtr) + numBytes;
 
     /*
      * [Bug 1462248]: The cause of the crash reported in this bug is this:
@@ -5788,7 +5748,7 @@ ReadChars(
 	    *dst = '\r';
 	}
 	statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
-	*offsetPtr += 1;
+	Tcl_SetObjLength(objPtr, numBytes + 1);
 
 	if (encEndFlagSuppressed) {
 	    statePtr->inputEncodingFlags |= TCL_ENCODING_END;
@@ -5829,6 +5789,7 @@ ReadChars(
 
 		SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
 	    }
+	    Tcl_SetObjLength(objPtr, numBytes);
 	    return -1;
 	}
 
@@ -5853,7 +5814,8 @@ ReadChars(
 	memcpy(RemovePoint(nextPtr), src, (size_t) srcLen);
 	RecycleBuffer(statePtr, bufPtr, 0);
 	statePtr->inQueueHead = nextPtr;
-	return ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr);
+	Tcl_SetObjLength(objPtr, numBytes);
+	return ReadChars(statePtr, objPtr, charsToRead, factorPtr);
     }
 
     dstRead = dstWrote;
@@ -5866,6 +5828,7 @@ ReadChars(
 	 */
 
 	if (dstWrote == 0) {
+	    Tcl_SetObjLength(objPtr, numBytes);
 	    return -1;
 	}
 	statePtr->inputEncodingState = oldState;
@@ -5905,7 +5868,7 @@ ReadChars(
     if (dstWrote > srcRead + 1) {
 	*factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;
     }
-    *offsetPtr += dstWrote;
+    Tcl_SetObjLength(objPtr, numBytes + dstWrote);
     return numChars;
 }
 
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index a929d04..d96d814 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -1139,7 +1139,8 @@ Tcl_AppendLimitedToObj(
 	if (ellipsis == NULL) {
 	    ellipsis = "...";
 	}
-	toCopy = Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes;
+	toCopy = (bytes == NULL) ? limit
+		: Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes;
     }
 
     /*
@@ -1386,7 +1387,8 @@ AppendUnicodeToUnicodeRep(
 	 * due to the reallocs below.
 	 */
 	int offset = -1;
-	if (unicode >= stringPtr->unicode && unicode <= stringPtr->unicode 
+	if (unicode && unicode >= stringPtr->unicode
+		&& unicode <= stringPtr->unicode
 		+ stringPtr->uallocated / sizeof(Tcl_UniChar)) {
 	    offset = unicode - stringPtr->unicode;
 	}
@@ -1405,8 +1407,10 @@ AppendUnicodeToUnicodeRep(
      * trailing null.
      */
 
-    memcpy(stringPtr->unicode + stringPtr->numChars, unicode,
-	    appendNumChars * sizeof(Tcl_UniChar));
+    if (unicode) {
+	memcpy(stringPtr->unicode + stringPtr->numChars, unicode,
+		appendNumChars * sizeof(Tcl_UniChar));
+    }
     stringPtr->unicode[numChars] = 0;
     stringPtr->numChars = numChars;
     stringPtr->allocated = 0;
@@ -1478,8 +1482,8 @@ AppendUtfToUnicodeRep(
     int numBytes)		/* Number of bytes of "bytes" to convert. */
 {
     Tcl_DString dsPtr;
-    int numChars;
-    Tcl_UniChar *unicode;
+    int numChars = numBytes;
+    Tcl_UniChar *unicode = NULL;
 
     if (numBytes < 0) {
 	numBytes = (bytes ? strlen(bytes) : 0);
@@ -1489,8 +1493,11 @@ AppendUtfToUnicodeRep(
     }
 
     Tcl_DStringInit(&dsPtr);
-    numChars = Tcl_NumUtfChars(bytes, numBytes);
-    unicode = (Tcl_UniChar *)Tcl_UtfToUniCharDString(bytes, numBytes, &dsPtr);
+    if (bytes) {
+	numChars = Tcl_NumUtfChars(bytes, numBytes);
+	unicode = (Tcl_UniChar *) Tcl_UtfToUniCharDString(bytes, numBytes,
+		&dsPtr);
+    }
     AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
     Tcl_DStringFree(&dsPtr);
 }
@@ -1547,7 +1554,7 @@ AppendUtfToUtfRep(
 	 * due to the reallocs below.
 	 */
 	int offset = -1;
-	if (bytes >= objPtr->bytes
+	if (bytes && bytes >= objPtr->bytes
 		&& bytes <= objPtr->bytes + objPtr->length) {
 	    offset = bytes - objPtr->bytes;
 	}
@@ -1585,7 +1592,9 @@ AppendUtfToUtfRep(
     stringPtr->numChars = -1;
     stringPtr->hasUnicode = 0;
 
-    memcpy(objPtr->bytes + oldLength, bytes, (size_t) numBytes);
+    if (bytes) {
+	memcpy(objPtr->bytes + oldLength, bytes, (size_t) numBytes);
+    }
     objPtr->bytes[newLength] = 0;
     objPtr->length = newLength;
 }
-- 
cgit v0.12


From d7757d423e285ae0c112407d1dcc60191aa0b4bd Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Thu, 30 Jan 2014 11:02:51 +0000
Subject: win/tclWinChan.c Tcl_InitNotifier: Bug [2413550] Avoid reopening of
 serial channels which causes issues with Bluetooth virtual com. Patch by Rolf
 Schroedter.

---
 ChangeLog          |   6 +++
 win/tclWinChan.c   | 151 ++++++++++++++++++++++++++++++++++++++++++++++++++++-
 win/tclWinInt.h    |   2 +-
 win/tclWinSerial.c |  25 +++++----
 4 files changed, 171 insertions(+), 13 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index fd8c7c7..aec77d9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -7,6 +7,12 @@ this log file.  You may still find useful things in it, but the Timeline is
 a better first place to look now.
 ============================================================================
 
+2014-01-30  Harald Oehlmann  <oehhar@users.sf.net>
+
+	* win/tclWinChan.c Tcl_InitNotifier: Bug [2413550]
+	  Avoid reopening of serial channels which causes issues with
+          Bluetooth virtual com. Patch by Rolf Schroedter.
+
 2013-08-30  Don Porter  <dgp@users.sourceforge.net>
 
 	* generic/tcl.h:	Bump to 8.5.15 for release.
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index 89d898f..19e3655 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -95,7 +95,7 @@ static void		FileThreadActionProc(ClientData instanceData,
 static int		FileTruncateProc(ClientData instanceData,
 			    Tcl_WideInt length);
 static DWORD		FileGetType(HANDLE handle);
-
+static int		NativeIsComPort(CONST TCHAR *nativeName);
 /*
  * This structure describes the channel type structure for file based IO.
  */
@@ -904,6 +904,33 @@ TclpOpenFileChannel(
     }
 
     /*
+     * [2413550] Avoid double-open of serial ports on Windows
+     * Special handling for Windows serial ports by a "name-hint"
+     * to directly open it with the OVERLAPPED flag set.
+     */
+
+    if( NativeIsComPort(nativeName) ) {
+
+	handle = TclWinSerialOpen(INVALID_HANDLE_VALUE, nativeName, accessMode);
+	if (handle == INVALID_HANDLE_VALUE) {
+	    TclWinConvertError(GetLastError());
+	    if (interp != (Tcl_Interp *) NULL) {
+		Tcl_AppendResult(interp, "couldn't open serial \"",
+			TclGetString(pathPtr), "\": ",
+			Tcl_PosixError(interp), NULL);
+	    }
+	    return NULL;
+	}
+
+	/*
+	* For natively named Windows serial ports we are done.
+	*/
+	channel = TclWinOpenSerialChannel(handle, channelName,
+		channelPermissions);
+
+	return channel;
+    }
+    /*
      * Set up the file sharing mode.  We want to allow simultaneous access.
      */
 
@@ -935,11 +962,15 @@ TclpOpenFileChannel(
     switch (FileGetType(handle)) {
     case FILE_TYPE_SERIAL:
 	/*
+	 * Natively named serial ports "com1-9", "\\\\.\\comXX" are 
+	 * already done with the code above.
+	 * Here we handle all other serial port names.
+	 *
 	 * Reopen channel for OVERLAPPED operation. Normally this shouldn't
 	 * fail, because the channel exists.
 	 */
 
-	handle = TclWinSerialReopen(handle, nativeName, accessMode);
+	handle = TclWinSerialOpen(handle, nativeName, accessMode);
 	if (handle == INVALID_HANDLE_VALUE) {
 	    TclWinConvertError(GetLastError());
 	    if (interp != (Tcl_Interp *) NULL) {
@@ -1476,6 +1507,122 @@ FileGetType(
     return type;
 }
 
+ /*
+ *----------------------------------------------------------------------
+ *
+ * NativeIsComPort --
+ *
+ *	Determines if a path refers to a Windows serial port.
+ *	A simple and efficient solution is to use a "name hint" to detect 
+ *      COM ports by their filename instead of resorting to a syscall 
+ *	to detect serialness after the fact.
+ *	The following patterns cover common serial port names:
+ *	    COM[1-9]:?
+ *	    //./COM[0-9]+
+ *	    \\.\COM[0-9]+
+ *
+ * Results:
+ *	1 = serial port, 0 = not.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NativeIsComPort(
+    const TCHAR *nativePath)	/* Path of file to access, native encoding. */
+{
+    /*
+     * Use wide-char or plain character case-insensitive comparison
+     */
+    if (tclWinProcs->useWide) {
+	const WCHAR *p = (const WCHAR *) nativePath;
+	int i, len = wcslen(p);
+
+	/*
+	 * 1. Look for com[1-9]:?
+	 */
+
+	if ( (len >= 4) && (len <= 5) 
+		&& (_wcsnicmp(p, L"com", 3) == 0) ) {
+	    /*
+	    * The 4th character must be a digit 1..9 optionally followed by a ":"
+	    */
+
+	    if ( (p[3] < L'1') || (p[3] > L'9') ) {
+		return 0;
+	    }
+	    if ( (len == 5) && (p[4] != L':') ) {
+		return 0;
+	    }
+	    return 1;
+	}
+
+	/*
+	 * 2. Look for //./com[0-9]+ or \\.\com[0-9]+
+	 */
+
+	if ( (len >= 8) && ( 
+		   (_wcsnicmp(p, L"//./com", 7) == 0)
+		|| (_wcsnicmp(p, L"\\\\.\\com", 7) == 0) ) )
+	{
+	    /*
+	    * Charaters 8..end must be a digits 0..9
+	    */
+
+	    for ( i=7; i<len; i++ ) {
+		if ( (p[i] < '0') || (p[i] > '9') ) {
+		    return 0;
+		}
+	    }
+	    return 1;
+	}
+
+    } else {
+	const char *p = (const char *) nativePath;
+	int   i, len = strlen(p);
+
+	/*
+	 * 1. Look for com[1-9]:?
+	 */
+
+	if ( (len >= 4) && (len <= 5) 
+		&& (strnicmp(p, "com", 3) == 0) ) {
+	    /*
+	    * The 4th character must be a digit 1..9 optionally followed by a ":"
+	    */
+
+	    if ( (p[3] < '1') || (p[3] > '9') ) {
+		return 0;
+	    }
+	    if ( (len == 5) && (p[4] != ':') ) {
+		return 0;
+	    }
+	    return 1;
+	}
+
+	/*
+	 * 2. Look for //./com[0-9]+ or \\.\com[0-9]+
+	 */
+
+	if ( (len >= 8) && ( 
+		   (strnicmp(p, "//./com", 7) == 0)
+		|| (strnicmp(p, "\\\\.\\com", 7) == 0) ) )
+	{
+	    /*
+	    * Charaters 8..end must be a digits 0..9
+	    */
+
+	    for ( i=7; i<len; i++ ) {
+		if ( (p[i] < '0') || (p[i] > '9') ) {
+		    return 0;
+		}
+	    }
+	    return 1;
+	}
+    }
+    return 0;
+}
+
 /*
  * Local Variables:
  * mode: c
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index 3d5e275..ccf48bb 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.h
@@ -187,7 +187,7 @@ MODULE_SCOPE Tcl_Channel TclWinOpenFileChannel(HANDLE handle, char *channelName,
 MODULE_SCOPE Tcl_Channel TclWinOpenSerialChannel(HANDLE handle,
 			    char *channelName, int permissions);
 MODULE_SCOPE void	TclWinResetInterfaceEncodings();
-MODULE_SCOPE HANDLE	TclWinSerialReopen(HANDLE handle, CONST TCHAR *name,
+MODULE_SCOPE HANDLE	TclWinSerialOpen(HANDLE handle, CONST TCHAR *name,
 			    DWORD access);
 MODULE_SCOPE int	TclWinSymLinkCopyDirectory(CONST TCHAR* LinkOriginal,
 			    CONST TCHAR* LinkCopy);
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index d5244ac..312a2f8 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -1410,23 +1410,22 @@ SerialWriterThread(
 /*
  *----------------------------------------------------------------------
  *
- * TclWinSerialReopen --
+ * TclWinSerialOpen --
  *
- *	Reopens the serial port with the OVERLAPPED FLAG set
+ *	Opens or Reopens the serial port with the OVERLAPPED FLAG set
  *
  * Results:
- *	Returns the new handle, or INVALID_HANDLE_VALUE. Normally there
- *	shouldn't be any error, because the same channel has previously been
- *	succeesfully opened.
+ *	Returns the new handle, or INVALID_HANDLE_VALUE. 
+ *	I an existing channel is specified it is closed and reopened.
  *
  * Side effects:
- *	May close the original handle
+ *	May close/reopen the original handle
  *
  *----------------------------------------------------------------------
  */
 
 HANDLE
-TclWinSerialReopen(
+TclWinSerialOpen(
     HANDLE handle,
     CONST TCHAR *name,
     DWORD access)
@@ -1434,16 +1433,22 @@ TclWinSerialReopen(
     SerialInit();
 
     /*
+     * If an open channel is specified, close it
+     */
+
+    if ( handle != INVALID_HANDLE_VALUE && CloseHandle(handle) == FALSE) {
+	return INVALID_HANDLE_VALUE;
+    }
+
+    /*
      * Multithreaded I/O needs the overlapped flag set otherwise
      * ClearCommError blocks under Windows NT/2000 until serial output is
      * finished
      */
 
-    if (CloseHandle(handle) == FALSE) {
-	return INVALID_HANDLE_VALUE;
-    }
     handle = (*tclWinProcs->createFileProc)(name, access, 0, 0,
 	    OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
+
     return handle;
 }
 
-- 
cgit v0.12


From 11b2556b272a74d9456a2b0b9cef5ccc76fd8316 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 6 Feb 2014 19:04:36 +0000
Subject: Revised ReadChars to restore an attempt to make sure we do not short
 read because of a false notion of limited storage space. The test suite does
 not appear to demonstrate any case where this matters. Could be an incomplete
 test suite, or an example of pointless code.

---
 generic/tclIO.c        |  8 +++++++-
 generic/tclInt.h       |  2 ++
 generic/tclStringObj.c | 32 ++++++++++++++++++++++++++++++++
 3 files changed, 41 insertions(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index f8baba3..cedf3f6 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5310,7 +5310,13 @@ ReadChars(
     dstNeeded = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
     (void) TclGetStringFromObj(objPtr, &numBytes);
     Tcl_AppendToObj(objPtr, NULL, dstNeeded);
-    dst = TclGetString(objPtr) + numBytes;
+    if (toRead == srcLen) {
+	unsigned int size;
+	dst = TclGetStringStorage(objPtr, &size) + numBytes;
+	dstNeeded = size - numBytes;
+    } else {
+	dst = TclGetString(objPtr) + numBytes;
+    }
 
     /*
      * [Bug 1462248]: The cause of the crash reported in this bug is this:
diff --git a/generic/tclInt.h b/generic/tclInt.h
index a998460..0c09ec0 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2571,6 +2571,8 @@ MODULE_SCOPE int	TclGetOpenModeEx(Tcl_Interp *interp,
 			    int *binaryPtr);
 MODULE_SCOPE Tcl_Obj *	TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
 MODULE_SCOPE const char *TclGetSrcInfoForCmd(Interp *iPtr, int *lenPtr);
+MODULE_SCOPE char *	TclGetStringStorage(Tcl_Obj *objPtr,
+			    unsigned int *sizePtr);
 MODULE_SCOPE int	TclGlob(Tcl_Interp *interp, char *pattern,
 			    Tcl_Obj *unquotedPrefix, int globFlags,
 			    Tcl_GlobTypeData *types);
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index d96d814..8c6a376 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -2711,6 +2711,38 @@ Tcl_ObjPrintf(
 /*
  *---------------------------------------------------------------------------
  *
+ * TclGetStringStorage --
+ *
+ *	Returns the string storage space of a Tcl_Obj.
+ *
+ * Results:
+ *	The pointer value objPtr->bytes is returned and the number of bytes
+ *	allocated there is written to *sizePtr (if known).
+ *
+ * Side effects:
+ *	May set objPtr->bytes.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+char *
+TclGetStringStorage(
+    Tcl_Obj *objPtr,
+    unsigned int *sizePtr)
+{
+    String *stringPtr;
+
+    if (objPtr->typePtr != &tclStringType || objPtr->bytes == NULL) {
+	return TclGetStringFromObj(objPtr, (int *)sizePtr);
+    }
+
+    stringPtr = GET_STRING(objPtr);
+    *sizePtr = stringPtr->allocated;
+    return objPtr->bytes;
+}
+/*
+ *---------------------------------------------------------------------------
+ *
  * TclStringObjReverse --
  *
  *	Implements the [string reverse] operation.
-- 
cgit v0.12


From d8e6ba4a3b30e39fc7cde4cb5550d2157c95e194 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 10 Feb 2014 11:59:22 +0000
Subject: Eliminate all usage of WIN32 and __WIN32__ macros: Some compilers
 (e.g. Clang/LLVM) don't define it, and _WIN32 is much more portable anyway.
 See:
 [http://nadeausoftware.com/articles/2012/01/c_c_tip_how_use_compiler_predefined_macros_detect_operating_system#WindowsCygwinnonPOSIXandMinGW]

---
 generic/tcl.h             | 35 ++++++++++++++++-------------------
 generic/tclClock.c        |  2 +-
 generic/tclCmdAH.c        |  2 +-
 generic/tclDecls.h        | 24 ++++++++++++------------
 generic/tclEnv.c          |  4 ++--
 generic/tclFCmd.c         |  2 +-
 generic/tclIOUtil.c       |  8 ++++----
 generic/tclIntDecls.h     |  0
 generic/tclIntPlatDecls.h | 16 ++++++++--------
 generic/tclLoad.c         |  4 ++--
 generic/tclMain.c         |  2 +-
 generic/tclPathObj.c      |  6 +++---
 generic/tclPlatDecls.h    |  6 +++---
 generic/tclStubInit.c     | 20 ++++++++++----------
 generic/tclTest.c         |  6 +++---
 generic/tclThreadJoin.c   |  4 ++--
 tools/genStubs.tcl        |  6 +++---
 win/configure             |  4 ++--
 win/tcl.m4                |  4 ++--
 win/tclWin32Dll.c         |  4 ++--
 win/tclWinTest.c          |  2 +-
 21 files changed, 79 insertions(+), 82 deletions(-)
 mode change 100644 => 100755 generic/tclDecls.h
 mode change 100644 => 100755 generic/tclIntDecls.h
 mode change 100644 => 100755 generic/tclIntPlatDecls.h
 mode change 100644 => 100755 generic/tclPlatDecls.h
 mode change 100644 => 100755 generic/tclStubInit.c

diff --git a/generic/tcl.h b/generic/tcl.h
index b7237bf..b93b3ac 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -67,15 +67,12 @@ extern "C" {
  * We use this method because there is no autoconf equivalent.
  */
 
-#ifndef __WIN32__
-#   if defined(_WIN32) || defined(WIN32) || defined(__MINGW32__) || defined(__BORLANDC__) || (defined(__WATCOMC__) && defined(__WINDOWS_386__))
+#ifdef _WIN32
+#   ifndef __WIN32__
 #	define __WIN32__
-#	ifndef WIN32
-#	    define WIN32
-#	endif
-#	ifndef _WIN32
-#	    define _WIN32
-#	endif
+#   endif
+#   ifndef WIN32
+#	define WIN32
 #   endif
 #endif
 
@@ -83,11 +80,11 @@ extern "C" {
  * STRICT: See MSDN Article Q83456
  */
 
-#ifdef __WIN32__
+#ifdef _WIN32
 #   ifndef STRICT
 #	define STRICT
 #   endif
-#endif /* __WIN32__ */
+#endif /* _WIN32 */
 
 /*
  * Utility macros: STRINGIFY takes an argument and wraps it in "" (double
@@ -191,7 +188,7 @@ extern "C" {
  *       MSVCRT.
  */
 
-#if (defined(__WIN32__) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
+#if (defined(_WIN32) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
 #   define HAVE_DECLSPEC 1
 #   ifdef STATIC_BUILD
 #       define DLLIMPORT
@@ -315,14 +312,14 @@ extern "C" {
  * VOID. This block is skipped under Cygwin and Mingw.
  */
 
-#if defined(__WIN32__) && !defined(HAVE_WINNT_IGNORE_VOID)
+#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID)
 #ifndef VOID
 #define VOID void
 typedef char CHAR;
 typedef short SHORT;
 typedef long LONG;
 #endif
-#endif /* __WIN32__ && !HAVE_WINNT_IGNORE_VOID */
+#endif /* _WIN32 && !HAVE_WINNT_IGNORE_VOID */
 
 /*
  * Macro to use instead of "void" for arguments that must have type "void *"
@@ -390,7 +387,7 @@ typedef long LONG;
  */
 
 #if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
-#   if defined(__WIN32__)
+#   if defined(_WIN32)
 #      define TCL_WIDE_INT_TYPE __int64
 #      ifdef __BORLANDC__
 #         define TCL_LL_MODIFIER	"L"
@@ -400,7 +397,7 @@ typedef long LONG;
 #   elif defined(__GNUC__)
 #      define TCL_WIDE_INT_TYPE long long
 #      define TCL_LL_MODIFIER	"ll"
-#   else /* ! __WIN32__ && ! __GNUC__ */
+#   else /* ! _WIN32 && ! __GNUC__ */
 /*
  * Don't know what platform it is and configure hasn't discovered what is
  * going on for us. Try to guess...
@@ -415,7 +412,7 @@ typedef long LONG;
 #	     define TCL_WIDE_INT_TYPE long long
 #         endif
 #      endif /* NO_LIMITS_H */
-#   endif /* __WIN32__ */
+#   endif /* _WIN32 */
 #endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */
 #ifdef TCL_WIDE_INT_IS_LONG
 #   undef TCL_WIDE_INT_TYPE
@@ -447,7 +444,7 @@ typedef unsigned TCL_WIDE_INT_TYPE	Tcl_WideUInt;
 #   define Tcl_DoubleAsWide(val)	((Tcl_WideInt)((double)(val)))
 #endif /* TCL_WIDE_INT_IS_LONG */
 
-#if defined(__WIN32__)
+#if defined(_WIN32)
 #   ifdef __BORLANDC__
 	typedef struct stati64 Tcl_StatBuf;
 #   elif defined(_WIN64)
@@ -562,7 +559,7 @@ typedef struct Tcl_ZLibStream_ *Tcl_ZlibStream;
  * will be called as the main fuction of the new thread created by that call.
  */
 
-#if defined __WIN32__
+#if defined _WIN32
 typedef unsigned (__stdcall Tcl_ThreadCreateProc) (ClientData clientData);
 #else
 typedef void (Tcl_ThreadCreateProc) (ClientData clientData);
@@ -574,7 +571,7 @@ typedef void (Tcl_ThreadCreateProc) (ClientData clientData);
  * in generic/tclThreadTest.c for it's usage.
  */
 
-#if defined __WIN32__
+#if defined _WIN32
 #   define Tcl_ThreadCreateType		unsigned __stdcall
 #   define TCL_THREAD_CREATE_RETURN	return 0
 #else
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 6d2976d..50d480c 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -19,7 +19,7 @@
  * Windows has mktime. The configurators do not check.
  */
 
-#ifdef __WIN32__
+#ifdef _WIN32
 #define HAVE_MKTIME 1
 #endif
 
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index f90819a..d90a747 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -1590,7 +1590,7 @@ FileAttrIsOwnedCmd(
 	 * test for equivalence to the current user.
 	 */
 
-#if defined(__WIN32__) || defined(__CYGWIN__)
+#if defined(_WIN32) || defined(__CYGWIN__)
 	value = 1;
 #else
 	value = (geteuid() == buf.st_uid);
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
old mode 100644
new mode 100755
index 830c998..91c0add
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -63,7 +63,7 @@ EXTERN void		Tcl_DbCkfree(char *ptr, const char *file, int line);
 /* 8 */
 EXTERN char *		Tcl_DbCkrealloc(char *ptr, unsigned int size,
 				const char *file, int line);
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
 /* 9 */
 EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
 				Tcl_FileProc *proc, ClientData clientData);
@@ -73,7 +73,7 @@ EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
 EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
 				Tcl_FileProc *proc, ClientData clientData);
 #endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
 /* 10 */
 EXTERN void		Tcl_DeleteFileHandler(int fd);
 #endif /* UNIX */
@@ -511,7 +511,7 @@ EXTERN Tcl_Interp *	Tcl_GetMaster(Tcl_Interp *interp);
 EXTERN const char *	Tcl_GetNameOfExecutable(void);
 /* 166 */
 EXTERN Tcl_Obj *	Tcl_GetObjResult(Tcl_Interp *interp);
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
 /* 167 */
 EXTERN int		Tcl_GetOpenFile(Tcl_Interp *interp,
 				const char *chanID, int forWriting,
@@ -1835,19 +1835,19 @@ typedef struct TclStubs {
     char * (*tcl_DbCkalloc) (unsigned int size, const char *file, int line); /* 6 */
     void (*tcl_DbCkfree) (char *ptr, const char *file, int line); /* 7 */
     char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 8 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
     void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
 #endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
     void (*reserved9)(void);
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
     void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
 #endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
     void (*tcl_DeleteFileHandler) (int fd); /* 10 */
 #endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
     void (*reserved10)(void);
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
@@ -2009,10 +2009,10 @@ typedef struct TclStubs {
     Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
     const char * (*tcl_GetNameOfExecutable) (void); /* 165 */
     Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
     int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
 #endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
     void (*reserved167)(void);
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
@@ -2513,7 +2513,7 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_DbCkfree) /* 7 */
 #define Tcl_DbCkrealloc \
 	(tclStubsPtr->tcl_DbCkrealloc) /* 8 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
 #define Tcl_CreateFileHandler \
 	(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
 #endif /* UNIX */
@@ -2521,7 +2521,7 @@ extern const TclStubs *tclStubsPtr;
 #define Tcl_CreateFileHandler \
 	(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
 #endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
 #define Tcl_DeleteFileHandler \
 	(tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
 #endif /* UNIX */
@@ -2841,7 +2841,7 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_GetNameOfExecutable) /* 165 */
 #define Tcl_GetObjResult \
 	(tclStubsPtr->tcl_GetObjResult) /* 166 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
 #define Tcl_GetOpenFile \
 	(tclStubsPtr->tcl_GetOpenFile) /* 167 */
 #endif /* UNIX */
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 8f51c1b..cd1a954 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -444,7 +444,7 @@ TclUnsetEnv(
      * that no = should be included, and Windows requires it.
      */
 
-#if defined(__WIN32__) || defined(__CYGWIN__)
+#if defined(_WIN32) || defined(__CYGWIN__)
     string = ckalloc(length + 2);
     memcpy(string, name, (size_t) length);
     string[length] = '=';
@@ -453,7 +453,7 @@ TclUnsetEnv(
     string = ckalloc(length + 1);
     memcpy(string, name, (size_t) length);
     string[length] = '\0';
-#endif /* WIN32 */
+#endif /* _WIN32 */
 
     Tcl_UtfToExternalDString(NULL, string, -1, &envString);
     string = ckrealloc(string, Tcl_DStringLength(&envString) + 1);
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 13377d3..6452fff 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -517,7 +517,7 @@ CopyRenameOneFile(
 	 * 16 bits and we get collisions. See bug #2015723.
 	 */
 
-#if !defined(WIN32) && !defined(__CYGWIN__)
+#if !defined(_WIN32) && !defined(__CYGWIN__)
 	if ((sourceStatBuf.st_ino != 0) && (targetStatBuf.st_ino != 0)) {
 	    if ((sourceStatBuf.st_ino == targetStatBuf.st_ino) &&
 		    (sourceStatBuf.st_dev == targetStatBuf.st_dev)) {
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 6259216..f624cb7 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -19,7 +19,7 @@
  */
 
 #include "tclInt.h"
-#ifdef __WIN32__
+#ifdef _WIN32
 #   include "tclWinInt.h"
 #endif
 #include "tclFileSystem.h"
@@ -792,7 +792,7 @@ TclFinalizeFilesystem(void)
      * filesystem is likely to fail.
      */
 
-#ifdef __WIN32__
+#ifdef _WIN32
     TclWinEncodingsCleanup();
 #endif
 }
@@ -819,7 +819,7 @@ TclResetFilesystem(void)
     filesystemList = &nativeFilesystemRecord;
     theFilesystemEpoch++;
 
-#ifdef __WIN32__
+#ifdef _WIN32
     /*
      * Cleans up the win32 API filesystem proc lookup table. This must happen
      * very late in finalization so that deleting of copied dlls can occur.
@@ -3255,7 +3255,7 @@ Tcl_LoadFile(
 	return TCL_ERROR;
     }
 
-#ifndef __WIN32__
+#ifndef _WIN32
     /*
      * Do we need to set appropriate permissions on the file? This may be
      * required on some systems. On Unix we could loop over the file
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
old mode 100644
new mode 100755
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
old mode 100644
new mode 100755
index 72719fe..2c74b5a
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -13,7 +13,7 @@
 #ifndef _TCLINTPLATDECLS
 #define _TCLINTPLATDECLS
 
-#ifdef __WIN32__
+#ifdef _WIN32
 #   define Tcl_DirEntry void
 #   define DIR void
 #endif
@@ -45,7 +45,7 @@ extern "C" {
  * Exported function declarations:
  */
 
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
 /* 0 */
 EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
 				Tcl_Channel chan);
@@ -104,7 +104,7 @@ EXTERN int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
 				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
 				Tcl_Obj *resultingNameObj);
 #endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
 /* 0 */
 EXTERN void		TclWinConvertError(DWORD errCode);
 /* 1 */
@@ -258,7 +258,7 @@ typedef struct TclIntPlatStubs {
     int magic;
     void *hooks;
 
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
     void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
     int (*tclpCloseFile) (TclFile file); /* 1 */
     Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
@@ -291,7 +291,7 @@ typedef struct TclIntPlatStubs {
     int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
     int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
 #endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
     void (*tclWinConvertError) (DWORD errCode); /* 0 */
     void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */
     struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
@@ -371,7 +371,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
  * Inline function declarations:
  */
 
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
 #define TclGetAndDetachPids \
 	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
 #define TclpCloseFile \
@@ -420,7 +420,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
 #define TclUnixOpenTemporaryFile \
 	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
 #endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
 #define TclWinConvertError \
 	(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
 #define TclWinConvertWSAError \
@@ -550,7 +550,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
 #undef TclpInetNtoa
 #define TclpInetNtoa inet_ntoa
 
-#if defined(__WIN32__) || defined(__CYGWIN__)
+#if defined(_WIN32) || defined(__CYGWIN__)
 #   undef TclWinNToHS
 #   define TclWinNToHS ntohs
 #else
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 5cacab1..7c70e03 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -830,7 +830,7 @@ Tcl_UnloadObjCmd(
 	 * Unload the shared library from the application memory...
 	 */
 
-#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
+#if defined(TCL_UNLOAD_DLLS) || defined(_WIN32)
 	/*
 	 * Some Unix dlls are poorly behaved - registering things like atexit
 	 * calls that can't be unregistered. If you unload such dlls, you get
@@ -1151,7 +1151,7 @@ TclFinalizeLoad(void)
 	pkgPtr = firstPackagePtr;
 	firstPackagePtr = pkgPtr->nextPtr;
 
-#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
+#if defined(TCL_UNLOAD_DLLS) || defined(_WIN32)
 	/*
 	 * Some Unix dlls are poorly behaved - registering things like atexit
 	 * calls that can't be unregistered. If you unload such dlls, you get
diff --git a/generic/tclMain.c b/generic/tclMain.c
index faea75a..360f5e9 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -47,7 +47,7 @@
  * we have to translate that to strcmp here.
  */
 
-#ifndef __WIN32__
+#ifndef _WIN32
 #   define TCHAR char
 #   define TEXT(arg) arg
 #   define _tcscmp strcmp
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index b7f3dcf..fe6063f 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -512,7 +512,7 @@ TclFSGetPathType(
 
     if (PATHFLAGS(pathPtr) == 0) {
 	/* The path is not absolute... */
-#ifdef __WIN32__
+#ifdef _WIN32
 	/* ... on Windows we must make another call to determine whether
 	 * it's relative or volumerelative [Bug 2571597]. */
 	return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
@@ -1956,7 +1956,7 @@ Tcl_FSGetNormalizedPath(
 		/*
 		 * We have a refCount on the cwd.
 		 */
-#ifdef __WIN32__
+#ifdef _WIN32
 	    } else if (type == TCL_PATH_VOLUME_RELATIVE) {
 		/*
 		 * Only Windows has volume-relative paths.
@@ -1969,7 +1969,7 @@ Tcl_FSGetNormalizedPath(
 		    return NULL;
 		}
 		pureNormalized = 0;
-#endif /* __WIN32__ */
+#endif /* _WIN32 */
 	    }
 	}
 
diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h
old mode 100644
new mode 100755
index 681854d..abc8ee8
--- a/generic/tclPlatDecls.h
+++ b/generic/tclPlatDecls.h
@@ -50,7 +50,7 @@ extern "C" {
  * Exported function declarations:
  */
 
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
 /* 0 */
 EXTERN TCHAR *		Tcl_WinUtfToTChar(const char *str, int len,
 				Tcl_DString *dsPtr);
@@ -75,7 +75,7 @@ typedef struct TclPlatStubs {
     int magic;
     void *hooks;
 
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
     TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */
     char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
 #endif /* WIN */
@@ -97,7 +97,7 @@ extern const TclPlatStubs *tclPlatStubsPtr;
  * Inline function declarations:
  */
 
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
 #define Tcl_WinUtfToTChar \
 	(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
 #define Tcl_WinTCharToUtf \
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
old mode 100644
new mode 100755
index e1918ef..097269f
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -90,7 +90,7 @@ static unsigned short TclWinNToHS(unsigned short ns) {
 }
 #endif
 
-#ifdef __WIN32__
+#ifdef _WIN32
 #   define TclUnixWaitForFile 0
 #   define TclUnixCopyFile 0
 #   define TclUnixOpenTemporaryFile 0
@@ -557,7 +557,7 @@ static const TclIntStubs tclIntStubs = {
 static const TclIntPlatStubs tclIntPlatStubs = {
     TCL_STUB_MAGIC,
     0,
-#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
     TclGetAndDetachPids, /* 0 */
     TclpCloseFile, /* 1 */
     TclpCreateCommandChannel, /* 2 */
@@ -590,7 +590,7 @@ static const TclIntPlatStubs tclIntPlatStubs = {
     TclWinCPUID, /* 29 */
     TclUnixOpenTemporaryFile, /* 30 */
 #endif /* UNIX */
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
     TclWinConvertError, /* 0 */
     TclWinConvertWSAError, /* 1 */
     TclWinGetServByName, /* 2 */
@@ -661,7 +661,7 @@ static const TclIntPlatStubs tclIntPlatStubs = {
 static const TclPlatStubs tclPlatStubs = {
     TCL_STUB_MAGIC,
     0,
-#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
+#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
     Tcl_WinUtfToTChar, /* 0 */
     Tcl_WinTCharToUtf, /* 1 */
 #endif /* WIN */
@@ -758,19 +758,19 @@ const TclStubs tclStubs = {
     Tcl_DbCkalloc, /* 6 */
     Tcl_DbCkfree, /* 7 */
     Tcl_DbCkrealloc, /* 8 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
     Tcl_CreateFileHandler, /* 9 */
 #endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
     0, /* 9 */
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
     Tcl_CreateFileHandler, /* 9 */
 #endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
     Tcl_DeleteFileHandler, /* 10 */
 #endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
     0, /* 10 */
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
@@ -932,10 +932,10 @@ const TclStubs tclStubs = {
     Tcl_GetMaster, /* 164 */
     Tcl_GetNameOfExecutable, /* 165 */
     Tcl_GetObjResult, /* 166 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
     Tcl_GetOpenFile, /* 167 */
 #endif /* UNIX */
-#if defined(__WIN32__) /* WIN */
+#if defined(_WIN32) /* WIN */
     0, /* 167 */
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index f121d0d..a27c95a 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -414,7 +414,7 @@ static int		TestNRELevels(ClientData clientData,
 static int		TestInterpResolverCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
-#if defined(HAVE_CPUID) || defined(__WIN32__)
+#if defined(HAVE_CPUID) || defined(_WIN32)
 static int		TestcpuidCmd(ClientData dummy,
 			    Tcl_Interp* interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -681,7 +681,7 @@ Tcltest_Init(
 	    NULL, NULL);
     Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
 	    NULL, NULL);
-#if defined(HAVE_CPUID) || defined(__WIN32__)
+#if defined(HAVE_CPUID) || defined(_WIN32)
     Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
 	    (ClientData) 0, NULL);
 #endif
@@ -6648,7 +6648,7 @@ TestNumUtfCharsCmd(
     return TCL_OK;
 }
 
-#if defined(HAVE_CPUID) || defined(__WIN32__)
+#if defined(HAVE_CPUID) || defined(_WIN32)
 /*
  *----------------------------------------------------------------------
  *
diff --git a/generic/tclThreadJoin.c b/generic/tclThreadJoin.c
index 4b09e1c..5c70a62 100644
--- a/generic/tclThreadJoin.c
+++ b/generic/tclThreadJoin.c
@@ -14,7 +14,7 @@
 
 #include "tclInt.h"
 
-#ifdef WIN32
+#ifdef _WIN32
 
 /*
  * The information about each joinable thread is remembered in a structure as
@@ -305,7 +305,7 @@ TclSignalExitThread(
 
     Tcl_MutexUnlock(&threadPtr->threadMutex);
 }
-#endif /* WIN32 */
+#endif /* _WIN32 */
 
 /*
  * Local Variables:
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index b45e560..7a75dc6 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -283,7 +283,7 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} {
     set text ""
     switch $plat {
 	win {
-	    append text "#if defined(__WIN32__)"
+	    append text "#if defined(_WIN32)"
 	    if {$withCygwin} {
 		append text " || defined(__CYGWIN__)"
 	    }
@@ -294,7 +294,7 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} {
 	    append text "#endif /* WIN */\n"
 	}
 	unix {
-	    append text "#if !defined(__WIN32__)"
+	    append text "#if !defined(_WIN32)"
 	    if {$withCygwin} {
 		append text " && !defined(__CYGWIN__)"
 	    }
@@ -320,7 +320,7 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} {
 	    append text "#endif /* AQUA */\n"
 	}
 	x11 {
-	    append text "#if !(defined(__WIN32__)"
+	    append text "#if !(defined(_WIN32)"
 	    if {$withCygwin} {
 		append text " || defined(__CYGWIN__)"
 	    }
diff --git a/win/configure b/win/configure
index 569172e..2affd38 100755
--- a/win/configure
+++ b/win/configure
@@ -3340,7 +3340,7 @@ cat confdefs.h >>conftest.$ac_ext
 cat >>conftest.$ac_ext <<_ACEOF
 /* end confdefs.h.  */
 
-	    #ifndef __WIN32__
+	    #ifndef _WIN32
 		#error cross-compiler
 	    #endif
 
@@ -3463,7 +3463,7 @@ cat confdefs.h >>conftest.$ac_ext
 cat >>conftest.$ac_ext <<_ACEOF
 /* end confdefs.h.  */
 
-		#ifdef __WIN32__
+		#ifdef _WIN32
 		    #error win32
 		#endif
 
diff --git a/win/tcl.m4 b/win/tcl.m4
index 625c329..d12ae10 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -572,7 +572,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
       AC_CACHE_CHECK(for cross-compile version of gcc,
 	ac_cv_cross,
 	AC_TRY_COMPILE([
-	    #ifndef __WIN32__
+	    #ifndef _WIN32
 		#error cross-compiler
 	    #endif
 	], [],
@@ -639,7 +639,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 	AC_CACHE_CHECK(for mingw32 version of gcc,
 	    ac_cv_win32,
 	    AC_TRY_COMPILE([
-		#ifdef __WIN32__
+		#ifdef _WIN32
 		    #error win32
 		#endif
 	    ], [],
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index 634e1d2..688fa8d 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.c
@@ -69,7 +69,7 @@ TCL_DECLARE_MUTEX(mountPointMap)
  * We will need this below.
  */
 
-#ifdef __WIN32__
+#ifdef _WIN32
 #ifndef STATIC_BUILD
 
 /*
@@ -137,7 +137,7 @@ DllMain(
     return TRUE;
 }
 #endif /* !STATIC_BUILD */
-#endif /* __WIN32__ */
+#endif /* _WIN32 */
 
 /*
  *----------------------------------------------------------------------
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index b83c0ba..6027e32 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -17,7 +17,7 @@
 /*
  * For TestplatformChmod on Windows
  */
-#ifdef __WIN32__
+#ifdef _WIN32
 #include <aclapi.h>
 #endif
 
-- 
cgit v0.12


From 38e56569f541a17fd0445bc3619d66e985e823db Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Tue, 11 Feb 2014 08:53:33 +0000
Subject: Changed position of flag evaluation as proposed by Phil Hoffman

---
 win/tclWinChan.c | 36 ++++++++++++++++++------------------
 1 file changed, 18 insertions(+), 18 deletions(-)

diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index 19e3655..6d480a8 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -886,24 +886,6 @@ TclpOpenFileChannel(
     }
 
     /*
-     * If the file is being created, get the file attributes from the
-     * permissions argument, else use the existing file attributes.
-     */
-
-    if (mode & O_CREAT) {
-	if (permissions & S_IWRITE) {
-	    flags = FILE_ATTRIBUTE_NORMAL;
-	} else {
-	    flags = FILE_ATTRIBUTE_READONLY;
-	}
-    } else {
-	flags = (*tclWinProcs->getFileAttributesProc)(nativeName);
-	if (flags == 0xFFFFFFFF) {
-	    flags = 0;
-	}
-    }
-
-    /*
      * [2413550] Avoid double-open of serial ports on Windows
      * Special handling for Windows serial ports by a "name-hint"
      * to directly open it with the OVERLAPPED flag set.
@@ -931,6 +913,24 @@ TclpOpenFileChannel(
 	return channel;
     }
     /*
+     * If the file is being created, get the file attributes from the
+     * permissions argument, else use the existing file attributes.
+     */
+
+    if (mode & O_CREAT) {
+	if (permissions & S_IWRITE) {
+	    flags = FILE_ATTRIBUTE_NORMAL;
+	} else {
+	    flags = FILE_ATTRIBUTE_READONLY;
+	}
+    } else {
+	flags = (*tclWinProcs->getFileAttributesProc)(nativeName);
+	if (flags == 0xFFFFFFFF) {
+	    flags = 0;
+	}
+    }
+
+    /*
      * Set up the file sharing mode.  We want to allow simultaneous access.
      */
 
-- 
cgit v0.12


From 67d68fe341c4c825148b48d7fd74d2136ac8fa6a Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 11 Feb 2014 10:58:30 +0000
Subject: Fix execute permission bit (should not be set) for *Decls.h files

---
 generic/tclDecls.h        | 0
 generic/tclIntDecls.h     | 0
 generic/tclIntPlatDecls.h | 0
 generic/tclPlatDecls.h    | 0
 generic/tclStubInit.c     | 0
 5 files changed, 0 insertions(+), 0 deletions(-)
 mode change 100755 => 100644 generic/tclDecls.h
 mode change 100755 => 100644 generic/tclIntDecls.h
 mode change 100755 => 100644 generic/tclIntPlatDecls.h
 mode change 100755 => 100644 generic/tclPlatDecls.h
 mode change 100755 => 100644 generic/tclStubInit.c

diff --git a/generic/tclDecls.h b/generic/tclDecls.h
old mode 100755
new mode 100644
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
old mode 100755
new mode 100644
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
old mode 100755
new mode 100644
diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h
old mode 100755
new mode 100644
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
old mode 100755
new mode 100644
-- 
cgit v0.12


From 08700ad2348944e47107ddbcbf18bbd7d861668d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 11 Feb 2014 19:53:41 +0000
Subject: Refactor so that CopyAndTranslateBuffer() calls on
 TranslateInputEOL() instead of duplicating so much of its function.  Note the
 testing gaps.

---
 generic/tclIO.c | 18 ++++++++++++++++--
 1 file changed, 16 insertions(+), 2 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index cedf3f6..09b8191 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -8805,8 +8805,6 @@ CopyAndTranslateBuffer(
 				 * in the current input buffer? */
     int copied;			/* How many characters were already copied
 				 * into the destination space? */
-    int i;			/* Iterates over the copied input looking for
-				 * the input eofChar. */
 
     /*
      * If there is no input at all, return zero. The invariant is that either
@@ -8821,6 +8819,15 @@ CopyAndTranslateBuffer(
     bufPtr = statePtr->inQueueHead;
     bytesInBuffer = BytesLeft(bufPtr);
 
+#if 1
+    copied = space;
+    if (bytesInBuffer <= copied) {
+	copied = bytesInBuffer;
+    }
+    TranslateInputEOL(statePtr, result, RemovePoint(bufPtr),
+	    &copied, &bytesInBuffer);
+    bufPtr->nextRemoved += copied;
+#else
     copied = 0;
     switch (statePtr->inputTranslation) {
     case TCL_TRANSLATE_LF:
@@ -8842,6 +8849,7 @@ CopyAndTranslateBuffer(
     case TCL_TRANSLATE_CR: {
 	char *end;
 
+	Tcl_Panic("Untested");
 	if (bytesInBuffer == 0) {
 	    return 0;
 	}
@@ -8873,6 +8881,7 @@ CopyAndTranslateBuffer(
 	 * If there is a held-back "\r" at EOF, produce it now.
 	 */
 
+	Tcl_Panic("Untested");
 	if (bytesInBuffer == 0) {
 	    if ((statePtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
 		    (INPUT_SAW_CR | CHANNEL_EOF)) {
@@ -8940,6 +8949,7 @@ CopyAndTranslateBuffer(
 	for (src = result; src < end; src++) {
 	    curByte = *src;
 	    if (curByte == '\r') {
+		Tcl_Panic("Untested");
 		SetFlag(statePtr, INPUT_SAW_CR);
 		*dst = '\n';
 		dst++;
@@ -8965,6 +8975,9 @@ CopyAndTranslateBuffer(
      */
 
     if (statePtr->inEofChar != 0) {
+	int i;
+
+	Tcl_Panic("Untested");
 	for (i = 0; i < copied; i++) {
 	    if (result[i] == (char) statePtr->inEofChar) {
 		/*
@@ -8979,6 +8992,7 @@ CopyAndTranslateBuffer(
 	    }
 	}
     }
+#endif
 
     /*
      * If the current buffer is empty recycle it.
-- 
cgit v0.12


From c3c6e18ae396cac45fbc5d94ce9e2e7b7cc2ffc3 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 12 Feb 2014 12:13:32 +0000
Subject: typo

---
 unix/tclConfig.sh.in | 2 +-
 win/tclConfig.sh.in  | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/unix/tclConfig.sh.in b/unix/tclConfig.sh.in
index d47e686..b58e9fd 100644
--- a/unix/tclConfig.sh.in
+++ b/unix/tclConfig.sh.in
@@ -165,5 +165,5 @@ TCL_BUILD_STUB_LIB_PATH='@TCL_BUILD_STUB_LIB_PATH@'
 # Path to the Tcl stub library in the install directory.
 TCL_STUB_LIB_PATH='@TCL_STUB_LIB_PATH@'
 
-# Flag, 1: we built Tcl with threads enables, 0 we didn't
+# Flag, 1: we built Tcl with threads enabled, 0 we didn't
 TCL_THREADS=@TCL_THREADS@
diff --git a/win/tclConfig.sh.in b/win/tclConfig.sh.in
index 65bc5c5..00a8790 100644
--- a/win/tclConfig.sh.in
+++ b/win/tclConfig.sh.in
@@ -175,6 +175,6 @@ TCL_BUILD_STUB_LIB_PATH='@TCL_BUILD_STUB_LIB_PATH@'
 # Path to the Tcl stub library in the install directory.
 TCL_STUB_LIB_PATH='@TCL_STUB_LIB_PATH@'
 
-# Flag, 1: we built Tcl with threads enables, 0 we didn't
+# Flag, 1: we built Tcl with threads enabled, 0 we didn't
 TCL_THREADS=@TCL_THREADS@
 
-- 
cgit v0.12


From bd474d3d6b7f770543d6e93ca2b6c9212c551bdf Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 16 Feb 2014 08:18:29 +0000
Subject: [9bf7e67b37]: minor documentation blooper

---
 doc/tclvars.n | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/doc/tclvars.n b/doc/tclvars.n
index 2fec222..9d7a4ce 100644
--- a/doc/tclvars.n
+++ b/doc/tclvars.n
@@ -10,7 +10,7 @@
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
-argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_precision, tcl_rcFileName, tcl_traceCompile, tcl_traceEval, tcl_wordchars, tcl_version \- Variables used by Tcl
+argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_precision, tcl_rcFileName, tcl_traceCompile, tcl_traceExec, tcl_wordchars, tcl_version \- Variables used by Tcl
 .BE
 .SH DESCRIPTION
 .PP
-- 
cgit v0.12


From abe90f6c1b82d92b9e000f861edde447cf1d7863 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 18 Feb 2014 17:54:06 +0000
Subject: Coverage test for -translation auto handling of INPUT_SAW_CR flag.
 Demonstrates refactor failure.

---
 generic/tclIO.c |  1 -
 tests/io.test   | 15 +++++++++++++++
 2 files changed, 15 insertions(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 09b8191..20101c2 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -8949,7 +8949,6 @@ CopyAndTranslateBuffer(
 	for (src = result; src < end; src++) {
 	    curByte = *src;
 	    if (curByte == '\r') {
-		Tcl_Panic("Untested");
 		SetFlag(statePtr, INPUT_SAW_CR);
 		*dst = '\n';
 		dst++;
diff --git a/tests/io.test b/tests/io.test
index 68051d7..e08c57a 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -6730,6 +6730,21 @@ test io-52.11 {TclCopyChannel & encodings} {fcopy} {
     file size $path(kyrillic.txt)
 } 3
 
+test io-52.12 {coverage of -translation auto} {
+    file delete $path(test1) $path(test2)
+    set out [open $path(test1) wb]
+    chan configure $out -translation lf
+    puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+    close $out
+    set in [open $path(test1)]
+    chan configure $in -buffersize 8
+    set out [open $path(test2) w]
+    fcopy $in $out
+    close $in
+    close $out
+    file size $path(test2)
+} 29
+
 test io-53.1 {CopyData} {fcopy} {
     file delete $path(test1)
     set f1 [open $thisScript]
-- 
cgit v0.12


From e3b160fb968cfca1ba3255292e5583bd0bf3e37d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 18 Feb 2014 18:26:22 +0000
Subject: Refactor correction exposed by coverage test.

---
 generic/tclIO.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 20101c2..01af6dc 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -8826,7 +8826,7 @@ CopyAndTranslateBuffer(
     }
     TranslateInputEOL(statePtr, result, RemovePoint(bufPtr),
 	    &copied, &bytesInBuffer);
-    bufPtr->nextRemoved += copied;
+    bufPtr->nextRemoved += bytesInBuffer;
 #else
     copied = 0;
     switch (statePtr->inputTranslation) {
-- 
cgit v0.12


From 997ad71bccf25cf78178d99b5bd94103ef365e4d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 18 Feb 2014 18:35:19 +0000
Subject: coverage test for -translation cr

---
 generic/tclIO.c |  1 -
 tests/io.test   | 14 ++++++++++++++
 2 files changed, 14 insertions(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 01af6dc..4197dc0 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -8849,7 +8849,6 @@ CopyAndTranslateBuffer(
     case TCL_TRANSLATE_CR: {
 	char *end;
 
-	Tcl_Panic("Untested");
 	if (bytesInBuffer == 0) {
 	    return 0;
 	}
diff --git a/tests/io.test b/tests/io.test
index e08c57a..0c2944b 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -6744,6 +6744,20 @@ test io-52.12 {coverage of -translation auto} {
     close $out
     file size $path(test2)
 } 29
+test io-52.13 {coverage of -translation cr} {
+    file delete $path(test1) $path(test2)
+    set out [open $path(test1) wb]
+    chan configure $out -translation lf
+    puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+    close $out
+    set in [open $path(test1)]
+    chan configure $in -buffersize 8 -translation cr
+    set out [open $path(test2) w]
+    fcopy $in $out
+    close $in
+    close $out
+    file size $path(test2)
+} 30
 
 test io-53.1 {CopyData} {fcopy} {
     file delete $path(test1)
-- 
cgit v0.12


From 9afa8a13e86fbd71a030ead7909cbe7d7db76296 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 18 Feb 2014 21:27:35 +0000
Subject: Another coverage test that reveals refactoring error.

---
 generic/tclIO.c |  2 +-
 tests/io.test   | 14 ++++++++++++++
 2 files changed, 15 insertions(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 4197dc0..c862923 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -8880,10 +8880,10 @@ CopyAndTranslateBuffer(
 	 * If there is a held-back "\r" at EOF, produce it now.
 	 */
 
-	Tcl_Panic("Untested");
 	if (bytesInBuffer == 0) {
 	    if ((statePtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
 		    (INPUT_SAW_CR | CHANNEL_EOF)) {
+		Tcl_Panic("Untested");
 		result[0] = '\r';
 		ResetFlag(statePtr, INPUT_SAW_CR);
 		return 1;
diff --git a/tests/io.test b/tests/io.test
index 0c2944b..4df44a3 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -6758,6 +6758,20 @@ test io-52.13 {coverage of -translation cr} {
     close $out
     file size $path(test2)
 } 30
+test io-52.14 {coverage of -translation crlf} {
+    file delete $path(test1) $path(test2)
+    set out [open $path(test1) wb]
+    chan configure $out -translation lf
+    puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+    close $out
+    set in [open $path(test1)]
+    chan configure $in -buffersize 8 -translation crlf
+    set out [open $path(test2) w]
+    fcopy $in $out
+    close $in
+    close $out
+    file size $path(test2)
+} 29
 
 test io-53.1 {CopyData} {fcopy} {
     file delete $path(test1)
-- 
cgit v0.12


From 1a35a544342c26a5fa207edcd05448d6f525d9a1 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 18 Feb 2014 23:20:06 +0000
Subject: Callers of TranslateInputEOL are expected to manage the INPUT_NEED_NL
 flag.

---
 generic/tclIO.c | 14 ++++++++++++++
 1 file changed, 14 insertions(+)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index c862923..68d370a 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -8824,6 +8824,20 @@ CopyAndTranslateBuffer(
     if (bytesInBuffer <= copied) {
 	copied = bytesInBuffer;
     }
+    if (copied == 0) {
+	return 0;
+    }
+    if (statePtr->flags & INPUT_NEED_NL) {
+	ResetFlag(statePtr, INPUT_NEED_NL);
+
+	if (RemovePoint(bufPtr)[0] == '\n') {
+	    bufPtr->nextRemoved++;
+	    *result = '\n';
+	} else {
+	    *result = '\r';
+	}
+	return 1;
+    }
     TranslateInputEOL(statePtr, result, RemovePoint(bufPtr),
 	    &copied, &bytesInBuffer);
     bufPtr->nextRemoved += bytesInBuffer;
-- 
cgit v0.12


From 03c5b98228950023fde73077aa1b3e401e373d1c Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 19 Feb 2014 03:36:15 +0000
Subject: Shortcut ReadBytes() when it's a no-op.

---
 generic/tclIO.c | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 68d370a..7820242 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5201,6 +5201,9 @@ ReadBytes(
     if ((unsigned) toRead > (unsigned) srcLen) {
 	toRead = srcLen;
     }
+    if (toRead == 0) {
+	return 0;
+    }
 
     (void) Tcl_GetByteArrayFromObj(objPtr, &length);
     TclAppendBytesToByteArray(objPtr, NULL, toRead);
@@ -5209,7 +5212,7 @@ ReadBytes(
 
     if (statePtr->flags & INPUT_NEED_NL) {
 	ResetFlag(statePtr, INPUT_NEED_NL);
-	if ((srcLen == 0) || (*src != '\n')) {
+	if (*src != '\n') {
 	    *dst = '\r';
 	    length += 1;
 	    Tcl_SetByteArrayLength(objPtr, length);
-- 
cgit v0.12


From e9a5cb0bbfec8877ccb5b56d39e6100ba9c5e42d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 19 Feb 2014 03:45:17 +0000
Subject: Next coverage test to expose another refactoring error.

---
 generic/tclIO.c |  1 -
 tests/io.test   | 14 ++++++++++++++
 2 files changed, 14 insertions(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 7820242..3b2b53e 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -8900,7 +8900,6 @@ CopyAndTranslateBuffer(
 	if (bytesInBuffer == 0) {
 	    if ((statePtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
 		    (INPUT_SAW_CR | CHANNEL_EOF)) {
-		Tcl_Panic("Untested");
 		result[0] = '\r';
 		ResetFlag(statePtr, INPUT_SAW_CR);
 		return 1;
diff --git a/tests/io.test b/tests/io.test
index 4df44a3..8c066ca 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -6772,6 +6772,20 @@ test io-52.14 {coverage of -translation crlf} {
     close $out
     file size $path(test2)
 } 29
+test io-52.15 {coverage of -translation crlf} {
+    file delete $path(test1) $path(test2)
+    set out [open $path(test1) wb]
+    chan configure $out -translation lf
+    puts -nonewline $out abcdefg\r
+    close $out
+    set in [open $path(test1)]
+    chan configure $in -buffersize 8 -translation crlf
+    set out [open $path(test2) w]
+    fcopy $in $out
+    close $in
+    close $out
+    file size $path(test2)
+} 8
 
 test io-53.1 {CopyData} {fcopy} {
     file delete $path(test1)
-- 
cgit v0.12


From 58b67990b95b7d36b3099c43cfcf6448b9c1b23d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 19 Feb 2014 14:10:55 +0000
Subject: [1230597] Update test comment.

---
 tests/namespace.test | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/namespace.test b/tests/namespace.test
index b59e09e..71b6860 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -301,7 +301,7 @@ test namespace-9.4 {Tcl_Import, simple import} {
     }
     test_ns_import::p
 } {cmd1: 123}
-test namespace-9.5 {Tcl_Import, can't redefine cmd unless allowOverwrite!=0} {
+test namespace-9.5 {Tcl_Import, RFE 1230597} {
     list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg
 } {0 {}}
 test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} {
-- 
cgit v0.12


From d0f15c03d3f5385a24eea5b7b2cdc6f8d95a8933 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 20 Feb 2014 03:51:16 +0000
Subject: Refactoring repair to fix failing test.

---
 generic/tclIO.c | 52 +++++++++++++++++++++++++++++++++++++---------------
 1 file changed, 37 insertions(+), 15 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 3b2b53e..3cddc29 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -8808,6 +8808,7 @@ CopyAndTranslateBuffer(
 				 * in the current input buffer? */
     int copied;			/* How many characters were already copied
 				 * into the destination space? */
+    int toCopy;
 
     /*
      * If there is no input at all, return zero. The invariant is that either
@@ -8822,30 +8823,51 @@ CopyAndTranslateBuffer(
     bufPtr = statePtr->inQueueHead;
     bytesInBuffer = BytesLeft(bufPtr);
 
+    copied = 0;
 #if 1
-    copied = space;
-    if (bytesInBuffer <= copied) {
-	copied = bytesInBuffer;
-    }
-    if (copied == 0) {
-	return 0;
-    }
     if (statePtr->flags & INPUT_NEED_NL) {
-	ResetFlag(statePtr, INPUT_NEED_NL);
 
-	if (RemovePoint(bufPtr)[0] == '\n') {
-	    bufPtr->nextRemoved++;
-	    *result = '\n';
-	} else {
+	/*
+	 * An earlier call to TranslateInputEOL ended in the read of a \r .
+	 * Only the next read from the same channel can complete the
+	 * translation sequence to tell us what character we should read.
+	 */
+
+	if (bytesInBuffer) {
+	    /* There's a next byte.  It will settle things. */
+	    ResetFlag(statePtr, INPUT_NEED_NL);
+
+	    if (RemovePoint(bufPtr)[0] == '\n') {
+		bufPtr->nextRemoved++;
+		bytesInBuffer--;
+		*result++ = '\n';
+	    } else {
+		*result++ = '\r';
+	    }
+	    copied++;
+	    space--;
+	} else if (statePtr->flags & CHANNEL_EOF) {
+	    /* There is no next byte, and there never will be (EOF). */
+	    ResetFlag(statePtr, INPUT_NEED_NL);
 	    *result = '\r';
+	    return 1;
+	} else {
+	    /* There is no next byte.  Ask the caller to read more. */
+	    return 0;
 	}
-	return 1;
+    }
+    toCopy = space;
+    if (bytesInBuffer <= toCopy) {
+	toCopy = bytesInBuffer;
+    }
+    if (toCopy == 0) {
+	return copied;
     }
     TranslateInputEOL(statePtr, result, RemovePoint(bufPtr),
-	    &copied, &bytesInBuffer);
+	    &toCopy, &bytesInBuffer);
     bufPtr->nextRemoved += bytesInBuffer;
+    copied += toCopy;
 #else
-    copied = 0;
     switch (statePtr->inputTranslation) {
     case TCL_TRANSLATE_LF:
 	if (bytesInBuffer == 0) {
-- 
cgit v0.12


From ddaf1d27cb4ec6db78294cb42e1fd46ae6d2dbc2 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 20 Feb 2014 20:31:55 +0000
Subject: Can we send some binary reads down the char-reading path?

---
 generic/tclIO.c | 13 ++++++++-----
 1 file changed, 8 insertions(+), 5 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 3636861..4d7133a 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5096,7 +5096,8 @@ DoReadChars(
     for (copied = 0; (unsigned) toRead > 0; ) {
 	copiedNow = -1;
 	if (statePtr->inQueueHead != NULL) {
-	    if (encoding == NULL) {
+	    if (encoding == NULL
+		    && statePtr->inputTranslation == TCL_TRANSLATE_LF) {
 		copiedNow = ReadBytes(statePtr, objPtr, toRead, &offset);
 	    } else {
 		copiedNow = ReadChars(statePtr, objPtr, toRead, &offset,
@@ -5320,6 +5321,8 @@ ReadChars(
     char *src, *dst;
     Tcl_EncodingState oldState;
     int encEndFlagSuppressed = 0;
+    Tcl_Encoding encoding = statePtr->encoding? statePtr->encoding
+	    : GetBinaryEncoding();
 
     factor = *factorPtr;
     offset = *offsetPtr;
@@ -5424,7 +5427,7 @@ ReadChars(
 	 */
 
 	ResetFlag(statePtr, INPUT_NEED_NL);
-	Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
+	Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
 		statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
 		dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars);
 	if ((dstWrote > 0) && (*dst == '\n')) {
@@ -5449,7 +5452,7 @@ ReadChars(
 	return 1;
     }
 
-    Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
+    Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
 	    statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
 	    dstNeeded + 1, &srcRead, &dstWrote, &numChars);
 
@@ -5522,7 +5525,7 @@ ReadChars(
 	    return -1;
 	}
 	statePtr->inputEncodingState = oldState;
-	Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
+	Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
 		statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
 		dst, dstRead + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
 	TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
@@ -5545,7 +5548,7 @@ ReadChars(
 
 	eof = Tcl_UtfAtIndex(dst, toRead);
 	statePtr->inputEncodingState = oldState;
-	Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
+	Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
 		statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
 		dst, eof - dst + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
 	dstRead = dstWrote;
-- 
cgit v0.12


From 9f6aaa68fc35449d224e5a1ea5d53e09ac38e509 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 20 Feb 2014 21:23:33 +0000
Subject: Switch consistently on the narrower def of binary mode.

---
 generic/tclIO.c | 14 +++++++++-----
 1 file changed, 9 insertions(+), 5 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 4d7133a..eae063b 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5060,6 +5060,7 @@ DoReadChars(
     ChannelBuffer *bufPtr;
     int offset, factor, copied, copiedNow, result;
     Tcl_Encoding encoding;
+    int binaryMode;
 #define UTF_EXPANSION_FACTOR	1024
 
     /*
@@ -5070,8 +5071,12 @@ DoReadChars(
     encoding = statePtr->encoding;
     factor = UTF_EXPANSION_FACTOR;
 
+    binaryMode = (encoding == NULL)
+	    && (statePtr->inputTranslation == TCL_TRANSLATE_LF) 
+	    && (statePtr->inEofChar == NULL);
+
     if (appendFlag == 0) {
-	if (encoding == NULL) {
+	if (binaryMode) {
 	    Tcl_SetByteArrayLength(objPtr, 0);
 	} else {
 	    Tcl_SetObjLength(objPtr, 0);
@@ -5086,7 +5091,7 @@ DoReadChars(
 	}
 	offset = 0;
     } else {
-	if (encoding == NULL) {
+	if (binaryMode) {
 	    Tcl_GetByteArrayFromObj(objPtr, &offset);
 	} else {
 	    TclGetStringFromObj(objPtr, &offset);
@@ -5096,8 +5101,7 @@ DoReadChars(
     for (copied = 0; (unsigned) toRead > 0; ) {
 	copiedNow = -1;
 	if (statePtr->inQueueHead != NULL) {
-	    if (encoding == NULL
-		    && statePtr->inputTranslation == TCL_TRANSLATE_LF) {
+	    if (binaryMode) {
 		copiedNow = ReadBytes(statePtr, objPtr, toRead, &offset);
 	    } else {
 		copiedNow = ReadChars(statePtr, objPtr, toRead, &offset,
@@ -5146,7 +5150,7 @@ DoReadChars(
     }
 
     ResetFlag(statePtr, CHANNEL_BLOCKED);
-    if (encoding == NULL) {
+    if (binaryMode) {
 	Tcl_SetByteArrayLength(objPtr, offset);
     } else {
 	Tcl_SetObjLength(objPtr, offset);
-- 
cgit v0.12


From 82eaf13ae6136c9679b5aeba5c75cd777f2829dd Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 21 Feb 2014 15:02:35 +0000
Subject: fix type error

---
 generic/tclIO.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index eae063b..ac28ec0 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5073,7 +5073,7 @@ DoReadChars(
 
     binaryMode = (encoding == NULL)
 	    && (statePtr->inputTranslation == TCL_TRANSLATE_LF) 
-	    && (statePtr->inEofChar == NULL);
+	    && (statePtr->inEofChar == '\0');
 
     if (appendFlag == 0) {
 	if (binaryMode) {
-- 
cgit v0.12


From 527d583d939f70450bc8b3db5077dd7d806c7c3e Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 21 Feb 2014 15:12:16 +0000
Subject: Simplify ReadBytes based on new constraints.

---
 generic/tclIO.c | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index ac28ec0..23e1fbf 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5242,6 +5242,10 @@ ReadBytes(
     }
     dst += offset;
 
+#if 1
+    memcpy(dst, src, (size_t) toRead);
+    srcRead = dstWrote = toRead;
+#else
     if (statePtr->flags & INPUT_NEED_NL) {
 	ResetFlag(statePtr, INPUT_NEED_NL);
 	if ((srcLen == 0) || (*src != '\n')) {
@@ -5262,6 +5266,7 @@ ReadBytes(
 	    return -1;
 	}
     }
+#endif
     bufPtr->nextRemoved += srcRead;
     *offsetPtr += dstWrote;
     return dstWrote;
-- 
cgit v0.12


From eb24399a17b85fad292fe5137bb9ea641f8b7896 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 23 Feb 2014 13:07:36 +0000
Subject: [3597178]: Improve documentation of what's going on with encodings

---
 doc/encoding.n | 34 +++++++++++++++++++++++++++-------
 doc/string.n   | 28 ++++++++++++++++++++++++----
 2 files changed, 51 insertions(+), 11 deletions(-)

diff --git a/doc/encoding.n b/doc/encoding.n
index be1dc3f..5782199 100644
--- a/doc/encoding.n
+++ b/doc/encoding.n
@@ -14,10 +14,21 @@ encoding \- Manipulate encodings
 .BE
 .SH INTRODUCTION
 .PP
-Strings in Tcl are encoded using 16-bit Unicode characters.  Different
-operating system interfaces or applications may generate strings in
-other encodings such as Shift-JIS.  The \fBencoding\fR command helps
-to bridge the gap between Unicode and these other formats.
+Strings in Tcl are logically a sequence of 16-bit Unicode characters.
+These strings are represented in memory as a sequence of bytes that
+may be in one of several encodings: modified UTF\-8 (which uses 1 to 3
+bytes per character), 16-bit
+.QW Unicode
+(which uses 2 bytes per character, with an endianness that is
+dependent on the host architecture), and binary (which uses a single
+byte per character but only handles a restricted range of characters).
+Tcl does not guarantee to always use the same encoding for the same
+string.
+.PP
+Different operating system interfaces or applications may generate
+strings in other encodings such as Shift\-JIS.  The \fBencoding\fR
+command helps to bridge the gap between Unicode and these other
+formats.
 .SH DESCRIPTION
 .PP
 Performs one of several encoding related operations, depending on
@@ -37,8 +48,9 @@ system encoding is used.
 Convert \fIstring\fR from Unicode to the specified \fIencoding\fR.
 The result is a sequence of bytes that represents the converted
 string.  Each byte is stored in the lower 8-bits of a Unicode
-character.  If \fIencoding\fR is not specified, the current
-system encoding is used.
+character (indeed, the resulting string is a binary string as far as
+Tcl is concerned, at least initially).  If \fIencoding\fR is not
+specified, the current system encoding is used.
 .TP
 \fBencoding dirs\fR ?\fIdirectoryList\fR?
 .
@@ -56,6 +68,11 @@ searchable directory, that element is ignored.
 .
 Returns a list containing the names of all of the encodings that are
 currently available. 
+The encodings
+.QW utf-8
+and
+.QW iso8859-1
+are guaranteed to be present in the list.
 .TP
 \fBencoding system\fR ?\fIencoding\fR?
 .
@@ -73,7 +90,7 @@ However, because the \fBsource\fR command always reads files using the
 current system encoding, Tcl will only source such files correctly
 when the encoding used to write the file is the same.  This tends not
 to be true in an internationalized setting.  For example, if such a
-file was sourced in North America (where the ISO8859-1 is normally
+file was sourced in North America (where the ISO8859\-1 is normally
 used), each byte in the file would be treated as a separate character
 that maps to the 00 page in Unicode.  The resulting Tcl strings will
 not contain the expected Japanese characters.  Instead, they will
@@ -93,3 +110,6 @@ which is the Hiragana letter HA.
 Tcl_GetEncoding(3)
 .SH KEYWORDS
 encoding, unicode
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/doc/string.n b/doc/string.n
index 76005fc..163abdd 100644
--- a/doc/string.n
+++ b/doc/string.n
@@ -343,10 +343,13 @@ misleading.
 \fBstring bytelength \fIstring\fR
 .
 Returns a decimal string giving the number of bytes used to represent
-\fIstring\fR in memory.  Because UTF\-8 uses one to three bytes to
-represent Unicode characters, the byte length will not be the same as
-the character length in general.  The cases where a script cares about
-the byte length are rare.
+\fIstring\fR in memory when encoded as Tcl's internal modified UTF\-8;
+Tcl may use other encodings for \fIstring\fR as well, and does not
+guarantee to only use a single encoding for a particular \fIstring\fR.
+Because UTF\-8 uses a variable number of bytes to represent Unicode
+characters, the byte length will not be the same as the character
+length in general.  The cases where a script cares about the byte
+length are rare.
 .RS
 .PP
 In almost all cases, you should use the
@@ -354,10 +357,27 @@ In almost all cases, you should use the
 Tcl byte array value).  Refer to the \fBTcl_NumUtfChars\fR manual
 entry for more details on the UTF\-8 representation.
 .PP
+Formally, the \fBstring bytelength\fR operation returns the content of
+the \fIlength\fR field of the \fBTcl_Obj\fR structure, after calling
+\fBTcl_GetString\fR to ensure that the \fIbytes\fR field is populated.
+This is highly unlikely to be useful to Tcl scripts, as Tcl's internal
+encoding is not strict UTF\-8, but rather a modified CESU\-8 with a
+denormalized NUL (identical to that used in a number of places by
+Java's serialization mechanism) to enable basic processing with
+non-Unicode-aware C functions.  As this representation should only
+ever be used by Tcl's implementation, the number of bytes used to
+store the representation is of very low value (except to C extension
+code, which has direct access for the purpose of memory management,
+etc.)
+.PP
 \fICompatibility note:\fR it is likely that this subcommand will be
 withdrawn in a future version of Tcl. It is better to use the
 \fBencoding convertto\fR command to convert a string to a known
 encoding and then apply \fBstring length\fR to that.
+.PP
+.CS
+\fBstring length\fR [encoding convertto utf-8 $theString]
+.CE
 .RE
 .TP
 \fBstring wordend \fIstring charIndex\fR
-- 
cgit v0.12


From 73bf5da01200e7f7127273188ea24d751eb75ddf Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 24 Feb 2014 21:01:07 +0000
Subject: simplification trims

---
 generic/tclIO.c | 34 ++++------------------------------
 1 file changed, 4 insertions(+), 30 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 5625ff2..1c5fed4 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5194,7 +5194,7 @@ ReadBytes(
 				 * the bytes from the first buffer are
 				 * returned. */
 {
-    int toRead, srcLen, length, srcRead, dstWrote;
+    int toRead, srcLen, length;
     ChannelBuffer *bufPtr;
     char *src, *dst;
 
@@ -5215,37 +5215,11 @@ ReadBytes(
     dst = (char *) Tcl_GetByteArrayFromObj(objPtr, NULL);
     dst += length;
 
-#if 1
     memcpy(dst, src, (size_t) toRead);
-    srcRead = dstWrote = toRead;
-#else
-    if (statePtr->flags & INPUT_NEED_NL) {
-	ResetFlag(statePtr, INPUT_NEED_NL);
-	if (*src != '\n') {
-	    *dst = '\r';
-	    length += 1;
-	    Tcl_SetByteArrayLength(objPtr, length);
-	    return 1;
-	}
-	*dst++ = '\n';
-	src++;
-	srcLen--;
-	toRead--;
-    }
-
-    srcRead = srcLen;
-    dstWrote = toRead;
-    if (TranslateInputEOL(statePtr, dst, src, &dstWrote, &srcRead) != 0) {
-	if (dstWrote == 0) {
-	    Tcl_SetByteArrayLength(objPtr, length);
-	    return -1;
-	}
-    }
-#endif
-    bufPtr->nextRemoved += srcRead;
-    length += dstWrote;
+    bufPtr->nextRemoved += toRead;
+    length += toRead;
     Tcl_SetByteArrayLength(objPtr, length);
-    return dstWrote;
+    return toRead;
 }
 
 /*
-- 
cgit v0.12


From c7f19f76c5362c2918fe01d49808b3246fd84100 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 24 Feb 2014 21:25:08 +0000
Subject: Reduce ReadBytes to simplest expression.

---
 generic/tclIO.c | 28 +++++-----------------------
 1 file changed, 5 insertions(+), 23 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 1c5fed4..a73f041 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5194,31 +5194,13 @@ ReadBytes(
 				 * the bytes from the first buffer are
 				 * returned. */
 {
-    int toRead, srcLen, length;
-    ChannelBuffer *bufPtr;
-    char *src, *dst;
-
-    bufPtr = statePtr->inQueueHead;
-    src = RemovePoint(bufPtr);
-    srcLen = BytesLeft(bufPtr);
-
-    toRead = bytesToRead;
-    if ((unsigned) toRead > (unsigned) srcLen) {
-	toRead = srcLen;
-    }
-    if (toRead == 0) {
-	return 0;
-    }
-
-    (void) Tcl_GetByteArrayFromObj(objPtr, &length);
-    TclAppendBytesToByteArray(objPtr, NULL, toRead);
-    dst = (char *) Tcl_GetByteArrayFromObj(objPtr, NULL);
-    dst += length;
+    ChannelBuffer *bufPtr = statePtr->inQueueHead;
+    int srcLen = BytesLeft(bufPtr);
+    int toRead = bytesToRead>srcLen || bytesToRead<0 ? srcLen : bytesToRead;
 
-    memcpy(dst, src, (size_t) toRead);
+    TclAppendBytesToByteArray(objPtr, (unsigned char *) RemovePoint(bufPtr),
+	    toRead);
     bufPtr->nextRemoved += toRead;
-    length += toRead;
-    Tcl_SetByteArrayLength(objPtr, length);
     return toRead;
 }
 
-- 
cgit v0.12


From 259729fa361e6d184ef91be067a93309e14cd998 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 25 Feb 2014 15:49:52 +0000
Subject: [8d5f5b8034] Flush internal representations in [string tolower] of
 unshared obj

---
 generic/tclExecute.c | 3 +++
 tests/string.test    | 9 +++++++++
 2 files changed, 12 insertions(+)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 89305e6..41730d3 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5392,6 +5392,7 @@ TEBCresume(
 	} else {
 	    length = Tcl_UtfToUpper(TclGetString(valuePtr));
 	    Tcl_SetObjLength(valuePtr, length);
+	    TclFreeIntRep(valuePtr);
 	    TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
 	    NEXT_INST_F(1, 0, 0);
 	}
@@ -5408,6 +5409,7 @@ TEBCresume(
 	} else {
 	    length = Tcl_UtfToLower(TclGetString(valuePtr));
 	    Tcl_SetObjLength(valuePtr, length);
+	    TclFreeIntRep(valuePtr);
 	    TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
 	    NEXT_INST_F(1, 0, 0);
 	}
@@ -5424,6 +5426,7 @@ TEBCresume(
 	} else {
 	    length = Tcl_UtfToTitle(TclGetString(valuePtr));
 	    Tcl_SetObjLength(valuePtr, length);
+	    TclFreeIntRep(valuePtr);
 	    TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
 	    NEXT_INST_F(1, 0, 0);
 	}
diff --git a/tests/string.test b/tests/string.test
index 740cdc6..cf658a2 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -1398,6 +1398,9 @@ test string-15.9 {string tolower} {
 test string-15.10 {string tolower, unicode} {
      string tolower ABCabc\xc7\xe7
 } "abcabc\xe7\xe7"
+test string-15.11 {string tolower, compiled} {
+    lindex [string tolower [list A B [list C]]] 1
+} b
 
 test string-16.1 {string toupper} {
     list [catch {string toupper} msg] $msg
@@ -1429,6 +1432,9 @@ test string-16.9 {string toupper} {
 test string-16.10 {string toupper, unicode} {
     string toupper ABCabc\xc7\xe7
 } "ABCABC\xc7\xc7"
+test string-16.11 {string toupper, compiled} {
+    lindex [string toupper [list a b [list c]]] 1
+} B
 
 test string-17.1 {string totitle} {
     list [catch {string totitle} msg] $msg
@@ -1451,6 +1457,9 @@ test string-17.6 {string totitle, unicode} {
 test string-17.7 {string totitle, unicode} {
     string totitle \u01f3BCabc\xc7\xe7
 } "\u01f2bcabc\xe7\xe7"
+test string-17.8 {string totitle, compiled} {
+    lindex [string totitle [list aa bb [list cc]]] 0
+} Aa
 
 test string-18.1 {string trim} {
     list [catch {string trim} msg] $msg
-- 
cgit v0.12


From e3adf1d9a076bcb2704e4364c50097b49e6348c5 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 26 Feb 2014 11:26:00 +0000
Subject: More coverage tests and bug fixes.

---
 generic/tclIO.c |  3 +--
 tests/io.test   | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 57 insertions(+), 2 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index a73f041..c2a8cab 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5644,7 +5644,7 @@ TranslateInputEOL(
 
 	SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
 	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
-	ResetFlag(statePtr, INPUT_SAW_CR | INPUT_NEED_NL);
+//	ResetFlag(statePtr, INPUT_SAW_CR | INPUT_NEED_NL);
 	return 1;
     }
 
@@ -8981,7 +8981,6 @@ CopyAndTranslateBuffer(
     if (statePtr->inEofChar != 0) {
 	int i;
 
-	Tcl_Panic("Untested");
 	for (i = 0; i < copied; i++) {
 	    if (result[i] == (char) statePtr->inEofChar) {
 		/*
diff --git a/tests/io.test b/tests/io.test
index 8c066ca..6f4877f 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -6786,6 +6786,62 @@ test io-52.15 {coverage of -translation crlf} {
     close $out
     file size $path(test2)
 } 8
+test io-52.16 {coverage of eofChar handling} {
+    file delete $path(test1) $path(test2)
+    set out [open $path(test1) wb]
+    chan configure $out -translation lf
+    puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+    close $out
+    set in [open $path(test1)]
+    chan configure $in -buffersize 8 -translation lf -eofchar a
+    set out [open $path(test2) w]
+    fcopy $in $out
+    close $in
+    close $out
+    file size $path(test2)
+} 0
+test io-52.17 {coverage of eofChar handling} {
+    file delete $path(test1) $path(test2)
+    set out [open $path(test1) wb]
+    chan configure $out -translation lf
+    puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+    close $out
+    set in [open $path(test1)]
+    chan configure $in -buffersize 8 -translation lf -eofchar d
+    set out [open $path(test2) w]
+    fcopy $in $out
+    close $in
+    close $out
+    file size $path(test2)
+} 3
+test io-52.18 {coverage of eofChar handling} {
+    file delete $path(test1) $path(test2)
+    set out [open $path(test1) wb]
+    chan configure $out -translation lf
+    puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+    close $out
+    set in [open $path(test1)]
+    chan configure $in -buffersize 8 -translation crlf -eofchar h
+    set out [open $path(test2) w]
+    fcopy $in $out
+    close $in
+    close $out
+    file size $path(test2)
+} 8
+test io-52.19 {coverage of eofChar handling} {
+    file delete $path(test1) $path(test2)
+    set out [open $path(test1) wb]
+    chan configure $out -translation lf
+    puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+    close $out
+    set in [open $path(test1)]
+    chan configure $in -buffersize 10 -translation crlf -eofchar h
+    set out [open $path(test2) w]
+    fcopy $in $out
+    close $in
+    close $out
+    file size $path(test2)
+} 8
 
 test io-53.1 {CopyData} {fcopy} {
     file delete $path(test1)
-- 
cgit v0.12


From 33648948cab45a58ba614f448459fdcb133023dc Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 26 Feb 2014 13:16:18 +0000
Subject: Simplify macro handling in tclOO*Decls.h, just as already done in
 "novem" [0c37ab8944], itcl*Decls.h and tdbc*Decls.h. This doesn't change the
 way symbols are exported. This simplifications were already present in the
 Tcl 8.6.2 headers, but those were buggy when tclOO was linked in statically
 without using stubs.

---
 generic/tclOO.decls     |  1 +
 generic/tclOODecls.h    | 78 ++++++++++++++++++++++++-------------------------
 generic/tclOOIntDecls.h | 45 ++++++++++------------------
 3 files changed, 55 insertions(+), 69 deletions(-)

diff --git a/generic/tclOO.decls b/generic/tclOO.decls
index 5d6f2c2..265ba88 100644
--- a/generic/tclOO.decls
+++ b/generic/tclOO.decls
@@ -18,6 +18,7 @@ library tclOO
 
 interface tclOO
 hooks tclOOInt
+scspec TCLAPI
 
 declare 0 {
     Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h
index d3b9e59..9fd62ec 100644
--- a/generic/tclOODecls.h
+++ b/generic/tclOODecls.h
@@ -5,19 +5,19 @@
 #ifndef _TCLOODECLS
 #define _TCLOODECLS
 
-#undef TCL_STORAGE_CLASS
-#ifdef BUILD_tcl
-#   define TCL_STORAGE_CLASS DLLEXPORT
-#else
-#   ifdef USE_TCL_STUBS
-#      undef USE_TCLOO_STUBS
-#      define USE_TCLOO_STUBS
-#      define TCL_STORAGE_CLASS
+#ifndef TCLAPI
+#   ifdef BUILD_tcl
+#	define TCLAPI extern DLLEXPORT
 #   else
-#      define TCL_STORAGE_CLASS DLLIMPORT
+#	define TCLAPI extern DLLIMPORT
 #   endif
 #endif
 
+#ifdef USE_TCL_STUBS
+#   undef USE_TCLOO_STUBS
+#   define USE_TCLOO_STUBS
+#endif
+
 /* !BEGIN!: Do not edit below this line. */
 
 #ifdef __cplusplus
@@ -29,92 +29,92 @@ extern "C" {
  */
 
 /* 0 */
-EXTERN Tcl_Object	Tcl_CopyObjectInstance(Tcl_Interp *interp,
+TCLAPI Tcl_Object	Tcl_CopyObjectInstance(Tcl_Interp *interp,
 				Tcl_Object sourceObject,
 				const char *targetName,
 				const char *targetNamespaceName);
 /* 1 */
-EXTERN Tcl_Object	Tcl_GetClassAsObject(Tcl_Class clazz);
+TCLAPI Tcl_Object	Tcl_GetClassAsObject(Tcl_Class clazz);
 /* 2 */
-EXTERN Tcl_Class	Tcl_GetObjectAsClass(Tcl_Object object);
+TCLAPI Tcl_Class	Tcl_GetObjectAsClass(Tcl_Object object);
 /* 3 */
-EXTERN Tcl_Command	Tcl_GetObjectCommand(Tcl_Object object);
+TCLAPI Tcl_Command	Tcl_GetObjectCommand(Tcl_Object object);
 /* 4 */
-EXTERN Tcl_Object	Tcl_GetObjectFromObj(Tcl_Interp *interp,
+TCLAPI Tcl_Object	Tcl_GetObjectFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr);
 /* 5 */
-EXTERN Tcl_Namespace *	Tcl_GetObjectNamespace(Tcl_Object object);
+TCLAPI Tcl_Namespace *	Tcl_GetObjectNamespace(Tcl_Object object);
 /* 6 */
-EXTERN Tcl_Class	Tcl_MethodDeclarerClass(Tcl_Method method);
+TCLAPI Tcl_Class	Tcl_MethodDeclarerClass(Tcl_Method method);
 /* 7 */
-EXTERN Tcl_Object	Tcl_MethodDeclarerObject(Tcl_Method method);
+TCLAPI Tcl_Object	Tcl_MethodDeclarerObject(Tcl_Method method);
 /* 8 */
-EXTERN int		Tcl_MethodIsPublic(Tcl_Method method);
+TCLAPI int		Tcl_MethodIsPublic(Tcl_Method method);
 /* 9 */
-EXTERN int		Tcl_MethodIsType(Tcl_Method method,
+TCLAPI int		Tcl_MethodIsType(Tcl_Method method,
 				const Tcl_MethodType *typePtr,
 				ClientData *clientDataPtr);
 /* 10 */
-EXTERN Tcl_Obj *	Tcl_MethodName(Tcl_Method method);
+TCLAPI Tcl_Obj *	Tcl_MethodName(Tcl_Method method);
 /* 11 */
-EXTERN Tcl_Method	Tcl_NewInstanceMethod(Tcl_Interp *interp,
+TCLAPI Tcl_Method	Tcl_NewInstanceMethod(Tcl_Interp *interp,
 				Tcl_Object object, Tcl_Obj *nameObj,
 				int isPublic, const Tcl_MethodType *typePtr,
 				ClientData clientData);
 /* 12 */
-EXTERN Tcl_Method	Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
+TCLAPI Tcl_Method	Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
 				Tcl_Obj *nameObj, int isPublic,
 				const Tcl_MethodType *typePtr,
 				ClientData clientData);
 /* 13 */
-EXTERN Tcl_Object	Tcl_NewObjectInstance(Tcl_Interp *interp,
+TCLAPI Tcl_Object	Tcl_NewObjectInstance(Tcl_Interp *interp,
 				Tcl_Class cls, const char *nameStr,
 				const char *nsNameStr, int objc,
 				Tcl_Obj *const *objv, int skip);
 /* 14 */
-EXTERN int		Tcl_ObjectDeleted(Tcl_Object object);
+TCLAPI int		Tcl_ObjectDeleted(Tcl_Object object);
 /* 15 */
-EXTERN int		Tcl_ObjectContextIsFiltering(
+TCLAPI int		Tcl_ObjectContextIsFiltering(
 				Tcl_ObjectContext context);
 /* 16 */
-EXTERN Tcl_Method	Tcl_ObjectContextMethod(Tcl_ObjectContext context);
+TCLAPI Tcl_Method	Tcl_ObjectContextMethod(Tcl_ObjectContext context);
 /* 17 */
-EXTERN Tcl_Object	Tcl_ObjectContextObject(Tcl_ObjectContext context);
+TCLAPI Tcl_Object	Tcl_ObjectContextObject(Tcl_ObjectContext context);
 /* 18 */
-EXTERN int		Tcl_ObjectContextSkippedArgs(
+TCLAPI int		Tcl_ObjectContextSkippedArgs(
 				Tcl_ObjectContext context);
 /* 19 */
-EXTERN ClientData	Tcl_ClassGetMetadata(Tcl_Class clazz,
+TCLAPI ClientData	Tcl_ClassGetMetadata(Tcl_Class clazz,
 				const Tcl_ObjectMetadataType *typePtr);
 /* 20 */
-EXTERN void		Tcl_ClassSetMetadata(Tcl_Class clazz,
+TCLAPI void		Tcl_ClassSetMetadata(Tcl_Class clazz,
 				const Tcl_ObjectMetadataType *typePtr,
 				ClientData metadata);
 /* 21 */
-EXTERN ClientData	Tcl_ObjectGetMetadata(Tcl_Object object,
+TCLAPI ClientData	Tcl_ObjectGetMetadata(Tcl_Object object,
 				const Tcl_ObjectMetadataType *typePtr);
 /* 22 */
-EXTERN void		Tcl_ObjectSetMetadata(Tcl_Object object,
+TCLAPI void		Tcl_ObjectSetMetadata(Tcl_Object object,
 				const Tcl_ObjectMetadataType *typePtr,
 				ClientData metadata);
 /* 23 */
-EXTERN int		Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
+TCLAPI int		Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
 				Tcl_ObjectContext context, int objc,
 				Tcl_Obj *const *objv, int skip);
 /* 24 */
-EXTERN Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
+TCLAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
 				Tcl_Object object);
 /* 25 */
-EXTERN void		Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
+TCLAPI void		Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
 				Tcl_ObjectMapMethodNameProc *mapMethodNameProc);
 /* 26 */
-EXTERN void		Tcl_ClassSetConstructor(Tcl_Interp *interp,
+TCLAPI void		Tcl_ClassSetConstructor(Tcl_Interp *interp,
 				Tcl_Class clazz, Tcl_Method method);
 /* 27 */
-EXTERN void		Tcl_ClassSetDestructor(Tcl_Interp *interp,
+TCLAPI void		Tcl_ClassSetDestructor(Tcl_Interp *interp,
 				Tcl_Class clazz, Tcl_Method method);
 /* 28 */
-EXTERN Tcl_Obj *	Tcl_GetObjectName(Tcl_Interp *interp,
+TCLAPI Tcl_Obj *	Tcl_GetObjectName(Tcl_Interp *interp,
 				Tcl_Object object);
 
 typedef struct {
@@ -231,6 +231,4 @@ extern const TclOOStubs *tclOOStubsPtr;
 
 /* !END!: Do not edit above this line. */
 
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLIMPORT
 #endif /* _TCLOODECLS */
diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h
index 4f70e5b..74a8d81 100644
--- a/generic/tclOOIntDecls.h
+++ b/generic/tclOOIntDecls.h
@@ -5,17 +5,6 @@
 #ifndef _TCLOOINTDECLS
 #define _TCLOOINTDECLS
 
-#undef TCL_STORAGE_CLASS
-#ifdef BUILD_tcl
-#   define TCL_STORAGE_CLASS DLLEXPORT
-#else
-#   ifdef USE_TCL_STUBS
-#      define TCL_STORAGE_CLASS
-#   else
-#      define TCL_STORAGE_CLASS DLLIMPORT
-#   endif
-#endif
-
 /* !BEGIN!: Do not edit below this line. */
 
 #ifdef __cplusplus
@@ -27,46 +16,46 @@ extern "C" {
  */
 
 /* 0 */
-EXTERN Tcl_Object	TclOOGetDefineCmdContext(Tcl_Interp *interp);
+TCLAPI Tcl_Object	TclOOGetDefineCmdContext(Tcl_Interp *interp);
 /* 1 */
-EXTERN Tcl_Method	TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
+TCLAPI Tcl_Method	TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
 				Object *oPtr, int flags, Tcl_Obj *nameObj,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				const Tcl_MethodType *typePtr,
 				ClientData clientData, Proc **procPtrPtr);
 /* 2 */
-EXTERN Tcl_Method	TclOOMakeProcMethod(Tcl_Interp *interp,
+TCLAPI Tcl_Method	TclOOMakeProcMethod(Tcl_Interp *interp,
 				Class *clsPtr, int flags, Tcl_Obj *nameObj,
 				const char *namePtr, Tcl_Obj *argsObj,
 				Tcl_Obj *bodyObj,
 				const Tcl_MethodType *typePtr,
 				ClientData clientData, Proc **procPtrPtr);
 /* 3 */
-EXTERN Method *		TclOONewProcInstanceMethod(Tcl_Interp *interp,
+TCLAPI Method *		TclOONewProcInstanceMethod(Tcl_Interp *interp,
 				Object *oPtr, int flags, Tcl_Obj *nameObj,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				ProcedureMethod **pmPtrPtr);
 /* 4 */
-EXTERN Method *		TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
+TCLAPI Method *		TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
 				int flags, Tcl_Obj *nameObj,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				ProcedureMethod **pmPtrPtr);
 /* 5 */
-EXTERN int		TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
+TCLAPI int		TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
 				int objc, Tcl_Obj *const *objv,
 				int publicOnly, Class *startCls);
 /* 6 */
-EXTERN int		TclOOIsReachable(Class *targetPtr, Class *startPtr);
+TCLAPI int		TclOOIsReachable(Class *targetPtr, Class *startPtr);
 /* 7 */
-EXTERN Method *		TclOONewForwardMethod(Tcl_Interp *interp,
+TCLAPI Method *		TclOONewForwardMethod(Tcl_Interp *interp,
 				Class *clsPtr, int isPublic,
 				Tcl_Obj *nameObj, Tcl_Obj *prefixObj);
 /* 8 */
-EXTERN Method *		TclOONewForwardInstanceMethod(Tcl_Interp *interp,
+TCLAPI Method *		TclOONewForwardInstanceMethod(Tcl_Interp *interp,
 				Object *oPtr, int isPublic, Tcl_Obj *nameObj,
 				Tcl_Obj *prefixObj);
 /* 9 */
-EXTERN Tcl_Method	TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
+TCLAPI Tcl_Method	TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
 				Tcl_Object oPtr,
 				TclOO_PreCallProc *preCallPtr,
 				TclOO_PostCallProc *postCallPtr,
@@ -75,7 +64,7 @@ EXTERN Tcl_Method	TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				int flags, void **internalTokenPtr);
 /* 10 */
-EXTERN Tcl_Method	TclOONewProcMethodEx(Tcl_Interp *interp,
+TCLAPI Tcl_Method	TclOONewProcMethodEx(Tcl_Interp *interp,
 				Tcl_Class clsPtr,
 				TclOO_PreCallProc *preCallPtr,
 				TclOO_PostCallProc *postCallPtr,
@@ -84,22 +73,22 @@ EXTERN Tcl_Method	TclOONewProcMethodEx(Tcl_Interp *interp,
 				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
 				int flags, void **internalTokenPtr);
 /* 11 */
-EXTERN int		TclOOInvokeObject(Tcl_Interp *interp,
+TCLAPI int		TclOOInvokeObject(Tcl_Interp *interp,
 				Tcl_Object object, Tcl_Class startCls,
 				int publicPrivate, int objc,
 				Tcl_Obj *const *objv);
 /* 12 */
-EXTERN void		TclOOObjectSetFilters(Object *oPtr, int numFilters,
+TCLAPI void		TclOOObjectSetFilters(Object *oPtr, int numFilters,
 				Tcl_Obj *const *filters);
 /* 13 */
-EXTERN void		TclOOClassSetFilters(Tcl_Interp *interp,
+TCLAPI void		TclOOClassSetFilters(Tcl_Interp *interp,
 				Class *classPtr, int numFilters,
 				Tcl_Obj *const *filters);
 /* 14 */
-EXTERN void		TclOOObjectSetMixins(Object *oPtr, int numMixins,
+TCLAPI void		TclOOObjectSetMixins(Object *oPtr, int numMixins,
 				Class *const *mixins);
 /* 15 */
-EXTERN void		TclOOClassSetMixins(Tcl_Interp *interp,
+TCLAPI void		TclOOClassSetMixins(Tcl_Interp *interp,
 				Class *classPtr, int numMixins,
 				Class *const *mixins);
 
@@ -174,6 +163,4 @@ extern const TclOOIntStubs *tclOOIntStubsPtr;
 
 /* !END!: Do not edit above this line. */
 
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLIMPORT
 #endif /* _TCLOOINTDECLS */
-- 
cgit v0.12


From 5a1cac2f139731c8a4cacfc7dce7b8c456e860f4 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 26 Feb 2014 17:47:46 +0000
Subject: New tests covering INPUT_NEED_NL flag handling.  One exposes a bug.

---
 tests/io.test | 71 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 71 insertions(+)

diff --git a/tests/io.test b/tests/io.test
index 68051d7..64c878d 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -4701,6 +4701,77 @@ test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
     close $f
     list $c $l $e
 } {21 8 1}
+test io-35.18 {Tcl_Eof, eof char, cr write, crlf read} {
+    file delete $path(test1)
+    set f [open $path(test1) w]
+    fconfigure $f -translation cr
+    puts $f abc\ndef
+    close $f
+    set s [file size $path(test1)]
+    set f [open $path(test1) r]
+    fconfigure $f -translation crlf
+    set l [string length [set in [read $f]]]
+    set e [eof $f]
+    close $f
+    list $s $l $e [scan [string index $in end] %c]
+} {8 8 1 13}
+test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} {
+    file delete $path(test1)
+    set f [open $path(test1) w]
+    fconfigure $f -translation cr -eofchar \x1a
+    puts $f abc\ndef
+    close $f
+    set s [file size $path(test1)]
+    set f [open $path(test1) r]
+    fconfigure $f -translation crlf -eofchar \x1a
+    set l [string length [set in [read $f]]]
+    set e [eof $f]
+    close $f
+    list $s $l $e [scan [string index $in end] %c]
+} {9 8 1 13}
+test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} {
+    file delete $path(test1)
+    set f [open $path(test1) w]
+    fconfigure $f -translation cr -eofchar \x1a
+    puts $f {}
+    close $f
+    set s [file size $path(test1)]
+    set f [open $path(test1) r]
+    fconfigure $f -translation crlf -eofchar \x1a
+    set l [string length [set in [read $f]]]
+    set e [eof $f]
+    close $f
+    list $s $l $e [scan [string index $in end] %c]
+} {2 1 1 13}
+test io-35.18c {Tcl_Eof, eof char, cr write, crlf read} {
+    file delete $path(test1)
+    set f [open $path(test1) w]
+    fconfigure $f -translation cr
+    puts $f {}
+    close $f
+    set s [file size $path(test1)]
+    set f [open $path(test1) r]
+    fconfigure $f -translation crlf
+    set l [string length [set in [read $f]]]
+    set e [eof $f]
+    close $f
+    list $s $l $e [scan [string index $in end] %c]
+} {1 1 1 13}
+test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} {
+    file delete $path(test1)
+    set f [open $path(test1) w]
+    fconfigure $f -translation cr -eofchar {}
+    set i [format abc\ndef\n%cqrs\nuvw 26]
+    puts $f $i
+    close $f
+    set c [file size $path(test1)]
+    set f [open $path(test1) r]
+    fconfigure $f -translation crlf -eofchar \x1a
+    set l [string length [set in [read $f]]]
+    set e [eof $f]
+    close $f
+    list $c $l $e [scan [string index $in end] %c]
+} {17 8 1 13}
 
 # Test Tcl_InputBlocked
 
-- 
cgit v0.12


From aad7393c9adb8f82f2594929954960b91d027032 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 27 Feb 2014 20:11:47 +0000
Subject: remove comment

---
 generic/tclIO.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index c2a8cab..8d75bf2 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5644,7 +5644,7 @@ TranslateInputEOL(
 
 	SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
 	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
-//	ResetFlag(statePtr, INPUT_SAW_CR | INPUT_NEED_NL);
+	ResetFlag(statePtr, INPUT_SAW_CR | INPUT_NEED_NL);
 	return 1;
     }
 
-- 
cgit v0.12


From 3df8548690a047e4fa9a445a253636a3e3a652df Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 27 Feb 2014 20:21:10 +0000
Subject: Work in progress attempting a ReadChars rewrite.

---
 generic/tclIO.c | 120 +++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 119 insertions(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 3636861..20428b5 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5372,6 +5372,120 @@ ReadChars(
     }
     dst = objPtr->bytes + offset;
 
+#if 1
+
+    /*
+     * This routine is burdened with satisfying several constraints.
+     * It cannot append more than 'charsToRead` chars onto objPtr.
+     * This is measured after encoding and translation transformations
+     * are completed.  There is no precise number of src bytes that can
+     * be associated with the limit.  Yet, when we are done, we must know
+     * precisely the number of src bytes that were consumed to produce
+     * the appended chars, so that all subsequent bytes are left in
+     * the buffers for future read operations.
+     *
+     * The consequence is that we have no choice but to implement a
+     * "trial and error" approach, where in general we may need to
+     * perform transformations and copies multiple times to achieve
+     * a consistent set of results.  This takes the shape of a loop.
+     */
+
+    int dstLimit = dstNeeded + 1;
+    int savedFlags = statePtr->flags;
+    int savedIEFlags = statePtr->inputEncodingFlags;
+    Tcl_EncodingState savedState = statePtr->inputEncodingState;
+
+    while (1) {
+	int dstDecoded;
+
+	/*
+	 * Perform the encoding transformation.  Read no more than
+	 * srcLen bytes, write no more than dstLimit bytes.
+	 */
+
+//fprintf(stdout, "Start %d %d\n", dstLimit, srcLen); fflush(stdout);
+	int code = Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
+		statePtr->inputEncodingFlags & (bufPtr->nextPtr
+		? ~0 : ~TCL_ENCODING_END), &statePtr->inputEncodingState,
+		dst, dstLimit, &srcRead, &dstDecoded, &numChars);
+
+	/*
+	 * Perform the translation transformation in place.  Read no more
+	 * than the dstDecoded bytes the encoding transformation actually
+	 * produced.  Capture the number of bytes written in dstWrote.
+	 * Capture the number of bytes actually consumed in dstRead.
+	 */
+
+//fprintf(stdout, "Key NS=%d MB=%d S=%d\n", TCL_CONVERT_NOSPACE,
+//TCL_CONVERT_MULTIBYTE, TCL_CONVERT_SYNTAX); fflush(stdout);
+//fprintf(stdout, "Decoded %d %d\n", dstDecoded,code); fflush(stdout);
+	dstWrote = dstRead = dstDecoded;
+	TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
+
+	if (dstRead < dstDecoded) {
+
+	    /*
+	     * The encoding transformation produced bytes that the
+	     * translation transformation did not consume.  Start over
+	     * and impose new limits so that doesn't happen again.
+	     */
+//fprintf(stdout, "X! %d %d\n", dstRead, dstDecoded); fflush(stdout);
+
+	    dstLimit = dstRead + TCL_UTF_MAX;
+	    statePtr->flags = savedFlags;
+	    statePtr->inputEncodingFlags = savedIEFlags;
+	    statePtr->inputEncodingState = savedState;
+	    continue;
+	}
+
+//fprintf(stdout, "check %d %d %d\n", dstWrote, dstRead, dstDecoded);
+//fflush(stdout);
+
+	/* 
+	 * The translation transformation can only reduce the number
+	 * of chars when it converts \r\n into \n.  The reduction in
+	 * the number of chars is the difference in bytes read and written.
+	 */
+
+	numChars -= (dstRead - dstWrote);
+
+	if (charsToRead > 0 && numChars > charsToRead) {
+
+	    /* 
+	     * We read more chars than allowed.  Reset limits to
+	     * prevent that and try again.
+	     */
+//fprintf(stdout, "Y!\n"); fflush(stdout);
+
+	    dstLimit = Tcl_UtfAtIndex(dst, charsToRead + 1) - dst;
+	    statePtr->flags = savedFlags;
+	    statePtr->inputEncodingFlags = savedIEFlags;
+	    statePtr->inputEncodingState = savedState;
+	    continue;
+	}
+
+	if (dstWrote == 0) {
+
+//fprintf(stdout, "Z!\n"); fflush(stdout);
+	    /* 
+	     * Could not read anything.  Ask caller to get more data.
+	     */
+
+	    return -1;
+	}
+
+	statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
+
+	bufPtr->nextRemoved += srcRead;
+	if (dstWrote > srcRead + 1) {
+	    *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;
+	}
+	*offsetPtr += dstWrote;
+//fprintf(stdout, "OK: %d\n", numChars); fflush(stdout);
+	return numChars;
+    }
+
+#else
     /*
      * [Bug 1462248]: The cause of the crash reported in this bug is this:
      *
@@ -5560,6 +5674,7 @@ ReadChars(
     }
     *offsetPtr += dstWrote;
     return numChars;
+#endif
 }
 
 /*
@@ -5661,7 +5776,9 @@ TranslateInputEOL(
 	    if (*src == '\r') {
 		src++;
 		if (src >= srcMax) {
-		    SetFlag(statePtr, INPUT_NEED_NL);
+//		    SetFlag(statePtr, INPUT_NEED_NL);
+//fprintf(stdout, "BREAK!\n"); fflush(stdout);
+src--; break;
 		} else if (*src == '\n') {
 		    *dst++ = *src++;
 		} else {
@@ -5673,6 +5790,7 @@ TranslateInputEOL(
 	}
 	srcLen = src - srcStart;
 	dstLen = dst - dstStart;
+//fprintf(stdout, "eh? %d %d\n", srcLen, dstLen); fflush(stdout);
 	break;
     }
     case TCL_TRANSLATE_AUTO: {
-- 
cgit v0.12


From 67ca0cb05fe3153db733521fbff66e5ba180358c Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Fri, 28 Feb 2014 10:47:53 +0000
Subject: Broken intermediate state.

Calling back to CreateClientSocket() from the event loop works, but
the final failed or succeeded state of an asyncronous socket does not
get notified to the channel correctly.
---
 unix/tclUnixSock.c |  15 +++
 win/tclWinSock.c   | 365 ++++++++++++++++++++++++++++++++---------------------
 2 files changed, 234 insertions(+), 146 deletions(-)

diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 49a6460..c866903 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -163,6 +163,18 @@ static TclInitProcessGlobalValueProc InitializeHostName;
 static ProcessGlobalValue hostName =
 	{0, 0, NULL, NULL, InitializeHostName, NULL, NULL};
 
+void printaddrinfo(struct addrinfo *addrlist, char *prefix)
+{
+    char host[NI_MAXHOST], port[NI_MAXSERV];
+    struct addrinfo *ai;
+    for (ai = addrlist; ai != NULL; ai = ai->ai_next) {
+	getnameinfo(ai->ai_addr, ai->ai_addrlen,
+		    host, sizeof(host),
+		    port, sizeof(port),
+		    NI_NUMERICHOST|NI_NUMERICSERV);
+	fprintf(stderr,"%s: %s:%s\n", prefix, host, port);
+    }
+}
 /*
  *----------------------------------------------------------------------
  *
@@ -1160,6 +1172,9 @@ Tcl_OpenTcpClient(
         return NULL;
     }
 
+    printaddrinfo(myaddrlist, "local");
+    printaddrinfo(addrlist, "remote");
+
     /*
      * Allocate a new TcpState for this socket.
      */
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 958e4ac..6afa094 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -47,6 +47,12 @@
 
 #include "tclWinInt.h"
 
+#if 1
+#define DEBUG(x) fprintf(stderr, ">>> %s(%d): %s<<<\n", __FUNCTION__, __LINE__, x)
+#else
+#define DEBUG(x)
+#endif
+
 /*
  * Which version of the winsock API do we want?
  */
@@ -76,7 +82,7 @@
 
 /* "sock" + a pointer in hex + \0 */
 #define SOCK_CHAN_LENGTH        (4 + sizeof(void *) * 2 + 1)
-#define SOCK_TEMPLATE           "sock%lx"
+#define SOCK_TEMPLATE           "sock%p"
 
 /*
  * The following variable is used to tell whether this module has been
@@ -156,6 +162,12 @@ struct SocketInfo {
     Tcl_TcpAcceptProc *acceptProc;
 				/* Proc to call on accept. */
     ClientData acceptProcData;	/* The data for the accept proc. */
+    struct addrinfo *addrlist;	/* Addresses to connect to. */
+    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 cachedBlocking;         /* Cache blocking mode of async socket. */
     int lastError;		/* Error code from last message. */
     struct SocketInfo *nextPtr;	/* The next socket on the per-thread socket
 				 * list. */
@@ -214,9 +226,7 @@ static WNDCLASS windowClass;
  * Static functions defined in this file.
  */
 
-static SocketInfo *	CreateClientSocket(Tcl_Interp *interp, int port,
-			    const char *host, const char *myaddr,
-			    int myport, int async);
+static int		CreateClientSocket(Tcl_Interp *interp, SocketInfo *infoPtr);
 static void		InitSockets(void);
 static SocketInfo *	NewSocketInfo(SOCKET socket);
 static void		SocketExitHandler(ClientData clientData);
@@ -267,6 +277,22 @@ static const Tcl_ChannelType tcpChannelType = {
     TcpThreadActionProc,    /* thread action proc */
     NULL		    /* truncate */
 };
+void printaddrinfo(struct addrinfo *ai, char *prefix)
+{
+    char host[NI_MAXHOST], port[NI_MAXSERV];
+    getnameinfo(ai->ai_addr, ai->ai_addrlen,
+		host, sizeof(host),
+		port, sizeof(port),
+		NI_NUMERICHOST|NI_NUMERICSERV);
+    fprintf(stderr,"%s: [%s]:%s\n", prefix, host, port);
+}
+void printaddrinfolist(struct addrinfo *addrlist, char *prefix)
+{
+    struct addrinfo *ai;
+    for (ai = addrlist; ai != NULL; ai = ai->ai_next) {
+	printaddrinfo(ai, prefix);
+    }
+}
 
 /*
  *----------------------------------------------------------------------
@@ -699,6 +725,8 @@ SocketEventProc(
     address addr;
     int len;
 
+    DEBUG("xxx");
+
     if (!(flags & TCL_FILE_EVENTS)) {
 	return 0;
     }
@@ -841,20 +869,18 @@ SocketEventProc(
 		    (WPARAM) SELECT, (LPARAM) infoPtr);
 	}
     }
-    if (events & (FD_WRITE | FD_CONNECT)) {
+    if (events & FD_WRITE) {
 	mask |= TCL_WRITABLE;
-	if (events & FD_CONNECT && infoPtr->lastError != NO_ERROR) {
-	    /*
-	     * Connect errors should also fire the readable handler.
-	     */
-
-	    mask |= TCL_READABLE;
-	}
     }
-
+    if (events & FD_CONNECT) {
+	DEBUG("Calling CreateClientSocket...");
+	CreateClientSocket(NULL, infoPtr);
+    }
     if (mask) {
+	DEBUG("Calling Tcl_NotifyChannel...");
 	Tcl_NotifyChannel(infoPtr->channel, mask);
     }
+    DEBUG("returning...");
     return 1;
 }
 
@@ -944,6 +970,13 @@ TcpCloseProc(
 	}
     }
 
+    if (infoPtr->addrlist != NULL) {
+        freeaddrinfo(infoPtr->addrlist);
+    }
+    if (infoPtr->myaddrlist != NULL) {
+        freeaddrinfo(infoPtr->myaddrlist);
+    }
+
     /*
      * TIP #218. Removed the code removing the structure from the global
      * socket list. This is now done by the thread action callbacks, and only
@@ -1072,22 +1105,11 @@ AddSocketInfoFd(
  */
 
 static SocketInfo *
-NewSocketInfo(
-    SOCKET socket)
+NewSocketInfo(SOCKET socket)
 {
     SocketInfo *infoPtr = ckalloc(sizeof(SocketInfo));
 
-    /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */
-    infoPtr->channel = 0;
-    infoPtr->sockets = NULL;
-    infoPtr->flags = 0;
-    infoPtr->watchEvents = 0;
-    infoPtr->readyEvents = 0;
-    infoPtr->selectEvents = 0;
-    infoPtr->acceptEventCount = 0;
-    infoPtr->acceptProc = NULL;
-    infoPtr->acceptProcData = NULL;
-    infoPtr->lastError = 0;
+    memset(infoPtr, 0, sizeof(SocketInfo));
 
     /*
      * TIP #218. Removed the code inserting the new structure into the global
@@ -1095,8 +1117,6 @@ NewSocketInfo(
      * there.
      */
 
-    infoPtr->nextPtr = NULL;
-
     AddSocketInfoFd(infoPtr, socket);
 
     return infoPtr;
@@ -1107,193 +1127,189 @@ NewSocketInfo(
  *
  * CreateClientSocket --
  *
- *	This function opens a new client socket and initializes the
- *	SocketInfo structure.
+ *	This function opens a new socket in client mode.
  *
  * Results:
- *	Returns a new SocketInfo, or NULL with an error in interp.
+ *      TCL_OK, if the socket was successfully connected or an asynchronous
+ *      connection is in progress. If an error occurs, TCL_ERROR is returned
+ *      and an error message is left in interp.
  *
  * Side effects:
- *	None, except for allocation of memory.
+ *	Opens a socket.
+ *
+ * Remarks:
+ *	A single host name may resolve to more than one IP address, e.g. for
+ *	an IPv4/IPv6 dual stack host. For handling asyncronously connecting
+ *	sockets in the background for such hosts, this function can act as a
+ *	coroutine. On the first call, it sets up the control variables for the
+ *	two nested loops over the local and remote addresses. Once the first
+ *	connection attempt is in progress, it sets up itself as a writable
+ *	event handler for that socket, and returns. When the callback occurs,
+ *	control is transferred to the "reenter" label, right after the initial
+ *	return and the loops resume as if they had never been interrupted.
+ *	For syncronously connecting sockets, the loops work the usual way.
  *
  *----------------------------------------------------------------------
  */
 
-static SocketInfo *
+static int
 CreateClientSocket(
     Tcl_Interp *interp,		/* For error reporting; can be NULL. */
-    int port,			/* Port number to open. */
-    const char *host,		/* Name of host on which to open port. */
-    const char *myaddr,		/* Optional client-side address */
-    int myport,			/* Optional client-side port */
-    int async)			/* If nonzero, connect client socket
-				 * asynchronously. */
+    SocketInfo *infoPtr)
 {
     u_long flag = 1;		/* Indicates nonblocking mode. */
-    int asyncConnect = 0;	/* Will be 1 if async connect is in
-				 * progress. */
-    unsigned short chosenport = 0;
-    struct addrinfo *addrlist = NULL, *addrPtr;
-				/* Socket address to connect to. */
-    struct addrinfo *myaddrlist = NULL, *myaddrPtr;
-				/* Socket address for our side. */
-    const char *errorMsg = NULL;
-    SOCKET sock = INVALID_SOCKET;
-    SocketInfo *infoPtr = NULL;	/* The returned value. */
-    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-
-    /*
-     * Check that WinSock is initialized; do not call it if not, to prevent
-     * system crashes. This can happen at exit time if the exit handler for
-     * WinSock ran before other exit handlers that want to use sockets.
-     */
+    int async_callback = (infoPtr->addr != NULL);
+    int connected = 0;
+    int async = infoPtr->flags & SOCKET_ASYNC_CONNECT;
 
-    if (!SocketsEnabled()) {
-	return NULL;
+    DEBUG(async_callback ? "subsequent" : "first");
+    DEBUG(async ? "async" : "sync");
+    if (async_callback) {
+        goto reenter;
     }
+    
+    for (infoPtr->addr = infoPtr->addrlist; infoPtr->addr != NULL;
+	 infoPtr->addr = infoPtr->addr->ai_next) {
+	
+        for (infoPtr->myaddr = infoPtr->myaddrlist; infoPtr->myaddr != NULL;
+	     infoPtr->myaddr = infoPtr->myaddr->ai_next) {
 
-    /*
-     * Construct the addresses for each end of the socket.
-     */
-
-    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0,
-	    &errorMsg)) {
-	goto error;
-    }
-    if (!TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
-	    &errorMsg)) {
-	goto error;
-    }
+	    DEBUG("inner loop");
 
-    for (addrPtr = addrlist; addrPtr != NULL;
-	 addrPtr = addrPtr->ai_next) {
-	for (myaddrPtr = myaddrlist; myaddrPtr != NULL;
-	     myaddrPtr = myaddrPtr->ai_next) {
 	    /*
 	     * No need to try combinations of local and remote addresses
 	     * of different families.
 	     */
 
-	    if (myaddrPtr->ai_family != addrPtr->ai_family) {
+	    if (infoPtr->myaddr->ai_family != infoPtr->addr->ai_family) {
+		DEBUG("family mismatch");
 		continue;
 	    }
 
-	    sock = socket(myaddrPtr->ai_family, SOCK_STREAM, 0);
-	    if (sock == INVALID_SOCKET) {
+	    DEBUG(infoPtr->myaddr->ai_family == AF_INET ? "IPv4" : "IPv6");
+	    printaddrinfo(infoPtr->myaddr, "~~ from");
+	    printaddrinfo(infoPtr->addr,   "~~   to");
+
+            /*
+             * Close the socket if it is still open from the last unsuccessful
+             * iteration.
+             */
+
+	    if (infoPtr->sockets->fd != INVALID_SOCKET) {
+		DEBUG("closesocket");
+		closesocket(infoPtr->sockets->fd);
+	    }
+
+	    infoPtr->sockets->fd = socket(infoPtr->myaddr->ai_family, SOCK_STREAM, 0);
+	    if (infoPtr->sockets->fd == INVALID_SOCKET) {
+		DEBUG("socket() failed");
 		TclWinConvertError((DWORD) WSAGetLastError());
 		continue;
 	    }
-
+	    
 	    /*
 	     * Win-NT has a misfeature that sockets are inherited in child
 	     * processes by default. Turn off the inherit bit.
 	     */
 
-	    SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);
+	    SetHandleInformation((HANDLE) infoPtr->sockets->fd, HANDLE_FLAG_INHERIT, 0);
 
 	    /*
 	     * Set kernel space buffering
 	     */
 
-	    TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE);
+	    TclSockMinimumBuffers((void *) infoPtr->sockets->fd, TCP_BUFFER_SIZE);
 
 	    /*
 	     * Try to bind to a local port.
 	     */
 
-	    if (bind(sock, myaddrPtr->ai_addr, myaddrPtr->ai_addrlen)
-		== SOCKET_ERROR) {
+	    if (bind(infoPtr->sockets->fd, infoPtr->myaddr->ai_addr,
+			infoPtr->myaddr->ai_addrlen) == SOCKET_ERROR) {
+		DEBUG("bind() failed");
 		TclWinConvertError((DWORD) WSAGetLastError());
-		goto looperror;
+		continue;
 	    }
 	    /*
 	     * Set the socket into nonblocking mode if the connect should
 	     * be done in the background.
 	     */
-	    if (async && ioctlsocket(sock, (long) FIONBIO, &flag)
+	    if (async && ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag)
 		== SOCKET_ERROR) {
+		DEBUG("FIONBIO");
 		TclWinConvertError((DWORD) WSAGetLastError());
-		goto looperror;
+		continue;
 	    }
 
 	    /*
 	     * Attempt to connect to the remote socket.
 	     */
 
-	    if (connect(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
-		== SOCKET_ERROR) {
+	    if (connect(infoPtr->sockets->fd, infoPtr->addr->ai_addr,
+			    infoPtr->addr->ai_addrlen) == SOCKET_ERROR) {
 		DWORD error = (DWORD) WSAGetLastError();
-		if (error != WSAEWOULDBLOCK) {
+
+		DEBUG("connect()");
+		// fprintf(stderr,"error = %lu\n", error);
+		if (error == WSAEWOULDBLOCK) {
+		    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+		    DEBUG("WSAEWOULDBLOCK");
+		    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
+		    infoPtr->selectEvents |= FD_CONNECT;
+
+		    ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
+		    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+				(LPARAM) infoPtr);
+		    return TCL_OK;
+		} else {
+		    DEBUG("ELSE");
 		    TclWinConvertError(error);
-		    goto looperror;
+		    continue;
 		}
-		
+	    reenter:
+		DEBUG("reenter");
+		fprintf(stderr, "lastError: %d\n", infoPtr->lastError);
 		/*
 		 * The connection is progressing in the background.
 		 */
-
-		asyncConnect = 1;
-	    }
-	    goto connected;
-	    
-	looperror:
-	    if (sock != INVALID_SOCKET) {
-		closesocket(sock);
-		sock = INVALID_SOCKET;
+		// infoPtr->selectEvents &= ~(FD_CONNECT);
+	    } else {
+		connected = 1;
+		goto connected;
 	    }
 	}
     }
     goto error;
+connected:
+    DEBUG("connected");
+    /*
+     * Set up the select mask for read/write events. If the connect
+     * attempt has not completed, include connect events.
+     */
+    
+    infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
 
-    connected:
-	/*
-	 * Add this socket to the global list of sockets.
-	 */
-
-	infoPtr = NewSocketInfo(sock);
-
-	/*
-	 * Set up the select mask for read/write events. If the connect
-	 * attempt has not completed, include connect events.
-	 */
-
-	infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
-	if (asyncConnect) {
-	    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
-	    infoPtr->selectEvents |= FD_CONNECT;
-	}
-
-  error:
-    if (addrlist != NULL) {
-	freeaddrinfo(addrlist);
-    }
-    if (myaddrlist != NULL) {
-	freeaddrinfo(myaddrlist);
-    }
-
+error:
     /*
      * Register for interest in events in the select mask. Note that this
      * automatically places the socket into non-blocking mode.
      */
 
-    if (infoPtr != NULL) {
-	ioctlsocket(sock, (long) FIONBIO, &flag);
+    if (connected) {
+	ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+
+	ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
 	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
 		(LPARAM) infoPtr);
-
-	return infoPtr;
+	return TCL_OK;
     }
 
     if (interp != NULL) {
         Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"couldn't open socket: %s",
-		(errorMsg ? errorMsg : Tcl_PosixError(interp))));
+		"couldn't open socket: %s", Tcl_PosixError(interp)));
     }
 
-    if (sock != INVALID_SOCKET) {
-	closesocket(sock);
-    }
-    return NULL;
+    return TCL_ERROR;
 }
 
 /*
@@ -1390,18 +1406,57 @@ Tcl_OpenTcpClient(
 				 * asynchronously. */
 {
     SocketInfo *infoPtr;
-    char channelName[16 + TCL_INTEGER_SPACE];
+    const char *errorMsg = NULL;
+    struct addrinfo *addrlist = NULL;
+    struct addrinfo *myaddrlist = NULL;
+    char channelName[SOCK_CHAN_LENGTH];
 
     if (TclpHasSockets(interp) != TCL_OK) {
 	return NULL;
     }
 
     /*
-     * Create a new client socket and wrap it in a channel.
+     * Check that WinSock is initialized; do not call it if not, to prevent
+     * system crashes. This can happen at exit time if the exit handler for
+     * WinSock ran before other exit handlers that want to use sockets.
+     */
+
+    if (!SocketsEnabled()) {
+	return NULL;
+    }
+
+    /*
+     * Do the name lookups for the local and remote addresses.
      */
 
-    infoPtr = CreateClientSocket(interp, port, host, myaddr, myport, async);
-    if (infoPtr == NULL) {
+    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg)
+            || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
+                    &errorMsg)) {
+        if (addrlist != NULL) {
+            freeaddrinfo(addrlist);
+        }
+        if (interp != NULL) {
+            Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                    "couldn't open socket: %s", errorMsg));
+        }
+        return NULL;
+    }
+    printaddrinfolist(myaddrlist, "local");
+    printaddrinfolist(addrlist, "remote");
+
+    infoPtr = NewSocketInfo(INVALID_SOCKET);
+    infoPtr->addrlist = addrlist;
+    infoPtr->myaddrlist = myaddrlist;
+    if (async) {
+	infoPtr->flags |= SOCKET_ASYNC_CONNECT;
+    }
+
+    /*
+     * Create a new client socket and wrap it in a channel.
+     */
+    
+    if (CreateClientSocket(interp, infoPtr) != TCL_OK) {
+	TcpCloseProc(infoPtr, NULL);
 	return NULL;
     }
 
@@ -1444,7 +1499,7 @@ Tcl_MakeTcpClientChannel(
     ClientData sock)		/* The socket to wrap up into a channel. */
 {
     SocketInfo *infoPtr;
-    char channelName[16 + TCL_INTEGER_SPACE];
+    char channelName[SOCK_CHAN_LENGTH];
     ThreadSpecificData *tsdPtr;
 
     if (TclpHasSockets(NULL) != TCL_OK) {
@@ -1506,7 +1561,7 @@ Tcl_OpenTcpServer(
     unsigned short chosenport = 0;
     struct addrinfo *addrPtr;	/* Socket address to listen on. */
     SocketInfo *infoPtr = NULL;	/* The returned value. */
-    void *addrlist = NULL;
+    struct addrinfo *addrlist = NULL;
     char channelName[SOCK_CHAN_LENGTH];
     u_long flag = 1;		/* Indicates nonblocking mode. */
     const char *errorMsg = NULL;
@@ -1694,7 +1749,7 @@ TcpAccept(
     SocketInfo *newInfoPtr;
     SocketInfo *infoPtr = fds->infoPtr;
     int len = sizeof(addr);
-    char channelName[16 + TCL_INTEGER_SPACE];
+    char channelName[SOCK_CHAN_LENGTH];
     char host[NI_MAXHOST], port[NI_MAXSERV];
     ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 
@@ -2512,10 +2567,12 @@ SocketProc(
 
     switch (message) {
     default:
+	    DEBUG("default");
 	return DefWindowProc(hwnd, message, wParam, lParam);
 	break;
 
     case WM_CREATE:
+	    DEBUG("CREATE");
 	/*
 	 * Store the initial tsdPtr, it's from a different thread, so it's not
 	 * directly accessible, but needed.
@@ -2531,10 +2588,12 @@ SocketProc(
 	break;
 
     case WM_DESTROY:
+	    DEBUG("DESTROY");
 	PostQuitMessage(0);
 	break;
 
     case SOCKET_MESSAGE:
+	    DEBUG("SOCKET_MESSAGE");
 	event = WSAGETSELECTEVENT(lParam);
 	error = WSAGETSELECTERROR(lParam);
 	socket = (SOCKET) wParam;
@@ -2549,6 +2608,11 @@ SocketProc(
 		infoPtr = infoPtr->nextPtr) {
 	    for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
 		if (fds->fd == socket) {
+		    if (event & FD_READ) 
+			DEBUG("|->FD_READ");
+		    if (event & FD_WRITE) 
+			DEBUG("|->FD_WRITE");
+
 		    /*
 		     * Update the socket state.
 		     *
@@ -2558,19 +2622,22 @@ SocketProc(
 		     */
 
 		    if (event & FD_CLOSE) {
+			DEBUG("FD_CLOSE");
 			infoPtr->acceptEventCount = 0;
 			infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
 		    } else if (event & FD_ACCEPT) {
-			infoPtr->acceptEventCount++;
+			DEBUG("FD_ACCEPT");
+			    infoPtr->acceptEventCount++;
 		    }
 
 		    if (event & FD_CONNECT) {
+			DEBUG("FD_CONNECT");
 			/*
 			 * The socket is now connected, clear the async connect
 			 * flag.
 			 */
 
-			infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+			//infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
 
 			/*
 			 * Remember any error that occurred so we can report
@@ -2582,15 +2649,17 @@ SocketProc(
 			    infoPtr->lastError = Tcl_GetErrno();
 			}
 		    }
-
+#if 0
 		    if (infoPtr->flags & SOCKET_ASYNC_CONNECT) {
-			infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+			DEBUG("SOCKET_ASYNC_CONNECT");
+			// infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
 			if (error != ERROR_SUCCESS) {
 			    TclWinConvertError((DWORD) error);
 			    infoPtr->lastError = Tcl_GetErrno();
 			}
 			infoPtr->readyEvents |= FD_WRITE;
 		    }
+#endif
 		    infoPtr->readyEvents |= event;
 
 		    /*
@@ -2607,10 +2676,12 @@ SocketProc(
 	break;
 
     case SOCKET_SELECT:
+	    DEBUG("SOCKET_SELECT");
 	infoPtr = (SocketInfo *) lParam;
 	for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
 	    infoPtr = (SocketInfo *) lParam;
 	    if (wParam == SELECT) {
+		DEBUG("SELECT");
 		WSAAsyncSelect(fds->fd, hwnd,
 			SOCKET_MESSAGE, infoPtr->selectEvents);
 	    } else {
@@ -2618,12 +2689,14 @@ SocketProc(
 		 * Clear the selection mask
 		 */
 
+		DEBUG("!SELECT");
 		WSAAsyncSelect(fds->fd, hwnd, 0, 0);
 	    }
 	}
 	break;
 
     case SOCKET_TERMINATE:
+	    DEBUG("SOCKET_TERMINATE");
 	DestroyWindow(hwnd);
 	break;
     }
-- 
cgit v0.12


From 4dd180a450af9fce8d8128ebc37dfe3aa3932c6e Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Fri, 28 Feb 2014 11:05:35 +0000
Subject: Make printf debugging switchable, because it affects 'make test'

---
 win/tclWinSock.c | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 6afa094..905297e 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -47,7 +47,8 @@
 
 #include "tclWinInt.h"
 
-#if 1
+//#define DEBUGGING
+#ifdef DEBUGGING
 #define DEBUG(x) fprintf(stderr, ">>> %s(%d): %s<<<\n", __FUNCTION__, __LINE__, x)
 #else
 #define DEBUG(x)
@@ -284,7 +285,9 @@ void printaddrinfo(struct addrinfo *ai, char *prefix)
 		host, sizeof(host),
 		port, sizeof(port),
 		NI_NUMERICHOST|NI_NUMERICSERV);
+#ifdef DEBUGGING
     fprintf(stderr,"%s: [%s]:%s\n", prefix, host, port);
+#endif
 }
 void printaddrinfolist(struct addrinfo *addrlist, char *prefix)
 {
@@ -1250,7 +1253,9 @@ CreateClientSocket(
 		DWORD error = (DWORD) WSAGetLastError();
 
 		DEBUG("connect()");
+#ifdef DEBUGGING
 		// fprintf(stderr,"error = %lu\n", error);
+#endif
 		if (error == WSAEWOULDBLOCK) {
 		    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 		    DEBUG("WSAEWOULDBLOCK");
@@ -1268,7 +1273,9 @@ CreateClientSocket(
 		}
 	    reenter:
 		DEBUG("reenter");
+#ifdef DEBUGGING
 		fprintf(stderr, "lastError: %d\n", infoPtr->lastError);
+#endif
 		/*
 		 * The connection is progressing in the background.
 		 */
-- 
cgit v0.12


From 607601abc11ec2e965fedc5d3cb1e6d83c3a4a10 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 28 Feb 2014 18:25:20 +0000
Subject: More ReadChars rewriting.  Test suite now passes. Note that this
 reform simplifies ReadChars a fair bit (at least in my eyes). Also it does
 away with the use of an INPUT_NEED_NL flag, using the same strategy for
 partial \r\n sequences as is used for incomplete multibyte chars.

---
 generic/tclIO.c | 194 ++++++++++++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 173 insertions(+), 21 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 20428b5..ec71991 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5403,7 +5403,6 @@ ReadChars(
 	 * srcLen bytes, write no more than dstLimit bytes.
 	 */
 
-//fprintf(stdout, "Start %d %d\n", dstLimit, srcLen); fflush(stdout);
 	int code = Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
 		statePtr->inputEncodingFlags & (bufPtr->nextPtr
 		? ~0 : ~TCL_ENCODING_END), &statePtr->inputEncodingState,
@@ -5416,9 +5415,6 @@ ReadChars(
 	 * Capture the number of bytes actually consumed in dstRead.
 	 */
 
-//fprintf(stdout, "Key NS=%d MB=%d S=%d\n", TCL_CONVERT_NOSPACE,
-//TCL_CONVERT_MULTIBYTE, TCL_CONVERT_SYNTAX); fflush(stdout);
-//fprintf(stdout, "Decoded %d %d\n", dstDecoded,code); fflush(stdout);
 	dstWrote = dstRead = dstDecoded;
 	TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
 
@@ -5426,20 +5422,144 @@ ReadChars(
 
 	    /*
 	     * The encoding transformation produced bytes that the
-	     * translation transformation did not consume.  Start over
-	     * and impose new limits so that doesn't happen again.
+	     * translation transformation did not consume.  Why did
+	     * this happen?
 	     */
-//fprintf(stdout, "X! %d %d\n", dstRead, dstDecoded); fflush(stdout);
 
-	    dstLimit = dstRead + TCL_UTF_MAX;
-	    statePtr->flags = savedFlags;
-	    statePtr->inputEncodingFlags = savedIEFlags;
-	    statePtr->inputEncodingState = savedState;
-	    continue;
-	}
+	    if (statePtr->inEofChar && dst[dstRead] == statePtr->inEofChar) {
+		/*
+		 * 1) There's an eof char set on the channel, and
+		 *    we saw it and stopped translating at that point.
+		 *
+		 * NOTE the bizarre spec of TranslateInputEOL in this case.
+		 * Clearly the eof char had to be read in order to account
+		 * for the stopping, but the value of dstRead does not
+		 * include it.
+		 *
+		 * Also rather bizarre, our caller can only notice an
+		 * EOF condition if we return the value -1 as the number
+		 * of chars read.  This forces us to perform a 2-call
+		 * dance where the first call can read all the chars
+		 * up to the eof char, and the second call is solely
+		 * for consuming the encoded eof char then pointed at
+		 * by src so that we can return that magic -1 value.
+		 * This seems really wasteful, especially since
+		 * the first decoding pass of each call is likely to
+		 * decode many bytes beyond that eof char that's all we
+		 * care about.
+		 */
+
+		if (dstRead == 0) {
+		    /*
+		     * Curious choice in the eof char handling.  We leave
+		     * the eof char in the buffer.  So, no need to compute
+		     * a proper srcRead value.  At this point, there
+		     * are no chars before the eof char in the buffer.
+		     */
+		    return -1;
+		}
+
+		{
+		    /*
+		     * There are chars leading the buffer before the eof
+		     * char.  Adjust the dstLimit so we go back and read
+		     * only those and do not encounter the eof char this
+		     * time.
+		     */
+
+		    dstLimit = dstRead + TCL_UTF_MAX;
+		    statePtr->flags = savedFlags;
+		    statePtr->inputEncodingFlags = savedIEFlags;
+		    statePtr->inputEncodingState = savedState;
+		    continue;
+		}
+	    }
+
+	    /*
+	     * 2) The other way to read fewer bytes than are decoded
+	     *    is when the final byte is \r and we're in a CRLF
+	     *    translation mode so we cannot decide whether to
+	     *	  record \r or \n yet.
+	     */
+
+	    assert(dstRead + 1 == dstDecoded);
+	    assert(dst[dstRead] == '\r');
+	    assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF);
+
+	    if (dstWrote > 0) {
+		/*
+		 * There are chars we can read before we hit the bare cr.
+		 * Go back with a smaller dstLimit so we get them in the
+		 * next pass, compute a matching srcRead, and don't end
+		 * up back here in this call.
+		 */
+
+		dstLimit = dstRead + TCL_UTF_MAX;
+		statePtr->flags = savedFlags;
+		statePtr->inputEncodingFlags = savedIEFlags;
+		statePtr->inputEncodingState = savedState;
+		continue;
+	    }
+
+	    assert(dstWrote == 0);
+	    assert(dstRead == 0);
+	    assert(dstDecoded == 1);
+
+	    /*
+	     * We decoded only the bare cr, and we cannot read a
+	     * translated char from that alone.  We have to know what's
+	     * next.  So why do we only have the one decoded char?
+	     */
+
+	    if (code != TCL_OK) {
+		char buffer[TCL_UTF_MAX + 2];
+		int read, decoded, count;
+
+		/* 
+		 * Didn't get everything the buffer could offer
+		 */
+
+		statePtr->flags = savedFlags;
+		statePtr->inputEncodingFlags = savedIEFlags;
+		statePtr->inputEncodingState = savedState;
+
+		Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
+		statePtr->inputEncodingFlags & (bufPtr->nextPtr
+		? ~0 : ~TCL_ENCODING_END), &statePtr->inputEncodingState,
+		buffer, TCL_UTF_MAX + 2, &read, &decoded, &count);
+
+		if (count == 2) {
+		    if (buffer[1] == '\n') {
+			/* \r\n translate to \n */
+			dst[0] = '\n';
+			bufPtr->nextRemoved += read;
+		    } else {
+			dst[0] = '\r';
+			bufPtr->nextRemoved += srcRead;
+		    }
+
+		    dst[1] = '\0';
+		    statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
+
+		    *offsetPtr += 1;
+		    return 1;
+		}
 
-//fprintf(stdout, "check %d %d %d\n", dstWrote, dstRead, dstDecoded);
-//fflush(stdout);
+	    } else if (statePtr->flags & CHANNEL_EOF) {
+
+		/*
+		 * The bare \r is the only char and we will never read
+		 * a subsequent char to make the determination.
+		 */
+
+		dst[0] = '\r';
+		bufPtr->nextRemoved = bufPtr->nextAdded;
+		*offsetPtr += 1;
+		return 1;
+	    }
+
+	    /* FALL THROUGH - get more data (dstWrote == 0) */
+	}
 
 	/* 
 	 * The translation transformation can only reduce the number
@@ -5455,7 +5575,6 @@ ReadChars(
 	     * We read more chars than allowed.  Reset limits to
 	     * prevent that and try again.
 	     */
-//fprintf(stdout, "Y!\n"); fflush(stdout);
 
 	    dstLimit = Tcl_UtfAtIndex(dst, charsToRead + 1) - dst;
 	    statePtr->flags = savedFlags;
@@ -5466,12 +5585,46 @@ ReadChars(
 
 	if (dstWrote == 0) {
 
-//fprintf(stdout, "Z!\n"); fflush(stdout);
-	    /* 
-	     * Could not read anything.  Ask caller to get more data.
+	    /*
+	     * We were not able to read any chars.  Maybe there were
+	     * not enough src bytes to decode into a char.  Maybe
+	     * a lone \r could not be translated (crlf mode).  Need
+	     * to combine any unused src bytes we have in the first
+	     * buffer with subsequent bytes to try again.
 	     */
 
-	    return -1;
+	    ChannelBuffer *nextPtr = bufPtr->nextPtr;
+
+	    if (nextPtr == NULL) {
+		if (srcLen > 0) {
+		    SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
+		}
+		return -1;
+	    }
+
+	    /*
+	     * Space is made at the beginning of the buffer to copy the
+	     * previous unused bytes there. Check first if the buffer we
+	     * are using actually has enough space at its beginning for
+	     * the data we are copying.  Because if not we will write over
+	     * the buffer management information, especially the 'nextPtr'.
+	     *
+	     * Note that the BUFFER_PADDING (See AllocChannelBuffer) is
+	     * used to prevent exactly this situation. I.e. it should never
+	     * happen.  Therefore it is ok to panic should it happen despite
+	     * the precautions.
+	     */
+
+	    if (nextPtr->nextRemoved - srcLen < 0) {
+		Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough");
+	    }
+
+	    nextPtr->nextRemoved -= srcLen;
+	    memcpy(RemovePoint(nextPtr), src, (size_t) srcLen);
+	    RecycleBuffer(statePtr, bufPtr, 0);
+	    statePtr->inQueueHead = nextPtr;
+	    return ReadChars(statePtr, objPtr, charsToRead,
+		    offsetPtr, factorPtr);
 	}
 
 	statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
@@ -5481,7 +5634,6 @@ ReadChars(
 	    *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;
 	}
 	*offsetPtr += dstWrote;
-//fprintf(stdout, "OK: %d\n", numChars); fflush(stdout);
 	return numChars;
     }
 
-- 
cgit v0.12


From 7b66d219bab6b6710a22b4b18ca563239ffdc050 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 28 Feb 2014 18:28:16 +0000
Subject: tidy up.

---
 generic/tclIO.c | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index ec71991..a0a349f 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5928,9 +5928,8 @@ TranslateInputEOL(
 	    if (*src == '\r') {
 		src++;
 		if (src >= srcMax) {
-//		    SetFlag(statePtr, INPUT_NEED_NL);
-//fprintf(stdout, "BREAK!\n"); fflush(stdout);
-src--; break;
+		    src--;
+		    break;
 		} else if (*src == '\n') {
 		    *dst++ = *src++;
 		} else {
@@ -5942,7 +5941,6 @@ src--; break;
 	}
 	srcLen = src - srcStart;
 	dstLen = dst - dstStart;
-//fprintf(stdout, "eh? %d %d\n", srcLen, dstLen); fflush(stdout);
 	break;
     }
     case TCL_TRANSLATE_AUTO: {
-- 
cgit v0.12


From bb1b4fcb06f80fddfd136a9bd14bf64808f45971 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 28 Feb 2014 18:36:00 +0000
Subject: another coverage test.

---
 tests/io.test | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

diff --git a/tests/io.test b/tests/io.test
index 0941e02..c325809 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -4772,6 +4772,21 @@ test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} {
     close $f
     list $c $l $e [scan [string index $in end] %c]
 } {17 8 1 13}
+test io-35.20 {Tcl_Eof, eof char in middle, cr write, crlf read} {
+    file delete $path(test1)
+    set f [open $path(test1) w]
+    fconfigure $f -translation cr -eofchar {}
+    set i [format \n%cqrsuvw 26]
+    puts $f $i
+    close $f
+    set c [file size $path(test1)]
+    set f [open $path(test1) r]
+    fconfigure $f -translation crlf -eofchar \x1a
+    set l [string length [set in [read $f]]]
+    set e [eof $f]
+    close $f
+    list $c $l $e [scan [string index $in end] %c]
+} {9 1 1 13}
 
 # Test Tcl_InputBlocked
 
-- 
cgit v0.12


From 6ac36ed52bd548be97ae7baa3022e822f6a1bdce Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Sat, 1 Mar 2014 03:01:41 +0000
Subject: Fixups make the test suite almost pass (except *io-39.17)

---
 generic/tclIO.c | 13 ++++++-------
 1 file changed, 6 insertions(+), 7 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 7b798af..139a05e 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5289,7 +5289,7 @@ ReadChars(
 	dst = TclGetString(objPtr) + numBytes;
     }
 
-#if 0
+#if 1
 
     /*
      * This routine is burdened with satisfying several constraints.
@@ -5373,6 +5373,7 @@ ReadChars(
 		     * a proper srcRead value.  At this point, there
 		     * are no chars before the eof char in the buffer.
 		     */
+		    Tcl_SetObjLength(objPtr, numBytes);
 		    return -1;
 		}
 
@@ -5459,7 +5460,6 @@ ReadChars(
 		    statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
 
 		    Tcl_SetObjLength(objPtr, numBytes + 1);
-		   // *offsetPtr += 1;
 		    return 1;
 		}
 
@@ -5473,7 +5473,6 @@ ReadChars(
 		dst[0] = '\r';
 		bufPtr->nextRemoved = bufPtr->nextAdded;
 		Tcl_SetObjLength(objPtr, numBytes + 1);
-		//*offsetPtr += 1;
 		return 1;
 	    }
 
@@ -5518,6 +5517,7 @@ ReadChars(
 		if (srcLen > 0) {
 		    SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
 		}
+		Tcl_SetObjLength(objPtr, numBytes);
 		return -1;
 	    }
 
@@ -5542,6 +5542,7 @@ ReadChars(
 	    memcpy(RemovePoint(nextPtr), src, (size_t) srcLen);
 	    RecycleBuffer(statePtr, bufPtr, 0);
 	    statePtr->inQueueHead = nextPtr;
+	    Tcl_SetObjLength(objPtr, numBytes);
 	    return ReadChars(statePtr, objPtr, charsToRead, factorPtr);
 	}
 
@@ -5552,7 +5553,6 @@ ReadChars(
 	    *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;
 	}
 	Tcl_SetObjLength(objPtr, numBytes + dstWrote);
-	//*offsetPtr += dstWrote;
 	return numChars;
     }
 
@@ -5850,9 +5850,8 @@ TranslateInputEOL(
 	    if (*src == '\r') {
 		src++;
 		if (src >= srcMax) {
-SetFlag(statePtr, INPUT_NEED_NL);
-//		    src--;
-//		    break;
+		    src--;
+		    break;
 		} else if (*src == '\n') {
 		    *dst++ = *src++;
 		} else {
-- 
cgit v0.12


From d2d1d997780ab3a1651986fc9820fd4a75ea8e56 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Mon, 3 Mar 2014 15:57:56 +0000
Subject: WIP: async open event now passes to SocketEventProc() and connects
 but does not finalyze that (I guess).

---
 win/tclWinSock.c | 38 +++++++++++++++++++++++---------------
 1 file changed, 23 insertions(+), 15 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 905297e..ccae931 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -681,7 +681,10 @@ SocketCheckProc(
     for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
 	    infoPtr = infoPtr->nextPtr) {
 	if ((infoPtr->readyEvents & infoPtr->watchEvents)
-		&& !(infoPtr->flags & SOCKET_PENDING)) {
+		&& !(infoPtr->flags & SOCKET_PENDING)
+		|| ( infoPtr->flags & SOCKET_ASYNC_CONNECT )
+		&& ( infoPtr->readyEvents & FD_CONNECT )
+	) {
 	    infoPtr->flags |= SOCKET_PENDING;
 	    evPtr = ckalloc(sizeof(SocketEvent));
 	    evPtr->header.proc = SocketEventProc;
@@ -875,7 +878,7 @@ SocketEventProc(
     if (events & FD_WRITE) {
 	mask |= TCL_WRITABLE;
     }
-    if (events & FD_CONNECT) {
+    if (infoPtr->readyEvents & FD_CONNECT) {
 	DEBUG("Calling CreateClientSocket...");
 	CreateClientSocket(NULL, infoPtr);
     }
@@ -1236,12 +1239,24 @@ CreateClientSocket(
 	    /*
 	     * Set the socket into nonblocking mode if the connect should
 	     * be done in the background.
+	     * Activate notification for a connect.
 	     */
-	    if (async && ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag)
-		== SOCKET_ERROR) {
-		DEBUG("FIONBIO");
-		TclWinConvertError((DWORD) WSAGetLastError());
-		continue;
+	    if (async) {
+		if (ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag)
+		    == SOCKET_ERROR) {
+		    DEBUG("FIONBIO");
+		    TclWinConvertError((DWORD) WSAGetLastError());
+		    continue;
+		}
+		{
+		    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+		    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
+		    infoPtr->selectEvents |= FD_CONNECT;
+
+		    ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
+		    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+				(LPARAM) infoPtr);
+		}
 	    }
 
 	    /*
@@ -1256,15 +1271,8 @@ CreateClientSocket(
 #ifdef DEBUGGING
 		// fprintf(stderr,"error = %lu\n", error);
 #endif
-		if (error == WSAEWOULDBLOCK) {
-		    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+		if (async && error == WSAEWOULDBLOCK) {
 		    DEBUG("WSAEWOULDBLOCK");
-		    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
-		    infoPtr->selectEvents |= FD_CONNECT;
-
-		    ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
-		    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-				(LPARAM) infoPtr);
 		    return TCL_OK;
 		} else {
 		    DEBUG("ELSE");
-- 
cgit v0.12


From c5233a1a3eb0706c49c436bda255bbcdac5bf009 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Tue, 4 Mar 2014 07:54:18 +0000
Subject: Reverted move of WSAAsyncSelect before connect -> FD_Connect message
 does also fire if it exists on call.

---
 win/tclWinSock.c | 31 +++++++++++++------------------
 1 file changed, 13 insertions(+), 18 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index ccae931..dd893ac 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1239,24 +1239,12 @@ CreateClientSocket(
 	    /*
 	     * Set the socket into nonblocking mode if the connect should
 	     * be done in the background.
-	     * Activate notification for a connect.
 	     */
-	    if (async) {
-		if (ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag)
-		    == SOCKET_ERROR) {
-		    DEBUG("FIONBIO");
-		    TclWinConvertError((DWORD) WSAGetLastError());
-		    continue;
-		}
-		{
-		    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-		    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
-		    infoPtr->selectEvents |= FD_CONNECT;
-
-		    ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
-		    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-				(LPARAM) infoPtr);
-		}
+	    if (async && ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag)
+		== SOCKET_ERROR) {
+		DEBUG("FIONBIO");
+		TclWinConvertError((DWORD) WSAGetLastError());
+		continue;
 	    }
 
 	    /*
@@ -1271,8 +1259,15 @@ CreateClientSocket(
 #ifdef DEBUGGING
 		// fprintf(stderr,"error = %lu\n", error);
 #endif
-		if (async && error == WSAEWOULDBLOCK) {
+		if (error == WSAEWOULDBLOCK) {
+		    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 		    DEBUG("WSAEWOULDBLOCK");
+		    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
+		    infoPtr->selectEvents |= FD_CONNECT;
+
+		    ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
+		    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+				(LPARAM) infoPtr);
 		    return TCL_OK;
 		} else {
 		    DEBUG("ELSE");
-- 
cgit v0.12


From 312c80abf4c34b3313aae1c532e5621066e8bd1c Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Tue, 4 Mar 2014 18:54:48 +0000
Subject:   *  Use watchEvents only for read/write/close events of [chan
 event], don't mix with internal use of accept and connect events.   *  WIP:
 Refactor the tail of CreateClientSocket() to get notifications for completed
 async connects right.

---
 win/tclWinSock.c | 145 +++++++++++++++++++++++++++++++------------------------
 1 file changed, 82 insertions(+), 63 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index dd893ac..6620def 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -47,7 +47,7 @@
 
 #include "tclWinInt.h"
 
-//#define DEBUGGING
+#define DEBUGGING
 #ifdef DEBUGGING
 #define DEBUG(x) fprintf(stderr, ">>> %s(%d): %s<<<\n", __FUNCTION__, __LINE__, x)
 #else
@@ -629,11 +629,13 @@ SocketSetupProc(
     /*
      * Check to see if there is a ready socket.	 If so, poll.
      */
-
     WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
     for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
 	    infoPtr = infoPtr->nextPtr) {
-	if (infoPtr->readyEvents & infoPtr->watchEvents) {
+	if (infoPtr->readyEvents &
+	    (infoPtr->watchEvents | FD_CONNECT | FD_ACCEPT)
+	) {
+	    DEBUG("Tcl_SetMaxBlockTime");
 	    Tcl_SetMaxBlockTime(&blockTime);
 	    break;
 	}
@@ -667,6 +669,7 @@ SocketCheckProc(
     SocketEvent *evPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
+    DEBUG("A");
     if (!(flags & TCL_FILE_EVENTS)) {
 	return;
     }
@@ -680,10 +683,9 @@ SocketCheckProc(
     WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
     for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
 	    infoPtr = infoPtr->nextPtr) {
-	if ((infoPtr->readyEvents & infoPtr->watchEvents)
-		&& !(infoPtr->flags & SOCKET_PENDING)
-		|| ( infoPtr->flags & SOCKET_ASYNC_CONNECT )
-		&& ( infoPtr->readyEvents & FD_CONNECT )
+	if ((infoPtr->readyEvents &
+		(infoPtr->watchEvents | FD_CONNECT | FD_ACCEPT))
+	    && !(infoPtr->flags & SOCKET_PENDING)
 	) {
 	    infoPtr->flags |= SOCKET_PENDING;
 	    evPtr = ckalloc(sizeof(SocketEvent));
@@ -731,8 +733,7 @@ SocketEventProc(
     address addr;
     int len;
 
-    DEBUG("xxx");
-
+    DEBUG("");
     if (!(flags & TCL_FILE_EVENTS)) {
 	return 0;
     }
@@ -760,10 +761,17 @@ SocketEventProc(
 
     infoPtr->flags &= ~SOCKET_PENDING;
 
+    if (infoPtr->readyEvents & FD_CONNECT) {
+	DEBUG("FD_CONNECT");
+	SetEvent(tsdPtr->socketListLock);
+	CreateClientSocket(NULL, infoPtr);
+	infoPtr->readyEvents &= ~(FD_CONNECT);
+	return 1;
+    }
+
     /*
      * Handle connection requests directly.
      */
-
     if (infoPtr->readyEvents & FD_ACCEPT) {
 	for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
 
@@ -845,6 +853,7 @@ SocketEventProc(
 
 	Tcl_Time blockTime = { 0, 0 };
 
+	DEBUG("FD_CLOSE");
 	Tcl_SetMaxBlockTime(&blockTime);
 	mask |= TCL_READABLE|TCL_WRITABLE;
     } else if (events & FD_READ) {
@@ -858,6 +867,7 @@ SocketEventProc(
 	 * readable, notify the channel driver, otherwise reset the async
 	 * select handler and keep waiting.
 	 */
+	DEBUG("FD_READ");
 
 	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
 		(WPARAM) UNSELECT, (LPARAM) infoPtr);
@@ -876,12 +886,9 @@ SocketEventProc(
 	}
     }
     if (events & FD_WRITE) {
+	DEBUG("FD_WRITE");
 	mask |= TCL_WRITABLE;
     }
-    if (infoPtr->readyEvents & FD_CONNECT) {
-	DEBUG("Calling CreateClientSocket...");
-	CreateClientSocket(NULL, infoPtr);
-    }
     if (mask) {
 	DEBUG("Calling Tcl_NotifyChannel...");
 	Tcl_NotifyChannel(infoPtr->channel, mask);
@@ -1164,14 +1171,17 @@ CreateClientSocket(
     SocketInfo *infoPtr)
 {
     u_long flag = 1;		/* Indicates nonblocking mode. */
-    int async_callback = (infoPtr->addr != NULL);
-    int connected = 0;
     int async = infoPtr->flags & SOCKET_ASYNC_CONNECT;
-
-    DEBUG(async_callback ? "subsequent" : "first");
+    int async_callback = infoPtr->sockets->fd != INVALID_SOCKET;
+    ThreadSpecificData *tsdPtr;
+    
     DEBUG(async ? "async" : "sync");
+
     if (async_callback) {
+	DEBUG("subsequent call");
         goto reenter;
+    } else {
+	DEBUG("first call");
     }
     
     for (infoPtr->addr = infoPtr->addrlist; infoPtr->addr != NULL;
@@ -1199,13 +1209,12 @@ CreateClientSocket(
             /*
              * Close the socket if it is still open from the last unsuccessful
              * iteration.
-             */
-
+             */	    
 	    if (infoPtr->sockets->fd != INVALID_SOCKET) {
 		DEBUG("closesocket");
 		closesocket(infoPtr->sockets->fd);
 	    }
-
+	    
 	    infoPtr->sockets->fd = socket(infoPtr->myaddr->ai_family, SOCK_STREAM, 0);
 	    if (infoPtr->sockets->fd == INVALID_SOCKET) {
 		DEBUG("socket() failed");
@@ -1254,7 +1263,7 @@ CreateClientSocket(
 	    if (connect(infoPtr->sockets->fd, infoPtr->addr->ai_addr,
 			    infoPtr->addr->ai_addrlen) == SOCKET_ERROR) {
 		DWORD error = (DWORD) WSAGetLastError();
-
+		TclWinConvertError(error);
 		DEBUG("connect()");
 #ifdef DEBUGGING
 		// fprintf(stderr,"error = %lu\n", error);
@@ -1262,64 +1271,59 @@ CreateClientSocket(
 		if (error == WSAEWOULDBLOCK) {
 		    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 		    DEBUG("WSAEWOULDBLOCK");
-		    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
 		    infoPtr->selectEvents |= FD_CONNECT;
 
 		    ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
 		    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
 				(LPARAM) infoPtr);
 		    return TCL_OK;
-		} else {
-		    DEBUG("ELSE");
-		    TclWinConvertError(error);
-		    continue;
+		reenter:
+		    Tcl_SetErrno(infoPtr->lastError);
+		    DEBUG("reenter");
+		    infoPtr->selectEvents &= ~(FD_CONNECT);
 		}
-	    reenter:
-		DEBUG("reenter");
+	    } else {
+		DWORD error = (DWORD) WSAGetLastError();
+		TclWinConvertError(error);
+	    }
 #ifdef DEBUGGING
-		fprintf(stderr, "lastError: %d\n", infoPtr->lastError);
+	    fprintf(stderr, "lastError: %d\n", Tcl_GetErrno());
 #endif
-		/*
-		 * The connection is progressing in the background.
-		 */
-		// infoPtr->selectEvents &= ~(FD_CONNECT);
-	    } else {
-		connected = 1;
-		goto connected;
+	    if (Tcl_GetErrno() == 0) {
+		goto out;
 	    }
 	}
     }
-    goto error;
-connected:
-    DEBUG("connected");
+
+out:
+    DEBUG("connected or finally failed");
+    if (Tcl_GetErrno() != 0 && interp != NULL) {
+	DEBUG("ERRNO");
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+				"couldn't open socket: %s", Tcl_PosixError(interp)));
+	}
+	return TCL_ERROR;
+    }
     /*
-     * Set up the select mask for read/write events. If the connect
-     * attempt has not completed, include connect events.
+     * Set up the select mask for read/write events.
      */
     
     infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
-
-error:
+    
     /*
      * Register for interest in events in the select mask. Note that this
      * automatically places the socket into non-blocking mode.
      */
-
-    if (connected) {
-	ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-
-	ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
-	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+    
+    tsdPtr = TclThreadDataKeyGet(&dataKey);
+    ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
+    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
 		(LPARAM) infoPtr);
-	return TCL_OK;
-    }
-
-    if (interp != NULL) {
-        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"couldn't open socket: %s", Tcl_PosixError(interp)));
+    if (async_callback) {
+	Tcl_NotifyChannel(infoPtr->channel, TCL_WRITABLE);
     }
-
-    return TCL_ERROR;
+    return TCL_OK;
 }
 
 /*
@@ -1348,7 +1352,6 @@ WaitForSocketEvent(
     int result = 1;
     int oldMode;
     ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-
     /*
      * Be sure to disable event servicing so we are truly modal.
      */
@@ -1464,7 +1467,7 @@ Tcl_OpenTcpClient(
     /*
      * Create a new client socket and wrap it in a channel.
      */
-    
+    DEBUG("");
     if (CreateClientSocket(interp, infoPtr) != TCL_OK) {
 	TcpCloseProc(infoPtr, NULL);
 	return NULL;
@@ -1702,7 +1705,6 @@ error:
 	 */
 	
 	infoPtr->selectEvents = FD_ACCEPT;
-	infoPtr->watchEvents |= FD_ACCEPT;
 	
 	/*
 	 * Register for interest in events in the select mask. Note that this
@@ -2289,6 +2291,9 @@ TcpGetOptionProc(
 	}
 	for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
 	    sock = fds->fd;
+#ifdef DEBUGGING
+	    fprintf(stderr, "sock == %d\n", sock);
+#endif
 	    size = sizeof(sockname);
 	    if (getsockname(sock, &(sockname.sa), &size) >= 0) {
 		int flags = reverseDNS;
@@ -2419,6 +2424,9 @@ TcpWatchProc(
 {
     SocketInfo *infoPtr = instanceData;
 
+    DEBUG((mask & TCL_READABLE) ? "+r":"-r");
+    DEBUG((mask & TCL_WRITABLE) ? "+w":"-w");
+
     /*
      * Update the watch events mask. Only if the socket is not a server
      * socket. [Bug 557878]
@@ -2427,10 +2435,10 @@ TcpWatchProc(
     if (!infoPtr->acceptProc) {
 	infoPtr->watchEvents = 0;
 	if (mask & TCL_READABLE) {
-	    infoPtr->watchEvents |= (FD_READ|FD_CLOSE|FD_ACCEPT);
+	    infoPtr->watchEvents |= (FD_READ|FD_CLOSE);
 	}
 	if (mask & TCL_WRITABLE) {
-	    infoPtr->watchEvents |= (FD_WRITE|FD_CLOSE|FD_CONNECT);
+	    infoPtr->watchEvents |= (FD_WRITE|FD_CLOSE);
 	}
 
 	/*
@@ -2613,10 +2621,16 @@ SocketProc(
 	 * eventState flag.
 	 */
 
+	DEBUG("FOO");
 	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	DEBUG("BAR");
 	for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
 		infoPtr = infoPtr->nextPtr) {
 	    for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
+#ifdef DEBUGGING
+		fprintf(stderr,"socket = %d, fd=%d, event = %d, error = %d\n",
+			socket, fds->fd, event, error);
+#endif
 		if (fds->fd == socket) {
 		    if (event & FD_READ) 
 			DEBUG("|->FD_READ");
@@ -2692,6 +2706,11 @@ SocketProc(
 	    infoPtr = (SocketInfo *) lParam;
 	    if (wParam == SELECT) {
 		DEBUG("SELECT");
+		if (infoPtr->selectEvents & FD_READ) DEBUG("  READ");
+		if (infoPtr->selectEvents & FD_WRITE) DEBUG("  WRITE");
+		if (infoPtr->selectEvents & FD_CLOSE) DEBUG("  CLOSE");
+		if (infoPtr->selectEvents & FD_CONNECT) DEBUG("  CONNECT");
+		if (infoPtr->selectEvents & FD_ACCEPT) DEBUG("  ACCEPT");
 		WSAAsyncSelect(fds->fd, hwnd,
 			SOCKET_MESSAGE, infoPtr->selectEvents);
 	    } else {
-- 
cgit v0.12


From 91e8a8f60c91ad11df3a1c00d36184b9bc0c9947 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Wed, 5 Mar 2014 10:20:09 +0000
Subject: Next async connect try works. Reset error and move notifier before
 connect.

---
 win/tclWinSock.c | 23 ++++++++++++-----------
 1 file changed, 12 insertions(+), 11 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 6620def..2da50f5 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1214,6 +1214,11 @@ CreateClientSocket(
 		DEBUG("closesocket");
 		closesocket(infoPtr->sockets->fd);
 	    }
+
+	    /*
+	     * Reset last error from last try
+	     */
+	    infoPtr->lastError = 0;
 	    
 	    infoPtr->sockets->fd = socket(infoPtr->myaddr->ai_family, SOCK_STREAM, 0);
 	    if (infoPtr->sockets->fd == INVALID_SOCKET) {
@@ -1249,11 +1254,13 @@ CreateClientSocket(
 	     * Set the socket into nonblocking mode if the connect should
 	     * be done in the background.
 	     */
-	    if (async && ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag)
-		== SOCKET_ERROR) {
-		DEBUG("FIONBIO");
-		TclWinConvertError((DWORD) WSAGetLastError());
-		continue;
+	    if (async) {
+		ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+		infoPtr->selectEvents |= FD_CONNECT;
+
+		ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
+		SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+			    (LPARAM) infoPtr);
 	    }
 
 	    /*
@@ -1269,13 +1276,7 @@ CreateClientSocket(
 		// fprintf(stderr,"error = %lu\n", error);
 #endif
 		if (error == WSAEWOULDBLOCK) {
-		    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 		    DEBUG("WSAEWOULDBLOCK");
-		    infoPtr->selectEvents |= FD_CONNECT;
-
-		    ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
-		    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-				(LPARAM) infoPtr);
 		    return TCL_OK;
 		reenter:
 		    Tcl_SetErrno(infoPtr->lastError);
-- 
cgit v0.12


From 60f72ecdaf9f585eb8210a95d43969c20ede5329 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Wed, 5 Mar 2014 13:09:22 +0000
Subject: Print out the value of infoPtr in DEBUG, so that coexisting sockets
 can be distinguished in the output.

---
 win/tclWinSock.c | 12 +++++-------
 1 file changed, 5 insertions(+), 7 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 2da50f5..64b2fc9 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -49,7 +49,8 @@
 
 #define DEBUGGING
 #ifdef DEBUGGING
-#define DEBUG(x) fprintf(stderr, ">>> %s(%d): %s<<<\n", __FUNCTION__, __LINE__, x)
+#define DEBUG(x) fprintf(stderr, ">>> %p %s(%d): %s<<<\n", \
+			    infoPtr, __FUNCTION__, __LINE__, x)
 #else
 #define DEBUG(x)
 #endif
@@ -669,7 +670,6 @@ SocketCheckProc(
     SocketEvent *evPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
-    DEBUG("A");
     if (!(flags & TCL_FILE_EVENTS)) {
 	return;
     }
@@ -683,10 +683,12 @@ SocketCheckProc(
     WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
     for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
 	    infoPtr = infoPtr->nextPtr) {
+    DEBUG("A");
 	if ((infoPtr->readyEvents &
 		(infoPtr->watchEvents | FD_CONNECT | FD_ACCEPT))
 	    && !(infoPtr->flags & SOCKET_PENDING)
 	) {
+    DEBUG("B");
 	    infoPtr->flags |= SOCKET_PENDING;
 	    evPtr = ckalloc(sizeof(SocketEvent));
 	    evPtr->header.proc = SocketEventProc;
@@ -1356,6 +1358,7 @@ WaitForSocketEvent(
     /*
      * Be sure to disable event servicing so we are truly modal.
      */
+    DEBUG("=============");
 
     oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
 
@@ -2586,12 +2589,10 @@ SocketProc(
 
     switch (message) {
     default:
-	    DEBUG("default");
 	return DefWindowProc(hwnd, message, wParam, lParam);
 	break;
 
     case WM_CREATE:
-	    DEBUG("CREATE");
 	/*
 	 * Store the initial tsdPtr, it's from a different thread, so it's not
 	 * directly accessible, but needed.
@@ -2607,12 +2608,10 @@ SocketProc(
 	break;
 
     case WM_DESTROY:
-	    DEBUG("DESTROY");
 	PostQuitMessage(0);
 	break;
 
     case SOCKET_MESSAGE:
-	    DEBUG("SOCKET_MESSAGE");
 	event = WSAGETSELECTEVENT(lParam);
 	error = WSAGETSELECTERROR(lParam);
 	socket = (SOCKET) wParam;
@@ -2668,7 +2667,6 @@ SocketProc(
 			 * Remember any error that occurred so we can report
 			 * connection failures.
 			 */
-
 			if (error != ERROR_SUCCESS) {
 			    TclWinConvertError((DWORD) error);
 			    infoPtr->lastError = Tcl_GetErrno();
-- 
cgit v0.12


From bf23be680c6a9233bd70707a05513b31b047d158 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Wed, 5 Mar 2014 13:12:13 +0000
Subject: avoid warnings about uninitialized infoPtr in DEBUG

---
 win/tclWinSock.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 64b2fc9..f06aad1 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -726,7 +726,7 @@ SocketEventProc(
     int flags)			/* Flags that indicate what events to handle,
 				 * such as TCL_FILE_EVENTS. */
 {
-    SocketInfo *infoPtr;
+    SocketInfo *infoPtr = NULL; /* DEBUG */
     SocketEvent *eventPtr = (SocketEvent *) evPtr;
     int mask = 0, events;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -2578,7 +2578,7 @@ SocketProc(
 {
     int event, error;
     SOCKET socket;
-    SocketInfo *infoPtr;
+    SocketInfo *infoPtr = NULL; /* DEBUG */
     TcpFdList *fds = NULL;
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
 #ifdef _WIN64
-- 
cgit v0.12


From 23801213cacd306b0bfddbdb51efcd15c88ed0f9 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 5 Mar 2014 14:23:38 +0000
Subject: Merge repair to correct failing tests.

---
 generic/tclIO.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 139a05e..6e3f0cf 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5320,7 +5320,7 @@ ReadChars(
 	 * srcLen bytes, write no more than dstLimit bytes.
 	 */
 
-	int code = Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
+	int code = Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
 		statePtr->inputEncodingFlags & (bufPtr->nextPtr
 		? ~0 : ~TCL_ENCODING_END), &statePtr->inputEncodingState,
 		dst, dstLimit, &srcRead, &dstDecoded, &numChars);
@@ -5441,7 +5441,7 @@ ReadChars(
 		statePtr->inputEncodingFlags = savedIEFlags;
 		statePtr->inputEncodingState = savedState;
 
-		Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
+		Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
 		statePtr->inputEncodingFlags & (bufPtr->nextPtr
 		? ~0 : ~TCL_ENCODING_END), &statePtr->inputEncodingState,
 		buffer, TCL_UTF_MAX + 2, &read, &decoded, &count);
-- 
cgit v0.12


From f320ea76a37f8837d998a6400000d59b72d1e376 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Wed, 5 Mar 2014 14:40:27 +0000
Subject: Refactor the error handling logic around connect()

---
 win/tclWinSock.c | 37 +++++++++++++++++--------------------
 1 file changed, 17 insertions(+), 20 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index f06aad1..d7b1b5b 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1176,6 +1176,7 @@ CreateClientSocket(
     int async = infoPtr->flags & SOCKET_ASYNC_CONNECT;
     int async_callback = infoPtr->sockets->fd != INVALID_SOCKET;
     ThreadSpecificData *tsdPtr;
+    DWORD error;
     
     DEBUG(async ? "async" : "sync");
 
@@ -1258,7 +1259,7 @@ CreateClientSocket(
 	     */
 	    if (async) {
 		ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-		infoPtr->selectEvents |= FD_CONNECT;
+		infoPtr->selectEvents |= FD_CONNECT | FD_READ | FD_WRITE;
 
 		ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
 		SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
@@ -1268,26 +1269,22 @@ CreateClientSocket(
 	    /*
 	     * Attempt to connect to the remote socket.
 	     */
-
-	    if (connect(infoPtr->sockets->fd, infoPtr->addr->ai_addr,
-			    infoPtr->addr->ai_addrlen) == SOCKET_ERROR) {
-		DWORD error = (DWORD) WSAGetLastError();
-		TclWinConvertError(error);
-		DEBUG("connect()");
+	    
+	    DEBUG("connect()");
+	    connect(infoPtr->sockets->fd, infoPtr->addr->ai_addr,
+		    infoPtr->addr->ai_addrlen);
+	    error = WSAGetLastError();
+	    TclWinConvertError(error);
 #ifdef DEBUGGING
-		// fprintf(stderr,"error = %lu\n", error);
+	    // fprintf(stderr,"error = %lu\n", error);
 #endif
-		if (error == WSAEWOULDBLOCK) {
-		    DEBUG("WSAEWOULDBLOCK");
-		    return TCL_OK;
-		reenter:
-		    Tcl_SetErrno(infoPtr->lastError);
-		    DEBUG("reenter");
-		    infoPtr->selectEvents &= ~(FD_CONNECT);
-		}
-	    } else {
-		DWORD error = (DWORD) WSAGetLastError();
-		TclWinConvertError(error);
+	    if (error == WSAEWOULDBLOCK) {
+		DEBUG("WSAEWOULDBLOCK");
+		return TCL_OK;
+	    reenter:
+		Tcl_SetErrno(infoPtr->lastError);
+		DEBUG("reenter");
+		infoPtr->selectEvents &= ~(FD_CONNECT);
 	    }
 #ifdef DEBUGGING
 	    fprintf(stderr, "lastError: %d\n", Tcl_GetErrno());
@@ -1311,7 +1308,7 @@ out:
     /*
      * Set up the select mask for read/write events.
      */
-    
+    DEBUG("selectEvents = FD_READ | FD_WRITE | FD_CLOSE");    
     infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
     
     /*
-- 
cgit v0.12


From 2910497fce32aefc629cfe738e7f2d5e0e941877 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Wed, 5 Mar 2014 15:15:43 +0000
Subject: "gets" blocked after async cannect: SOCKET_ASYNC_CONNECT was not
 cleared

---
 win/tclWinSock.c | 24 ++++++++++++------------
 1 file changed, 12 insertions(+), 12 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index d7b1b5b..162cbd4 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1259,7 +1259,7 @@ CreateClientSocket(
 	     */
 	    if (async) {
 		ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-		infoPtr->selectEvents |= FD_CONNECT | FD_READ | FD_WRITE;
+		infoPtr->selectEvents |= FD_CONNECT;
 
 		ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
 		SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
@@ -2653,18 +2653,18 @@ SocketProc(
 
 		    if (event & FD_CONNECT) {
 			DEBUG("FD_CONNECT");
-			/*
-			 * The socket is now connected, clear the async connect
-			 * flag.
-			 */
 
-			//infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
-
-			/*
-			 * Remember any error that occurred so we can report
-			 * connection failures.
-			 */
-			if (error != ERROR_SUCCESS) {
+			if (error == ERROR_SUCCESS) {
+			    /*
+			     * The socket is now connected, clear the async connect
+			     * flag.
+			     */
+			    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+			} else {
+			    /*
+			     * Remember any error that occurred so we can report
+			     * connection failures.
+			     */
 			    TclWinConvertError((DWORD) error);
 			    infoPtr->lastError = Tcl_GetErrno();
 			}
-- 
cgit v0.12


From 9d31d410437d7e7fad1201c869e0a7c479daf693 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 5 Mar 2014 17:16:35 +0000
Subject: Adapt CopyAndTranslateBuffer() to changes in TranslateInputEOL().
 Notably no longer using the INPUT_NEED_NL flag.

---
 generic/tclIO.c | 117 +++++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 77 insertions(+), 40 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 6e3f0cf..013f8dd 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5914,7 +5914,7 @@ TranslateInputEOL(
 
 	SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
 	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
-	ResetFlag(statePtr, INPUT_SAW_CR | INPUT_NEED_NL);
+	ResetFlag(statePtr, INPUT_SAW_CR);
 	return 1;
     }
 
@@ -9046,7 +9046,6 @@ CopyAndTranslateBuffer(
 				 * in the current input buffer? */
     int copied;			/* How many characters were already copied
 				 * into the destination space? */
-    int toCopy;
 
     /*
      * If there is no input at all, return zero. The invariant is that either
@@ -9061,51 +9060,90 @@ CopyAndTranslateBuffer(
     bufPtr = statePtr->inQueueHead;
     bytesInBuffer = BytesLeft(bufPtr);
 
-    copied = 0;
-#if 0
-    if (statePtr->flags & INPUT_NEED_NL) {
+#if 1
+    copied = space;
+    if (bytesInBuffer <= copied) {
+	copied = bytesInBuffer;
+    }
+    if (copied == 0) {
+	return copied;
+    }
+    TranslateInputEOL(statePtr, result, RemovePoint(bufPtr),
+	    &copied, &bytesInBuffer);
+    bufPtr->nextRemoved += bytesInBuffer;
 
-	/*
-	 * An earlier call to TranslateInputEOL ended in the read of a \r .
-	 * Only the next read from the same channel can complete the
-	 * translation sequence to tell us what character we should read.
-	 */
+    /*
+     * If the current buffer is empty recycle it.
+     */
+
+    if (IsBufferEmpty(bufPtr)) {
+	statePtr->inQueueHead = bufPtr->nextPtr;
+	if (statePtr->inQueueHead == NULL) {
+	    statePtr->inQueueTail = NULL;
+	}
+	RecycleBuffer(statePtr, bufPtr, 0);
+    } else {
+
+	if (copied > 0) {
+	    return copied;
+	}
 
-	if (bytesInBuffer) {
-	    /* There's a next byte.  It will settle things. */
-	    ResetFlag(statePtr, INPUT_NEED_NL);
+	if (statePtr->inEofChar
+		&& RemovePoint(bufPtr)[0] == statePtr->inEofChar) {
+	    return 0;
+	}
 
-	    if (RemovePoint(bufPtr)[0] == '\n') {
-		bufPtr->nextRemoved++;
-		bytesInBuffer--;
-		*result++ = '\n';
-	    } else {
-		*result++ = '\r';
+	if (BytesLeft(bufPtr) == 1) {
+
+	    ChannelBuffer *nextPtr = bufPtr->nextPtr;
+
+	    if (nextPtr == NULL) {
+
+		if (statePtr->flags & CHANNEL_EOF) {
+		    *result = '\r';
+		    bufPtr->nextRemoved += 1;
+		    return 1;
+		}
+
+		SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
+		return 0;
 	    }
-	    copied++;
-	    space--;
-	} else if (statePtr->flags & CHANNEL_EOF) {
-	    /* There is no next byte, and there never will be (EOF). */
-	    ResetFlag(statePtr, INPUT_NEED_NL);
+
+	    nextPtr->nextRemoved -= 1;
+	    memcpy(RemovePoint(nextPtr), RemovePoint(bufPtr), 1);
+	    RecycleBuffer(statePtr, bufPtr, 0);
+	    statePtr->inQueueHead = nextPtr;
+	    return 0;
+	}
+
+	if (statePtr->inEofChar
+		&& RemovePoint(bufPtr)[1] == statePtr->inEofChar) {
 	    *result = '\r';
+	    bufPtr->nextRemoved += 1;
 	    return 1;
-	} else {
-	    /* There is no next byte.  Ask the caller to read more. */
-	    return 0;
 	}
+	/*
+	 * Buffer is not empty.  How can that be?
+	 * 0) We stopped early due to the value of "space".
+	 * 	=> copied > 0 and all is fine.
+	 * 1) We saw eof char and stopped the translation copy.
+	 *	=> if (copied > 0) or ((copied == 0) and @ eof char),
+	 *		return is fine.
+	 * 2) The buffer holds a \r while in CRLF translation, followed
+	 *    by either the end of the buffer, or the eof char.
+	 */
+
     }
-    toCopy = space;
-    if (bytesInBuffer <= toCopy) {
-	toCopy = bytesInBuffer;
-    }
-    if (toCopy == 0) {
-	return copied;
-    }
-    TranslateInputEOL(statePtr, result, RemovePoint(bufPtr),
-	    &toCopy, &bytesInBuffer);
-    bufPtr->nextRemoved += bytesInBuffer;
-    copied += toCopy;
+
+    /*
+     * Return the number of characters copied into the result buffer. This may
+     * be different from the number of bytes consumed, because of EOL
+     * translations.
+     */
+
+    return copied;
 #else
+    copied = 0;
     switch (statePtr->inputTranslation) {
     case TCL_TRANSLATE_LF:
 	if (bytesInBuffer == 0) {
@@ -9265,7 +9303,6 @@ CopyAndTranslateBuffer(
 	    }
 	}
     }
-#endif
 
     /*
      * If the current buffer is empty recycle it.
@@ -9286,6 +9323,7 @@ CopyAndTranslateBuffer(
      */
 
     return copied;
+#endif
 }
 
 /*
@@ -10726,7 +10764,6 @@ DumpFlags(
     ChanFlag('S', CHANNEL_STICKY_EOF);
     ChanFlag('B', CHANNEL_BLOCKED);
     ChanFlag('/', INPUT_SAW_CR);
-    ChanFlag('*', INPUT_NEED_NL);
     ChanFlag('D', CHANNEL_DEAD);
     ChanFlag('R', CHANNEL_RAW_MODE);
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-- 
cgit v0.12


From 94a4d6ac65eed79a3fe89a71d1c2a429793300bc Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 5 Mar 2014 19:41:51 +0000
Subject: Remove old dead code; silence compiler warnings; tidy up.

---
 generic/tclIO.c | 415 ++------------------------------------------------------
 generic/tclIO.h |   3 -
 2 files changed, 12 insertions(+), 406 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 013f8dd..821d111 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5252,33 +5252,25 @@ ReadChars(
 				 * UTF-8. On output, contains another guess
 				 * based on the data seen so far. */
 {
-    int toRead, factor, srcLen, dstNeeded, numBytes;
-    int srcRead, dstWrote, numChars, dstRead;
-    ChannelBuffer *bufPtr;
-    char *src, *dst;
-    Tcl_EncodingState oldState;
-    int encEndFlagSuppressed = 0;
     Tcl_Encoding encoding = statePtr->encoding? statePtr->encoding
 	    : GetBinaryEncoding();
-
-    factor = *factorPtr;
-
-    bufPtr = statePtr->inQueueHead;
-    src = RemovePoint(bufPtr);
-    srcLen = BytesLeft(bufPtr);
-
-    toRead = charsToRead;
-    if ((unsigned)toRead > (unsigned)srcLen) {
-	toRead = srcLen;
-    }
+    Tcl_EncodingState savedState = statePtr->inputEncodingState;
+    ChannelBuffer *bufPtr = statePtr->inQueueHead;
+    int savedIEFlags = statePtr->inputEncodingFlags;
+    int savedFlags = statePtr->flags;
+    char *dst, *src = RemovePoint(bufPtr);
+    int dstLimit, numBytes, srcLen = BytesLeft(bufPtr);
+    int toRead = ((unsigned) charsToRead > srcLen) ? srcLen : charsToRead;
 
     /*
      * 'factor' is how much we guess that the bytes in the source buffer will
      * expand when converted to UTF-8 chars. This guess comes from analyzing
      * how many characters were produced by the previous pass.
      */
+    
+    int factor = *factorPtr;
+    int dstNeeded = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
 
-    dstNeeded = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
     (void) TclGetStringFromObj(objPtr, &numBytes);
     Tcl_AppendToObj(objPtr, NULL, dstNeeded);
     if (toRead == srcLen) {
@@ -5289,8 +5281,6 @@ ReadChars(
 	dst = TclGetString(objPtr) + numBytes;
     }
 
-#if 1
-
     /*
      * This routine is burdened with satisfying several constraints.
      * It cannot append more than 'charsToRead` chars onto objPtr.
@@ -5307,13 +5297,9 @@ ReadChars(
      * a consistent set of results.  This takes the shape of a loop.
      */
 
-    int dstLimit = dstNeeded + 1;
-    int savedFlags = statePtr->flags;
-    int savedIEFlags = statePtr->inputEncodingFlags;
-    Tcl_EncodingState savedState = statePtr->inputEncodingState;
-
+    dstLimit = dstNeeded + 1;
     while (1) {
-	int dstDecoded;
+	int dstDecoded, dstRead, dstWrote, srcRead, numChars;
 
 	/*
 	 * Perform the encoding transformation.  Read no more than
@@ -5555,200 +5541,6 @@ ReadChars(
 	Tcl_SetObjLength(objPtr, numBytes + dstWrote);
 	return numChars;
     }
-
-#else
-    /*
-     * [Bug 1462248]: The cause of the crash reported in this bug is this:
-     *
-     * - ReadChars, called with a single buffer, with a incomplete
-     *	 multi-byte character at the end (only the first byte of it).
-     * - Encoding translation fails, asks for more data
-     * - Data is read, and eof is reached, TCL_ENCODING_END (TEE) is set.
-     * - ReadChar is called again, converts the first buffer, but due to TEE
-     *	 it does not check for incomplete multi-byte data, and the character
-     *	 just after the end of the first buffer is a valid completion of the
-     *	 multi-byte header in the actual buffer. The conversion reads more
-     *	 characters from the buffer then present. This causes nextRemoved to
-     *	 overshoot nextAdded and the next reads compute a negative srcLen,
-     *	 cause further translations to fail, causing copying of data into the
-     *	 next buffer using bad arguments, causing the mecpy for to eventually
-     *	 fail.
-     *
-     * In the end it is a memory access bug spiraling out of control if the
-     * conditions are _just so_. And ultimate cause is that TEE is given to a
-     * conversion where it should not. TEE signals that this is the last
-     * buffer. Except in our case it is not.
-     *
-     * My solution is to suppress TEE if the first buffer is not the last. We
-     * will eventually need it given that EOF has been reached, but not right
-     * now. This is what the new flag "endEncSuppressFlag" is for.
-     *
-     * The bug in 'Tcl_Utf2UtfProc' where it read from memory behind the
-     * actual buffer has been fixed as well, and fixes the problem with the
-     * crash too, but this would still allow the generic layer to
-     * accidentially break a multi-byte sequence if the conditions are just
-     * right, because again the ExternalToUtf would be successful where it
-     * should not.
-     */
-
-    if ((statePtr->inputEncodingFlags & TCL_ENCODING_END) &&
-	    (bufPtr->nextPtr != NULL)) {
-	/*
-	 * TEE is set for a buffer which is not the last. Squash it for now,
-	 * and restore it later, before yielding control to our caller.
-	 */
-
-	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
-	encEndFlagSuppressed = 1;
-    }
-
-    oldState = statePtr->inputEncodingState;
-    if (statePtr->flags & INPUT_NEED_NL) {
-	/*
-	 * We want a '\n' because the last character we saw was '\r'.
-	 */
-
-	ResetFlag(statePtr, INPUT_NEED_NL);
-	Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
-		statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
-		dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars);
-	if ((dstWrote > 0) && (*dst == '\n')) {
-	    /*
-	     * The next char was a '\n'. Consume it and produce a '\n'.
-	     */
-
-	    bufPtr->nextRemoved += srcRead;
-	} else {
-	    /*
-	     * The next char was not a '\n'. Produce a '\r'.
-	     */
-
-	    *dst = '\r';
-	}
-	statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
-	Tcl_SetObjLength(objPtr, numBytes + 1);
-
-	if (encEndFlagSuppressed) {
-	    statePtr->inputEncodingFlags |= TCL_ENCODING_END;
-	}
-	return 1;
-    }
-
-    Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
-	    statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
-	    dstNeeded + 1, &srcRead, &dstWrote, &numChars);
-
-    if (encEndFlagSuppressed) {
-	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
-    }
-
-    if (srcRead == 0) {
-	/*
-	 * Not enough bytes in src buffer to make a complete char. Copy the
-	 * bytes to the next buffer to make a new contiguous string, then tell
-	 * the caller to fill the buffer with more bytes.
-	 */
-
-	ChannelBuffer *nextPtr;
-
-	nextPtr = bufPtr->nextPtr;
-	if (nextPtr == NULL) {
-	    if (srcLen > 0) {
-		/*
-		 * There isn't enough data in the buffers to complete the next
-		 * character, so we need to wait for more data before the next
-		 * file event can be delivered. [Bug 478856]
-		 *
-		 * The exception to this is if the input buffer was completely
-		 * empty before we tried to convert its contents. Nothing in,
-		 * nothing out, and no incomplete character data. The
-		 * conversion before the current one was complete.
-		 */
-
-		SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
-	    }
-	    Tcl_SetObjLength(objPtr, numBytes);
-	    return -1;
-	}
-
-	/*
-	 * Space is made at the beginning of the buffer to copy the previous
-	 * unused bytes there. Check first if the buffer we are using actually
-	 * has enough space at its beginning for the data we are copying.
-	 * Because if not we will write over the buffer management
-	 * information, especially the 'nextPtr'.
-	 *
-	 * Note that the BUFFER_PADDING (See AllocChannelBuffer) is used to
-	 * prevent exactly this situation. I.e. it should never happen.
-	 * Therefore it is ok to panic should it happen despite the
-	 * precautions.
-	 */
-
-	if (nextPtr->nextRemoved - srcLen < 0) {
-	    Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough");
-	}
-
-	nextPtr->nextRemoved -= srcLen;
-	memcpy(RemovePoint(nextPtr), src, (size_t) srcLen);
-	RecycleBuffer(statePtr, bufPtr, 0);
-	statePtr->inQueueHead = nextPtr;
-	Tcl_SetObjLength(objPtr, numBytes);
-	return ReadChars(statePtr, objPtr, charsToRead, factorPtr);
-    }
-
-    dstRead = dstWrote;
-    if (TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead) != 0) {
-	/*
-	 * Hit EOF char. How many bytes of src correspond to where the EOF was
-	 * located in dst? Run the conversion again with an output buffer just
-	 * big enough to hold the data so we can get the correct value for
-	 * srcRead.
-	 */
-
-	if (dstWrote == 0) {
-	    Tcl_SetObjLength(objPtr, numBytes);
-	    return -1;
-	}
-	statePtr->inputEncodingState = oldState;
-	Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
-		statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
-		dst, dstRead + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
-	TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
-    }
-
-    /*
-     * The number of characters that we got may be less than the number that
-     * we started with because "\r\n" sequences may have been turned into just
-     * '\n' in dst.
-     */
-
-    numChars -= (dstRead - dstWrote);
-
-    if ((unsigned) numChars > (unsigned) toRead) {
-	/*
-	 * Got too many chars.
-	 */
-
-	const char *eof;
-
-	eof = Tcl_UtfAtIndex(dst, toRead);
-	statePtr->inputEncodingState = oldState;
-	Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
-		statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
-		dst, eof - dst + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
-	dstRead = dstWrote;
-	TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
-	numChars -= (dstRead - dstWrote);
-    }
-    statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
-
-    bufPtr->nextRemoved += srcRead;
-    if (dstWrote > srcRead + 1) {
-	*factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;
-    }
-    Tcl_SetObjLength(objPtr, numBytes + dstWrote);
-    return numChars;
-#endif
 }
 
 /*
@@ -9060,7 +8852,6 @@ CopyAndTranslateBuffer(
     bufPtr = statePtr->inQueueHead;
     bytesInBuffer = BytesLeft(bufPtr);
 
-#if 1
     copied = space;
     if (bytesInBuffer <= copied) {
 	copied = bytesInBuffer;
@@ -9142,188 +8933,6 @@ CopyAndTranslateBuffer(
      */
 
     return copied;
-#else
-    copied = 0;
-    switch (statePtr->inputTranslation) {
-    case TCL_TRANSLATE_LF:
-	if (bytesInBuffer == 0) {
-	    return 0;
-	}
-
-	/*
-	 * Copy the current chunk into the result buffer.
-	 */
-
-	if (bytesInBuffer < space) {
-	    space = bytesInBuffer;
-	}
-	memcpy(result, RemovePoint(bufPtr), (size_t) space);
-	bufPtr->nextRemoved += space;
-	copied = space;
-	break;
-    case TCL_TRANSLATE_CR: {
-	char *end;
-
-	if (bytesInBuffer == 0) {
-	    return 0;
-	}
-
-	/*
-	 * Copy the current chunk into the result buffer, then replace all \r
-	 * with \n.
-	 */
-
-	if (bytesInBuffer < space) {
-	    space = bytesInBuffer;
-	}
-	memcpy(result, RemovePoint(bufPtr), (size_t) space);
-	bufPtr->nextRemoved += space;
-	copied = space;
-
-	for (end = result + copied; result < end; result++) {
-	    if (*result == '\r') {
-		*result = '\n';
-	    }
-	}
-	break;
-    }
-    case TCL_TRANSLATE_CRLF: {
-	char *src, *end, *dst;
-	int curByte;
-
-	/*
-	 * If there is a held-back "\r" at EOF, produce it now.
-	 */
-
-	if (bytesInBuffer == 0) {
-	    if ((statePtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
-		    (INPUT_SAW_CR | CHANNEL_EOF)) {
-		result[0] = '\r';
-		ResetFlag(statePtr, INPUT_SAW_CR);
-		return 1;
-	    }
-	    return 0;
-	}
-
-	/*
-	 * Copy the current chunk and replace "\r\n" with "\n" (but not
-	 * standalone "\r"!).
-	 */
-
-	if (bytesInBuffer < space) {
-	    space = bytesInBuffer;
-	}
-	memcpy(result, RemovePoint(bufPtr), (size_t) space);
-	bufPtr->nextRemoved += space;
-	copied = space;
-
-	end = result + copied;
-	dst = result;
-	for (src = result; src < end; src++) {
-	    curByte = *src;
-	    if (curByte == '\n') {
-		ResetFlag(statePtr, INPUT_SAW_CR);
-	    } else if (statePtr->flags & INPUT_SAW_CR) {
-		ResetFlag(statePtr, INPUT_SAW_CR);
-		*dst = '\r';
-		dst++;
-	    }
-	    if (curByte == '\r') {
-		SetFlag(statePtr, INPUT_SAW_CR);
-	    } else {
-		*dst = (char) curByte;
-		dst++;
-	    }
-	}
-	copied = dst - result;
-	break;
-    }
-    case TCL_TRANSLATE_AUTO: {
-	char *src, *end, *dst;
-	int curByte;
-
-	if (bytesInBuffer == 0) {
-	    return 0;
-	}
-
-	/*
-	 * Loop over the current buffer, converting "\r" and "\r\n" to "\n".
-	 */
-
-	if (bytesInBuffer < space) {
-	    space = bytesInBuffer;
-	}
-	memcpy(result, RemovePoint(bufPtr), (size_t) space);
-	bufPtr->nextRemoved += space;
-	copied = space;
-
-	end = result + copied;
-	dst = result;
-	for (src = result; src < end; src++) {
-	    curByte = *src;
-	    if (curByte == '\r') {
-		SetFlag(statePtr, INPUT_SAW_CR);
-		*dst = '\n';
-		dst++;
-	    } else {
-		if ((curByte != '\n') || !(statePtr->flags & INPUT_SAW_CR)) {
-		    *dst = (char) curByte;
-		    dst++;
-		}
-		ResetFlag(statePtr, INPUT_SAW_CR);
-	    }
-	}
-	copied = dst - result;
-	break;
-    }
-    default:
-	Tcl_Panic("unknown eol translation mode");
-    }
-
-    /*
-     * If an in-stream EOF character is set for this channel, check that the
-     * input we copied so far does not contain the EOF char. If it does, copy
-     * only up to and excluding that character.
-     */
-
-    if (statePtr->inEofChar != 0) {
-	int i;
-
-	for (i = 0; i < copied; i++) {
-	    if (result[i] == (char) statePtr->inEofChar) {
-		/*
-		 * Set sticky EOF so that no further input is presented to the
-		 * caller.
-		 */
-
-		SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
-		statePtr->inputEncodingFlags |= TCL_ENCODING_END;
-		copied = i;
-		break;
-	    }
-	}
-    }
-
-    /*
-     * If the current buffer is empty recycle it.
-     */
-
-    if (IsBufferEmpty(bufPtr)) {
-	statePtr->inQueueHead = bufPtr->nextPtr;
-	if (statePtr->inQueueHead == NULL) {
-	    statePtr->inQueueTail = NULL;
-	}
-	RecycleBuffer(statePtr, bufPtr, 0);
-    }
-
-    /*
-     * Return the number of characters copied into the result buffer. This may
-     * be different from the number of bytes consumed, because of EOL
-     * translations.
-     */
-
-    return copied;
-#endif
 }
 
 /*
diff --git a/generic/tclIO.h b/generic/tclIO.h
index ebf2ef7..a57d4c5 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -252,9 +252,6 @@ typedef struct ChannelState {
 #define INPUT_SAW_CR		(1<<12)	/* Channel is in CRLF eol input
 					 * translation mode and the last byte
 					 * seen was a "\r". */
-#define INPUT_NEED_NL		(1<<15)	/* Saw a '\r' at end of last buffer,
-					 * and there should be a '\n' at
-					 * beginning of next buffer. */
 #define CHANNEL_DEAD		(1<<13)	/* The channel has been closed by the
 					 * exit handler (on exit) but not
 					 * deallocated. When any IO operation
-- 
cgit v0.12


From 3d0e0863c3cb661e0e0b03a84f6227bc3b5a0d20 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Thu, 6 Mar 2014 10:37:13 +0000
Subject: Terminate async connect synchronously by any blocking operation

---
 win/tclWinSock.c | 116 +++++++++++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 104 insertions(+), 12 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 162cbd4..263ef9a 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -47,7 +47,7 @@
 
 #include "tclWinInt.h"
 
-#define DEBUGGING
+//#define DEBUGGING
 #ifdef DEBUGGING
 #define DEBUG(x) fprintf(stderr, ">>> %p %s(%d): %s<<<\n", \
 			    infoPtr, __FUNCTION__, __LINE__, x)
@@ -207,6 +207,9 @@ typedef struct {
 #define SOCKET_ASYNC_CONNECT	(1<<2)	/* This socket uses async connect. */
 #define SOCKET_PENDING		(1<<3)	/* A message has been sent for this
 					 * socket */
+#define SOCKET_REENTER_PENDING	(1<<4)	/* The reentering after a received
+					 * FD_CONNECT to CreateClientSocket
+					 * is pending */
 
 typedef struct {
     HWND hwnd;			/* Handle to window for socket messages. */
@@ -236,6 +239,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		WaitForAsyncConnect(SocketInfo *infoPtr, int *errorCodePtr);
 static int		WaitForSocketEvent(SocketInfo *infoPtr, int events,
 			    int *errorCodePtr);
 static DWORD WINAPI	SocketThread(LPVOID arg);
@@ -763,11 +767,12 @@ SocketEventProc(
 
     infoPtr->flags &= ~SOCKET_PENDING;
 
-    if (infoPtr->readyEvents & FD_CONNECT) {
+    /* Continue async connect if pending and ready */
+    if ( (infoPtr->flags & SOCKET_REENTER_PENDING)
+	    && (infoPtr->readyEvents & FD_CONNECT) ) {
 	DEBUG("FD_CONNECT");
 	SetEvent(tsdPtr->socketListLock);
 	CreateClientSocket(NULL, infoPtr);
-	infoPtr->readyEvents &= ~(FD_CONNECT);
 	return 1;
     }
 
@@ -1173,15 +1178,22 @@ CreateClientSocket(
     SocketInfo *infoPtr)
 {
     u_long flag = 1;		/* Indicates nonblocking mode. */
-    int async = infoPtr->flags & SOCKET_ASYNC_CONNECT;
+    /*
+     * We are started with async connect and the connect notification
+     * was not jet received
+     */
+    int async_connect = infoPtr->flags & SOCKET_ASYNC_CONNECT;
+    /* We were called by the event procedure and continue our loop */
     int async_callback = infoPtr->sockets->fd != INVALID_SOCKET;
     ThreadSpecificData *tsdPtr;
     DWORD error;
     
-    DEBUG(async ? "async" : "sync");
+    DEBUG(async_connect ? "async connect" : "sync connect");
 
     if (async_callback) {
 	DEBUG("subsequent call");
+	/* Clear this pending reenter case */
+	infoPtr->flags &= ~(SOCKET_REENTER_PENDING);
         goto reenter;
     } else {
 	DEBUG("first call");
@@ -1257,7 +1269,7 @@ CreateClientSocket(
 	     * Set the socket into nonblocking mode if the connect should
 	     * be done in the background.
 	     */
-	    if (async) {
+	    if (async_connect) {
 		ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 		infoPtr->selectEvents |= FD_CONNECT;
 
@@ -1280,6 +1292,8 @@ CreateClientSocket(
 #endif
 	    if (error == WSAEWOULDBLOCK) {
 		DEBUG("WSAEWOULDBLOCK");
+		/* Jump out and remember that we want to get back in */
+		infoPtr->flags |= SOCKET_REENTER_PENDING;
 		return TCL_OK;
 	    reenter:
 		Tcl_SetErrno(infoPtr->lastError);
@@ -1299,6 +1313,8 @@ out:
     DEBUG("connected or finally failed");
     if (Tcl_GetErrno() != 0 && interp != NULL) {
 	DEBUG("ERRNO");
+        /* Clear async flag so if a read is done it does not block */
+        infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
 	if (interp != NULL) {
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 				"couldn't open socket: %s", Tcl_PosixError(interp)));
@@ -1329,6 +1345,82 @@ out:
 /*
  *----------------------------------------------------------------------
  *
+ * WaitForAsyncConnect --
+ *
+ *	Terminate an asyncroneous connect syncroneously.
+ *	This routine should only be called if flag ASYNC_CONNECT is set.
+ *
+ * Results:
+ *	Returns 1 on success or 0 on failure, with an error code in
+ *	errorCodePtr.
+ *
+ * Side effects:
+ *	Processes socket events off the system queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WaitForAsyncConnect(
+    SocketInfo *infoPtr,	/* Information about this socket. */
+    int *errorCodePtr)		/* Where to store errors? */
+{
+    int result = 1;
+    int oldMode;
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+    /*
+     * A non blocking socket waiting for an asyncronous connect
+     * returns directly an error
+     */
+    if (infoPtr->flags & SOCKET_ASYNC) {
+	    *errorCodePtr = EWOULDBLOCK;
+	    return 0;
+	}
+
+    /*
+     * Be sure to disable event servicing so we are truly modal.
+     */
+
+    oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
+
+    /*
+     * Disable async connect as we continue now synchoneously
+     */
+
+    /* ToDo: need thread protection * */
+    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+
+    /*
+     * Reset WSAAsyncSelect so we have a fresh set of events pending.
+     */
+
+    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT,
+	    (LPARAM) infoPtr);
+    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+	    (LPARAM) infoPtr);
+
+    while (1) {
+	/* Check for connect event */
+	if (infoPtr->readyEvents & FD_CONNECT) {
+	    /* continue async connect syncroneously */
+	    result = CreateClientSocket(NULL, infoPtr);
+	    (void) Tcl_SetServiceMode(oldMode);
+	    /* Todo: find adequate error code */
+	    *errorCodePtr = EFAULT;
+	    return (result == TCL_OK);
+	}
+
+	/*
+	 * Wait until something happens.
+	 */
+
+	WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * WaitForSocketEvent --
  *
  *	Waits until one of the specified events occurs on a socket.
@@ -1865,11 +1957,11 @@ TcpInputProc(
     }
 
     /*
-     * Check to see if the socket is connected before trying to read.
+     * Check if there is an async connect to terminate
      */
 
-    if ((infoPtr->flags & SOCKET_ASYNC_CONNECT)
-	    && !WaitForSocketEvent(infoPtr, FD_CONNECT, errorCodePtr)) {
+    if ( (infoPtr->flags & SOCKET_REENTER_PENDING)
+	    && !WaitForAsyncConnect(infoPtr, errorCodePtr)) {
 	return -1;
     }
 
@@ -1993,11 +2085,11 @@ TcpOutputProc(
     }
 
     /*
-     * Check to see if the socket is connected before trying to write.
+     * Check if there is an async connect to terminate
      */
 
-    if ((infoPtr->flags & SOCKET_ASYNC_CONNECT)
-	    && !WaitForSocketEvent(infoPtr, FD_CONNECT, errorCodePtr)) {
+    if ( (infoPtr->flags & SOCKET_REENTER_PENDING)
+	    && !WaitForAsyncConnect(infoPtr, errorCodePtr)) {
 	return -1;
     }
 
-- 
cgit v0.12


From a59f5c70234be1134e3752519daa601c3c850365 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 6 Mar 2014 15:51:06 +0000
Subject: Variable "rawStart" serves no purpose.

---
 generic/tclIO.c | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 821d111..b0d0e32 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4464,7 +4464,7 @@ FilterInputBytes(
     ChannelState *statePtr = chanPtr->state;
 				/* State info for channel */
     ChannelBuffer *bufPtr;
-    char *raw, *rawStart, *dst;
+    char *raw, *dst;
     int offset, toRead, dstNeeded, spaceLeft, result, rawLen;
     Tcl_Obj *objPtr;
 #define ENCODING_LINESIZE 20	/* Lower bound on how many bytes to convert at
@@ -4521,8 +4521,7 @@ FilterInputBytes(
      * string rep if we need more space.
      */
 
-    rawStart = RemovePoint(bufPtr);
-    raw = rawStart;
+    raw = RemovePoint(bufPtr);
     rawLen = BytesLeft(bufPtr);
 
     dst = *gsPtr->dstPtr;
-- 
cgit v0.12


From e53f96cbd13df27c822ebe8cc9a5e215f70b800f Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Thu, 6 Mar 2014 18:21:40 +0000
Subject: More debug to chase different fd in struct than in callback

---
 tests/socket.test |  6 ++++
 win/tclWinSock.c  | 93 ++++++++++++++++++++++++-------------------------------
 2 files changed, 46 insertions(+), 53 deletions(-)

diff --git a/tests/socket.test b/tests/socket.test
index 51219e6..74c44ce 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -1855,12 +1855,15 @@ test socket-14.6 {[socket -async] with no event loop and [fconfigure -error] bef
     -constraints [list socket supported_inet supported_inet6] \
     -setup {
         proc accept {s a p} {
+            global s
             puts $s bye
             close $s
+            set s ok
         }
         set server [socket -server accept -myaddr 127.0.0.1 0]
         set port [lindex [fconfigure $server -sockname] 2]
         set x ""
+        set s ""
     } \
     -body {
         set client [socket -async localhost $port]
@@ -1869,6 +1872,9 @@ test socket-14.6 {[socket -async] with no event loop and [fconfigure -error] bef
             lappend x [fconfigure $client -error]
             update
         }
+        # This test blocked, as gets waits for the accept which did
+        # not run due to missing vwait
+        vwait sok
         lappend x [gets $client]
     } \
     -cleanup {
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 263ef9a..0533ecd 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -47,7 +47,7 @@
 
 #include "tclWinInt.h"
 
-//#define DEBUGGING
+#define DEBUGGING
 #ifdef DEBUGGING
 #define DEBUG(x) fprintf(stderr, ">>> %p %s(%d): %s<<<\n", \
 			    infoPtr, __FUNCTION__, __LINE__, x)
@@ -768,12 +768,14 @@ SocketEventProc(
     infoPtr->flags &= ~SOCKET_PENDING;
 
     /* Continue async connect if pending and ready */
-    if ( (infoPtr->flags & SOCKET_REENTER_PENDING)
-	    && (infoPtr->readyEvents & FD_CONNECT) ) {
+    if ( infoPtr->readyEvents & FD_CONNECT ) {
+	infoPtr->readyEvents &= ~(FD_CONNECT);
 	DEBUG("FD_CONNECT");
-	SetEvent(tsdPtr->socketListLock);
-	CreateClientSocket(NULL, infoPtr);
-	return 1;
+        if ( infoPtr->flags & SOCKET_REENTER_PENDING ) {
+	    SetEvent(tsdPtr->socketListLock);
+	    CreateClientSocket(NULL, infoPtr);
+	    return 1;
+	}
     }
 
     /*
@@ -1192,8 +1194,6 @@ CreateClientSocket(
 
     if (async_callback) {
 	DEBUG("subsequent call");
-	/* Clear this pending reenter case */
-	infoPtr->flags &= ~(SOCKET_REENTER_PENDING);
         goto reenter;
     } else {
 	DEBUG("first call");
@@ -1242,6 +1242,9 @@ CreateClientSocket(
 		continue;
 	    }
 	    
+#ifdef DEBUGGING
+	    fprintf(stderr, "Client socket %d created\n", infoPtr->sockets->fd);
+#endif
 	    /*
 	     * Win-NT has a misfeature that sockets are inherited in child
 	     * processes by default. Turn off the inherit bit.
@@ -1287,12 +1290,11 @@ CreateClientSocket(
 		    infoPtr->addr->ai_addrlen);
 	    error = WSAGetLastError();
 	    TclWinConvertError(error);
-#ifdef DEBUGGING
-	    // fprintf(stderr,"error = %lu\n", error);
-#endif
-	    if (error == WSAEWOULDBLOCK) {
+	    if (async_connect && error == WSAEWOULDBLOCK) {
 		DEBUG("WSAEWOULDBLOCK");
-		/* Jump out and remember that we want to get back in */
+		/*
+		 * Activate FD_CONNECT notification and reenter jump
+		 */
 		infoPtr->flags |= SOCKET_REENTER_PENDING;
 		return TCL_OK;
 	    reenter:
@@ -1300,6 +1302,11 @@ CreateClientSocket(
 		DEBUG("reenter");
 		infoPtr->selectEvents &= ~(FD_CONNECT);
 	    }
+	    /*
+	     * Clear the reenter flag also for the (hypothetic) case
+	     * that connect did succeed emidiately
+	     */
+	    infoPtr->flags &= ~(SOCKET_REENTER_PENDING);
 #ifdef DEBUGGING
 	    fprintf(stderr, "lastError: %d\n", Tcl_GetErrno());
 #endif
@@ -1311,10 +1318,10 @@ CreateClientSocket(
 
 out:
     DEBUG("connected or finally failed");
+    /* Clear async flag (not really necessary, not used any more) */
+    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
     if (Tcl_GetErrno() != 0 && interp != NULL) {
 	DEBUG("ERRNO");
-        /* Clear async flag so if a read is done it does not block */
-        infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
 	if (interp != NULL) {
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 				"couldn't open socket: %s", Tcl_PosixError(interp)));
@@ -1373,9 +1380,9 @@ WaitForAsyncConnect(
      * returns directly an error
      */
     if (infoPtr->flags & SOCKET_ASYNC) {
-	    *errorCodePtr = EWOULDBLOCK;
-	    return 0;
-	}
+	*errorCodePtr = EWOULDBLOCK;
+	return 0;
+    }
 
     /*
      * Be sure to disable event servicing so we are truly modal.
@@ -1387,21 +1394,15 @@ WaitForAsyncConnect(
      * Disable async connect as we continue now synchoneously
      */
 
-    /* ToDo: need thread protection * */
+    /* ToDo: need thread protection? */
     infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
 
-    /*
-     * Reset WSAAsyncSelect so we have a fresh set of events pending.
-     */
-
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT,
-	    (LPARAM) infoPtr);
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-	    (LPARAM) infoPtr);
-
     while (1) {
 	/* Check for connect event */
 	if (infoPtr->readyEvents & FD_CONNECT) {
+	    /* Consume the connect event */
+	    /* ToDo: eventual signaling ? */
+	    infoPtr->readyEvents &= ~(FD_CONNECT);
 	    /* continue async connect syncroneously */
 	    result = CreateClientSocket(NULL, infoPtr);
 	    (void) Tcl_SetServiceMode(oldMode);
@@ -2745,39 +2746,23 @@ SocketProc(
 
 		    if (event & FD_CONNECT) {
 			DEBUG("FD_CONNECT");
-
-			if (error == ERROR_SUCCESS) {
-			    /*
-			     * The socket is now connected, clear the async connect
-			     * flag.
-			     */
-			    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
-			} else {
-			    /*
-			     * Remember any error that occurred so we can report
-			     * connection failures.
-			     */
-			    TclWinConvertError((DWORD) error);
-			    infoPtr->lastError = Tcl_GetErrno();
-			}
-		    }
-#if 0
-		    if (infoPtr->flags & SOCKET_ASYNC_CONNECT) {
-			DEBUG("SOCKET_ASYNC_CONNECT");
-			// infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+			/*
+			 * Remember any error that occurred so we can report
+			 * connection failures.
+			 */
 			if (error != ERROR_SUCCESS) {
 			    TclWinConvertError((DWORD) error);
 			    infoPtr->lastError = Tcl_GetErrno();
 			}
-			infoPtr->readyEvents |= FD_WRITE;
 		    }
-#endif
+		    /*
+		     * Inform main thread about signaled events
+		     */
 		    infoPtr->readyEvents |= event;
 
 		    /*
 		     * Wake up the Main Thread.
 		     */
-
 		    SetEvent(tsdPtr->readyEvent);
 		    Tcl_ThreadAlert(tsdPtr->threadId);
 		    break;
@@ -2788,10 +2773,12 @@ SocketProc(
 	break;
 
     case SOCKET_SELECT:
-	    DEBUG("SOCKET_SELECT");
+	DEBUG("SOCKET_SELECT");
 	infoPtr = (SocketInfo *) lParam;
 	for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
-	    infoPtr = (SocketInfo *) lParam;
+#ifdef DEBUGGING
+	    fprintf(stderr,"loop over fd = %d\n",fds->fd);
+#endif
 	    if (wParam == SELECT) {
 		DEBUG("SELECT");
 		if (infoPtr->selectEvents & FD_READ) DEBUG("  READ");
-- 
cgit v0.12


From bc91d5aa1ef2be26a0f1a6d3de3fb05724964afe Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Fri, 7 Mar 2014 07:40:30 +0000
Subject: Still incomplete info structure in event proc: try to protect with
 locks (unsuccesful). Probably locks in accept socket creation missing.

---
 win/tclWinSock.c | 63 +++++++++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 51 insertions(+), 12 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 0533ecd..62d4073 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1151,6 +1151,12 @@ NewSocketInfo(SOCKET socket)
  *
  *	This function opens a new socket in client mode.
  *
+ *	This might be called in 3 circumstances:
+ *	-   By a regular socket command
+ *	-   By the event handler to continue an asynchroneous connect
+ *	-   By a blocking socket function (gets/puts) to terminate the
+ *	    connect synchroneously
+ *
  * Results:
  *      TCL_OK, if the socket was successfully connected or an asynchronous
  *      connection is in progress. If an error occurs, TCL_ERROR is returned
@@ -1179,6 +1185,7 @@ CreateClientSocket(
     Tcl_Interp *interp,		/* For error reporting; can be NULL. */
     SocketInfo *infoPtr)
 {
+    DWORD error;
     u_long flag = 1;		/* Indicates nonblocking mode. */
     /*
      * We are started with async connect and the connect notification
@@ -1187,8 +1194,7 @@ CreateClientSocket(
     int async_connect = infoPtr->flags & SOCKET_ASYNC_CONNECT;
     /* We were called by the event procedure and continue our loop */
     int async_callback = infoPtr->sockets->fd != INVALID_SOCKET;
-    ThreadSpecificData *tsdPtr;
-    DWORD error;
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
     
     DEBUG(async_connect ? "async connect" : "sync connect");
 
@@ -1230,12 +1236,20 @@ CreateClientSocket(
 		closesocket(infoPtr->sockets->fd);
 	    }
 
+	    /* get infoPtr lock */
+	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+
 	    /*
 	     * Reset last error from last try
 	     */
 	    infoPtr->lastError = 0;
 	    
 	    infoPtr->sockets->fd = socket(infoPtr->myaddr->ai_family, SOCK_STREAM, 0);
+	    
+	    /* Free list lock */
+	    SetEvent(tsdPtr->socketListLock);
+
+	    /* continue on socket creation error */
 	    if (infoPtr->sockets->fd == INVALID_SOCKET) {
 		DEBUG("socket() failed");
 		TclWinConvertError((DWORD) WSAGetLastError());
@@ -1273,12 +1287,21 @@ CreateClientSocket(
 	     * be done in the background.
 	     */
 	    if (async_connect) {
-		ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+		/* get infoPtr lock */
+		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+
+		/* Now get connect events */
 		infoPtr->selectEvents |= FD_CONNECT;
 
-		ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
+		/* Free list lock */
+		SetEvent(tsdPtr->socketListLock);
+
+		// ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
 		SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
 			    (LPARAM) infoPtr);
+	    } else {
+		/* Free list lock */
+		SetEvent(tsdPtr->socketListLock);
 	    }
 
 	    /*
@@ -1300,7 +1323,11 @@ CreateClientSocket(
 	    reenter:
 		Tcl_SetErrno(infoPtr->lastError);
 		DEBUG("reenter");
+		/* get infoPtr lock */
+		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 		infoPtr->selectEvents &= ~(FD_CONNECT);
+		/* Free list lock */
+		SetEvent(tsdPtr->socketListLock);
 	    }
 	    /*
 	     * Clear the reenter flag also for the (hypothetic) case
@@ -1390,27 +1417,39 @@ WaitForAsyncConnect(
 
     oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
 
-    /*
-     * Disable async connect as we continue now synchoneously
-     */
-
-    /* ToDo: need thread protection? */
-    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
-
     while (1) {
+	
+	/* get infoPtr lock */
+        WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	
 	/* Check for connect event */
 	if (infoPtr->readyEvents & FD_CONNECT) {
+
 	    /* Consume the connect event */
-	    /* ToDo: eventual signaling ? */
 	    infoPtr->readyEvents &= ~(FD_CONNECT);
+
+	    /*
+	     * Disable async connect as we continue now synchoneously
+	     */
+	    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+
+            /* Free list lock */
+            SetEvent(tsdPtr->socketListLock);
+
 	    /* continue async connect syncroneously */
 	    result = CreateClientSocket(NULL, infoPtr);
+
+	    /* Restore event service mode */
 	    (void) Tcl_SetServiceMode(oldMode);
+
 	    /* Todo: find adequate error code */
 	    *errorCodePtr = EFAULT;
 	    return (result == TCL_OK);
 	}
 
+        /* Free list lock */
+        SetEvent(tsdPtr->socketListLock);
+
 	/*
 	 * Wait until something happens.
 	 */
-- 
cgit v0.12


From a895183137cb5e741f92353116465a9e27c432e4 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 7 Mar 2014 19:43:16 +0000
Subject: Simplify the input eof char scan.  Update some comments.

---
 generic/tclIO.c | 64 +++++++++++++++++++++++++++++----------------------------
 1 file changed, 33 insertions(+), 31 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index b0d0e32..03aac32 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5244,7 +5244,11 @@ ReadChars(
 				 * is larger than the number of characters
 				 * available in the first buffer, only the
 				 * characters from the first buffer are
-				 * returned. */
+				 * returned. The execption is when there is
+				 * not any complete character in the first
+				 * buffer.  In that case, a recursive call
+				 * effectively obtains chars from the
+				 * second buffer. */
     int *factorPtr)		/* On input, contains a guess of how many
 				 * bytes need to be allocated to hold the
 				 * result of converting N source bytes to
@@ -5259,6 +5263,15 @@ ReadChars(
     int savedFlags = statePtr->flags;
     char *dst, *src = RemovePoint(bufPtr);
     int dstLimit, numBytes, srcLen = BytesLeft(bufPtr);
+
+    /*
+     * One src byte can yield at most one character.  So when the
+     * number of src bytes we plan to read is less than the limit on
+     * character count to be read, clearly we will remain within that
+     * limit, and we can use the value of "srcLen" as a tighter limit
+     * for sizing receiving buffers.
+     */
+
     int toRead = ((unsigned) charsToRead > srcLen) ? srcLen : charsToRead;
 
     /*
@@ -5569,43 +5582,32 @@ TranslateInputEOL(
 				 * characters. */
     const char *srcStart,	/* Source characters. */
     int *dstLenPtr,		/* On entry, the maximum length of output
-				 * buffer in bytes; must be <= *srcLenPtr. On
-				 * exit, the number of bytes actually used in
-				 * output buffer. */
+				 * buffer in bytes. On exit, the number of
+				 * bytes actually used in output buffer. */
     int *srcLenPtr)		/* On entry, the length of source buffer. On
 				 * exit, the number of bytes read from the
 				 * source buffer. */
 {
-    int dstLen, srcLen, inEofChar;
-    const char *eof;
+    const char *eof = NULL;
+    int dstLen = *dstLenPtr;
+    int srcLen = *srcLenPtr;
+    int inEofChar = statePtr->inEofChar;
 
-    dstLen = *dstLenPtr;
-
-    eof = NULL;
-    inEofChar = statePtr->inEofChar;
     if (inEofChar != '\0') {
 	/*
-	 * Find EOF in translated buffer then compress out the EOL. The source
-	 * buffer may be much longer than the destination buffer - we only
-	 * want to return EOF if the EOF has been copied to the destination
-	 * buffer.
+	 * Make sure we do not read past any logical end of channel input
+	 * created by the presence of the input eof char.
 	 */
 
-	const char *src, *srcMax;
-
-	srcMax = srcStart + *srcLenPtr;
-	for (src = srcStart; src < srcMax; src++) {
-	    if (*src == inEofChar) {
-		eof = src;
-		srcLen = src - srcStart;
-		if (srcLen < dstLen) {
-		    dstLen = srcLen;
-		}
-		*srcLenPtr = srcLen;
-		break;
-	    }
+	if ((eof = memchr(srcStart, inEofChar, srcLen))) {
+	    srcLen = eof - srcStart;
 	}
     }
+
+    if (dstLen > srcLen) {
+	dstLen = srcLen;
+    }
+
     switch (statePtr->inputTranslation) {
     case TCL_TRANSLATE_LF:
 	if (dstStart != srcStart) {
@@ -5635,7 +5637,7 @@ TranslateInputEOL(
 	dst = dstStart;
 	src = srcStart;
 	srcEnd = srcStart + dstLen;
-	srcMax = srcStart + *srcLenPtr;
+	srcMax = srcStart + srcLen;
 
 	for ( ; src < srcEnd; ) {
 	    if (*src == '\r') {
@@ -5663,7 +5665,7 @@ TranslateInputEOL(
 	dst = dstStart;
 	src = srcStart;
 	srcEnd = srcStart + dstLen;
-	srcMax = srcStart + *srcLenPtr;
+	srcMax = srcStart + srcLen;
 
 	if ((statePtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
 	    if (*src == '\n') {
@@ -5692,9 +5694,10 @@ TranslateInputEOL(
 	break;
     }
     default:
-	return 0;
+	Tcl_Panic("unknown input translation %d", statePtr->inputTranslation);
     }
     *dstLenPtr = dstLen;
+    *srcLenPtr = srcLen;
 
     if ((eof != NULL) && (srcStart + srcLen >= eof)) {
 	/*
@@ -5709,7 +5712,6 @@ TranslateInputEOL(
 	return 1;
     }
 
-    *srcLenPtr = srcLen;
     return 0;
 }
 
-- 
cgit v0.12


From 83f5493faa96da87b5327be1f49e432f5a870879 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 7 Mar 2014 20:15:12 +0000
Subject: TranslateInputEOL() callers no longer need assert dstLen <= srcLen.

---
 generic/tclIO.c | 12 +++++-------
 1 file changed, 5 insertions(+), 7 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 03aac32..d23ca03 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5330,7 +5330,8 @@ ReadChars(
 	 * Capture the number of bytes actually consumed in dstRead.
 	 */
 
-	dstWrote = dstRead = dstDecoded;
+	dstWrote = dstLimit;
+	dstRead = dstDecoded;
 	TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
 
 	if (dstRead < dstDecoded) {
@@ -8852,14 +8853,11 @@ CopyAndTranslateBuffer(
     }
     bufPtr = statePtr->inQueueHead;
     bytesInBuffer = BytesLeft(bufPtr);
+    if (bytesInBuffer == 0) {
+	return 0;
+    }
 
     copied = space;
-    if (bytesInBuffer <= copied) {
-	copied = bytesInBuffer;
-    }
-    if (copied == 0) {
-	return copied;
-    }
     TranslateInputEOL(statePtr, result, RemovePoint(bufPtr),
 	    &copied, &bytesInBuffer);
     bufPtr->nextRemoved += bytesInBuffer;
-- 
cgit v0.12


From 85ef4165965dd5e25ccfb0e01ac2d1cf4b3df7aa Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sun, 9 Mar 2014 21:55:51 +0000
Subject: Mark io-35.18b test as knownBug

---
 tests/io.test | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

diff --git a/tests/io.test b/tests/io.test
index 64c878d..4791280 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -4701,7 +4701,7 @@ test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
     close $f
     list $c $l $e
 } {21 8 1}
-test io-35.18 {Tcl_Eof, eof char, cr write, crlf read} {
+test io-35.18 {Tcl_Eof, eof char, cr write, crlf read} -body {
     file delete $path(test1)
     set f [open $path(test1) w]
     fconfigure $f -translation cr
@@ -4714,8 +4714,8 @@ test io-35.18 {Tcl_Eof, eof char, cr write, crlf read} {
     set e [eof $f]
     close $f
     list $s $l $e [scan [string index $in end] %c]
-} {8 8 1 13}
-test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} {
+} -result {8 8 1 13}
+test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} -body {
     file delete $path(test1)
     set f [open $path(test1) w]
     fconfigure $f -translation cr -eofchar \x1a
@@ -4728,8 +4728,8 @@ test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} {
     set e [eof $f]
     close $f
     list $s $l $e [scan [string index $in end] %c]
-} {9 8 1 13}
-test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} {
+} -result {9 8 1 13}
+test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} -constraints knownBug -body {
     file delete $path(test1)
     set f [open $path(test1) w]
     fconfigure $f -translation cr -eofchar \x1a
@@ -4742,8 +4742,8 @@ test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} {
     set e [eof $f]
     close $f
     list $s $l $e [scan [string index $in end] %c]
-} {2 1 1 13}
-test io-35.18c {Tcl_Eof, eof char, cr write, crlf read} {
+} -result {2 1 1 13}
+test io-35.18c {Tcl_Eof, eof char, cr write, crlf read} -body {
     file delete $path(test1)
     set f [open $path(test1) w]
     fconfigure $f -translation cr
@@ -4756,8 +4756,8 @@ test io-35.18c {Tcl_Eof, eof char, cr write, crlf read} {
     set e [eof $f]
     close $f
     list $s $l $e [scan [string index $in end] %c]
-} {1 1 1 13}
-test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} {
+} -result {1 1 1 13}
+test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} -body {
     file delete $path(test1)
     set f [open $path(test1) w]
     fconfigure $f -translation cr -eofchar {}
@@ -4771,7 +4771,7 @@ test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} {
     set e [eof $f]
     close $f
     list $c $l $e [scan [string index $in end] %c]
-} {17 8 1 13}
+} -result {17 8 1 13}
 
 # Test Tcl_InputBlocked
 
-- 
cgit v0.12


From 62268820f73d797eebfc2a66ed3fa856c27daeb7 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 10 Mar 2014 03:09:03 +0000
Subject: TranslateInputEOL doesn't need to return anything.  No caller cares.
 Other optimizations and simplifications.

---
 generic/tclIO.c | 79 +++++++++++++++++++++++++++++++--------------------------
 1 file changed, 43 insertions(+), 36 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index d23ca03..6dfdd03 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -214,7 +214,7 @@ static int		StackSetBlockMode(Channel *chanPtr, int mode);
 static int		SetBlockMode(Tcl_Interp *interp, Channel *chanPtr,
 			    int mode);
 static void		StopCopy(CopyState *csPtr);
-static int		TranslateInputEOL(ChannelState *statePtr, char *dst,
+static void		TranslateInputEOL(ChannelState *statePtr, char *dst,
 			    const char *src, int *dstLenPtr, int *srcLenPtr);
 static void		UpdateInterest(Channel *chanPtr);
 static int		Write(Channel *chanPtr, const char *src,
@@ -5574,7 +5574,7 @@ ReadChars(
  *---------------------------------------------------------------------------
  */
 
-static int
+static void 
 TranslateInputEOL(
     ChannelState *statePtr,	/* Channel being read, for EOL translation and
 				 * EOF character. */
@@ -5594,6 +5594,29 @@ TranslateInputEOL(
     int srcLen = *srcLenPtr;
     int inEofChar = statePtr->inEofChar;
 
+    /*
+     * Depending on the translation mode in use, there's no need
+     * to scan more srcLen bytes at srcStart than can possibly transform
+     * to dstLen bytes.  This keeps the scan for eof char below from
+     * being pointlessly long.
+     */
+
+    switch (statePtr->inputTranslation) {
+    case TCL_TRANSLATE_LF:
+    case TCL_TRANSLATE_CR:
+	if (srcLen > dstLen) {
+	/* In these modes, each src byte become a dst byte. */
+	    srcLen = dstLen;
+	}
+	break;
+    default:
+	/* In other modes, at most 2 src bytes become a dst byte. */
+	if (srcLen > 2 * dstLen) {
+	    srcLen = 2 * dstLen;
+	}
+	break;
+    }
+
     if (inEofChar != '\0') {
 	/*
 	 * Make sure we do not read past any logical end of channel input
@@ -5605,36 +5628,29 @@ TranslateInputEOL(
 	}
     }
 
-    if (dstLen > srcLen) {
-	dstLen = srcLen;
-    }
-
     switch (statePtr->inputTranslation) {
     case TCL_TRANSLATE_LF:
+    case TCL_TRANSLATE_CR:
 	if (dstStart != srcStart) {
-	    memcpy(dstStart, srcStart, (size_t) dstLen);
+	    memcpy(dstStart, srcStart, (size_t) srcLen);
 	}
-	srcLen = dstLen;
-	break;
-    case TCL_TRANSLATE_CR: {
-	char *dst, *dstEnd;
+	if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
+	    char *dst = dstStart;
+	    char *dstEnd = dstStart + srcLen;
 
-	if (dstStart != srcStart) {
-	    memcpy(dstStart, srcStart, (size_t) dstLen);
-	}
-	dstEnd = dstStart + dstLen;
-	for (dst = dstStart; dst < dstEnd; dst++) {
-	    if (*dst == '\r') {
-		*dst = '\n';
+	    while ((dst = memchr(dst, '\r', dstEnd - dst))) {
+		*dst++ = '\n';
 	    }
 	}
-	srcLen = dstLen;
+	dstLen = srcLen;
 	break;
-    }
     case TCL_TRANSLATE_CRLF: {
 	char *dst;
 	const char *src, *srcEnd, *srcMax;
 
+    if (dstLen > srcLen) {
+	dstLen = srcLen;
+    }
 	dst = dstStart;
 	src = srcStart;
 	srcEnd = srcStart + dstLen;
@@ -5660,29 +5676,23 @@ TranslateInputEOL(
 	break;
     }
     case TCL_TRANSLATE_AUTO: {
-	char *dst;
-	const char *src, *srcEnd, *srcMax;
+	const char *srcEnd = srcStart + srcLen;
+	const char *dstEnd = dstStart + dstLen;
+	const char *src = srcStart;
+	char *dst = dstStart;
 
-	dst = dstStart;
-	src = srcStart;
-	srcEnd = srcStart + dstLen;
-	srcMax = srcStart + srcLen;
-
-	if ((statePtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
+	if ((statePtr->flags & INPUT_SAW_CR) && srcLen) {
 	    if (*src == '\n') {
 		src++;
 	    }
 	    ResetFlag(statePtr, INPUT_SAW_CR);
 	}
-	for ( ; src < srcEnd; ) {
+	for ( ; dst < dstEnd && src < srcEnd; ) {
 	    if (*src == '\r') {
 		src++;
-		if (src >= srcMax) {
+		if (src == srcEnd) {
 		    SetFlag(statePtr, INPUT_SAW_CR);
 		} else if (*src == '\n') {
-		    if (srcEnd < srcMax) {
-			srcEnd++;
-		    }
 		    src++;
 		}
 		*dst++ = '\n';
@@ -5710,10 +5720,7 @@ TranslateInputEOL(
 	SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
 	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
 	ResetFlag(statePtr, INPUT_SAW_CR);
-	return 1;
     }
-
-    return 0;
 }
 
 /*
-- 
cgit v0.12


From 3c84887dc4fac9f47f2c1b5521c6d889ab6f9dc1 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Mon, 10 Mar 2014 12:08:44 +0000
Subject:   *  tclUnixSock.c: Fix WaitForConnect() for client sockets that have
 to try more than one address.   *  socket.test: Extend and improve tests for
 [socket -async]   *  socket.test: Add latency measuring and calculation for
 Windows.

---
 tests/socket.test  | 199 +++++++++++++++++++++++++++++++++++++++++++++++------
 unix/tclUnixSock.c |  20 +++---
 2 files changed, 190 insertions(+), 29 deletions(-)

diff --git a/tests/socket.test b/tests/socket.test
index 74c44ce..bfe6990 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -86,8 +86,21 @@ puts $s2 test1; gets $s1
 puts $s2 test2; gets $s1
 close $s1; close $s2
 set t2 [clock milliseconds]
-set latency [expr {($t2-$t1)*2}]; # doubled as a safety margin
-unset t1 t2 s1 s2 server
+set lat1 [expr {($t2-$t1)*2}]; # doubled as a safety margin
+
+# Test the latency of failed connection attempts over the loopback
+# interface. They can take more than a second under Windowos and requres
+# additional [after]s in some tests that are not needed on systems that fail
+# immediately.
+set t1 [clock milliseconds]
+catch {socket 127.0.0.1 [randport]}
+set t2 [clock milliseconds]
+set lat2 [expr {($t2-$t1)*2}]
+
+# 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}]
+unset t1 t2 s1 s2 lat1 lat2 server
 
 # If remoteServerIP or remoteServerPort are not set, check in the environment
 # variables for externally set values.
@@ -1723,7 +1736,7 @@ catch {close $commandSocket}
 catch {close $remoteProcChan}
 }
 unset ::tcl::unsupported::socketAF
-test socket-14.0 {[socket -async] when server only listens on IPv4} \
+test socket-14.0.0 {[socket -async] when server only listens on IPv4} \
     -constraints [list socket supported_any localhost_v4] \
     -setup {
         proc accept {s a p} {
@@ -1736,7 +1749,29 @@ test socket-14.0 {[socket -async] when server only listens on IPv4} \
         set port [lindex [fconfigure $server -sockname] 2]
     } -body {
         set client [socket -async localhost $port]
-        set after [after 1000 {set x [fconfigure $client -error]}]
+        set after [after $latency {set x [fconfigure $client -error]}]
+        vwait x
+        set x
+    } -cleanup {
+        after cancel $after
+        close $server
+        close $client
+        unset x
+    } -result ok
+test socket-14.0.1 {[socket -async] when server only listens on IPv6} \
+    -constraints [list socket supported_any localhost_v4] \
+    -setup {
+        proc accept {s a p} {
+            global x
+            puts $s bye
+            close $s
+            set x ok
+        }
+        set server [socket -server accept -myaddr ::1 0]
+        set port [lindex [fconfigure $server -sockname] 2]
+    } -body {
+        set client [socket -async localhost $port]
+        set after [after $latency {set x [fconfigure $client -error]}]
         vwait x
         set x
     } -cleanup {
@@ -1763,7 +1798,7 @@ test socket-14.1 {[socket -async] fileevent while still connecting} \
             lappend x [fconfigure $client -error]
 	    fileevent $client writable {}
         }
-        set after [after 1000 {lappend x timeout}]
+        set after [after $latency {lappend x timeout}]
         while {[llength $x] < 2 && "timeout" ni $x} {
             vwait x
         }
@@ -1781,7 +1816,7 @@ test socket-14.2 {[socket -async] fileevent connection refused} \
 	    regexp {[^:]*: (.*)} $client -> x
 	} else {
             fileevent $client writable {set x [fconfigure $client -error]}
-            set after [after 1000 {set x timeout}]
+            set after [after $latency {set x timeout}]
             vwait x
 	    after cancel $after
             if {$x eq "timeout"} {
@@ -1806,7 +1841,7 @@ test socket-14.3 {[socket -async] when server only listens on IPv6} \
         set port [lindex [fconfigure $server -sockname] 2]
     } -body {
         set client [socket -async localhost $port]
-        set after [after 1000 {set x [fconfigure $client -error]}]
+        set after [after $latency {set x [fconfigure $client -error]}]
         vwait x
         set x
     } -cleanup {
@@ -1832,7 +1867,7 @@ test socket-14.4 {[socket -async] and both, readdable and writable fileevents} \
             fileevent $client writable {}
         }
         fileevent $client readable {lappend x [gets $client]}
-        set after [after 1000 {lappend x timeout}]
+        set after [after $latency {lappend x timeout}]
         while {[llength $x] < 2 && "timeout" ni $x} {
             vwait x
         }
@@ -1851,38 +1886,162 @@ 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 {[socket -async] with no event loop and [fconfigure -error] before the socket is connected} \
+test socket-14.6.0 {[socket -async] with no event loop and server listening on IPv4} \
     -constraints [list socket supported_inet supported_inet6] \
     -setup {
         proc accept {s a p} {
-            global s
+            global x
             puts $s bye
             close $s
-            set s ok
+            set x ok
         }
         set server [socket -server accept -myaddr 127.0.0.1 0]
         set port [lindex [fconfigure $server -sockname] 2]
         set x ""
-        set s ""
     } \
     -body {
         set client [socket -async localhost $port]
-        foreach _ {1 2} {
-            lappend x [lindex [fconfigure $client -sockname] 0]
-            lappend x [fconfigure $client -error]
+        for {set i 0} {$i < 50} {incr i } {
             update
+            if {$x ne ""} {
+                lappend x [gets $client]
+                break
+            }
+            after 100
         }
-        # This test blocked, as gets waits for the accept which did
-        # not run due to missing vwait
-        vwait sok
-        lappend x [gets $client]
+        set x
     } \
     -cleanup {
         close $server
         close $client
         unset x
     } \
-    -result [list ::1 "connection refused" 127.0.0.1 "" bye]
+    -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] \
+    -setup {
+        proc accept {s a p} {
+            global x
+            puts $s bye
+            close $s
+            set x ok
+        }
+        set server [socket -server accept -myaddr ::1 0]
+        set port [lindex [fconfigure $server -sockname] 2]
+        set x ""
+    } \
+    -body {
+        set client [socket -async localhost $port]
+        for {set i 0} {$i < 50} {incr i } {
+            update
+            if {$x ne ""} {
+                lappend x [gets $client]
+                break
+            }
+            after 100
+        }
+        set x
+    } \
+    -cleanup {
+        close $server
+        close $client
+        unset x
+    } \
+    -result {ok bye}
+test socket-14.7.0 {pending [socket -async] and blocking [gets], server is IPv4} \
+    -constraints {socket supported_inet supported_inet6} \
+    -setup {
+        makeFile {
+            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]
+            flush stdout
+            vwait x
+        } script
+        set fd [open |[list [interpreter] script] RDWR]
+        set port [gets $fd]
+    } -body {
+        set sock [socket -async localhost $port]
+        gets $sock
+    } -cleanup {
+        # make sure the server exits
+        catch {socket 127.0.0.1 $port}
+        close $sock
+        close $fd
+    } -result {ok}
+test socket-14.7.1 {pending [socket -async] and blocking [gets], server is IPv6} \
+    -constraints {socket supported_inet supported_inet6} \
+    -setup {
+        makeFile {
+            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]
+            flush stdout
+            vwait x
+        } script
+        set fd [open |[list [interpreter] script] RDWR]
+        set port [gets $fd]
+    } -body {
+        set sock [socket -async localhost $port]
+        gets $sock
+    } -cleanup {
+        # make sure the server exits
+        catch {socket ::1 $port}
+        close $sock
+        close $fd
+    } -result {ok}
+test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IPv4} \
+    -constraints {socket supported_inet supported_inet6} \
+    -setup {
+        makeFile {
+            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]
+            flush stdout
+            vwait x
+        } script
+        set fd [open |[list [interpreter] script] RDWR]
+        set port [gets $fd]
+    } -body {
+        set sock [socket -async localhost $port]
+        fconfigure $sock -blocking 0
+        for {set i 0} {$i < 50} {incr i } {
+            if {[set x [gets $sock]] ne ""} break
+            after 200
+        }
+        set x
+    } -cleanup {
+        # make sure the server exits
+        catch {socket 127.0.0.1 $port}
+        close $sock
+        close $fd
+    } -result {ok}
+test socket-14.8.1 {pending [socket -async] and nonblocking [gets], server is IPv6} \
+    -constraints {socket supported_inet supported_inet6} \
+    -setup {
+        makeFile {
+            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]
+            flush stdout
+            vwait x
+        } script
+        set fd [open |[list [interpreter] script] RDWR]
+        set port [gets $fd]
+    } -body {
+        set sock [socket -async localhost $port]
+        fconfigure $sock -blocking 0
+        for {set i 0} {$i < 50} {incr i } {
+            if {[set x [gets $sock]] ne ""} break
+            after 200
+        }
+        set x
+    } -cleanup {
+        # make sure the server exits
+        catch {socket ::1 $port}
+        close $sock
+        close $fd
+    } -result {ok}
 
 ::tcltest::cleanupTests
 flush stdout
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index c866903..41d729e 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -163,6 +163,8 @@ static TclInitProcessGlobalValueProc InitializeHostName;
 static ProcessGlobalValue hostName =
 	{0, 0, NULL, NULL, InitializeHostName, NULL, NULL};
 
+#if 0
+/* printf debugging */
 void printaddrinfo(struct addrinfo *addrlist, char *prefix)
 {
     char host[NI_MAXHOST], port[NI_MAXSERV];
@@ -175,6 +177,7 @@ void printaddrinfo(struct addrinfo *addrlist, char *prefix)
 	fprintf(stderr,"%s: %s:%s\n", prefix, host, port);
     }
 }
+#endif
 /*
  *----------------------------------------------------------------------
  *
@@ -409,18 +412,20 @@ WaitForConnect(
 	    timeOut = 0;
 	} else {
 	    timeOut = -1;
+	    CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
 	}
 	errno = 0;
 	state = TclUnixWaitForFile(statePtr->fds.fd,
 		TCL_WRITABLE | TCL_EXCEPTION, timeOut);
-	if (state & TCL_EXCEPTION) {
-	    return -1;
-	}
-	if (state & TCL_WRITABLE) {
-	    CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
-	} else if (timeOut == 0) {
+        CreateClientSocket(NULL, statePtr);
+        if (statePtr->flags & TCP_ASYNC_CONNECT) {
+            /* We are still in progress, so ignore the result of the last
+             * attempt */
 	    *errorCodePtr = errno = EWOULDBLOCK;
 	    return -1;
+        }
+	if (state & TCL_EXCEPTION) {
+	    return -1;
 	}
     }
     return 0;
@@ -1172,9 +1177,6 @@ Tcl_OpenTcpClient(
         return NULL;
     }
 
-    printaddrinfo(myaddrlist, "local");
-    printaddrinfo(addrlist, "remote");
-
     /*
      * Allocate a new TcpState for this socket.
      */
-- 
cgit v0.12


From 18bf8d8c83fcdf19f769fb12de0c53931f640f81 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Mon, 10 Mar 2014 14:36:38 +0000
Subject: Workaround if FD_CONNECT notification comes before socket list
 registration in TcpThreadActionProc

---
 win/tclWinSock.c | 264 ++++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 184 insertions(+), 80 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 62d4073..a3a770f 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -47,8 +47,8 @@
 
 #include "tclWinInt.h"
 
-#define DEBUGGING
-#ifdef DEBUGGING
+//#define DEBUGGING
+//#ifdef DEBUGGING
 #define DEBUG(x) fprintf(stderr, ">>> %p %s(%d): %s<<<\n", \
 			    infoPtr, __FUNCTION__, __LINE__, x)
 #else
@@ -220,6 +220,10 @@ typedef struct {
 				 * socketThread has been initialized and has
 				 * started. */
     HANDLE socketListLock;	/* Win32 Event to lock the socketList */
+    SocketInfo *pendingSocketInfo;
+				/* This socket is opened but not jet in the
+				 * list. This value is also checked by
+				 * the event structure. */
     SocketInfo *socketList;	/* Every open socket in this thread has an
 				 * entry on this list. */
 } ThreadSpecificData;
@@ -239,9 +243,10 @@ 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		WaitForAsyncConnect(SocketInfo *infoPtr, int *errorCodePtr);
+static int		WaitForConnect(SocketInfo *infoPtr, int *errorCodePtr);
 static int		WaitForSocketEvent(SocketInfo *infoPtr, int events,
 			    int *errorCodePtr);
+static int		FindFDInList(SocketInfo *infoPtr, SOCKET socket);
 static DWORD WINAPI	SocketThread(LPVOID arg);
 static void		TcpThreadActionProc(ClientData instanceData,
 			    int action);
@@ -398,6 +403,7 @@ InitSockets(void)
      */
 
     tsdPtr = TCL_TSD_INIT(&dataKey);
+    tsdPtr->pendingSocketInfo = NULL;
     tsdPtr->socketList = NULL;
     tsdPtr->hwnd       = NULL;
     tsdPtr->threadId   = Tcl_GetCurrentThread();
@@ -687,12 +693,12 @@ SocketCheckProc(
     WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
     for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
 	    infoPtr = infoPtr->nextPtr) {
-    DEBUG("A");
+	DEBUG("Socket loop");
 	if ((infoPtr->readyEvents &
 		(infoPtr->watchEvents | FD_CONNECT | FD_ACCEPT))
 	    && !(infoPtr->flags & SOCKET_PENDING)
 	) {
-    DEBUG("B");
+	    DEBUG("Event found");
 	    infoPtr->flags |= SOCKET_PENDING;
 	    evPtr = ckalloc(sizeof(SocketEvent));
 	    evPtr->header.proc = SocketEventProc;
@@ -1283,25 +1289,49 @@ CreateClientSocket(
 		continue;
 	    }
 	    /*
-	     * Set the socket into nonblocking mode if the connect should
-	     * be done in the background.
+	     * For asyncroneous connect set the socket in nonblocking mode
+	     * and activate connect notification
 	     */
 	    if (async_connect) {
+		SocketInfo *infoPtr2;
+		int in_socket_list = 0;
 		/* get infoPtr lock */
 		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 
-		/* Now get connect events */
-		infoPtr->selectEvents |= FD_CONNECT;
+		/*
+		 * Check if my infoPtr is already in the tsdPtr->socketList
+		 * It is set after this call by TcpThreadActionProc and is set
+		 * on a second round.
+		 *
+		 * If not, we buffer my infoPtr in the tsd memory so it is not
+		 * lost by the event procedure
+		 */
 
-		/* Free list lock */
+		for (infoPtr2 = tsdPtr->socketList; infoPtr2 != NULL;
+			infoPtr2 = infoPtr->nextPtr) {
+		    if (infoPtr2 == infoPtr) {
+			in_socket_list = 1;
+			break;
+		    }
+		}
+		if (!in_socket_list) {
+		    tsdPtr->pendingSocketInfo = infoPtr;
+		}
+		/*
+		 * Set connect mask to connect events
+		 * This is activated by a SOCKET_SELECT message to the notifier
+		 * thread.
+		 */
+		infoPtr->selectEvents |= FD_CONNECT;
+		
+		/*
+		 * Free list lock
+		 */
 		SetEvent(tsdPtr->socketListLock);
 
-		// ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
+    		/* activate accept notification */
 		SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-			    (LPARAM) infoPtr);
-	    } else {
-		/* Free list lock */
-		SetEvent(tsdPtr->socketListLock);
+			(LPARAM) infoPtr);
 	    }
 
 	    /*
@@ -1311,29 +1341,41 @@ CreateClientSocket(
 	    DEBUG("connect()");
 	    connect(infoPtr->sockets->fd, infoPtr->addr->ai_addr,
 		    infoPtr->addr->ai_addrlen);
+
 	    error = WSAGetLastError();
 	    TclWinConvertError(error);
+
 	    if (async_connect && error == WSAEWOULDBLOCK) {
+		/*
+		 * Asynchroneous connect
+		 */
 		DEBUG("WSAEWOULDBLOCK");
+
+
 		/*
-		 * Activate FD_CONNECT notification and reenter jump
+		 * Remember that we jump back behind this next round
 		 */
 		infoPtr->flags |= SOCKET_REENTER_PENDING;
 		return TCL_OK;
+
 	    reenter:
-		Tcl_SetErrno(infoPtr->lastError);
 		DEBUG("reenter");
+		/*
+		 * Re-entry point for async connect after connect event or
+		 * blocking operation
+		 *
+		 * Clear the reenter flag
+		 */
+		infoPtr->flags &= ~(SOCKET_REENTER_PENDING);
 		/* get infoPtr lock */
 		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+		/* Get signaled connect error */
+		Tcl_SetErrno(infoPtr->lastError);
+		/* Clear eventual connect flag */
 		infoPtr->selectEvents &= ~(FD_CONNECT);
 		/* Free list lock */
 		SetEvent(tsdPtr->socketListLock);
 	    }
-	    /*
-	     * Clear the reenter flag also for the (hypothetic) case
-	     * that connect did succeed emidiately
-	     */
-	    infoPtr->flags &= ~(SOCKET_REENTER_PENDING);
 #ifdef DEBUGGING
 	    fprintf(stderr, "lastError: %d\n", Tcl_GetErrno());
 #endif
@@ -1379,13 +1421,13 @@ out:
 /*
  *----------------------------------------------------------------------
  *
- * WaitForAsyncConnect --
+ * WaitForConnect --
  *
  *	Terminate an asyncroneous connect syncroneously.
  *	This routine should only be called if flag ASYNC_CONNECT is set.
  *
  * Results:
- *	Returns 1 on success or 0 on failure, with an error code in
+ *	Returns -1 on success or 0 on failure, with an error code in
  *	errorCodePtr.
  *
  * Side effects:
@@ -1395,11 +1437,11 @@ out:
  */
 
 static int
-WaitForAsyncConnect(
+WaitForConnect(
     SocketInfo *infoPtr,	/* Information about this socket. */
     int *errorCodePtr)		/* Where to store errors? */
 {
-    int result = 1;
+    int result;
     int oldMode;
     ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
     /*
@@ -2001,7 +2043,7 @@ TcpInputProc(
      */
 
     if ( (infoPtr->flags & SOCKET_REENTER_PENDING)
-	    && !WaitForAsyncConnect(infoPtr, errorCodePtr)) {
+	    && !WaitForConnect(infoPtr, errorCodePtr)) {
 	return -1;
     }
 
@@ -2129,7 +2171,7 @@ TcpOutputProc(
      */
 
     if ( (infoPtr->flags & SOCKET_REENTER_PENDING)
-	    && !WaitForAsyncConnect(infoPtr, errorCodePtr)) {
+	    && !WaitForConnect(infoPtr, errorCodePtr)) {
 	return -1;
     }
 
@@ -2708,6 +2750,7 @@ SocketProc(
     int event, error;
     SOCKET socket;
     SocketInfo *infoPtr = NULL; /* DEBUG */
+    int info_found = 0;
     TcpFdList *fds = NULL;
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
 #ifdef _WIN64
@@ -2745,68 +2788,88 @@ SocketProc(
 	error = WSAGETSELECTERROR(lParam);
 	socket = (SOCKET) wParam;
 
+        #ifdef DEBUGGING
+	fprintf(stderr,"event = %d, error=%d\n",event,error);
+	#endif
+	if (event & FD_READ) DEBUG("READ Event");
+	if (event & FD_WRITE) DEBUG("WRITE Event");
+	if (event & FD_CLOSE) DEBUG("CLOSE Event");
+	if (event & FD_CONNECT)
+	    DEBUG("CONNECT Event");
+	if (event & FD_ACCEPT) DEBUG("ACCEPT Event");
+
+	DEBUG("Get list lock");
+	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+
 	/*
 	 * Find the specified socket on the socket list and update its
 	 * eventState flag.
 	 */
 
-	DEBUG("FOO");
-	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-	DEBUG("BAR");
 	for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
 		infoPtr = infoPtr->nextPtr) {
-	    for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
-#ifdef DEBUGGING
-		fprintf(stderr,"socket = %d, fd=%d, event = %d, error = %d\n",
-			socket, fds->fd, event, error);
-#endif
-		if (fds->fd == socket) {
-		    if (event & FD_READ) 
-			DEBUG("|->FD_READ");
-		    if (event & FD_WRITE) 
-			DEBUG("|->FD_WRITE");
-
-		    /*
-		     * Update the socket state.
-		     *
-		     * A count of FD_ACCEPTS is stored, so if an FD_CLOSE event
-		     * happens, then clear the FD_ACCEPT count. Otherwise,
-		     * increment the count if the current event is an FD_ACCEPT.
-		     */
-
-		    if (event & FD_CLOSE) {
-			DEBUG("FD_CLOSE");
-			infoPtr->acceptEventCount = 0;
-			infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
-		    } else if (event & FD_ACCEPT) {
-			DEBUG("FD_ACCEPT");
-			    infoPtr->acceptEventCount++;
-		    }
+    	    DEBUG("Cur InfoPtr");
+    	    if ( FindFDInList(infoPtr,socket) ) {
+    		info_found = 1;
+    		DEBUG("InfoPtr found");
+    		break;
+    	    }
+    	}
+    	/*
+    	 * Check if there is a pending info structure not jet in the
+    	 * list
+    	 */
+    	if ( !info_found
+    		&& tsdPtr->pendingSocketInfo != NULL
+    		&& FindFDInList(tsdPtr->pendingSocketInfo,socket) ) {
+    	    infoPtr = tsdPtr->pendingSocketInfo;
+    	    DEBUG("Pending InfoPtr found");
+    	    info_found = 1;
+    	}
+    	if (info_found) {
+	    if (event & FD_READ) 
+		DEBUG("|->FD_READ");
+	    if (event & FD_WRITE) 
+		DEBUG("|->FD_WRITE");
 
-		    if (event & FD_CONNECT) {
-			DEBUG("FD_CONNECT");
-			/*
-			 * Remember any error that occurred so we can report
-			 * connection failures.
-			 */
-			if (error != ERROR_SUCCESS) {
-			    TclWinConvertError((DWORD) error);
-			    infoPtr->lastError = Tcl_GetErrno();
-			}
-		    }
-		    /*
-		     * Inform main thread about signaled events
-		     */
-		    infoPtr->readyEvents |= event;
-
-		    /*
-		     * Wake up the Main Thread.
-		     */
-		    SetEvent(tsdPtr->readyEvent);
-		    Tcl_ThreadAlert(tsdPtr->threadId);
-		    break;
+	    /*
+	     * Update the socket state.
+	     *
+	     * A count of FD_ACCEPTS is stored, so if an FD_CLOSE event
+	     * happens, then clear the FD_ACCEPT count. Otherwise,
+	     * increment the count if the current event is an FD_ACCEPT.
+	     */
+
+	    if (event & FD_CLOSE) {
+		DEBUG("FD_CLOSE");
+		infoPtr->acceptEventCount = 0;
+		infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
+	    } else if (event & FD_ACCEPT) {
+		DEBUG("FD_ACCEPT");
+		    infoPtr->acceptEventCount++;
+	    }
+
+	    if (event & FD_CONNECT) {
+		DEBUG("FD_CONNECT");
+		/*
+		 * Remember any error that occurred so we can report
+		 * connection failures.
+		 */
+		if (error != ERROR_SUCCESS) {
+		    TclWinConvertError((DWORD) error);
+		    infoPtr->lastError = Tcl_GetErrno();
 		}
 	    }
+	    /*
+	     * Inform main thread about signaled events
+	     */
+	    infoPtr->readyEvents |= event;
+
+	    /*
+	     * Wake up the Main Thread.
+	     */
+	    SetEvent(tsdPtr->readyEvent);
+	    Tcl_ThreadAlert(tsdPtr->threadId);
 	}
 	SetEvent(tsdPtr->socketListLock);
 	break;
@@ -2850,6 +2913,39 @@ SocketProc(
 /*
  *----------------------------------------------------------------------
  *
+ * FindFDInList --
+ *
+ *	Return true, if the given file descriptior is contained in the
+ *	file descriptor list.
+ *
+ * Results:
+ *	true if found.
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FindFDInList(
+    SocketInfo *infoPtr,
+    SOCKET socket)
+{
+    TcpFdList *fds;
+    for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
+        #ifdef DEBUGGING
+	fprintf(stderr,"socket = %d, fd=%d",socket,fds);
+	#endif
+	if (fds->fd == socket) {
+	    return 1;
+	}
+    }
+    return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_GetHostName --
  *
  *	Returns the name of the local host.
@@ -3064,8 +3160,15 @@ TcpThreadActionProc(
 	tsdPtr = TCL_TSD_INIT(&dataKey);
 
 	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	DEBUG("Inserting pointer to list");
 	infoPtr->nextPtr = tsdPtr->socketList;
 	tsdPtr->socketList = infoPtr;
+	
+	if (infoPtr == tsdPtr->pendingSocketInfo) {
+	    DEBUG("Clearing temporary info pointer");
+	    tsdPtr->pendingSocketInfo = NULL;
+	}
+	
 	SetEvent(tsdPtr->socketListLock);
 
 	notifyCmd = SELECT;
@@ -3081,6 +3184,7 @@ TcpThreadActionProc(
 	 */
 
 	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	DEBUG("Removing pointer from list");
 	for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL;
 		nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
 	    if ((*nextPtrPtr) == infoPtr) {
-- 
cgit v0.12


From c6c9538be56e14eb89700fa1ca1903d246a756c0 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Mon, 10 Mar 2014 15:22:56 +0000
Subject: Also continue async connect without event loop if gets/puts is called
 (test socket-14.8.*)

---
 win/tclWinSock.c | 56 ++++++++++++++++++++++++++++++++++----------------------
 1 file changed, 34 insertions(+), 22 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index a3a770f..e689830 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -48,7 +48,7 @@
 #include "tclWinInt.h"
 
 //#define DEBUGGING
-//#ifdef DEBUGGING
+#ifdef DEBUGGING
 #define DEBUG(x) fprintf(stderr, ">>> %p %s(%d): %s<<<\n", \
 			    infoPtr, __FUNCTION__, __LINE__, x)
 #else
@@ -201,7 +201,7 @@ typedef struct {
  * structure.
  */
 
-#define SOCKET_ASYNC		(1<<0)	/* The socket is in blocking mode. */
+#define TCP_ASYNC_SOCKET	(1<<0)	/* The socket is in blocking mode. */
 #define SOCKET_EOF		(1<<1)	/* A zero read happened on the
 					 * socket. */
 #define SOCKET_ASYNC_CONNECT	(1<<2)	/* This socket uses async connect. */
@@ -937,9 +937,9 @@ TcpBlockProc(
     SocketInfo *infoPtr = instanceData;
 
     if (mode == TCL_MODE_NONBLOCKING) {
-	infoPtr->flags |= SOCKET_ASYNC;
+	infoPtr->flags |= TCP_ASYNC_SOCKET;
     } else {
-	infoPtr->flags &= ~(SOCKET_ASYNC);
+	infoPtr->flags &= ~(TCP_ASYNC_SOCKET);
     }
     return 0;
 }
@@ -1389,7 +1389,7 @@ out:
     DEBUG("connected or finally failed");
     /* Clear async flag (not really necessary, not used any more) */
     infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
-    if (Tcl_GetErrno() != 0 && interp != NULL) {
+    if ( Tcl_GetErrno() != 0 ) {
 	DEBUG("ERRNO");
 	if (interp != NULL) {
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -1427,7 +1427,7 @@ out:
  *	This routine should only be called if flag ASYNC_CONNECT is set.
  *
  * Results:
- *	Returns -1 on success or 0 on failure, with an error code in
+ *	Returns 1 on success or 0 on failure, with an error code in
  *	errorCodePtr.
  *
  * Side effects:
@@ -1444,14 +1444,6 @@ WaitForConnect(
     int result;
     int oldMode;
     ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-    /*
-     * A non blocking socket waiting for an asyncronous connect
-     * returns directly an error
-     */
-    if (infoPtr->flags & SOCKET_ASYNC) {
-	*errorCodePtr = EWOULDBLOCK;
-	return 0;
-    }
 
     /*
      * Be sure to disable event servicing so we are truly modal.
@@ -1471,28 +1463,48 @@ WaitForConnect(
 	    infoPtr->readyEvents &= ~(FD_CONNECT);
 
 	    /*
-	     * Disable async connect as we continue now synchoneously
+	     * For blocking sockets disable async connect
+	     * as we continue now synchoneously
 	     */
-	    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+	    if (! ( infoPtr->flags & TCP_ASYNC_SOCKET ) ) {
+		infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+	    }
 
             /* Free list lock */
             SetEvent(tsdPtr->socketListLock);
 
-	    /* continue async connect syncroneously */
+	    /* continue connect */
 	    result = CreateClientSocket(NULL, infoPtr);
 
 	    /* Restore event service mode */
 	    (void) Tcl_SetServiceMode(oldMode);
 
-	    /* Todo: find adequate error code */
+	    /* Succesfully connected or async connect restarted */
+	    if (result == TCL_OK) {
+		if ( infoPtr->flags & SOCKET_REENTER_PENDING ) {
+		    *errorCodePtr = EWOULDBLOCK;
+		    return 0;
+		}
+		return 1;
+	    }
+	    /* error case */
 	    *errorCodePtr = EFAULT;
-	    return (result == TCL_OK);
+	    return 1;
 	}
 
         /* Free list lock */
         SetEvent(tsdPtr->socketListLock);
 
 	/*
+	 * A non blocking socket waiting for an asyncronous connect
+	 * returns directly an error
+	 */
+	if ( infoPtr->flags & TCP_ASYNC_SOCKET ) {
+	    *errorCodePtr = EWOULDBLOCK;
+	    return 0;
+	}
+
+	/*
 	 * Wait until something happens.
 	 */
 
@@ -1549,7 +1561,7 @@ WaitForSocketEvent(
 	    break;
 	} else if (infoPtr->readyEvents & events) {
 	    break;
-	} else if (infoPtr->flags & SOCKET_ASYNC) {
+	} else if (infoPtr->flags & TCP_ASYNC_SOCKET) {
 	    *errorCodePtr = EWOULDBLOCK;
 	    result = 0;
 	    break;
@@ -2101,7 +2113,7 @@ TcpInputProc(
 	 * Check for error condition or underflow in non-blocking case.
 	 */
 
-	if ((infoPtr->flags & SOCKET_ASYNC) || (error != WSAEWOULDBLOCK)) {
+	if ((infoPtr->flags & TCP_ASYNC_SOCKET) || (error != WSAEWOULDBLOCK)) {
 	    TclWinConvertError(error);
 	    *errorCodePtr = Tcl_GetErrno();
 	    bytesRead = -1;
@@ -2205,7 +2217,7 @@ TcpOutputProc(
 	error = WSAGetLastError();
 	if (error == WSAEWOULDBLOCK) {
 	    infoPtr->readyEvents &= ~(FD_WRITE);
-	    if (infoPtr->flags & SOCKET_ASYNC) {
+	    if (infoPtr->flags & TCP_ASYNC_SOCKET) {
 		*errorCodePtr = EWOULDBLOCK;
 		bytesWritten = -1;
 		break;
-- 
cgit v0.12


From ad589d66e2f1ec13f0ba2c482bd70547aaec8fba Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Mon, 10 Mar 2014 15:38:21 +0000
Subject: Fire write fileevent if async connect fails finally (test
 socket-14.2)

---
 win/tclWinSock.c | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index e689830..01a0f6f 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1395,6 +1395,12 @@ out:
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 				"couldn't open socket: %s", Tcl_PosixError(interp)));
 	}
+	/*
+	 * In the final error case inform fileevent that we failed
+	 */
+	if (async_callback) {
+	    Tcl_NotifyChannel(infoPtr->channel, TCL_WRITABLE);
+	}
 	return TCL_ERROR;
     }
     /*
@@ -1423,8 +1429,11 @@ out:
  *
  * WaitForConnect --
  *
- *	Terminate an asyncroneous connect syncroneously.
- *	This routine should only be called if flag ASYNC_CONNECT is set.
+ *	Process an asyncroneous connect by gets/puts commands.
+ *	For blocking calls, terminate connect synchroneously.
+ *	For non blocking calls, do one asynchroneous step if possible.
+ *	This routine should only be called if flag SOCKET_REENTER_PENDING
+ *	is set.
  *
  * Results:
  *	Returns 1 on success or 0 on failure, with an error code in
@@ -1432,6 +1441,7 @@ out:
  *
  * Side effects:
  *	Processes socket events off the system queue.
+ *	May process asynchroneous connect.
  *
  *----------------------------------------------------------------------
  */
-- 
cgit v0.12


From 138267abe275e454e892fe55ad5f3e16fd032278 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Mon, 10 Mar 2014 16:59:09 +0000
Subject: Additional security for wrong pointer

---
 win/tclWinSock.c | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 01a0f6f..d8b9129 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1379,6 +1379,12 @@ CreateClientSocket(
 #ifdef DEBUGGING
 	    fprintf(stderr, "lastError: %d\n", Tcl_GetErrno());
 #endif
+	    /*
+	     * Clear the tsd socket list pointer if we did not wait for
+	     * the FD_CONNECT asyncroneously
+	     */
+	    tsdPtr->pendingSocketInfo = NULL;
+	    
 	    if (Tcl_GetErrno() == 0) {
 		goto out;
 	    }
-- 
cgit v0.12


From 091096d315755aa89f28bd063b426e16a4c16e51 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 10 Mar 2014 17:58:32 +0000
Subject: Bring CRLF translation in parallel with others.

---
 generic/tclIO.c | 20 +++++++-------------
 tests/io.test   | 14 ++++++++++++++
 2 files changed, 21 insertions(+), 13 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 6dfdd03..2971838 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5645,21 +5645,15 @@ TranslateInputEOL(
 	dstLen = srcLen;
 	break;
     case TCL_TRANSLATE_CRLF: {
-	char *dst;
-	const char *src, *srcEnd, *srcMax;
-
-    if (dstLen > srcLen) {
-	dstLen = srcLen;
-    }
-	dst = dstStart;
-	src = srcStart;
-	srcEnd = srcStart + dstLen;
-	srcMax = srcStart + srcLen;
+	const char *srcEnd = srcStart + srcLen;
+	const char *dstEnd = dstStart + dstLen;
+	const char *src = srcStart;
+	char *dst = dstStart;
 
-	for ( ; src < srcEnd; ) {
+	for ( ; dst < dstEnd && src < srcEnd; ) {
 	    if (*src == '\r') {
 		src++;
-		if (src >= srcMax) {
+		if (src == srcEnd) {
 		    src--;
 		    break;
 		} else if (*src == '\n') {
@@ -5710,7 +5704,7 @@ TranslateInputEOL(
     *dstLenPtr = dstLen;
     *srcLenPtr = srcLen;
 
-    if ((eof != NULL) && (srcStart + srcLen >= eof)) {
+    if (srcStart + srcLen == eof) {
 	/*
 	 * EOF character was seen in EOL translated range. Leave current file
 	 * position pointing at the EOF character, but don't store the EOF
diff --git a/tests/io.test b/tests/io.test
index c325809..e3fff32 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -6858,6 +6858,20 @@ test io-52.14 {coverage of -translation crlf} {
     close $out
     file size $path(test2)
 } 29
+test io-52.14.1 {coverage of -translation crlf} {
+    file delete $path(test1) $path(test2)
+    set out [open $path(test1) wb]
+    chan configure $out -translation lf
+    puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+    close $out
+    set in [open $path(test1)]
+    chan configure $in -buffersize 8 -translation crlf
+    set out [open $path(test2) w]
+    fcopy $in $out -size 2
+    close $in
+    close $out
+    file size $path(test2)
+} 2
 test io-52.15 {coverage of -translation crlf} {
     file delete $path(test1) $path(test2)
     set out [open $path(test1) wb]
-- 
cgit v0.12


From 4964ea0ff919aca3e872155d323cd72868cb93f3 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Mon, 10 Mar 2014 18:11:08 +0000
Subject: WaitForConnect may only call back to CreateClientSocket when the
 socket is writable or something. When it does so for a pending socket, it is
 falsely assumed to have succeeded and a subsequent read/write operation will
 fail.

---
 tests/socket.test  | 4 ++--
 unix/tclUnixSock.c | 4 +++-
 2 files changed, 5 insertions(+), 3 deletions(-)

diff --git a/tests/socket.test b/tests/socket.test
index bfe6990..a21bb8d 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -2006,7 +2006,7 @@ test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IP
         set sock [socket -async localhost $port]
         fconfigure $sock -blocking 0
         for {set i 0} {$i < 50} {incr i } {
-            if {[set x [gets $sock]] ne ""} break
+            if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
             after 200
         }
         set x
@@ -2032,7 +2032,7 @@ test socket-14.8.1 {pending [socket -async] and nonblocking [gets], server is IP
         set sock [socket -async localhost $port]
         fconfigure $sock -blocking 0
         for {set i 0} {$i < 50} {incr i } {
-            if {[set x [gets $sock]] ne ""} break
+            if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
             after 200
         }
         set x
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 41d729e..6e84ed5 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -417,7 +417,9 @@ WaitForConnect(
 	errno = 0;
 	state = TclUnixWaitForFile(statePtr->fds.fd,
 		TCL_WRITABLE | TCL_EXCEPTION, timeOut);
-        CreateClientSocket(NULL, statePtr);
+        if (state != 0) {
+            CreateClientSocket(NULL, statePtr);
+        }
         if (statePtr->flags & TCP_ASYNC_CONNECT) {
             /* We are still in progress, so ignore the result of the last
              * attempt */
-- 
cgit v0.12


From dd5ac1c6419faed6fedef71a19409cb52335353c Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 10 Mar 2014 19:00:19 +0000
Subject: Rewrite CRLF translation to use more system calls.

---
 generic/tclIO.c | 46 ++++++++++++++++++++++++++++------------------
 1 file changed, 28 insertions(+), 18 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 2971838..1070f0a 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5645,28 +5645,38 @@ TranslateInputEOL(
 	dstLen = srcLen;
 	break;
     case TCL_TRANSLATE_CRLF: {
-	const char *srcEnd = srcStart + srcLen;
-	const char *dstEnd = dstStart + dstLen;
-	const char *src = srcStart;
+	const char *crFound, *src = srcStart;
 	char *dst = dstStart;
-
-	for ( ; dst < dstEnd && src < srcEnd; ) {
-	    if (*src == '\r') {
-		src++;
-		if (src == srcEnd) {
-		    src--;
-		    break;
-		} else if (*src == '\n') {
-		    *dst++ = *src++;
-		} else {
-		    *dst++ = '\r';
-		}
+	int lesser = (dstLen < srcLen) ? dstLen : srcLen;
+
+	while ((crFound = memchr(src, '\r', lesser))) {
+	    int numBytes = crFound - src;
+	    memmove(dst, src, numBytes);
+
+	    dst += numBytes;
+	    src += numBytes;
+	    dstLen -= numBytes;
+	    srcLen -= numBytes;
+	    if (srcLen == 1) {
+		/* valid src bytes end in \r */
+		lesser = 0;
+		break;
+	    }
+	    if (src[1] == '\n') {
+		*dst++ = '\n';
+		srcLen -= 2;
+		src += 2;
 	    } else {
-		*dst++ = *src++;
+		*dst++ = '\r';
+		srcLen--;
+		src++;
 	    }
+	    dstLen++;
+	    lesser = (dstLen < srcLen) ? dstLen : srcLen;
 	}
-	srcLen = src - srcStart;
-	dstLen = dst - dstStart;
+	memmove(dst, src, lesser);
+	srcLen = src + lesser - srcStart;
+	dstLen = dst + lesser - dstStart;
 	break;
     }
     case TCL_TRANSLATE_AUTO: {
-- 
cgit v0.12


From ea4c5e97e3d2d2751578fa19df54d98988aa46f4 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 10 Mar 2014 19:29:54 +0000
Subject: Test for the bug I just committed.

---
 tests/io.test | 14 ++++++++++++++
 1 file changed, 14 insertions(+)

diff --git a/tests/io.test b/tests/io.test
index e3fff32..1bc3799 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -6872,6 +6872,20 @@ test io-52.14.1 {coverage of -translation crlf} {
     close $out
     file size $path(test2)
 } 2
+test io-52.14.2 {coverage of -translation crlf} {
+    file delete $path(test1) $path(test2)
+    set out [open $path(test1) wb]
+    chan configure $out -translation lf
+    puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+    close $out
+    set in [open $path(test1)]
+    chan configure $in -translation crlf
+    set out [open $path(test2) w]
+    fcopy $in $out -size 9
+    close $in
+    close $out
+    file size $path(test2)
+} 9
 test io-52.15 {coverage of -translation crlf} {
     file delete $path(test1) $path(test2)
     set out [open $path(test1) wb]
-- 
cgit v0.12


From d539d0925f6d60f1334d053247c8f3112e8de938 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 10 Mar 2014 19:30:22 +0000
Subject: .... and then the bug fix.

---
 generic/tclIO.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 1070f0a..6194637 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5671,7 +5671,7 @@ TranslateInputEOL(
 		srcLen--;
 		src++;
 	    }
-	    dstLen++;
+	    dstLen--;
 	    lesser = (dstLen < srcLen) ? dstLen : srcLen;
 	}
 	memmove(dst, src, lesser);
-- 
cgit v0.12


From 507194e18d3ee09110002c002daa35eea2b249fd Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 11 Mar 2014 03:38:55 +0000
Subject: Trial rewrite of AUTO input translation.

---
 generic/tclIO.c | 35 +++++++++++++++++++++++++++++++++++
 1 file changed, 35 insertions(+)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 6194637..8d8e30f 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5680,6 +5680,40 @@ TranslateInputEOL(
 	break;
     }
     case TCL_TRANSLATE_AUTO: {
+#if 1
+	const char *crFound, *src = srcStart;
+	char *dst = dstStart;
+	int lesser;
+
+	if ((statePtr->flags & INPUT_SAW_CR) && srcLen) {
+	    if (*src == '\n') {
+		src++;
+		srcLen--;
+	    }
+	    ResetFlag(statePtr, INPUT_SAW_CR);
+	}
+	lesser = (dstLen < srcLen) ? dstLen : srcLen;
+	while ((crFound = memchr(src, '\r', lesser))) {
+	    int numBytes = crFound - src;
+	    memmove(dst, src, numBytes);
+
+	    dst[numBytes] = '\n';
+	    dst += numBytes + 1;
+	    dstLen -= numBytes + 1;
+	    src += numBytes + 1;
+	    srcLen -= numBytes + 1;
+	    if (srcLen == 0) {
+		SetFlag(statePtr, INPUT_SAW_CR);
+	    } else if (*src == '\n') {
+		src++;
+		srcLen--;
+	    }
+	    lesser = (dstLen < srcLen) ? dstLen : srcLen;
+	}
+	memmove(dst, src, lesser);
+	srcLen = src + lesser - srcStart;
+	dstLen = dst + lesser - dstStart;
+#else
 	const char *srcEnd = srcStart + srcLen;
 	const char *dstEnd = dstStart + dstLen;
 	const char *src = srcStart;
@@ -5706,6 +5740,7 @@ TranslateInputEOL(
 	}
 	srcLen = src - srcStart;
 	dstLen = dst - dstStart;
+#endif
 	break;
     }
     default:
-- 
cgit v0.12


From ad739fa25ae937cd6dc5435db43f36c310d3a738 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Tue, 11 Mar 2014 13:35:37 +0000
Subject: No [fconfigure -error] error in connect process; gets after failed
 async connect returns connect error

---
 win/tclWinSock.c | 29 +++++++++++++++++++----------
 1 file changed, 19 insertions(+), 10 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index d8b9129..33eddd5 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1249,6 +1249,7 @@ CreateClientSocket(
 	     * Reset last error from last try
 	     */
 	    infoPtr->lastError = 0;
+	    Tcl_SetErrno(0);
 	    
 	    infoPtr->sockets->fd = socket(infoPtr->myaddr->ai_family, SOCK_STREAM, 0);
 	    
@@ -1504,8 +1505,8 @@ WaitForConnect(
 		return 1;
 	    }
 	    /* error case */
-	    *errorCodePtr = EFAULT;
-	    return 1;
+	    *errorCodePtr = Tcl_GetErrno();
+	    return 0;
 	}
 
         /* Free list lock */
@@ -2417,15 +2418,23 @@ TcpGetOptionProc(
 
     if ((len > 1) && (optionName[1] == 'e') &&
 	    (strncmp(optionName, "-error", len) == 0)) {
-	int optlen;
 	DWORD err;
-	int ret;
-
-	optlen = sizeof(int);
-	ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR,
-		(char *)&err, &optlen);
-	if (ret == SOCKET_ERROR) {
-	    err = WSAGetLastError();
+	/*
+	 * Check if an asyncroneous connect is running
+	 * and return ok
+	 */
+	if (infoPtr->flags & SOCKET_REENTER_PENDING) {
+	    err = 0;
+	} else {
+	    int optlen;
+	    int ret;
+
+	    optlen = sizeof(int);
+	    ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR,
+		    (char *)&err, &optlen);
+	    if (ret == SOCKET_ERROR) {
+		err = WSAGetLastError();
+	    }
 	}
 	if (err) {
 	    TclWinConvertError(err);
-- 
cgit v0.12


From 63b89595467a04db5b8a034eab47617e86ab6606 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 11 Mar 2014 16:51:38 +0000
Subject: Compress code for better single screen viewing.

---
 generic/tclIO.c | 55 ++++++++-----------------------------------------------
 1 file changed, 8 insertions(+), 47 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 8d8e30f..b4f1c0c 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5653,10 +5653,8 @@ TranslateInputEOL(
 	    int numBytes = crFound - src;
 	    memmove(dst, src, numBytes);
 
-	    dst += numBytes;
-	    src += numBytes;
-	    dstLen -= numBytes;
-	    srcLen -= numBytes;
+	    dst += numBytes; dstLen -= numBytes;
+	    src += numBytes; srcLen -= numBytes;
 	    if (srcLen == 1) {
 		/* valid src bytes end in \r */
 		lesser = 0;
@@ -5664,12 +5662,10 @@ TranslateInputEOL(
 	    }
 	    if (src[1] == '\n') {
 		*dst++ = '\n';
-		srcLen -= 2;
-		src += 2;
+		src += 2; srcLen -= 2;
 	    } else {
 		*dst++ = '\r';
-		srcLen--;
-		src++;
+		src++; srcLen--;
 	    }
 	    dstLen--;
 	    lesser = (dstLen < srcLen) ? dstLen : srcLen;
@@ -5680,16 +5676,12 @@ TranslateInputEOL(
 	break;
     }
     case TCL_TRANSLATE_AUTO: {
-#if 1
 	const char *crFound, *src = srcStart;
 	char *dst = dstStart;
 	int lesser;
 
 	if ((statePtr->flags & INPUT_SAW_CR) && srcLen) {
-	    if (*src == '\n') {
-		src++;
-		srcLen--;
-	    }
+	    if (*src == '\n') { src++; srcLen--; }
 	    ResetFlag(statePtr, INPUT_SAW_CR);
 	}
 	lesser = (dstLen < srcLen) ? dstLen : srcLen;
@@ -5698,49 +5690,18 @@ TranslateInputEOL(
 	    memmove(dst, src, numBytes);
 
 	    dst[numBytes] = '\n';
-	    dst += numBytes + 1;
-	    dstLen -= numBytes + 1;
-	    src += numBytes + 1;
-	    srcLen -= numBytes + 1;
+	    dst += numBytes + 1; dstLen -= numBytes + 1;
+	    src += numBytes + 1; srcLen -= numBytes + 1;
 	    if (srcLen == 0) {
 		SetFlag(statePtr, INPUT_SAW_CR);
 	    } else if (*src == '\n') {
-		src++;
-		srcLen--;
+		src++; srcLen--;
 	    }
 	    lesser = (dstLen < srcLen) ? dstLen : srcLen;
 	}
 	memmove(dst, src, lesser);
 	srcLen = src + lesser - srcStart;
 	dstLen = dst + lesser - dstStart;
-#else
-	const char *srcEnd = srcStart + srcLen;
-	const char *dstEnd = dstStart + dstLen;
-	const char *src = srcStart;
-	char *dst = dstStart;
-
-	if ((statePtr->flags & INPUT_SAW_CR) && srcLen) {
-	    if (*src == '\n') {
-		src++;
-	    }
-	    ResetFlag(statePtr, INPUT_SAW_CR);
-	}
-	for ( ; dst < dstEnd && src < srcEnd; ) {
-	    if (*src == '\r') {
-		src++;
-		if (src == srcEnd) {
-		    SetFlag(statePtr, INPUT_SAW_CR);
-		} else if (*src == '\n') {
-		    src++;
-		}
-		*dst++ = '\n';
-	    } else {
-		*dst++ = *src++;
-	    }
-	}
-	srcLen = src - srcStart;
-	dstLen = dst - dstStart;
-#endif
 	break;
     }
     default:
-- 
cgit v0.12


From 8baf8e577ab51fc28a14b48622dbbba82c33ac24 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Tue, 11 Mar 2014 17:34:54 +0000
Subject:   *  Hide transient errors of the internal iterations of [socket
 -async] from the script level.   *  More tests for corner cases.

---
 tests/socket.test  | 160 +++++++++++++++++++++++++++++++++++++++++++++++++++--
 unix/tclUnixSock.c |  75 ++++++++++++-------------
 2 files changed, 189 insertions(+), 46 deletions(-)

diff --git a/tests/socket.test b/tests/socket.test
index a21bb8d..6b072c2 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -1759,7 +1759,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_v4] \
+    -constraints [list socket supported_any localhost_v6] \
     -setup {
         proc accept {s a p} {
             global x
@@ -1962,13 +1962,13 @@ test socket-14.7.0 {pending [socket -async] and blocking [gets], server is IPv4}
         set port [gets $fd]
     } -body {
         set sock [socket -async localhost $port]
-        gets $sock
+        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
-    } -result {ok}
+    } -result {{} ok {}}
 test socket-14.7.1 {pending [socket -async] and blocking [gets], server is IPv6} \
     -constraints {socket supported_inet supported_inet6} \
     -setup {
@@ -1983,13 +1983,22 @@ test socket-14.7.1 {pending [socket -async] and blocking [gets], server is IPv6}
         set port [gets $fd]
     } -body {
         set sock [socket -async localhost $port]
-        gets $sock
+        list [fconfigure $sock -error] [gets $sock] [fconfigure $sock -error]
     } -cleanup {
         # make sure the server exits
         catch {socket ::1 $port}
         close $sock
         close $fd
-    } -result {ok}
+    } -result {{} ok {}}
+test socket-14.7.2 {pending [socket -async] and blocking [gets], no listener} \
+    -constraints {socket supported_inet supported_inet6} \
+    -body {
+        set sock [socket -async localhost [randport]]
+        catch {gets $sock} x
+        list $x [fconfigure $sock -error]
+    } -cleanup {
+        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} \
     -setup {
@@ -2007,6 +2016,7 @@ test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IP
         fconfigure $sock -blocking 0
         for {set i 0} {$i < 50} {incr i } {
             if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
+            update
             after 200
         }
         set x
@@ -2033,6 +2043,7 @@ test socket-14.8.1 {pending [socket -async] and nonblocking [gets], server is IP
         fconfigure $sock -blocking 0
         for {set i 0} {$i < 50} {incr i } {
             if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
+            update
             after 200
         }
         set x
@@ -2042,6 +2053,145 @@ test socket-14.8.1 {pending [socket -async] and nonblocking [gets], server is IP
         close $sock
         close $fd
     } -result {ok}
+test socket-14.8.2 {pending [socket -async] and nonblocking [gets], no listener} \
+    -constraints {socket supported_inet supported_inet6} \
+    -body {
+        set sock [socket -async localhost [randport]]
+        fconfigure $sock -blocking 0
+        for {set i 0} {$i < 50} {incr i } {
+            if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
+            update
+            after 200
+        }
+        fconfigure $sock -error
+    } -cleanup {
+        close $sock
+    } -match glob -result {connection refused}
+test socket-14.9.0 {pending [socket -async] and blocking [puts], server is IPv4} \
+    -constraints {socket supported_inet supported_inet6} \
+    -setup {
+        makeFile {
+            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]
+            flush stdout
+            vwait x
+            puts [gets $x]
+        } script
+        set fd [open |[list [interpreter] script] RDWR]
+        set port [gets $fd]
+    } -body {
+        set sock [socket -async localhost $port]
+        puts $sock ok
+        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
+    } -result {{} ok}
+test socket-14.9.1 {pending [socket -async] and blocking [puts], server is IPv6} \
+    -constraints {socket supported_inet supported_inet6} \
+    -setup {
+        makeFile {
+            set server [socket -server accept -myaddr ::1 0]
+            proc accept {s h p} {set ::x $s}
+            puts [lindex [fconfigure $server -sockname] 2]
+            flush stdout
+            vwait x
+            puts [gets $x]
+        } script
+        set fd [open |[list [interpreter] script] RDWR]
+        set port [gets $fd]
+    } -body {
+        set sock [socket -async localhost $port]
+        puts $sock ok
+        flush $sock
+        list [fconfigure $sock -error] [gets $fd]
+    } -cleanup {
+        # make sure the server exits
+        catch {socket ::1 $port}
+        close $sock
+        close $fd
+    } -result {{} ok}
+test socket-14.10.0 {pending [socket -async] and blocking [puts], server is IPv4} \
+    -constraints {socket supported_inet supported_inet6} \
+    -setup {
+        makeFile {
+            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]
+            flush stdout
+            vwait x
+            puts [gets $x]
+        } script
+        set fd [open |[list [interpreter] script] RDWR]
+        set port [gets $fd]
+    } -body {
+        set sock [socket -async localhost $port]
+        fconfigure $sock -blocking 0
+        puts $sock ok
+        flush $sock
+        fileevent $fd readable {set x 1}
+        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
+    } -result {{} ok}
+test socket-14.10.1 {pending [socket -async] and blocking [puts], server is IPv6} \
+    -constraints {socket supported_inet supported_inet6} \
+    -setup {
+        makeFile {
+            set server [socket -server accept -myaddr ::1 0]
+            proc accept {s h p} {set ::x $s}
+            puts [lindex [fconfigure $server -sockname] 2]
+            flush stdout
+            vwait x
+            puts [gets $x]
+        } script
+        set fd [open |[list [interpreter] script] RDWR]
+        set port [gets $fd]
+    } -body {
+        set sock [socket -async localhost $port]
+        fconfigure $sock -blocking 0
+        puts $sock ok
+        flush $sock
+        fileevent $fd readable {set x 1}
+        vwait x
+        list [fconfigure $sock -error] [gets $fd]
+    } -cleanup {
+        # make sure the server exits
+        catch {socket ::1 $port}
+        close $sock
+        close $fd
+    } -result {{} ok}
+test socket-14.11.0 {pending [socket -async] and blocking [puts], no listener, no flush} \
+    -constraints {socket supported_inet supported_inet6} \
+    -body {
+        set sock [socket -async localhost [randport]]
+        fconfigure $sock -blocking 0
+        puts $sock ok
+        fileevent $sock writable {set x 1}
+        vwait x
+        close $sock
+    } -cleanup {
+    } -result {broken pipe} -returnCodes 1
+test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, flush} \
+    -constraints {socket supported_inet supported_inet6} \
+    -body {
+        set sock [socket -async localhost [randport]]
+        fconfigure $sock -blocking 0
+        puts $sock ok
+        flush $sock
+        fileevent $sock writable {set x 1}
+        vwait x
+        close $sock
+    } -cleanup {
+    } -result {broken pipe} -returnCodes 1
 
 ::tcltest::cleanupTests
 flush stdout
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 6e84ed5..8336bdb 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 status;                 /* Cache status of async socket. */
+    int error;                  /* Cache SO_ERROR of async socket. */
     int cachedBlocking;         /* Cache blocking mode of async socket. */
 };
 
@@ -417,7 +417,7 @@ WaitForConnect(
 	errno = 0;
 	state = TclUnixWaitForFile(statePtr->fds.fd,
 		TCL_WRITABLE | TCL_EXCEPTION, timeOut);
-        if (state != 0) {
+        if (timeOut == -1 && state != 0) {
             CreateClientSocket(NULL, statePtr);
         }
         if (statePtr->flags & TCP_ASYNC_CONNECT) {
@@ -522,6 +522,7 @@ TcpOutputProc(
 	return -1;
     }
     written = send(statePtr->fds.fd, buf, (size_t) toWrite, 0);
+
     if (written > -1) {
 	return written;
     }
@@ -752,24 +753,22 @@ TcpGetOptionProc(
     if ((len > 1) && (optionName[1] == 'e') &&
 	    (strncmp(optionName, "-error", len) == 0)) {
 	socklen_t optlen = sizeof(int);
-	int err, ret;
 
-        if (statePtr->status == 0) {
-            ret = getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR,
-                            (char *) &err, &optlen);
-            if (statePtr->flags & TCP_ASYNC_CONNECT) {
-                statePtr->status = err;
-            }
-            if (ret < 0) {
-                err = errno;
-            }
+        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 {
-            err = statePtr->status;
-            statePtr->status = 0;
+            int err;
+            getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR,
+                    (char *) &err, &optlen);
+            errno = err;
+        }
+        if (errno != 0) {
+	    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errno), -1);
         }
-	if (err != 0) {
-	    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(err), -1);
-	}
 	return TCL_OK;
     }
 
@@ -982,7 +981,7 @@ CreateClientSocket(
 {
     socklen_t optlen;
     int async_callback = (state->addr != NULL);
-    int status;
+    int ret = -1, error;
     int async = state->flags & TCP_ASYNC_CONNECT;
 
     if (async_callback) {
@@ -991,8 +990,6 @@ CreateClientSocket(
 
     for (state->addr = state->addrlist; state->addr != NULL;
             state->addr = state->addr->ai_next) {
-	status = -1;
-
         for (state->myaddr = state->myaddrlist; state->myaddr != NULL;
                 state->myaddr = state->myaddr->ai_next) {
             int reuseaddr;
@@ -1014,6 +1011,7 @@ CreateClientSocket(
             if (state->fds.fd >= 0) {
 		close(state->fds.fd);
 		state->fds.fd = -1;
+                errno = 0;
 	    }
 
 	    state->fds.fd = socket(state->addr->ai_family, SOCK_STREAM, 0);
@@ -1035,19 +1033,18 @@ CreateClientSocket(
 	    TclSockMinimumBuffers(INT2PTR(state->fds.fd), SOCKET_BUFSIZE);
     
 	    if (async) {
-		status = TclUnixSetBlockingMode(state->fds.fd,
-                        TCL_MODE_NONBLOCKING);
-		if (status < 0) {
+                ret = TclUnixSetBlockingMode(state->fds.fd,TCL_MODE_NONBLOCKING);
+                if (ret < 0) {
                     continue;
-		}
-	    }
+                }
+            }
 
             reuseaddr = 1;
             (void) setsockopt(state->fds.fd, SOL_SOCKET, SO_REUSEADDR,
                     (char *) &reuseaddr, sizeof(reuseaddr));
-            status = bind(state->fds.fd, state->myaddr->ai_addr,
+            ret = bind(state->fds.fd, state->myaddr->ai_addr,
                     state->myaddr->ai_addrlen);
-            if (status < 0) {
+            if (ret < 0) {
                 continue;
             }
 
@@ -1058,9 +1055,10 @@ CreateClientSocket(
 	     * in being informed when the connect completes.
 	     */
 	    
-	    status = connect(state->fds.fd, state->addr->ai_addr,
-                    state->addr->ai_addrlen);
-	    if (status < 0 && errno == EINPROGRESS) {
+	    ret = connect(state->fds.fd, state->addr->ai_addr,
+                        state->addr->ai_addrlen);
+            error = errno;
+	    if (ret < 0 && errno == EINPROGRESS) {
                 Tcl_CreateFileHandler(state->fds.fd,
                         TCL_WRITABLE|TCL_EXCEPTION, TcpAsyncCallback, state);
                 return TCL_OK;
@@ -1077,23 +1075,18 @@ CreateClientSocket(
 
                 optlen = sizeof(int);
 
-                if (state->status == 0) {
-                    getsockopt(state->fds.fd, SOL_SOCKET, SO_ERROR,
-                            (char *) &status, &optlen);
-                    state->status = status;
-                } else {
-                    status = state->status;
-                    state->status = 0;
-                }
+                getsockopt(state->fds.fd, SOL_SOCKET, SO_ERROR,
+                        (char *) &error, &optlen);
+                errno = error;
             }
-	    if (status == 0) {
+	    if (ret == 0 || errno == 0) {
 		goto out;
 	    }
 	}
     }
 
 out:
-
+    state->error = errno;
     CLEAR_BITS(state->flags, TCP_ASYNC_CONNECT);
     if (async_callback) {
         /*
@@ -1113,7 +1106,7 @@ out:
          */
 
         Tcl_NotifyChannel(state->channel, TCL_WRITABLE);
-    } else if (status != 0) {
+    } else if (ret != 0) {
         /*
          * Failure for either a synchronous connection, or an async one that
          * failed before it could enter background mode, e.g. because an
-- 
cgit v0.12


From f52bc4c0b11afcb0144f828bd128be56202099a6 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Fri, 14 Mar 2014 09:12:13 +0000
Subject: Async connect terminates: fire fileevent by setting readyEvent,
 propage commit fail message to [fconfigure -error]

---
 win/tclWinSock.c | 162 +++++++++++++++++++++++++++++++++++++------------------
 1 file changed, 110 insertions(+), 52 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 33eddd5..0ea8f04 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -170,7 +170,8 @@ struct SocketInfo {
     struct addrinfo *myaddr;	/* Iterator over myaddrlist. */
     int status;                 /* Cache status of async socket. */
     int cachedBlocking;         /* Cache blocking mode of async socket. */
-    int lastError;		/* Error code from last message. */
+    int lastError;		/* Error code from notifier thread. */
+    int connectError;		/* Error code from failed async connect. */
     struct SocketInfo *nextPtr;	/* The next socket on the per-thread socket
 				 * list. */
 };
@@ -243,7 +244,8 @@ 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(SocketInfo *infoPtr, int *errorCodePtr);
+static int		WaitForConnect(SocketInfo *infoPtr, int *errorCodePtr,
+			    int terminate_connect);
 static int		WaitForSocketEvent(SocketInfo *infoPtr, int events,
 			    int *errorCodePtr);
 static int		FindFDInList(SocketInfo *infoPtr, SOCKET socket);
@@ -778,9 +780,13 @@ SocketEventProc(
 	infoPtr->readyEvents &= ~(FD_CONNECT);
 	DEBUG("FD_CONNECT");
         if ( infoPtr->flags & SOCKET_REENTER_PENDING ) {
+	    /* free list lock */
 	    SetEvent(tsdPtr->socketListLock);
-	    CreateClientSocket(NULL, infoPtr);
-	    return 1;
+	    /* Do one connect step */
+	    if (TCL_OK != CreateClientSocket(NULL, infoPtr) ) {
+		/* On final fail save error for fconfigure -error */
+		infoPtr->connectError = Tcl_GetErrno();
+	    }
 	}
     }
 
@@ -1393,41 +1399,65 @@ CreateClientSocket(
     }
 
 out:
+    /*
+     * Socket connected or connection failed
+     */
     DEBUG("connected or finally failed");
     /* Clear async flag (not really necessary, not used any more) */
     infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
-    if ( Tcl_GetErrno() != 0 ) {
+
+    /*
+     * Final connect failure
+     */
+
+    if ( Tcl_GetErrno() == 0 ) {
+	/*
+	 * Succesfully connected
+	 */
+	/*
+	 * Set up the select mask for read/write events.
+	 */
+	DEBUG("selectEvents = FD_READ | FD_WRITE | FD_CLOSE");    
+	infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
+        
+	/*
+	 * Register for interest in events in the select mask. Note that this
+	 * automatically places the socket into non-blocking mode.
+	 */
+        
+	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+		    (LPARAM) infoPtr);
+    } else {
+	/*
+	 * Connect failed
+	 */
 	DEBUG("ERRNO");
-	if (interp != NULL) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-				"couldn't open socket: %s", Tcl_PosixError(interp)));
-	}
+
 	/*
-	 * In the final error case inform fileevent that we failed
+	 * For async connect schedule a writable event to report the fail.
 	 */
 	if (async_callback) {
-	    Tcl_NotifyChannel(infoPtr->channel, TCL_WRITABLE);
+	    /*
+	     * Set up the select mask for read/write events.
+	     */
+	    DEBUG("selectEvents = FD_WRITE for fail writable");    
+	    infoPtr->selectEvents = FD_WRITE;
+	    /* get infoPtr lock */
+	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	    /* Clear eventual connect flag */
+	    infoPtr->readyEvents |= FD_WRITE;
+	    /* Free list lock */
+	    SetEvent(tsdPtr->socketListLock);
+	}
+	/*
+	 * Error message on syncroneous connect
+	 */
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "couldn't open socket: %s", Tcl_PosixError(interp)));
 	}
 	return TCL_ERROR;
     }
-    /*
-     * Set up the select mask for read/write events.
-     */
-    DEBUG("selectEvents = FD_READ | FD_WRITE | FD_CLOSE");    
-    infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
-    
-    /*
-     * Register for interest in events in the select mask. Note that this
-     * automatically places the socket into non-blocking mode.
-     */
-    
-    tsdPtr = TclThreadDataKeyGet(&dataKey);
-    ioctlsocket(infoPtr->sockets->fd, (long) FIONBIO, &flag);
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-		(LPARAM) infoPtr);
-    if (async_callback) {
-	Tcl_NotifyChannel(infoPtr->channel, TCL_WRITABLE);
-    }
     return TCL_OK;
 }
 
@@ -1436,15 +1466,20 @@ out:
  *
  * WaitForConnect --
  *
- *	Process an asyncroneous connect by gets/puts commands.
- *	For blocking calls, terminate connect synchroneously.
- *	For non blocking calls, do one asynchroneous step if possible.
+ *	Process an asyncroneous connect by other commands (gets... ).
+ *	Do one connect step if pending as if the event loop would run.
+ *
+ *	Blocking commands may call in with terminate_connect to terminate
+ *	the syncroneous connect syncroneously.
+ *
  *	This routine should only be called if flag SOCKET_REENTER_PENDING
  *	is set.
  *
  * Results:
- *	Returns 1 on success or 0 on failure, with an error code in
+ *	Returns 1 on success or 0 on failure, with a possix error code in
  *	errorCodePtr.
+ *	If the connect is not terminated, errorCode is set to EWOULDBLOCK
+ *	and 0 is returned.
  *
  * Side effects:
  *	Processes socket events off the system queue.
@@ -1456,7 +1491,8 @@ out:
 static int
 WaitForConnect(
     SocketInfo *infoPtr,	/* Information about this socket. */
-    int *errorCodePtr)		/* Where to store errors? */
+    int *errorCodePtr,		/* Where to store errors? */
+    int terminate_connect)	/* Should the connect be terminated? */
 {
     int result;
     int oldMode;
@@ -1483,7 +1519,7 @@ WaitForConnect(
 	     * For blocking sockets disable async connect
 	     * as we continue now synchoneously
 	     */
-	    if (! ( infoPtr->flags & TCP_ASYNC_SOCKET ) ) {
+	    if ( terminate_connect ) {
 		infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
 	    }
 
@@ -1516,7 +1552,7 @@ WaitForConnect(
 	 * A non blocking socket waiting for an asyncronous connect
 	 * returns directly an error
 	 */
-	if ( infoPtr->flags & TCP_ASYNC_SOCKET ) {
+	if ( ! terminate_connect ) {
 	    *errorCodePtr = EWOULDBLOCK;
 	    return 0;
 	}
@@ -2068,11 +2104,14 @@ TcpInputProc(
     }
 
     /*
-     * Check if there is an async connect to terminate
+     * Check if there is an async connect running.
+     * For blocking sockets terminate connect, otherwise do one step.
+     * For a non blocking socket return EWOULDBLOCK if connect not terminated
      */
 
     if ( (infoPtr->flags & SOCKET_REENTER_PENDING)
-	    && !WaitForConnect(infoPtr, errorCodePtr)) {
+	    && !WaitForConnect(infoPtr, errorCodePtr,
+		! ( infoPtr->flags & TCP_ASYNC_SOCKET ))) {
 	return -1;
     }
 
@@ -2196,11 +2235,14 @@ TcpOutputProc(
     }
 
     /*
-     * Check if there is an async connect to terminate
+     * Check if there is an async connect running.
+     * For blocking sockets terminate connect, otherwise do one step.
+     * For a non blocking socket return EWOULDBLOCK if connect not terminated
      */
 
     if ( (infoPtr->flags & SOCKET_REENTER_PENDING)
-	    && !WaitForConnect(infoPtr, errorCodePtr)) {
+	    && !WaitForConnect(infoPtr, errorCodePtr,
+		! ( infoPtr->flags & TCP_ASYNC_SOCKET ))) {
 	return -1;
     }
 
@@ -2418,28 +2460,44 @@ TcpGetOptionProc(
 
     if ((len > 1) && (optionName[1] == 'e') &&
 	    (strncmp(optionName, "-error", len) == 0)) {
-	DWORD err;
-	/*
-	 * Check if an asyncroneous connect is running
-	 * and return ok
-	 */
-	if (infoPtr->flags & SOCKET_REENTER_PENDING) {
-	    err = 0;
+
+	if ( (infoPtr->flags & SOCKET_REENTER_PENDING) ) {
+
+	    /*
+	     * Asyncroneous connect is running.
+	     * Process it one step without blocking.
+	     * Return its error or nothing if connect not
+	     * terminated.
+	     */
+
+	    int errorCode;
+	    if (!WaitForConnect(infoPtr, &errorCode, 0)
+		    && errorCode != EWOULDBLOCK) {
+		/* connect terminated with error */
+		Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errorCode), -1);
+	    }
+	} else if (infoPtr->connectError != 0) {
+	    /*
+	     * An async connect error was not jet reported.
+	     */
+	    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(infoPtr->connectError), -1);
+	    infoPtr->connectError = 0;
 	} else {
 	    int optlen;
 	    int ret;
+    	    DWORD err;
 
 	    optlen = sizeof(int);
 	    ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR,
 		    (char *)&err, &optlen);
 	    if (ret == SOCKET_ERROR) {
 		err = WSAGetLastError();
+		if (err) {
+		    TclWinConvertError(err);
+		    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
+		}
 	    }
 	}
-	if (err) {
-	    TclWinConvertError(err);
-	    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
-	}
 	return TCL_OK;
     }
 
@@ -2971,7 +3029,7 @@ FindFDInList(
     TcpFdList *fds;
     for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
         #ifdef DEBUGGING
-	fprintf(stderr,"socket = %d, fd=%d",socket,fds);
+	fprintf(stderr,"socket = %d, fd=%d\n",socket,fds);
 	#endif
 	if (fds->fd == socket) {
 	    return 1;
-- 
cgit v0.12


From 7dc014d8e0a311dd0298724157b449414392b33d Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Fri, 14 Mar 2014 10:59:48 +0000
Subject: Remove writable shortcut and errorneous workaround to get [connect
 -async] fail error to [fconfigure -error]

---
 win/tclWinSock.c | 36 ++++++++++++++++++------------------
 1 file changed, 18 insertions(+), 18 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 0ea8f04..d9b9789 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -170,8 +170,7 @@ struct SocketInfo {
     struct addrinfo *myaddr;	/* Iterator over myaddrlist. */
     int status;                 /* Cache status of async socket. */
     int cachedBlocking;         /* Cache blocking mode of async socket. */
-    int lastError;		/* Error code from notifier thread. */
-    int connectError;		/* Error code from failed async connect. */
+    int lastError;		/* Error code from last message. */
     struct SocketInfo *nextPtr;	/* The next socket on the per-thread socket
 				 * list. */
 };
@@ -780,13 +779,9 @@ SocketEventProc(
 	infoPtr->readyEvents &= ~(FD_CONNECT);
 	DEBUG("FD_CONNECT");
         if ( infoPtr->flags & SOCKET_REENTER_PENDING ) {
-	    /* free list lock */
 	    SetEvent(tsdPtr->socketListLock);
-	    /* Do one connect step */
-	    if (TCL_OK != CreateClientSocket(NULL, infoPtr) ) {
-		/* On final fail save error for fconfigure -error */
-		infoPtr->connectError = Tcl_GetErrno();
-	    }
+	    CreateClientSocket(NULL, infoPtr);
+	    return 1;
 	}
     }
 
@@ -2476,26 +2471,31 @@ TcpGetOptionProc(
 		/* connect terminated with error */
 		Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errorCode), -1);
 	    }
-	} else if (infoPtr->connectError != 0) {
-	    /*
-	     * An async connect error was not jet reported.
-	     */
-	    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(infoPtr->connectError), -1);
-	    infoPtr->connectError = 0;
+
 	} else {
 	    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();
-		if (err) {
-		    TclWinConvertError(err);
-		    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
-		}
+	    }
+	    /*
+	     * Return error message
+	     */
+	    if (err) {
+		TclWinConvertError(err);
+		Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
 	    }
 	}
 	return TCL_OK;
-- 
cgit v0.12


From c02f2ee223615fe5b82e63c097199e34d0803814 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Fri, 14 Mar 2014 14:26:22 +0000
Subject:   *  More test improvements for async sockets.   *  Advance async
 connections whenever the channel is touched (e.g. by [chan configure]).   * 
 Add a noblock argument to WaitForConnect(), so that advancing async
 connections from [chan configure] doesn't block even on a blocking socket.

---
 tests/socket.test  | 45 ++++++++++++++++++++++++++-------------------
 unix/tclUnixSock.c | 28 +++++++++++++++++++++-------
 2 files changed, 47 insertions(+), 26 deletions(-)

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


From cf759170c20c57b8dd8dad33a78c8e1273b99cf2 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Fri, 14 Mar 2014 16:59:25 +0000
Subject: file tclWinSock.c reorganized to minimize diff to tclUnixSock.c. No
 functional change

---
 win/tclWinSock.c | 3675 +++++++++++++++++++++++++++---------------------------
 1 file changed, 1859 insertions(+), 1816 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index d9b9789..f65ea46 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -9,6 +9,9 @@
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
  * -----------------------------------------------------------------------
+ * The order and naming of functions in this file should minimize
+ * the file diff to tclUnixSock.c.
+ * -----------------------------------------------------------------------
  *
  * General information on how this module works.
  *
@@ -50,7 +53,7 @@
 //#define DEBUGGING
 #ifdef DEBUGGING
 #define DEBUG(x) fprintf(stderr, ">>> %p %s(%d): %s<<<\n", \
-			    infoPtr, __FUNCTION__, __LINE__, x)
+			    statePtr, __FUNCTION__, __LINE__, x)
 #else
 #define DEBUG(x)
 #endif
@@ -82,6 +85,15 @@
 #undef getsockopt
 #undef setsockopt
 
+/*
+ * Helper macros to make parts of this file clearer. The macros do exactly
+ * what they say on the tin. :-) They also only ever refer to their arguments
+ * once, and so can be used without regard to side effects.
+ */
+
+#define SET_BITS(var, bits)	((var) |= (bits))
+#define CLEAR_BITS(var, bits)	((var) &= ~(bits))
+
 /* "sock" + a pointer in hex + \0 */
 #define SOCK_CHAN_LENGTH        (4 + sizeof(void *) * 2 + 1)
 #define SOCK_TEMPLATE           "sock%p"
@@ -97,15 +109,6 @@ static const TCHAR classname[] = TEXT("TclSocket");
 TCL_DECLARE_MUTEX(socketMutex)
 
 /*
- * The following variable holds the network name of this host.
- */
-
-static TclInitProcessGlobalValueProc InitializeHostName;
-static ProcessGlobalValue hostName = {
-    0, 0, NULL, NULL, InitializeHostName, NULL, NULL
-};
-
-/*
  * The following defines declare the messages used on socket windows.
  */
 
@@ -131,20 +134,19 @@ typedef union {
 #define IN6_ARE_ADDR_EQUAL IN6_ADDR_EQUAL
 #endif
 
-typedef struct SocketInfo SocketInfo;
+/*
+ * This structure describes per-instance state of a tcp based channel.
+ */
+
+typedef struct TcpState TcpState;
 
 typedef struct TcpFdList {
-    SocketInfo *infoPtr;
+    TcpState *statePtr;
     SOCKET fd;
     struct TcpFdList *next;
 } TcpFdList;
 
-/*
- * The following structure is used to store the data associated with each
- * socket.
- */
-
-struct SocketInfo {
+struct TcpState {
     Tcl_Channel channel;	/* Channel associated with this socket. */
     struct TcpFdList *sockets;	/* Windows SOCKET handle. */
     int flags;			/* Bit field comprised of the flags described
@@ -154,28 +156,55 @@ struct SocketInfo {
 				 * indicate which events are interesting. */
     int readyEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
 				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
-				 * indicate which events have occurred. */
+				 * indicate which events have occurred.
+				 * Set by notifier thread, access must be
+				 * protected by semaphore */
     int selectEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
 				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
 				 * indicate which events are currently being
 				 * selected. */
     int acceptEventCount;	/* Count of the current number of FD_ACCEPTs
-				 * that have arrived and not yet processed. */
+				 * that have arrived and not yet processed.
+				 * Set by notifier thread, access must be
+				 * protected by semaphore */
     Tcl_TcpAcceptProc *acceptProc;
 				/* Proc to call on accept. */
     ClientData acceptProcData;	/* The data for the accept proc. */
+
+    /*
+     * Only needed for client sockets
+     */
+
     struct addrinfo *addrlist;	/* Addresses to connect to. */
     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 cachedBlocking;         /* Cache blocking mode of async socket. */
-    int lastError;		/* Error code from last message. */
-    struct SocketInfo *nextPtr;	/* The next socket on the per-thread socket
+    int lastError;		/* Error code from last message.
+				 * Set by notifier thread, access must be
+				 * protected by semaphore */
+    struct TcpState *nextPtr;	/* The next socket on the per-thread socket
 				 * list. */
 };
 
 /*
+ * These bits may be ORed together into the "flags" field of a TcpState
+ * structure.
+ */
+
+#define TCP_ASYNC_SOCKET	(1<<0)	/* Asynchronous socket. */
+#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 SOCKET_REENTER_PENDING	(1<<4)	/* CreateClientSocket was called to
+					 * process an async connect. This
+					 * flag indicates that reentry is
+					 * still pending */
+
+/*
  * The following structure is what is added to the Tcl event queue when a
  * socket event occurs.
  */
@@ -184,8 +213,8 @@ typedef struct {
     Tcl_Event header;		/* Information that is standard for all
 				 * events. */
     SOCKET socket;		/* Socket descriptor that is ready. Used to
-				 * find the SocketInfo structure for the file
-				 * (can't point directly to the SocketInfo
+				 * find the TcpState structure for the file
+				 * (can't point directly to the TcpState
 				 * structure because it could go away while
 				 * the event is queued). */
 } SocketEvent;
@@ -196,20 +225,6 @@ typedef struct {
 
 #define TCP_BUFFER_SIZE 4096
 
-/*
- * The following macros may be used to set the flags field of a SocketInfo
- * structure.
- */
-
-#define TCP_ASYNC_SOCKET	(1<<0)	/* The socket is in blocking mode. */
-#define SOCKET_EOF		(1<<1)	/* A zero read happened on the
-					 * socket. */
-#define SOCKET_ASYNC_CONNECT	(1<<2)	/* This socket uses async connect. */
-#define SOCKET_PENDING		(1<<3)	/* A message has been sent for this
-					 * socket */
-#define SOCKET_REENTER_PENDING	(1<<4)	/* The reentering after a received
-					 * FD_CONNECT to CreateClientSocket
-					 * is pending */
 
 typedef struct {
     HWND hwnd;			/* Handle to window for socket messages. */
@@ -220,11 +235,11 @@ typedef struct {
 				 * socketThread has been initialized and has
 				 * started. */
     HANDLE socketListLock;	/* Win32 Event to lock the socketList */
-    SocketInfo *pendingSocketInfo;
+    TcpState *pendingTcpState;
 				/* This socket is opened but not jet in the
 				 * list. This value is also checked by
 				 * the event structure. */
-    SocketInfo *socketList;	/* Every open socket in this thread has an
+    TcpState *socketList;	/* Every open socket in this thread has an
 				 * entry on this list. */
 } ThreadSpecificData;
 
@@ -232,22 +247,24 @@ static Tcl_ThreadDataKey dataKey;
 static WNDCLASS windowClass;
 
 /*
- * Static functions defined in this file.
+ * Static routines for this file:
  */
 
-static int		CreateClientSocket(Tcl_Interp *interp, SocketInfo *infoPtr);
+static int		CreateClientSocket(Tcl_Interp *interp,
+			    TcpState *state);
 static void		InitSockets(void);
-static SocketInfo *	NewSocketInfo(SOCKET socket);
+static TcpState *	NewSocketInfo(SOCKET socket);
 static void		SocketExitHandler(ClientData clientData);
 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(SocketInfo *infoPtr, int *errorCodePtr,
+static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr,
 			    int terminate_connect);
-static int		WaitForSocketEvent(SocketInfo *infoPtr, int events,
+static int		WaitForSocketEvent(TcpState *statePtr, int events,
 			    int *errorCodePtr);
-static int		FindFDInList(SocketInfo *infoPtr, SOCKET socket);
+static void		AddSocketInfoFd(TcpState *statePtr,  SOCKET socket);
+static int		FindFDInList(TcpState *statePtr, SOCKET socket);
 static DWORD WINAPI	SocketThread(LPVOID arg);
 static void		TcpThreadActionProc(ClientData instanceData,
 			    int action);
@@ -255,7 +272,7 @@ static void		TcpThreadActionProc(ClientData instanceData,
 static Tcl_EventCheckProc	SocketCheckProc;
 static Tcl_EventProc		SocketEventProc;
 static Tcl_EventSetupProc	SocketSetupProc;
-static Tcl_DriverBlockModeProc	TcpBlockProc;
+static Tcl_DriverBlockModeProc	TcpBlockModeProc;
 static Tcl_DriverCloseProc	TcpCloseProc;
 static Tcl_DriverClose2Proc	TcpClose2Proc;
 static Tcl_DriverSetOptionProc	TcpSetOptionProc;
@@ -267,28 +284,37 @@ static Tcl_DriverGetHandleProc	TcpGetHandleProc;
 
 /*
  * This structure describes the channel type structure for TCP socket
- * based IO.
+ * based IO:
  */
 
 static const Tcl_ChannelType tcpChannelType = {
-    "tcp",		    /* Type name. */
-    TCL_CHANNEL_VERSION_5,  /* v5 channel */
-    TcpCloseProc,	    /* Close proc. */
-    TcpInputProc,	    /* Input proc. */
-    TcpOutputProc,	    /* Output proc. */
-    NULL,		    /* Seek proc. */
-    TcpSetOptionProc,	    /* Set option proc. */
-    TcpGetOptionProc,	    /* Get option proc. */
-    TcpWatchProc,	    /* Set up notifier to watch this channel. */
-    TcpGetHandleProc,	    /* Get an OS handle from channel. */
-    TcpClose2Proc,	    /* Close2proc. */
-    TcpBlockProc,	    /* Set socket into (non-)blocking mode. */
-    NULL,		    /* flush proc. */
-    NULL,		    /* handler proc. */
-    NULL,		    /* wide seek proc */
-    TcpThreadActionProc,    /* thread action proc */
-    NULL		    /* truncate */
+    "tcp",			/* Type name. */
+    TCL_CHANNEL_VERSION_5,	/* v5 channel */
+    TcpCloseProc,		/* Close proc. */
+    TcpInputProc,		/* Input proc. */
+    TcpOutputProc,		/* Output proc. */
+    NULL,			/* Seek proc. */
+    TcpSetOptionProc,		/* Set option proc. */
+    TcpGetOptionProc,		/* Get option proc. */
+    TcpWatchProc,		/* Initialize notifier. */
+    TcpGetHandleProc,		/* Get OS handles out of channel. */
+    TcpClose2Proc,		/* Close2 proc. */
+    TcpBlockModeProc,		/* Set blocking or non-blocking mode.*/
+    NULL,			/* flush proc. */
+    NULL,			/* handler proc. */
+    NULL,			/* wide seek proc. */
+    TcpThreadActionProc,	/* thread action proc. */
+    NULL			/* truncate proc. */
 };
+
+/*
+ * The following variable holds the network name of this host.
+ */
+
+static TclInitProcessGlobalValueProc InitializeHostName;
+static ProcessGlobalValue hostName =
+	{0, 0, NULL, NULL, InitializeHostName, NULL, NULL};
+
 void printaddrinfo(struct addrinfo *ai, char *prefix)
 {
     char host[NI_MAXHOST], port[NI_MAXSERV];
@@ -311,202 +337,125 @@ void printaddrinfolist(struct addrinfo *addrlist, char *prefix)
 /*
  *----------------------------------------------------------------------
  *
- * InitSockets --
- *
- *	Initialize the socket module.  If winsock startup is successful,
- *	registers the event window for the socket notifier code.
+ * InitializeHostName --
  *
- *	Assumes socketMutex is held.
+ *	This routine sets the process global value of the name of the local
+ *	host on which the process is running.
  *
  * Results:
  *	None.
  *
- * Side effects:
- *	Initializes winsock, registers a new window class and creates a
- *	window for use in asynchronous socket notification.
- *
  *----------------------------------------------------------------------
  */
 
-static void
-InitSockets(void)
+void
+InitializeHostName(
+    char **valuePtr,
+    int *lengthPtr,
+    Tcl_Encoding *encodingPtr)
 {
-    DWORD id, err;
-    WSADATA wsaData;
-    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-
-    if (!initialized) {
-	initialized = 1;
-	TclCreateLateExitHandler(SocketExitHandler, NULL);
+    TCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1];
+    DWORD length = MAX_COMPUTERNAME_LENGTH + 1;
+    Tcl_DString ds;
 
+    if (GetComputerName(tbuf, &length) != 0) {
 	/*
-	 * Create the async notification window with a new class. We must
-	 * create a new class to avoid a Windows 95 bug that causes us to get
-	 * the wrong message number for socket events if the message window is
-	 * a subclass of a static control.
+	 * Convert string from native to UTF then change to lowercase.
 	 */
 
-	windowClass.style = 0;
-	windowClass.cbClsExtra = 0;
-	windowClass.cbWndExtra = 0;
-	windowClass.hInstance = TclWinGetTclInstance();
-	windowClass.hbrBackground = NULL;
-	windowClass.lpszMenuName = NULL;
-	windowClass.lpszClassName = classname;
-	windowClass.lpfnWndProc = SocketProc;
-	windowClass.hIcon = NULL;
-	windowClass.hCursor = NULL;
-
-	if (!RegisterClass(&windowClass)) {
-	    TclWinConvertError(GetLastError());
-	    goto initFailure;
-	}
-
-	/*
-	 * Initialize the winsock library and check the interface version
-	 * actually loaded. We only ask for the 1.1 interface and do require
-	 * that it not be less than 1.1.
-	 */
+	Tcl_UtfToLower(Tcl_WinTCharToUtf(tbuf, -1, &ds));
 
-	err = WSAStartup((WORD) MAKEWORD(WSA_VERSION_MAJOR,WSA_VERSION_MINOR),
-		&wsaData);
-	if (err != 0) {
-	    TclWinConvertError(err);
-	    goto initFailure;
-	}
+    } else {
+	Tcl_DStringInit(&ds);
+	if (TclpHasSockets(NULL) == TCL_OK) {
+	    /*
+	     * The buffer size of 256 is recommended by the MSDN page that
+	     * documents gethostname() as being always adequate.
+	     */
 
-	/*
-	 * Note the byte positions ae swapped for the comparison, so that
-	 * 0x0002 (2.0, MAKEWORD(2,0)) doesn't look less than 0x0101 (1.1). We
-	 * want the comparison to be 0x0200 < 0x0101.
-	 */
+	    Tcl_DString inDs;
 
-	if (MAKEWORD(HIBYTE(wsaData.wVersion), LOBYTE(wsaData.wVersion))
-		< MAKEWORD(WSA_VERSION_MINOR, WSA_VERSION_MAJOR)) {
-	    TclWinConvertError(WSAVERNOTSUPPORTED);
-	    WSACleanup();
-	    goto initFailure;
+	    Tcl_DStringInit(&inDs);
+	    Tcl_DStringSetLength(&inDs, 256);
+	    if (gethostname(Tcl_DStringValue(&inDs),
+		    Tcl_DStringLength(&inDs)) == 0) {
+		Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1,
+			&ds);
+	    }
+	    Tcl_DStringFree(&inDs);
 	}
     }
 
-    /*
-     * Check for per-thread initialization.
-     */
-
-    if (tsdPtr != NULL) {
-	return;
-    }
-
-    /*
-     * OK, this thread has never done anything with sockets before.  Construct
-     * a worker thread to handle asynchronous events related to sockets
-     * assigned to _this_ thread.
-     */
-
-    tsdPtr = TCL_TSD_INIT(&dataKey);
-    tsdPtr->pendingSocketInfo = NULL;
-    tsdPtr->socketList = NULL;
-    tsdPtr->hwnd       = NULL;
-    tsdPtr->threadId   = Tcl_GetCurrentThread();
-    tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
-    if (tsdPtr->readyEvent == NULL) {
-	goto initFailure;
-    }
-    tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL);
-    if (tsdPtr->socketListLock == NULL) {
-	goto initFailure;
-    }
-    tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, 0,
-	    &id);
-    if (tsdPtr->socketThread == NULL) {
-	goto initFailure;
-    }
-
-    SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST);
-
-    /*
-     * Wait for the thread to signal when the window has been created and if
-     * it is ready to go.
-     */
-
-    WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
-
-    if (tsdPtr->hwnd == NULL) {
-	goto initFailure;	/* Trouble creating the window. */
-    }
-
-    Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
-    return;
-
-  initFailure:
-    TclpFinalizeSockets();
-    initialized = -1;
-    return;
+    *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
+    *lengthPtr = Tcl_DStringLength(&ds);
+    *valuePtr = ckalloc((*lengthPtr) + 1);
+    memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1);
+    Tcl_DStringFree(&ds);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * SocketsEnabled --
+ * Tcl_GetHostName --
  *
- *	Check that the WinSock was successfully initialized.
+ *	Returns the name of the local host.
  *
  * Results:
- *	1 if it is.
+ *	A string containing the network name for this machine, or an empty
+ *	string if we can't figure out the name. The caller must not modify or
+ *	free this string.
  *
  * Side effects:
- *	None.
+ *	Caches the name to return for future calls.
  *
  *----------------------------------------------------------------------
  */
 
-    /* ARGSUSED */
-static int
-SocketsEnabled(void)
+const char *
+Tcl_GetHostName(void)
 {
-    int enabled;
-
-    Tcl_MutexLock(&socketMutex);
-    enabled = (initialized == 1);
-    Tcl_MutexUnlock(&socketMutex);
-    return enabled;
+    return Tcl_GetString(TclGetProcessGlobalValue(&hostName));
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
- * SocketExitHandler --
+ * TclpHasSockets --
  *
- *	Callback invoked during exit clean up to delete the socket
- *	communication window and to release the WinSock DLL.
+ *	This function determines whether sockets are available on the current
+ *	system and returns an error in interp if they are not. Note that
+ *	interp may be NULL.
  *
  * Results:
- *	None.
+ *	Returns TCL_OK if the system supports sockets, or TCL_ERROR with an
+ *	error in interp (if non-NULL).
  *
  * Side effects:
- *	None.
+ *	If not already prepared, initializes the TSD structure and socket
+ *	message handling thread associated to the calling thread for the
+ *	subsystem of the driver.
  *
  *----------------------------------------------------------------------
  */
 
-    /* ARGSUSED */
-static void
-SocketExitHandler(
-    ClientData clientData)		/* Not used. */
+int
+TclpHasSockets(
+    Tcl_Interp *interp)		/* Where to write an error message if sockets
+				 * are not present, or NULL if no such message
+				 * is to be written. */
 {
     Tcl_MutexLock(&socketMutex);
-
-    /*
-     * Make sure the socket event handling window is cleaned-up for, at
-     * most, this thread.
-     */
-
-    TclpFinalizeSockets();
-    UnregisterClass(classname, TclWinGetTclInstance());
-    WSACleanup();
-    initialized = 0;
+    InitSockets();
     Tcl_MutexUnlock(&socketMutex);
+
+    if (SocketsEnabled()) {
+	return TCL_OK;
+    }
+    if (interp != NULL) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"sockets are not available on this system", -1));
+    }
+    return TCL_ERROR;
 }
 
 /*
@@ -570,379 +519,400 @@ TclpFinalizeSockets(void)
 /*
  *----------------------------------------------------------------------
  *
- * TclpHasSockets --
+ * TcpBlockModeProc --
  *
- *	This function determines whether sockets are available on the current
- *	system and returns an error in interp if they are not. Note that
- *	interp may be NULL.
+ *	This function is invoked by the generic IO level to set blocking and
+ *	nonblocking mode on a TCP socket based channel.
  *
  * Results:
- *	Returns TCL_OK if the system supports sockets, or TCL_ERROR with an
- *	error in interp (if non-NULL).
+ *	0 if successful, errno when failed.
  *
  * Side effects:
- *	If not already prepared, initializes the TSD structure and socket
- *	message handling thread associated to the calling thread for the
- *	subsystem of the driver.
+ *	Sets the device into blocking or nonblocking mode.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclpHasSockets(
-    Tcl_Interp *interp)		/* Where to write an error message if sockets
-				 * are not present, or NULL if no such message
-				 * is to be written. */
+	/* ARGSUSED */
+static int
+TcpBlockModeProc(
+    ClientData instanceData,	/* Socket state. */
+    int mode)			/* The mode to set. Can be one of
+				 * TCL_MODE_BLOCKING or
+				 * TCL_MODE_NONBLOCKING. */
 {
-    Tcl_MutexLock(&socketMutex);
-    InitSockets();
-    Tcl_MutexUnlock(&socketMutex);
+    TcpState *statePtr = instanceData;
 
-    if (SocketsEnabled()) {
-	return TCL_OK;
-    }
-    if (interp != NULL) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		"sockets are not available on this system", -1));
+    if (mode == TCL_MODE_NONBLOCKING) {
+	statePtr->flags |= TCP_ASYNC_SOCKET;
+    } else {
+	statePtr->flags &= ~(TCP_ASYNC_SOCKET);
     }
-    return TCL_ERROR;
+    return 0;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * SocketSetupProc --
+ * WaitForConnect --
  *
- *	This function is invoked before Tcl_DoOneEvent blocks waiting for an
- *	event.
+ *	Process an asyncroneous connect by other commands (gets... ).
+ *	Do one connect step if pending as if the event loop would run.
+ *
+ *	Blocking commands may call in with terminate_connect to terminate
+ *	the syncroneous connect syncroneously.
+ *
+ *	Ok is directly returned if no async connect is running.
  *
  * Results:
- *	None.
+ *	Returns 1 on success or 0 on failure, with a possix error code in
+ *	errorCodePtr.
+ *	If the connect is not terminated, errorCode is set to EWOULDBLOCK
+ *	and 0 is returned.
  *
  * Side effects:
- *	Adjusts the block time if needed.
+ *	Processes socket events off the system queue.
+ *	May process asynchroneous connect.
  *
  *----------------------------------------------------------------------
  */
 
-void
-SocketSetupProc(
-    ClientData data,		/* Not used. */
-    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
+static int
+WaitForConnect(
+    TcpState *statePtr,		/* State of the socket. */
+    int *errorCodePtr,		/* Where to store errors? */
+    int terminate_connect)	/* Should the connect be terminated? */
 {
-    SocketInfo *infoPtr;
-    Tcl_Time blockTime = { 0, 0 };
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
-    if (!(flags & TCL_FILE_EVENTS)) {
-	return;
-    }
+    int result;
+    int oldMode;
+    ThreadSpecificData *tsdPtr;
 
     /*
-     * Check to see if there is a ready socket.	 If so, poll.
+     * Check if an async connect is running. If not return ok
+     */
+    if ( !(statePtr->flags & SOCKET_REENTER_PENDING) )
+	return 1;
+    
+    /*
+     * Be sure to disable event servicing so we are truly modal.
      */
-    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-    for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
-	    infoPtr = infoPtr->nextPtr) {
-	if (infoPtr->readyEvents &
-	    (infoPtr->watchEvents | FD_CONNECT | FD_ACCEPT)
-	) {
-	    DEBUG("Tcl_SetMaxBlockTime");
-	    Tcl_SetMaxBlockTime(&blockTime);
-	    break;
-	}
-    }
-    SetEvent(tsdPtr->socketListLock);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SocketCheckProc --
- *
- *	This function is called by Tcl_DoOneEvent to check the socket event
- *	source for events.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	May queue an event.
- *
- *----------------------------------------------------------------------
- */
 
-static void
-SocketCheckProc(
-    ClientData data,		/* Not used. */
-    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
-{
-    SocketInfo *infoPtr;
-    SocketEvent *evPtr;
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
 
-    if (!(flags & TCL_FILE_EVENTS)) {
-	return;
-    }
+    while (1) {
 
-    /*
-     * Queue events for any ready sockets that don't already have events
-     * queued (caused by persistent states that won't generate WinSock
-     * events).
-     */
+	/* get statePtr lock */
+        tsdPtr = TclThreadDataKeyGet(&dataKey);
+	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	
+	/* Check for connect event */
+	if (statePtr->readyEvents & FD_CONNECT) {
 
-    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-    for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
-	    infoPtr = infoPtr->nextPtr) {
-	DEBUG("Socket loop");
-	if ((infoPtr->readyEvents &
-		(infoPtr->watchEvents | FD_CONNECT | FD_ACCEPT))
-	    && !(infoPtr->flags & SOCKET_PENDING)
-	) {
-	    DEBUG("Event found");
-	    infoPtr->flags |= SOCKET_PENDING;
-	    evPtr = ckalloc(sizeof(SocketEvent));
-	    evPtr->header.proc = SocketEventProc;
-	    evPtr->socket = infoPtr->sockets->fd;
-	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
+	    /* Consume the connect event */
+	    statePtr->readyEvents &= ~(FD_CONNECT);
+
+	    /*
+	     * For blocking sockets disable async connect
+	     * as we continue now synchoneously
+	     */
+	    if ( terminate_connect ) {
+		statePtr->flags &= ~(TCP_ASYNC_CONNECT);
+	    }
+
+	    /* Free list lock */
+	    SetEvent(tsdPtr->socketListLock);
+
+	    /* continue connect */
+	    result = CreateClientSocket(NULL, statePtr);
+
+	    /* Restore event service mode */
+	    (void) Tcl_SetServiceMode(oldMode);
+
+	    /* Succesfully connected or async connect restarted */
+	    if (result == TCL_OK) {
+		if ( statePtr->flags & SOCKET_REENTER_PENDING ) {
+		    *errorCodePtr = EWOULDBLOCK;
+		    return 0;
+		}
+		return 1;
+	    }
+	    /* error case */
+	    *errorCodePtr = Tcl_GetErrno();
+	    return 0;
+	}
+
+        /* Free list lock */
+        SetEvent(tsdPtr->socketListLock);
+
+	/*
+	 * A non blocking socket waiting for an asyncronous connect
+	 * returns directly an error
+	 */
+	if ( ! terminate_connect ) {
+	    *errorCodePtr = EWOULDBLOCK;
+	    return 0;
 	}
+
+	/*
+	 * Wait until something happens.
+	 */
+
+	WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
     }
-    SetEvent(tsdPtr->socketListLock);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * SocketEventProc --
+ * TcpInputProc --
  *
- *	This function is called by Tcl_ServiceEvent when a socket event
- *	reaches the front of the event queue. This function is responsible for
- *	notifying the generic channel code.
+ *	This function is invoked by the generic IO level to read input from a
+ *	TCP socket based channel.
  *
  * Results:
- *	Returns 1 if the event was handled, meaning it should be removed from
- *	the queue. Returns 0 if the event was not handled, meaning it should
- *	stay on the queue. The only time the event isn't handled is if the
- *	TCL_FILE_EVENTS flag bit isn't set.
+ *	The number of bytes read is returned or -1 on error. An output
+ *	argument contains the POSIX error code on error, or zero if no error
+ *	occurred.
  *
  * Side effects:
- *	Whatever the channel callback functions do.
+ *	Reads input from the input device of the channel.
  *
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 static int
-SocketEventProc(
-    Tcl_Event *evPtr,		/* Event to service. */
-    int flags)			/* Flags that indicate what events to handle,
-				 * such as TCL_FILE_EVENTS. */
+TcpInputProc(
+    ClientData instanceData,	/* Socket state. */
+    char *buf,			/* Where to store data read. */
+    int bufSize,		/* How much space is available in the
+				 * buffer? */
+    int *errorCodePtr)		/* Where to store error code. */
 {
-    SocketInfo *infoPtr = NULL; /* DEBUG */
-    SocketEvent *eventPtr = (SocketEvent *) evPtr;
-    int mask = 0, events;
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    TcpFdList *fds;
-    SOCKET newSocket;
-    address addr;
-    int len;
+    TcpState *statePtr = instanceData;
+    int bytesRead;
+    DWORD error;
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 
-    DEBUG("");
-    if (!(flags & TCL_FILE_EVENTS)) {
-	return 0;
-    }
+    *errorCodePtr = 0;
 
     /*
-     * Find the specified socket on the socket list.
+     * Check that WinSock is initialized; do not call it if not, to prevent
+     * system crashes. This can happen at exit time if the exit handler for
+     * WinSock ran before other exit handlers that want to use sockets.
      */
 
-    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-    for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
-	    infoPtr = infoPtr->nextPtr) {
-	if (infoPtr->sockets->fd == eventPtr->socket) {
-	    break;
-	}
+    if (!SocketsEnabled()) {
+	*errorCodePtr = EFAULT;
+	return -1;
     }
 
     /*
-     * Discard events that have gone stale.
+     * First check to see if EOF was already detected, to prevent calling the
+     * socket stack after the first time EOF is detected.
      */
 
-    if (!infoPtr) {
-        SetEvent(tsdPtr->socketListLock);
-	return 1;
+    if (statePtr->flags & SOCKET_EOF) {
+	return 0;
     }
 
-    infoPtr->flags &= ~SOCKET_PENDING;
+    /*
+     * Check if there is an async connect running.
+     * For blocking sockets terminate connect, otherwise do one step.
+     * For a non blocking socket return EWOULDBLOCK if connect not terminated
+     */
 
-    /* Continue async connect if pending and ready */
-    if ( infoPtr->readyEvents & FD_CONNECT ) {
-	infoPtr->readyEvents &= ~(FD_CONNECT);
-	DEBUG("FD_CONNECT");
-        if ( infoPtr->flags & SOCKET_REENTER_PENDING ) {
-	    SetEvent(tsdPtr->socketListLock);
-	    CreateClientSocket(NULL, infoPtr);
-	    return 1;
-	}
+    if ( !WaitForConnect(statePtr, errorCodePtr,
+	    ! ( statePtr->flags & TCP_ASYNC_SOCKET ))) {
+	return -1;
     }
 
     /*
-     * Handle connection requests directly.
+     * No EOF, and it is connected, so try to read more from the socket. Note
+     * that we clear the FD_READ bit because read events are level triggered
+     * so a new event will be generated if there is still data available to be
+     * read. We have to simulate blocking behavior here since we are always
+     * using non-blocking sockets.
      */
-    if (infoPtr->readyEvents & FD_ACCEPT) {
-	for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
 
-	    /*
-	    * Accept the incoming connection request.
-	    */
-	    len = sizeof(address);
+    while (1) {
+	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+		(WPARAM) UNSELECT, (LPARAM) statePtr);
+	/* single fd operation: this proc is only called for a connected socket. */
+	bytesRead = recv(statePtr->sockets->fd, buf, bufSize, 0);
+	statePtr->readyEvents &= ~(FD_READ);
 
-	    newSocket = accept(fds->fd, &(addr.sa), &len);
+	/*
+	 * Check for end-of-file condition or successful read.
+	 */
 
-	    /* On Tcl server sockets with multiple OS fds we loop over the fds trying
-	     * an accept() on each, so we expect INVALID_SOCKET.  There are also other
-	     * network stack conditions that can result in FD_ACCEPT but a subsequent
-	     * failure on accept() by the time we get around to it.
-	     * Access to sockets (acceptEventCount, readyEvents) in socketList
-	     * is still protected by the lock (prevents reintroduction of 
-	     * SF Tcl Bug 3056775.
-	     */
+	if (bytesRead == 0) {
+	    statePtr->flags |= SOCKET_EOF;
+	}
+	if (bytesRead != SOCKET_ERROR) {
+	    break;
+	}
 
-	    if (newSocket == INVALID_SOCKET) {
-		/* int err = WSAGetLastError(); */
-		continue;
-	    }
-
-	    /*
-	     * It is possible that more than one FD_ACCEPT has been sent, so an extra
-	     * count must be kept. Decrement the count, and reset the readyEvent bit
-	     * if the count is no longer > 0.
-	     */
-	    infoPtr->acceptEventCount--;
-
-	    if (infoPtr->acceptEventCount <= 0) {
-		infoPtr->readyEvents &= ~(FD_ACCEPT);
-	    }
-
-	    SetEvent(tsdPtr->socketListLock);
-
-	    /* Caution: TcpAccept() has the side-effect of evaluating the server
-	     * accept script (via AcceptCallbackProc() in tclIOCmd.c), which can
-	     * close the server socket and invalidate infoPtr and fds.
-	     * If TcpAccept() accepts a socket we must return immediately and let
-	     * SocketCheckProc queue additional FD_ACCEPT events.
-	     */
-	    TcpAccept(fds, newSocket, addr);
-	    return 1;
-	}
-
-	/* Loop terminated with no sockets accepted; clear the ready mask so 
-	 * we can detect the next connection request. Note that connection 
-	 * requests are level triggered, so if there is a request already 
-	 * pending, a new event will be generated.
+	/*
+	 * If an error occurs after the FD_CLOSE has arrived, then ignore the
+	 * error and report an EOF.
 	 */
-	infoPtr->acceptEventCount = 0;
-	infoPtr->readyEvents &= ~(FD_ACCEPT);
-
-	SetEvent(tsdPtr->socketListLock);
-	return 1;
-    }
-
-    SetEvent(tsdPtr->socketListLock);
 
-    /*
-     * Mask off unwanted events and compute the read/write mask so we can
-     * notify the channel.
-     */
+	if (statePtr->readyEvents & FD_CLOSE) {
+	    statePtr->flags |= SOCKET_EOF;
+	    bytesRead = 0;
+	    break;
+	}
 
-    events = infoPtr->readyEvents & infoPtr->watchEvents;
+	error = WSAGetLastError();
 
-    if (events & FD_CLOSE) {
 	/*
-	 * If the socket was closed and the channel is still interested in
-	 * read events, then we need to ensure that we keep polling for this
-	 * event until someone does something with the channel. Note that we
-	 * do this before calling Tcl_NotifyChannel so we don't have to watch
-	 * out for the channel being deleted out from under us. This may cause
-	 * a redundant trip through the event loop, but it's simpler than
-	 * trying to do unwind protection.
+	 * If an RST comes, then ignore the error and report an EOF just like
+	 * on unix.
 	 */
 
-	Tcl_Time blockTime = { 0, 0 };
-
-	DEBUG("FD_CLOSE");
-	Tcl_SetMaxBlockTime(&blockTime);
-	mask |= TCL_READABLE|TCL_WRITABLE;
-    } else if (events & FD_READ) {
-	fd_set readFds;
-	struct timeval timeout;
+	if (error == WSAECONNRESET) {
+	    statePtr->flags |= SOCKET_EOF;
+	    bytesRead = 0;
+	    break;
+	}
 
 	/*
-	 * We must check to see if data is really available, since someone
-	 * could have consumed the data in the meantime. Turn off async
-	 * notification so select will work correctly. If the socket is still
-	 * readable, notify the channel driver, otherwise reset the async
-	 * select handler and keep waiting.
+	 * Check for error condition or underflow in non-blocking case.
 	 */
-	DEBUG("FD_READ");
 
-	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
-		(WPARAM) UNSELECT, (LPARAM) infoPtr);
+	if ((statePtr->flags & TCP_ASYNC_SOCKET) || (error != WSAEWOULDBLOCK)) {
+	    TclWinConvertError(error);
+	    *errorCodePtr = Tcl_GetErrno();
+	    bytesRead = -1;
+	    break;
+	}
 
-	FD_ZERO(&readFds);
-	FD_SET(infoPtr->sockets->fd, &readFds);
-	timeout.tv_usec = 0;
-	timeout.tv_sec = 0;
+	/*
+	 * In the blocking case, wait until the file becomes readable or
+	 * closed and try again.
+	 */
 
-	if (select(0, &readFds, NULL, NULL, &timeout) != 0) {
-	    mask |= TCL_READABLE;
-	} else {
-	    infoPtr->readyEvents &= ~(FD_READ);
-	    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
-		    (WPARAM) SELECT, (LPARAM) infoPtr);
+	if (!WaitForSocketEvent(statePtr, FD_READ|FD_CLOSE, errorCodePtr)) {
+	    bytesRead = -1;
+	    break;
 	}
     }
-    if (events & FD_WRITE) {
-	DEBUG("FD_WRITE");
-	mask |= TCL_WRITABLE;
-    }
-    if (mask) {
-	DEBUG("Calling Tcl_NotifyChannel...");
-	Tcl_NotifyChannel(infoPtr->channel, mask);
-    }
-    DEBUG("returning...");
-    return 1;
+
+    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr);
+
+    return bytesRead;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TcpBlockProc --
+ * TcpOutputProc --
  *
- *	Sets a socket into blocking or non-blocking mode.
+ *	This function is called by the generic IO level to write data to a
+ *	socket based channel.
  *
  * Results:
- *	0 if successful, errno if there was an error.
+ *	The number of bytes written or -1 on failure.
  *
  * Side effects:
- *	None.
+ *	Produces output on the socket.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-TcpBlockProc(
-    ClientData instanceData,	/* The socket to block/un-block. */
-    int mode)			/* TCL_MODE_BLOCKING or
-				 * TCL_MODE_NONBLOCKING. */
+TcpOutputProc(
+    ClientData instanceData,	/* Socket state. */
+    const char *buf,		/* The data buffer. */
+    int toWrite,		/* How many bytes to write? */
+    int *errorCodePtr)		/* Where to store error code. */
 {
-    SocketInfo *infoPtr = instanceData;
+    TcpState *statePtr = instanceData;
+    int written;
+    DWORD error;
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 
-    if (mode == TCL_MODE_NONBLOCKING) {
-	infoPtr->flags |= TCP_ASYNC_SOCKET;
-    } else {
-	infoPtr->flags &= ~(TCP_ASYNC_SOCKET);
+    *errorCodePtr = 0;
+
+    /*
+     * Check that WinSock is initialized; do not call it if not, to prevent
+     * system crashes. This can happen at exit time if the exit handler for
+     * WinSock ran before other exit handlers that want to use sockets.
+     */
+
+    if (!SocketsEnabled()) {
+	*errorCodePtr = EFAULT;
+	return -1;
     }
-    return 0;
+
+    /*
+     * Check if there is an async connect running.
+     * For blocking sockets terminate connect, otherwise do one step.
+     * For a non blocking socket return EWOULDBLOCK if connect not terminated
+     */
+
+    if ( !WaitForConnect(statePtr, errorCodePtr,
+	    ! ( statePtr->flags & TCP_ASYNC_SOCKET ))) {
+	return -1;
+    }
+
+    while (1) {
+	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+		(WPARAM) UNSELECT, (LPARAM) statePtr);
+
+	/* single fd operation: this proc is only called for a connected socket. */
+	written = send(statePtr->sockets->fd, buf, toWrite, 0);
+	if (written != SOCKET_ERROR) {
+	    /*
+	     * Since Windows won't generate a new write event until we hit an
+	     * overflow condition, we need to force the event loop to poll
+	     * until the condition changes.
+	     */
+
+	    if (statePtr->watchEvents & FD_WRITE) {
+		Tcl_Time blockTime = { 0, 0 };
+		Tcl_SetMaxBlockTime(&blockTime);
+	    }
+	    break;
+	}
+
+	/*
+	 * Check for error condition or overflow. In the event of overflow, we
+	 * need to clear the FD_WRITE flag so we can detect the next writable
+	 * event. Note that Windows only sends a new writable event after a
+	 * send fails with WSAEWOULDBLOCK.
+	 */
+
+	error = WSAGetLastError();
+	if (error == WSAEWOULDBLOCK) {
+	    statePtr->readyEvents &= ~(FD_WRITE);
+	    if (statePtr->flags & TCP_ASYNC_SOCKET) {
+		*errorCodePtr = EWOULDBLOCK;
+		written = -1;
+		break;
+	    }
+	} else {
+	    TclWinConvertError(error);
+	    *errorCodePtr = Tcl_GetErrno();
+	    written = -1;
+	    break;
+	}
+
+	/*
+	 * In the blocking case, wait until the file becomes writable or
+	 * closed and try again.
+	 */
+
+	if (!WaitForSocketEvent(statePtr, FD_WRITE|FD_CLOSE, errorCodePtr)) {
+	    written = -1;
+	    break;
+	}
+    }
+
+    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr);
+
+    return written;
 }
 
 /*
@@ -969,7 +939,7 @@ TcpCloseProc(
     ClientData instanceData,	/* The socket to close. */
     Tcl_Interp *interp)		/* Unused. */
 {
-    SocketInfo *infoPtr = instanceData;
+    TcpState *statePtr = instanceData;
     /* TIP #218 */
     int errorCode = 0;
     /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */
@@ -987,9 +957,9 @@ TcpCloseProc(
 	 * background.
 	 */
 
-	while ( infoPtr->sockets != NULL ) {
-	    TcpFdList *thisfd = infoPtr->sockets;
-	    infoPtr->sockets = thisfd->next;
+	while ( statePtr->sockets != NULL ) {
+	    TcpFdList *thisfd = statePtr->sockets;
+	    statePtr->sockets = thisfd->next;
 
 	    if (closesocket(thisfd->fd) == SOCKET_ERROR) {
 		TclWinConvertError((DWORD) WSAGetLastError());
@@ -999,11 +969,11 @@ TcpCloseProc(
 	}
     }
 
-    if (infoPtr->addrlist != NULL) {
-        freeaddrinfo(infoPtr->addrlist);
+    if (statePtr->addrlist != NULL) {
+        freeaddrinfo(statePtr->addrlist);
     }
-    if (infoPtr->myaddrlist != NULL) {
-        freeaddrinfo(infoPtr->myaddrlist);
+    if (statePtr->myaddrlist != NULL) {
+        freeaddrinfo(statePtr->myaddrlist);
     }
 
     /*
@@ -1013,7 +983,7 @@ TcpCloseProc(
      * fear of damaging the list.
      */
 
-    ckfree(infoPtr);
+    ckfree(statePtr);
     return errorCode;
 }
 
@@ -1040,14 +1010,15 @@ TcpClose2Proc(
     Tcl_Interp *interp,		/* For error reporting. */
     int flags)			/* Flags that indicate which side to close. */
 {
-    SocketInfo *infoPtr = instanceData;
-    int errorCode = 0, sd;
+    TcpState *statePtr = instanceData;
+    int errorCode = 0;
+    int sd;
 
     /*
      * Shutdown the OS socket handle.
      */
 
-    switch (flags) {
+    switch(flags) {
     case TCL_CLOSE_READ:
 	sd = SD_RECEIVE;
 	break;
@@ -1057,14 +1028,14 @@ TcpClose2Proc(
     default:
 	if (interp) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "Socket close2proc called bidirectionally", -1));
+		    "socket close2proc called bidirectionally", -1));
 	}
 	return TCL_ERROR;
     }
 
     /* single fd operation: Tcl_OpenTcpServer() does not set TCL_READABLE or
      * TCL_WRITABLE so this should never be called for a server socket. */
-    if (shutdown(infoPtr->sockets->fd, sd) == SOCKET_ERROR) {
+    if (shutdown(statePtr->sockets->fd, sd) == SOCKET_ERROR) {
 	TclWinConvertError((DWORD) WSAGetLastError());
 	errorCode = Tcl_GetErrno();
     }
@@ -1075,745 +1046,799 @@ TcpClose2Proc(
 /*
  *----------------------------------------------------------------------
  *
- * AddSocketInfoFd --
+ * TcpSetOptionProc --
  *
- *	This function adds a SOCKET file descriptor to the 'sockets' linked 
- *	list of a SocketInfo structure.
+ *	Sets Tcp channel specific options.
  *
  * Results:
- *	None.
+ *	None, unless an error happens.
  *
  * Side effects:
- *	None, except for allocation of memory.
+ *	Changes attributes of the socket at the system level.
  *
  *----------------------------------------------------------------------
  */
 
-static void
-AddSocketInfoFd(
-    SocketInfo *infoPtr, 
-    SOCKET socket)
+static int
+TcpSetOptionProc(
+    ClientData instanceData,	/* Socket state. */
+    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
+    const char *optionName,	/* Name of the option to set. */
+    const char *value)		/* New value for option. */
 {
-    TcpFdList *fds = infoPtr->sockets;
+#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
+    TcpState *statePtr = instanceData;
+    SOCKET sock;
+#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
 
-    if ( fds == NULL ) {
-	/* Add the first FD */
-	infoPtr->sockets = ckalloc(sizeof(TcpFdList));
-	fds = infoPtr->sockets;
-    } else {
-	/* Find end of list and append FD */
-	while ( fds->next != NULL ) {
-	    fds = fds->next;
+    /*
+     * Check that WinSock is initialized; do not call it if not, to prevent
+     * system crashes. This can happen at exit time if the exit handler for
+     * WinSock ran before other exit handlers that want to use sockets.
+     */
+
+    if (!SocketsEnabled()) {
+	if (interp) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "winsock is not initialized", -1));
 	}
-    
-	fds->next = ckalloc(sizeof(TcpFdList));
-	fds = fds->next;
+	return TCL_ERROR;
     }
 
-    /* Populate new FD */
-    fds->fd = socket;
-    fds->infoPtr = infoPtr;
-    fds->next = NULL;
-}
-
-    
-/*
- *----------------------------------------------------------------------
- *
- * NewSocketInfo --
- *
- *	This function allocates and initializes a new SocketInfo structure.
- *
- * Results:
- *	Returns a newly allocated SocketInfo.
- *
- * Side effects:
- *	None, except for allocation of memory.
- *
- *----------------------------------------------------------------------
- */
-
-static SocketInfo *
-NewSocketInfo(SOCKET socket)
-{
-    SocketInfo *infoPtr = ckalloc(sizeof(SocketInfo));
-
-    memset(infoPtr, 0, sizeof(SocketInfo));
+#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
+    #error "TCL_FEATURE_KEEPALIVE_NAGLE not reviewed for whether to treat statePtr->sockets as single fd or list"
+    sock = statePtr->sockets->fd;
 
-    /*
-     * TIP #218. Removed the code inserting the new structure into the global
-     * list. This is now handled in the thread action callbacks, and only
-     * there.
-     */
+    if (!strcasecmp(optionName, "-keepalive")) {
+	BOOL val = FALSE;
+	int boolVar, rtn;
 
-    AddSocketInfoFd(infoPtr, socket);
+	if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (boolVar) {
+	    val = TRUE;
+	}
+	rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
+		(const char *) &val, sizeof(BOOL));
+	if (rtn != 0) {
+	    TclWinConvertError(WSAGetLastError());
+	    if (interp) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"couldn't set socket option: %s",
+			Tcl_PosixError(interp)));
+	    }
+	    return TCL_ERROR;
+	}
+	return TCL_OK;
+    } else if (!strcasecmp(optionName, "-nagle")) {
+	BOOL val = FALSE;
+	int boolVar, rtn;
+
+	if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (!boolVar) {
+	    val = TRUE;
+	}
+	rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY,
+		(const char *) &val, sizeof(BOOL));
+	if (rtn != 0) {
+	    TclWinConvertError(WSAGetLastError());
+	    if (interp) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"couldn't set socket option: %s",
+			Tcl_PosixError(interp)));
+	    }
+	    return TCL_ERROR;
+	}
+	return TCL_OK;
+    }
 
-    return infoPtr;
+    return Tcl_BadChannelOption(interp, optionName, "keepalive nagle");
+#else
+    return Tcl_BadChannelOption(interp, optionName, "");
+#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * CreateClientSocket --
+ * TcpGetOptionProc --
  *
- *	This function opens a new socket in client mode.
+ *	Computes an option value for a TCP socket based channel, or a list of
+ *	all options and their values.
  *
- *	This might be called in 3 circumstances:
- *	-   By a regular socket command
- *	-   By the event handler to continue an asynchroneous connect
- *	-   By a blocking socket function (gets/puts) to terminate the
- *	    connect synchroneously
+ *	Note: This code is based on code contributed by John Haxby.
  *
  * Results:
- *      TCL_OK, if the socket was successfully connected or an asynchronous
- *      connection is in progress. If an error occurs, TCL_ERROR is returned
- *      and an error message is left in interp.
+ *	A standard Tcl result. The value of the specified option or a list of
+ *	all options and their values is returned in the supplied DString. Sets
+ *	Error message if needed.
  *
  * Side effects:
- *	Opens a socket.
- *
- * Remarks:
- *	A single host name may resolve to more than one IP address, e.g. for
- *	an IPv4/IPv6 dual stack host. For handling asyncronously connecting
- *	sockets in the background for such hosts, this function can act as a
- *	coroutine. On the first call, it sets up the control variables for the
- *	two nested loops over the local and remote addresses. Once the first
- *	connection attempt is in progress, it sets up itself as a writable
- *	event handler for that socket, and returns. When the callback occurs,
- *	control is transferred to the "reenter" label, right after the initial
- *	return and the loops resume as if they had never been interrupted.
- *	For syncronously connecting sockets, the loops work the usual way.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-CreateClientSocket(
-    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
-    SocketInfo *infoPtr)
+TcpGetOptionProc(
+    ClientData instanceData,	/* Socket state. */
+    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
+    const char *optionName,	/* Name of the option to retrieve the value
+				 * for, or NULL to get all options and their
+				 * values. */
+    Tcl_DString *dsPtr)		/* Where to store the computed value;
+				 * initialized by caller. */
 {
-    DWORD error;
-    u_long flag = 1;		/* Indicates nonblocking mode. */
+    TcpState *statePtr = instanceData;
+    char host[NI_MAXHOST], port[NI_MAXSERV];
+    SOCKET sock;
+    size_t len = 0;
+    int reverseDNS = 0;
+#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"
+
     /*
-     * We are started with async connect and the connect notification
-     * was not jet received
+     * Check that WinSock is initialized; do not call it if not, to prevent
+     * system crashes. This can happen at exit time if the exit handler for
+     * WinSock ran before other exit handlers that want to use sockets.
      */
-    int async_connect = infoPtr->flags & SOCKET_ASYNC_CONNECT;
-    /* We were called by the event procedure and continue our loop */
-    int async_callback = infoPtr->sockets->fd != INVALID_SOCKET;
-    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-    
-    DEBUG(async_connect ? "async connect" : "sync connect");
 
-    if (async_callback) {
-	DEBUG("subsequent call");
-        goto reenter;
-    } else {
-	DEBUG("first call");
+    if (!SocketsEnabled()) {
+	if (interp) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "winsock is not initialized", -1));
+	}
+	return TCL_ERROR;
     }
-    
-    for (infoPtr->addr = infoPtr->addrlist; infoPtr->addr != NULL;
-	 infoPtr->addr = infoPtr->addr->ai_next) {
-	
-        for (infoPtr->myaddr = infoPtr->myaddrlist; infoPtr->myaddr != NULL;
-	     infoPtr->myaddr = infoPtr->myaddr->ai_next) {
-
-	    DEBUG("inner loop");
-
-	    /*
-	     * No need to try combinations of local and remote addresses
-	     * of different families.
-	     */
-
-	    if (infoPtr->myaddr->ai_family != infoPtr->addr->ai_family) {
-		DEBUG("family mismatch");
-		continue;
-	    }
 
-	    DEBUG(infoPtr->myaddr->ai_family == AF_INET ? "IPv4" : "IPv6");
-	    printaddrinfo(infoPtr->myaddr, "~~ from");
-	    printaddrinfo(infoPtr->addr,   "~~   to");
+    sock = statePtr->sockets->fd;
+    if (optionName != NULL) {
+	len = strlen(optionName);
+    }
 
-            /*
-             * Close the socket if it is still open from the last unsuccessful
-             * iteration.
-             */	    
-	    if (infoPtr->sockets->fd != INVALID_SOCKET) {
-		DEBUG("closesocket");
-		closesocket(infoPtr->sockets->fd);
-	    }
+    if ((len > 1) && (optionName[1] == 'e') &&
+	    (strncmp(optionName, "-error", len) == 0)) {
 
-	    /* get infoPtr lock */
-	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	if ( (statePtr->flags & SOCKET_REENTER_PENDING) ) {
 
 	    /*
-	     * Reset last error from last try
+	     * Asyncroneous connect is running.
+	     * Process it one step without blocking.
+	     * Return its error or nothing if connect not
+	     * terminated.
 	     */
-	    infoPtr->lastError = 0;
-	    Tcl_SetErrno(0);
-	    
-	    infoPtr->sockets->fd = socket(infoPtr->myaddr->ai_family, SOCK_STREAM, 0);
-	    
-	    /* Free list lock */
-	    SetEvent(tsdPtr->socketListLock);
 
-	    /* continue on socket creation error */
-	    if (infoPtr->sockets->fd == INVALID_SOCKET) {
-		DEBUG("socket() failed");
-		TclWinConvertError((DWORD) WSAGetLastError());
-		continue;
+	    int errorCode;
+	    if (!WaitForConnect(statePtr, &errorCode, 0)
+		    && errorCode != EWOULDBLOCK) {
+		/* connect terminated with error */
+		Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errorCode), -1);
 	    }
-	    
-#ifdef DEBUGGING
-	    fprintf(stderr, "Client socket %d created\n", infoPtr->sockets->fd);
-#endif
-	    /*
-	     * Win-NT has a misfeature that sockets are inherited in child
-	     * processes by default. Turn off the inherit bit.
-	     */
 
-	    SetHandleInformation((HANDLE) infoPtr->sockets->fd, HANDLE_FLAG_INHERIT, 0);
+	} else {
+	    int optlen;
+	    int ret;
+    	    DWORD err;
 
 	    /*
-	     * Set kernel space buffering
+	     * Populater the err Variable with a possix error
 	     */
-
-	    TclSockMinimumBuffers((void *) infoPtr->sockets->fd, TCP_BUFFER_SIZE);
-
+	    optlen = sizeof(int);
+	    ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR,
+		    (char *)&err, &optlen);
 	    /*
-	     * Try to bind to a local port.
+	     * The error was not returned directly but should be
+	     * taken from WSA
 	     */
-
-	    if (bind(infoPtr->sockets->fd, infoPtr->myaddr->ai_addr,
-			infoPtr->myaddr->ai_addrlen) == SOCKET_ERROR) {
-		DEBUG("bind() failed");
-		TclWinConvertError((DWORD) WSAGetLastError());
-		continue;
+	    if (ret == SOCKET_ERROR) {
+		err = WSAGetLastError();
 	    }
 	    /*
-	     * For asyncroneous connect set the socket in nonblocking mode
-	     * and activate connect notification
+	     * Return error message
 	     */
-	    if (async_connect) {
-		SocketInfo *infoPtr2;
-		int in_socket_list = 0;
-		/* get infoPtr lock */
-		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	    if (err) {
+		TclWinConvertError(err);
+		Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
+	    }
+	}
+	return TCL_OK;
+    }
 
-		/*
-		 * Check if my infoPtr is already in the tsdPtr->socketList
-		 * It is set after this call by TcpThreadActionProc and is set
-		 * on a second round.
-		 *
-		 * If not, we buffer my infoPtr in the tsd memory so it is not
-		 * lost by the event procedure
-		 */
+    if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
+	reverseDNS = NI_NUMERICHOST;
+    }
 
-		for (infoPtr2 = tsdPtr->socketList; infoPtr2 != NULL;
-			infoPtr2 = infoPtr->nextPtr) {
-		    if (infoPtr2 == infoPtr) {
-			in_socket_list = 1;
-			break;
-		    }
-		}
-		if (!in_socket_list) {
-		    tsdPtr->pendingSocketInfo = infoPtr;
-		}
-		/*
-		 * Set connect mask to connect events
-		 * This is activated by a SOCKET_SELECT message to the notifier
-		 * thread.
-		 */
-		infoPtr->selectEvents |= FD_CONNECT;
-		
-		/*
-		 * Free list lock
-		 */
-		SetEvent(tsdPtr->socketListLock);
+    if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
+	    (strncmp(optionName, "-peername", len) == 0))) {
+	address peername;
+	socklen_t size = sizeof(peername);
 
-    		/* activate accept notification */
-		SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-			(LPARAM) infoPtr);
+	if (getpeername(sock, (LPSOCKADDR) &(peername.sa), &size) == 0) {
+	    if (len == 0) {
+		Tcl_DStringAppendElement(dsPtr, "-peername");
+		Tcl_DStringStartSublist(dsPtr);
 	    }
 
+	    getnameinfo(&(peername.sa), size, host, sizeof(host),
+		    NULL, 0, NI_NUMERICHOST);
+	    Tcl_DStringAppendElement(dsPtr, host);
+	    getnameinfo(&(peername.sa), size, host, sizeof(host),
+		    port, sizeof(port), reverseDNS | NI_NUMERICSERV);
+	    Tcl_DStringAppendElement(dsPtr, host);
+	    Tcl_DStringAppendElement(dsPtr, port);
+	    if (len == 0) {
+		Tcl_DStringEndSublist(dsPtr);
+	    } else {
+		return TCL_OK;
+	    }
+	} else {
 	    /*
-	     * Attempt to connect to the remote socket.
+	     * getpeername failed - but if we were asked for all the options
+	     * (len==0), don't flag an error at that point because it could be
+	     * an fconfigure request on a server socket (such sockets have no
+	     * peer). {Copied from unix/tclUnixChan.c}
 	     */
-	    
-	    DEBUG("connect()");
-	    connect(infoPtr->sockets->fd, infoPtr->addr->ai_addr,
-		    infoPtr->addr->ai_addrlen);
-
-	    error = WSAGetLastError();
-	    TclWinConvertError(error);
 
-	    if (async_connect && error == WSAEWOULDBLOCK) {
-		/*
-		 * Asynchroneous connect
-		 */
-		DEBUG("WSAEWOULDBLOCK");
+	    if (len) {
+		TclWinConvertError((DWORD) WSAGetLastError());
+		if (interp) {
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "can't get peername: %s",
+			    Tcl_PosixError(interp)));
+		}
+		return TCL_ERROR;
+	    }
+	}
+    }
 
+    if ((len == 0) || ((len > 1) && (optionName[1] == 's') &&
+	    (strncmp(optionName, "-sockname", len) == 0))) {
+	TcpFdList *fds;
+	address sockname;
+	socklen_t size;
+	int found = 0;
 
-		/*
-		 * Remember that we jump back behind this next round
-		 */
-		infoPtr->flags |= SOCKET_REENTER_PENDING;
-		return TCL_OK;
+	if (len == 0) {
+	    Tcl_DStringAppendElement(dsPtr, "-sockname");
+	    Tcl_DStringStartSublist(dsPtr);
+	}
+	for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
+	    sock = fds->fd;
+#ifdef DEBUGGING
+	    fprintf(stderr, "sock == %d\n", sock);
+#endif
+	    size = sizeof(sockname);
+	    if (getsockname(sock, &(sockname.sa), &size) >= 0) {
+		int flags = reverseDNS;
+
+		found = 1;
+		getnameinfo(&sockname.sa, size, host, sizeof(host),
+			NULL, 0, NI_NUMERICHOST);
+		Tcl_DStringAppendElement(dsPtr, host);
 
-	    reenter:
-		DEBUG("reenter");
 		/*
-		 * Re-entry point for async connect after connect event or
-		 * blocking operation
-		 *
-		 * Clear the reenter flag
+		 * We don't want to resolve INADDR_ANY and sin6addr_any; they
+		 * can sometimes cause problems (and never have a name).
 		 */
-		infoPtr->flags &= ~(SOCKET_REENTER_PENDING);
-		/* get infoPtr lock */
-		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-		/* Get signaled connect error */
-		Tcl_SetErrno(infoPtr->lastError);
-		/* Clear eventual connect flag */
-		infoPtr->selectEvents &= ~(FD_CONNECT);
-		/* Free list lock */
-		SetEvent(tsdPtr->socketListLock);
+		flags |= NI_NUMERICSERV;
+		if (sockname.sa.sa_family == AF_INET) {
+		    if (sockname.sa4.sin_addr.s_addr == INADDR_ANY) {
+			flags |= NI_NUMERICHOST;
+		    }
+		} else if (sockname.sa.sa_family == AF_INET6) {
+		    if ((IN6_ARE_ADDR_EQUAL(&sockname.sa6.sin6_addr,
+				&in6addr_any)) ||
+			    (IN6_IS_ADDR_V4MAPPED(&sockname.sa6.sin6_addr)
+			    && sockname.sa6.sin6_addr.s6_addr[12] == 0
+			    && sockname.sa6.sin6_addr.s6_addr[13] == 0
+			    && sockname.sa6.sin6_addr.s6_addr[14] == 0
+			    && sockname.sa6.sin6_addr.s6_addr[15] == 0)) {
+			flags |= NI_NUMERICHOST;
+		    }
+		}
+		getnameinfo(&sockname.sa, size, host, sizeof(host),
+			port, sizeof(port), flags);
+		Tcl_DStringAppendElement(dsPtr, host);
+		Tcl_DStringAppendElement(dsPtr, port);
 	    }
-#ifdef DEBUGGING
-	    fprintf(stderr, "lastError: %d\n", Tcl_GetErrno());
-#endif
-	    /*
-	     * Clear the tsd socket list pointer if we did not wait for
-	     * the FD_CONNECT asyncroneously
-	     */
-	    tsdPtr->pendingSocketInfo = NULL;
-	    
-	    if (Tcl_GetErrno() == 0) {
-		goto out;
+	}
+	if (found) {
+	    if (len == 0) {
+		Tcl_DStringEndSublist(dsPtr);
+	    } else {
+		return TCL_OK;
 	    }
+	} else {
+	    if (interp) {
+		TclWinConvertError((DWORD) WSAGetLastError());
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"can't get sockname: %s", Tcl_PosixError(interp)));
+	    }
+	    return TCL_ERROR;
 	}
     }
 
-out:
-    /*
-     * Socket connected or connection failed
-     */
-    DEBUG("connected or finally failed");
-    /* Clear async flag (not really necessary, not used any more) */
-    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
+    if (len == 0 || !strncmp(optionName, "-keepalive", len)) {
+	int optlen;
+	BOOL opt = FALSE;
 
-    /*
-     * Final connect failure
-     */
+	if (len == 0) {
+	    Tcl_DStringAppendElement(dsPtr, "-keepalive");
+	}
+	optlen = sizeof(BOOL);
+	getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&opt, &optlen);
+	if (opt) {
+	    Tcl_DStringAppendElement(dsPtr, "1");
+	} else {
+	    Tcl_DStringAppendElement(dsPtr, "0");
+	}
+	if (len > 0) {
+	    return TCL_OK;
+	}
+    }
 
-    if ( Tcl_GetErrno() == 0 ) {
-	/*
-	 * Succesfully connected
-	 */
-	/*
-	 * Set up the select mask for read/write events.
-	 */
-	DEBUG("selectEvents = FD_READ | FD_WRITE | FD_CLOSE");    
-	infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
-        
-	/*
-	 * Register for interest in events in the select mask. Note that this
-	 * automatically places the socket into non-blocking mode.
-	 */
-        
-	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-		    (LPARAM) infoPtr);
-    } else {
-	/*
-	 * Connect failed
-	 */
-	DEBUG("ERRNO");
+    if (len == 0 || !strncmp(optionName, "-nagle", len)) {
+	int optlen;
+	BOOL opt = FALSE;
 
-	/*
-	 * For async connect schedule a writable event to report the fail.
-	 */
-	if (async_callback) {
-	    /*
-	     * Set up the select mask for read/write events.
-	     */
-	    DEBUG("selectEvents = FD_WRITE for fail writable");    
-	    infoPtr->selectEvents = FD_WRITE;
-	    /* get infoPtr lock */
-	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-	    /* Clear eventual connect flag */
-	    infoPtr->readyEvents |= FD_WRITE;
-	    /* Free list lock */
-	    SetEvent(tsdPtr->socketListLock);
+	if (len == 0) {
+	    Tcl_DStringAppendElement(dsPtr, "-nagle");
 	}
-	/*
-	 * Error message on syncroneous connect
-	 */
-	if (interp != NULL) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "couldn't open socket: %s", Tcl_PosixError(interp)));
+	optlen = sizeof(BOOL);
+	getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt, &optlen);
+	if (opt) {
+	    Tcl_DStringAppendElement(dsPtr, "0");
+	} else {
+	    Tcl_DStringAppendElement(dsPtr, "1");
 	}
-	return TCL_ERROR;
+	if (len > 0) {
+	    return TCL_OK;
+	}
+    }
+#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
+
+    if (len > 0) {
+#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
+	return Tcl_BadChannelOption(interp, optionName,
+		"peername sockname keepalive nagle");
+#else
+	return Tcl_BadChannelOption(interp, optionName, "peername sockname");
+#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
     }
+
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * WaitForConnect --
- *
- *	Process an asyncroneous connect by other commands (gets... ).
- *	Do one connect step if pending as if the event loop would run.
- *
- *	Blocking commands may call in with terminate_connect to terminate
- *	the syncroneous connect syncroneously.
+ * TcpWatchProc --
  *
- *	This routine should only be called if flag SOCKET_REENTER_PENDING
- *	is set.
+ *	Informs the channel driver of the events that the generic channel code
+ *	wishes to receive on this socket.
  *
  * Results:
- *	Returns 1 on success or 0 on failure, with a possix error code in
- *	errorCodePtr.
- *	If the connect is not terminated, errorCode is set to EWOULDBLOCK
- *	and 0 is returned.
+ *	None.
  *
  * Side effects:
- *	Processes socket events off the system queue.
- *	May process asynchroneous connect.
+ *	May cause the notifier to poll if any of the specified conditions are
+ *	already true.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-WaitForConnect(
-    SocketInfo *infoPtr,	/* Information about this socket. */
-    int *errorCodePtr,		/* Where to store errors? */
-    int terminate_connect)	/* Should the connect be terminated? */
+static void
+TcpWatchProc(
+    ClientData instanceData,	/* The socket state. */
+    int mask)			/* Events of interest; an OR-ed combination of
+				 * TCL_READABLE, TCL_WRITABLE and
+				 * TCL_EXCEPTION. */
 {
-    int result;
-    int oldMode;
-    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+    TcpState *statePtr = instanceData;
+
+    DEBUG((mask & TCL_READABLE) ? "+r":"-r");
+    DEBUG((mask & TCL_WRITABLE) ? "+w":"-w");
 
     /*
-     * Be sure to disable event servicing so we are truly modal.
+     * Update the watch events mask. Only if the socket is not a server
+     * socket. [Bug 557878]
      */
 
-    oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
-
-    while (1) {
-	
-	/* get infoPtr lock */
-        WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-	
-	/* Check for connect event */
-	if (infoPtr->readyEvents & FD_CONNECT) {
-
-	    /* Consume the connect event */
-	    infoPtr->readyEvents &= ~(FD_CONNECT);
-
-	    /*
-	     * For blocking sockets disable async connect
-	     * as we continue now synchoneously
-	     */
-	    if ( terminate_connect ) {
-		infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
-	    }
-
-            /* Free list lock */
-            SetEvent(tsdPtr->socketListLock);
+    if (!statePtr->acceptProc) {
+	statePtr->watchEvents = 0;
+	if (mask & TCL_READABLE) {
+	    statePtr->watchEvents |= (FD_READ|FD_CLOSE);
+	}
+	if (mask & TCL_WRITABLE) {
+	    statePtr->watchEvents |= (FD_WRITE|FD_CLOSE);
+	}
 
-	    /* continue connect */
-	    result = CreateClientSocket(NULL, infoPtr);
+	/*
+	 * If there are any conditions already set, then tell the notifier to
+	 * poll rather than block.
+	 */
 
-	    /* Restore event service mode */
-	    (void) Tcl_SetServiceMode(oldMode);
+	if (statePtr->readyEvents & statePtr->watchEvents) {
+	    Tcl_Time blockTime = { 0, 0 };
 
-	    /* Succesfully connected or async connect restarted */
-	    if (result == TCL_OK) {
-		if ( infoPtr->flags & SOCKET_REENTER_PENDING ) {
-		    *errorCodePtr = EWOULDBLOCK;
-		    return 0;
-		}
-		return 1;
-	    }
-	    /* error case */
-	    *errorCodePtr = Tcl_GetErrno();
-	    return 0;
-	}
-
-        /* Free list lock */
-        SetEvent(tsdPtr->socketListLock);
-
-	/*
-	 * A non blocking socket waiting for an asyncronous connect
-	 * returns directly an error
-	 */
-	if ( ! terminate_connect ) {
-	    *errorCodePtr = EWOULDBLOCK;
-	    return 0;
+	    Tcl_SetMaxBlockTime(&blockTime);
 	}
-
-	/*
-	 * Wait until something happens.
-	 */
-
-	WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
     }
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * WaitForSocketEvent --
+ * TcpGetHandleProc --
  *
- *	Waits until one of the specified events occurs on a socket.
+ *	Called from Tcl_GetChannelHandle to retrieve OS handles from inside a
+ *	TCP socket based channel.
  *
  * Results:
- *	Returns 1 on success or 0 on failure, with an error code in
- *	errorCodePtr.
+ *	Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no
+ *	handle for the specified direction.
  *
  * Side effects:
- *	Processes socket events off the system queue.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 static int
-WaitForSocketEvent(
-    SocketInfo *infoPtr,	/* Information about this socket. */
-    int events,			/* Events to look for. */
-    int *errorCodePtr)		/* Where to store errors? */
+TcpGetHandleProc(
+    ClientData instanceData,	/* The socket state. */
+    int direction,		/* Not used. */
+    ClientData *handlePtr)	/* Where to store the handle. */
 {
-    int result = 1;
-    int oldMode;
-    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-    /*
-     * Be sure to disable event servicing so we are truly modal.
-     */
-    DEBUG("=============");
-
-    oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
-
-    /*
-     * Reset WSAAsyncSelect so we have a fresh set of events pending.
-     */
-
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT,
-	    (LPARAM) infoPtr);
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-	    (LPARAM) infoPtr);
-
-    while (1) {
-	if (infoPtr->lastError) {
-	    *errorCodePtr = infoPtr->lastError;
-	    result = 0;
-	    break;
-	} else if (infoPtr->readyEvents & events) {
-	    break;
-	} else if (infoPtr->flags & TCP_ASYNC_SOCKET) {
-	    *errorCodePtr = EWOULDBLOCK;
-	    result = 0;
-	    break;
-	}
+    TcpState *statePtr = instanceData;
 
-	/*
-	 * Wait until something happens.
-	 */
+    *handlePtr = INT2PTR(statePtr->sockets->fd);
+    return TCL_OK;
+}
 
-	WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
-    }
 
-    (void) Tcl_SetServiceMode(oldMode);
-    return result;
-}
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_OpenTcpClient --
+ * CreateClientSocket --
  *
- *	Opens a TCP client socket and creates a channel around it.
+ *	This function opens a new socket in client mode.
+ *
+ *	This might be called in 3 circumstances:
+ *	-   By a regular socket command
+ *	-   By the event handler to continue an asynchroneous connect
+ *	-   By a blocking socket function (gets/puts) to terminate the
+ *	    connect synchroneously
  *
  * Results:
- *	The channel or NULL if failed. An error message is returned in the
- *	interpreter on failure.
+ *      TCL_OK, if the socket was successfully connected or an asynchronous
+ *      connection is in progress. If an error occurs, TCL_ERROR is returned
+ *      and an error message is left in interp.
  *
  * Side effects:
- *	Opens a client socket and creates a new channel.
+ *	Opens a socket.
+ *
+ * Remarks:
+ *	A single host name may resolve to more than one IP address, e.g. for
+ *	an IPv4/IPv6 dual stack host. For handling asyncronously connecting
+ *	sockets in the background for such hosts, this function can act as a
+ *	coroutine. On the first call, it sets up the control variables for the
+ *	two nested loops over the local and remote addresses. Once the first
+ *	connection attempt is in progress, it sets up itself as a writable
+ *	event handler for that socket, and returns. When the callback occurs,
+ *	control is transferred to the "reenter" label, right after the initial
+ *	return and the loops resume as if they had never been interrupted.
+ *	For syncronously connecting sockets, the loops work the usual way.
  *
  *----------------------------------------------------------------------
  */
 
-Tcl_Channel
-Tcl_OpenTcpClient(
+static int
+CreateClientSocket(
     Tcl_Interp *interp,		/* For error reporting; can be NULL. */
-    int port,			/* Port number to open. */
-    const char *host,		/* Host on which to open port. */
-    const char *myaddr,		/* Client-side address */
-    int myport,			/* Client-side port */
-    int async)			/* If nonzero, should connect client socket
-				 * asynchronously. */
+    TcpState *statePtr)
 {
-    SocketInfo *infoPtr;
-    const char *errorMsg = NULL;
-    struct addrinfo *addrlist = NULL;
-    struct addrinfo *myaddrlist = NULL;
-    char channelName[SOCK_CHAN_LENGTH];
-
-    if (TclpHasSockets(interp) != TCL_OK) {
-	return NULL;
-    }
-
+    DWORD error;
+    u_long flag = 1;		/* Indicates nonblocking mode. */
     /*
-     * Check that WinSock is initialized; do not call it if not, to prevent
-     * system crashes. This can happen at exit time if the exit handler for
-     * WinSock ran before other exit handlers that want to use sockets.
+     * We are started with async connect and the connect notification
+     * was not jet received
      */
+    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;
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+    
+    DEBUG(async_connect ? "async connect" : "sync connect");
 
-    if (!SocketsEnabled()) {
-	return NULL;
+    if (async_callback) {
+	DEBUG("subsequent call");
+        goto reenter;
+    } else {
+	DEBUG("first call");
     }
+    
+    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) {
 
-    /*
-     * Do the name lookups for the local and remote addresses.
-     */
+	    DEBUG("inner loop");
 
-    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg)
-            || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
-                    &errorMsg)) {
-        if (addrlist != NULL) {
-            freeaddrinfo(addrlist);
-        }
-        if (interp != NULL) {
-            Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                    "couldn't open socket: %s", errorMsg));
-        }
-        return NULL;
-    }
-    printaddrinfolist(myaddrlist, "local");
-    printaddrinfolist(addrlist, "remote");
+	    /*
+	     * No need to try combinations of local and remote addresses
+	     * of different families.
+	     */
 
-    infoPtr = NewSocketInfo(INVALID_SOCKET);
-    infoPtr->addrlist = addrlist;
-    infoPtr->myaddrlist = myaddrlist;
-    if (async) {
-	infoPtr->flags |= SOCKET_ASYNC_CONNECT;
-    }
+	    if (statePtr->myaddr->ai_family != statePtr->addr->ai_family) {
+		DEBUG("family mismatch");
+		continue;
+	    }
 
-    /*
-     * Create a new client socket and wrap it in a channel.
-     */
-    DEBUG("");
-    if (CreateClientSocket(interp, infoPtr) != TCL_OK) {
-	TcpCloseProc(infoPtr, NULL);
-	return NULL;
-    }
+	    DEBUG(statePtr->myaddr->ai_family == AF_INET ? "IPv4" : "IPv6");
+	    printaddrinfo(statePtr->myaddr, "~~ from");
+	    printaddrinfo(statePtr->addr,   "~~   to");
 
-    sprintf(channelName, SOCK_TEMPLATE, infoPtr);
+            /*
+             * Close the socket if it is still open from the last unsuccessful
+             * iteration.
+             */	    
+	    if (statePtr->sockets->fd != INVALID_SOCKET) {
+		DEBUG("closesocket");
+		closesocket(statePtr->sockets->fd);
+	    }
 
-    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
-	    infoPtr, (TCL_READABLE | TCL_WRITABLE));
-    if (TCL_ERROR == Tcl_SetChannelOption(NULL, infoPtr->channel,
-	    "-translation", "auto crlf")) {
-	Tcl_Close(NULL, infoPtr->channel);
-	return NULL;
-    } else if (TCL_ERROR == Tcl_SetChannelOption(NULL, infoPtr->channel,
-	    "-eofchar", "")) {
-	Tcl_Close(NULL, infoPtr->channel);
-	return NULL;
-    }
-    return infoPtr->channel;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_MakeTcpClientChannel --
- *
- *	Creates a Tcl_Channel from an existing client TCP socket.
- *
- * Results:
- *	The Tcl_Channel wrapped around the preexisting TCP socket.
- *
- * Side effects:
- *	None.
- *
- * NOTE: Code contributed by Mark Diekhans (markd@grizzly.com)
- *
- *----------------------------------------------------------------------
- */
+	    /* get statePtr lock */
+	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 
-Tcl_Channel
-Tcl_MakeTcpClientChannel(
-    ClientData sock)		/* The socket to wrap up into a channel. */
-{
-    SocketInfo *infoPtr;
-    char channelName[SOCK_CHAN_LENGTH];
-    ThreadSpecificData *tsdPtr;
+	    /*
+	     * Reset last error from last try
+	     */
+	    statePtr->lastError = 0;
+	    Tcl_SetErrno(0);
+	    
+	    statePtr->sockets->fd = socket(statePtr->myaddr->ai_family, SOCK_STREAM, 0);
+	    
+	    /* Free list lock */
+	    SetEvent(tsdPtr->socketListLock);
 
-    if (TclpHasSockets(NULL) != TCL_OK) {
-	return NULL;
-    }
+	    /* continue on socket creation error */
+	    if (statePtr->sockets->fd == INVALID_SOCKET) {
+		DEBUG("socket() failed");
+		TclWinConvertError((DWORD) WSAGetLastError());
+		continue;
+	    }
+	    
+#ifdef DEBUGGING
+	    fprintf(stderr, "Client socket %d created\n", statePtr->sockets->fd);
+#endif
+	    /*
+	     * Win-NT has a misfeature that sockets are inherited in child
+	     * processes by default. Turn off the inherit bit.
+	     */
 
-    tsdPtr = TclThreadDataKeyGet(&dataKey);
+	    SetHandleInformation((HANDLE) statePtr->sockets->fd, HANDLE_FLAG_INHERIT, 0);
 
-    /*
-     * Set kernel space buffering and non-blocking.
-     */
+	    /*
+	     * Set kernel space buffering
+	     */
 
-    TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE);
+	    TclSockMinimumBuffers((void *) statePtr->sockets->fd, TCP_BUFFER_SIZE);
 
-    infoPtr = NewSocketInfo((SOCKET) sock);
+	    /*
+	     * Try to bind to a local port.
+	     */
 
-    /*
-     * Start watching for read/write events on the socket.
-     */
+	    if (bind(statePtr->sockets->fd, statePtr->myaddr->ai_addr,
+			statePtr->myaddr->ai_addrlen) == SOCKET_ERROR) {
+		DEBUG("bind() failed");
+		TclWinConvertError((DWORD) WSAGetLastError());
+		continue;
+	    }
+	    /*
+	     * For asyncroneous connect set the socket in nonblocking mode
+	     * and activate connect notification
+	     */
+	    if (async_connect) {
+		TcpState *statePtr2;
+		int in_socket_list = 0;
+		/* get statePtr lock */
+		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 
-    infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr);
+		/*
+		 * Check if my statePtr is already in the tsdPtr->socketList
+		 * It is set after this call by TcpThreadActionProc and is set
+		 * on a second round.
+		 *
+		 * If not, we buffer my statePtr in the tsd memory so it is not
+		 * lost by the event procedure
+		 */
+
+		for (statePtr2 = tsdPtr->socketList; statePtr2 != NULL;
+			statePtr2 = statePtr->nextPtr) {
+		    if (statePtr2 == statePtr) {
+			in_socket_list = 1;
+			break;
+		    }
+		}
+		if (!in_socket_list) {
+		    tsdPtr->pendingTcpState = statePtr;
+		}
+		/*
+		 * Set connect mask to connect events
+		 * This is activated by a SOCKET_SELECT message to the notifier
+		 * thread.
+		 */
+		statePtr->selectEvents |= FD_CONNECT;
+		
+		/*
+		 * Free list lock
+		 */
+		SetEvent(tsdPtr->socketListLock);
+
+    		/* activate accept notification */
+		SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+			(LPARAM) statePtr);
+	    }
+
+	    /*
+	     * Attempt to connect to the remote socket.
+	     */
+	    
+	    DEBUG("connect()");
+	    connect(statePtr->sockets->fd, statePtr->addr->ai_addr,
+		    statePtr->addr->ai_addrlen);
+
+	    error = WSAGetLastError();
+	    TclWinConvertError(error);
+
+	    if (async_connect && error == WSAEWOULDBLOCK) {
+		/*
+		 * Asynchroneous connect
+		 */
+		DEBUG("WSAEWOULDBLOCK");
+
+
+		/*
+		 * Remember that we jump back behind this next round
+		 */
+		statePtr->flags |= SOCKET_REENTER_PENDING;
+		return TCL_OK;
+
+	    reenter:
+		DEBUG("reenter");
+		/*
+		 * Re-entry point for async connect after connect event or
+		 * blocking operation
+		 *
+		 * Clear the reenter flag
+		 */
+		statePtr->flags &= ~(SOCKET_REENTER_PENDING);
+		/* get statePtr lock */
+		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+		/* Get signaled connect error */
+		Tcl_SetErrno(statePtr->lastError);
+		/* Clear eventual connect flag */
+		statePtr->selectEvents &= ~(FD_CONNECT);
+		/* Free list lock */
+		SetEvent(tsdPtr->socketListLock);
+	    }
+#ifdef DEBUGGING
+	    fprintf(stderr, "lastError: %d\n", Tcl_GetErrno());
+#endif
+	    /*
+	     * Clear the tsd socket list pointer if we did not wait for
+	     * the FD_CONNECT asyncroneously
+	     */
+	    tsdPtr->pendingTcpState = NULL;
+	    
+	    if (Tcl_GetErrno() == 0) {
+		goto out;
+	    }
+	}
+    }
+
+out:
+    /*
+     * Socket connected or connection failed
+     */
+    DEBUG("connected or finally failed");
+    /* Clear async flag (not really necessary, not used any more) */
+    statePtr->flags &= ~(TCP_ASYNC_CONNECT);
+
+    /*
+     * Final connect failure
+     */
+
+    if ( Tcl_GetErrno() == 0 ) {
+	/*
+	 * Succesfully connected
+	 */
+	/*
+	 * Set up the select mask for read/write events.
+	 */
+	DEBUG("selectEvents = FD_READ | FD_WRITE | FD_CLOSE");    
+	statePtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
+        
+	/*
+	 * Register for interest in events in the select mask. Note that this
+	 * automatically places the socket into non-blocking mode.
+	 */
+        
+	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+		    (LPARAM) statePtr);
+    } else {
+	/*
+	 * Connect failed
+	 */
+	DEBUG("ERRNO");
 
-    sprintf(channelName, SOCK_TEMPLATE, infoPtr);
-    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
-	    infoPtr, (TCL_READABLE | TCL_WRITABLE));
-    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
-    return infoPtr->channel;
+	/*
+	 * For async connect schedule a writable event to report the fail.
+	 */
+	if (async_callback) {
+	    /*
+	     * Set up the select mask for read/write events.
+	     */
+	    DEBUG("selectEvents = FD_WRITE for fail writable");    
+	    statePtr->selectEvents = FD_WRITE;
+	    /* get statePtr lock */
+	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	    /* Clear eventual connect flag */
+	    statePtr->readyEvents |= FD_WRITE;
+	    /* Free list lock */
+	    SetEvent(tsdPtr->socketListLock);
+	}
+	/*
+	 * Error message on syncroneous connect
+	 */
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "couldn't open socket: %s", Tcl_PosixError(interp)));
+	}
+	return TCL_ERROR;
+    }
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_OpenTcpServer --
+ * Tcl_OpenTcpClient --
  *
- *	Opens a TCP server socket and creates a channel around it.
+ *	Opens a TCP client socket and creates a channel around it.
  *
  * Results:
  *	The channel or NULL if failed. An error message is returned in the
  *	interpreter on failure.
  *
  * Side effects:
- *	Opens a server socket and creates a new channel.
+ *	Opens a client socket and creates a new channel.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Channel
-Tcl_OpenTcpServer(
-    Tcl_Interp *interp,		/* For error reporting - may be NULL. */
+Tcl_OpenTcpClient(
+    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
     int port,			/* Port number to open. */
-    const char *host,		/* Name of local host. */
-    Tcl_TcpAcceptProc *acceptProc,
-				/* Callback for accepting connections from new
-				 * clients. */
-    ClientData acceptProcData)	/* Data for the callback. */
+    const char *host,		/* Host on which to open port. */
+    const char *myaddr,		/* Client-side address */
+    int myport,			/* Client-side port */
+    int async)			/* If nonzero, attempt to do an asynchronous
+				 * connect. Otherwise we do a blocking
+				 * connect. */
 {
-    SOCKET sock = INVALID_SOCKET;
-    unsigned short chosenport = 0;
-    struct addrinfo *addrPtr;	/* Socket address to listen on. */
-    SocketInfo *infoPtr = NULL;	/* The returned value. */
-    struct addrinfo *addrlist = NULL;
-    char channelName[SOCK_CHAN_LENGTH];
-    u_long flag = 1;		/* Indicates nonblocking mode. */
+    TcpState *statePtr;
     const char *errorMsg = NULL;
-    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+    struct addrinfo *addrlist = NULL, *myaddrlist = NULL;
+    char channelName[SOCK_CHAN_LENGTH];
 
     if (TclpHasSockets(interp) != TCL_OK) {
 	return NULL;
@@ -1830,116 +1855,270 @@ Tcl_OpenTcpServer(
     }
 
     /*
-     * Construct the addresses for each end of the socket.
+     * Do the name lookups for the local and remote addresses.
      */
 
-    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 1, &errorMsg)) {
-	goto error;
+    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg)
+            || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
+                    &errorMsg)) {
+        if (addrlist != NULL) {
+            freeaddrinfo(addrlist);
+        }
+        if (interp != NULL) {
+            Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                    "couldn't open socket: %s", errorMsg));
+        }
+        return NULL;
     }
+    printaddrinfolist(myaddrlist, "local");
+    printaddrinfolist(addrlist, "remote");
 
-    for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
-	sock = socket(addrPtr->ai_family, addrPtr->ai_socktype,
-                addrPtr->ai_protocol);
-	if (sock == INVALID_SOCKET) {
-	    TclWinConvertError((DWORD) WSAGetLastError());
-	    continue;
-	}
-	
-	/*
-	 * Win-NT has a misfeature that sockets are inherited in child
-	 * processes by default. Turn off the inherit bit.
-	 */
-	
-	SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);
-	
-	/*
-	 * Set kernel space buffering
-	 */
-	
-	TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE);
-	
-	/*
-	 * Make sure we use the same port when opening two server sockets
-	 * for IPv4 and IPv6.
-	 *
-	 * As sockaddr_in6 uses the same offset and size for the port
-	 * member as sockaddr_in, we can handle both through the IPv4 API.
-	 */
-	
-	if (port == 0 && chosenport != 0) {
-	    ((struct sockaddr_in *) addrPtr->ai_addr)->sin_port =
-		htons(chosenport);
-	}
-	
-	/*
-	 * Bind to the specified port. Note that we must not call
-	 * setsockopt with SO_REUSEADDR because Microsoft allows addresses
-	 * to be reused even if they are still in use.
-	 *
-	 * Bind should not be affected by the socket having already been
-	 * set into nonblocking mode. If there is trouble, this is one
-	 * place to look for bugs.
-	 */
-	
-	if (bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
-	    == SOCKET_ERROR) {
-	    TclWinConvertError((DWORD) WSAGetLastError());
-	    closesocket(sock);
-	    continue;
-	}
-	if (port == 0 && chosenport == 0) {
-	    address sockname;
-	    socklen_t namelen = sizeof(sockname);
-	    
-	    /*
-	     * Synchronize port numbers when binding to port 0 of multiple
-	     * addresses.
-	     */
-	    
-	    if (getsockname(sock, &sockname.sa, &namelen) >= 0) {
-		chosenport = ntohs(sockname.sa4.sin_port);
-	    }
-	}
-	
-	/*
-	 * Set the maximum number of pending connect requests to the max
-	 * value allowed on each platform (Win32 and Win32s may be
-	 * different, and there may be differences between TCP/IP stacks).
-	 */
-	
-	if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
-	    TclWinConvertError((DWORD) WSAGetLastError());
-	    closesocket(sock);
-	    continue;
-	}
-	
-	if (infoPtr == NULL) {
-	    /*
-	     * Add this socket to the global list of sockets.
-	     */
-	    infoPtr = NewSocketInfo(sock);
-	} else {
-	    AddSocketInfoFd( infoPtr, sock );
-	}
+    statePtr = NewSocketInfo(INVALID_SOCKET);
+    statePtr->addrlist = addrlist;
+    statePtr->myaddrlist = myaddrlist;
+    if (async) {
+	statePtr->flags |= TCP_ASYNC_CONNECT;
     }
 
-error:
-     if (addrlist != NULL) {
-	freeaddrinfo(addrlist);
+    /*
+     * Create a new client socket and wrap it in a channel.
+     */
+    DEBUG("");
+    if (CreateClientSocket(interp, statePtr) != TCL_OK) {
+	TcpCloseProc(statePtr, NULL);
+	return NULL;
+    }
+
+    sprintf(channelName, SOCK_TEMPLATE, statePtr);
+
+    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+	    statePtr, (TCL_READABLE | TCL_WRITABLE));
+    if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel,
+	    "-translation", "auto crlf")) {
+	Tcl_Close(NULL, statePtr->channel);
+	return NULL;
+    } else if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel,
+	    "-eofchar", "")) {
+	Tcl_Close(NULL, statePtr->channel);
+	return NULL;
+    }
+    return statePtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MakeTcpClientChannel --
+ *
+ *	Creates a Tcl_Channel from an existing client TCP socket.
+ *
+ * Results:
+ *	The Tcl_Channel wrapped around the preexisting TCP socket.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_MakeTcpClientChannel(
+    ClientData sock)		/* The socket to wrap up into a channel. */
+{
+    TcpState *statePtr;
+    char channelName[SOCK_CHAN_LENGTH];
+    ThreadSpecificData *tsdPtr;
+
+    if (TclpHasSockets(NULL) != TCL_OK) {
+	return NULL;
+    }
+
+    tsdPtr = TclThreadDataKeyGet(&dataKey);
+
+    /*
+     * Set kernel space buffering and non-blocking.
+     */
+
+    TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE);
+
+    statePtr = NewSocketInfo((SOCKET) sock);
+
+    /*
+     * Start watching for read/write events on the socket.
+     */
+
+    statePtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
+    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr);
+
+    sprintf(channelName, SOCK_TEMPLATE, statePtr);
+    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+	    statePtr, (TCL_READABLE | TCL_WRITABLE));
+    Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf");
+    return statePtr->channel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OpenTcpServer --
+ *
+ *	Opens a TCP server socket and creates a channel around it.
+ *
+ * Results:
+ *	The channel or NULL if failed. If an error occurred, an error message
+ *	is left in the interp's result if interp is not NULL.
+ *
+ * Side effects:
+ *	Opens a server socket and creates a new channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_OpenTcpServer(
+    Tcl_Interp *interp,		/* For error reporting - may be NULL. */
+    int port,			/* Port number to open. */
+    const char *myHost,		/* Name of local host. */
+    Tcl_TcpAcceptProc *acceptProc,
+				/* Callback for accepting connections from new
+				 * clients. */
+    ClientData acceptProcData)	/* Data for the callback. */
+{
+    SOCKET sock = INVALID_SOCKET;
+    unsigned short chosenport = 0;
+    struct addrinfo *addrlist = NULL;
+    struct addrinfo *addrPtr;	/* Socket address to listen on. */
+    TcpState *statePtr = NULL;	/* The returned value. */
+    char channelName[SOCK_CHAN_LENGTH];
+    u_long flag = 1;		/* Indicates nonblocking mode. */
+    const char *errorMsg = NULL;
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+
+    if (TclpHasSockets(interp) != TCL_OK) {
+	return NULL;
+    }
+
+    /*
+     * Check that WinSock is initialized; do not call it if not, to prevent
+     * system crashes. This can happen at exit time if the exit handler for
+     * WinSock ran before other exit handlers that want to use sockets.
+     */
+
+    if (!SocketsEnabled()) {
+	return NULL;
+    }
+
+    /*
+     * Construct the addresses for each end of the socket.
+     */
+
+    if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, &errorMsg)) {
+	goto error;
+    }
+
+    for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
+	sock = socket(addrPtr->ai_family, addrPtr->ai_socktype,
+                addrPtr->ai_protocol);
+	if (sock == INVALID_SOCKET) {
+	    TclWinConvertError((DWORD) WSAGetLastError());
+	    continue;
+	}
+	
+	/*
+	 * Win-NT has a misfeature that sockets are inherited in child
+	 * processes by default. Turn off the inherit bit.
+	 */
+	
+	SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);
+	
+	/*
+	 * Set kernel space buffering
+	 */
+	
+	TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE);
+	
+	/*
+	 * Make sure we use the same port when opening two server sockets
+	 * for IPv4 and IPv6.
+	 *
+	 * As sockaddr_in6 uses the same offset and size for the port
+	 * member as sockaddr_in, we can handle both through the IPv4 API.
+	 */
+	
+	if (port == 0 && chosenport != 0) {
+	    ((struct sockaddr_in *) addrPtr->ai_addr)->sin_port =
+		htons(chosenport);
+	}
+	
+	/*
+	 * Bind to the specified port. Note that we must not call
+	 * setsockopt with SO_REUSEADDR because Microsoft allows addresses
+	 * to be reused even if they are still in use.
+	 *
+	 * Bind should not be affected by the socket having already been
+	 * set into nonblocking mode. If there is trouble, this is one
+	 * place to look for bugs.
+	 */
+	
+	if (bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
+	    == SOCKET_ERROR) {
+	    TclWinConvertError((DWORD) WSAGetLastError());
+	    closesocket(sock);
+	    continue;
+	}
+	if (port == 0 && chosenport == 0) {
+	    address sockname;
+	    socklen_t namelen = sizeof(sockname);
+	    
+	    /*
+	     * Synchronize port numbers when binding to port 0 of multiple
+	     * addresses.
+	     */
+	    
+	    if (getsockname(sock, &sockname.sa, &namelen) >= 0) {
+		chosenport = ntohs(sockname.sa4.sin_port);
+	    }
+	}
+	
+	/*
+	 * Set the maximum number of pending connect requests to the max
+	 * value allowed on each platform (Win32 and Win32s may be
+	 * different, and there may be differences between TCP/IP stacks).
+	 */
+	
+	if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
+	    TclWinConvertError((DWORD) WSAGetLastError());
+	    closesocket(sock);
+	    continue;
+	}
+	
+	if (statePtr == NULL) {
+	    /*
+	     * Add this socket to the global list of sockets.
+	     */
+	    statePtr = NewSocketInfo(sock);
+	} else {
+	    AddSocketInfoFd( statePtr, sock );
+	}
+    }
+
+error:
+    if (addrlist != NULL) {
+	freeaddrinfo(addrlist);
     }
 
-    if (infoPtr != NULL) {
+    if (statePtr != NULL) {
 
-	infoPtr->acceptProc = acceptProc;
-	infoPtr->acceptProcData = acceptProcData;
-	sprintf(channelName, SOCK_TEMPLATE, infoPtr);
-	infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
-					    infoPtr, 0);	
+	statePtr->acceptProc = acceptProc;
+	statePtr->acceptProcData = acceptProcData;
+	sprintf(channelName, SOCK_TEMPLATE, statePtr);
+	statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
+		statePtr, 0);
 	/*
 	 * Set up the select mask for connection request events.
 	 */
 	
-	infoPtr->selectEvents = FD_ACCEPT;
+	statePtr->selectEvents = FD_ACCEPT;
 	
 	/*
 	 * Register for interest in events in the select mask. Note that this
@@ -1948,13 +2127,13 @@ error:
 
 	ioctlsocket(sock, (long) FIONBIO, &flag);
 	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-		    (LPARAM) infoPtr);
-	if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "")
+		    (LPARAM) statePtr);
+	if (Tcl_SetChannelOption(interp, statePtr->channel, "-eofchar", "")
 	    == TCL_ERROR) {
-	    Tcl_Close(NULL, infoPtr->channel);
+	    Tcl_Close(NULL, statePtr->channel);
 	    return NULL;
 	}
-	return infoPtr->channel;
+	return statePtr->channel;
     }
 
     if (interp != NULL) {
@@ -1973,28 +2152,27 @@ error:
  *----------------------------------------------------------------------
  *
  * TcpAccept --
- *
- *	Creates a channel for a newly accepted socket connection. This is 
- *	called by SocketEventProc and it in turns calls the registered 
- *	accept function.
+ *	Accept a TCP socket connection.	 This is called by the event loop.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Invokes the accept proc which may invoke arbitrary Tcl code.
+ *	Creates a new connection socket. Calls the registered callback for the
+ *	connection acceptance mechanism.
  *
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 static void
 TcpAccept(
     TcpFdList *fds,	/* Server socket that accepted newSocket. */
     SOCKET newSocket,   /* Newly accepted socket. */
     address addr)       /* Address of new socket. */
 {
-    SocketInfo *newInfoPtr;
-    SocketInfo *infoPtr = fds->infoPtr;
+    TcpState *newInfoPtr;
+    TcpState *statePtr = fds->statePtr;
     int len = sizeof(addr);
     char channelName[SOCK_CHAN_LENGTH];
     char host[NI_MAXHOST], port[NI_MAXSERV];
@@ -2039,10 +2217,10 @@ TcpAccept(
      * Invoke the accept callback function.
      */
 
-    if (infoPtr->acceptProc != NULL) {
+    if (statePtr->acceptProc != NULL) {
 	getnameinfo(&(addr.sa), len, host, sizeof(host), port, sizeof(port),
                     NI_NUMERICHOST|NI_NUMERICSERV);
-	infoPtr->acceptProc(infoPtr->acceptProcData, newInfoPtr->channel,
+	statePtr->acceptProc(statePtr->acceptProcData, newInfoPtr->channel,
 			    host, atoi(port));
     }
 }
@@ -2050,707 +2228,652 @@ TcpAccept(
 /*
  *----------------------------------------------------------------------
  *
- * TcpInputProc --
+ * InitSockets --
  *
- *	This function is called by the generic IO level to read data from a
- *	socket based channel.
+ *	Initialize the socket module.  If winsock startup is successful,
+ *	registers the event window for the socket notifier code.
+ *
+ *	Assumes socketMutex is held.
  *
  * Results:
- *	The number of bytes read or -1 on error.
+ *	None.
  *
  * Side effects:
- *	Consumes input from the socket.
+ *	Initializes winsock, registers a new window class and creates a
+ *	window for use in asynchronous socket notification.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-TcpInputProc(
-    ClientData instanceData,	/* The socket state. */
-    char *buf,			/* Where to store data. */
-    int toRead,			/* Maximum number of bytes to read. */
-    int *errorCodePtr)		/* Where to store error codes. */
+static void
+InitSockets(void)
 {
-    SocketInfo *infoPtr = instanceData;
-    int bytesRead;
-    DWORD error;
+    DWORD id, err;
+    WSADATA wsaData;
     ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 
-    *errorCodePtr = 0;
+    if (!initialized) {
+	initialized = 1;
+	TclCreateLateExitHandler(SocketExitHandler, NULL);
 
-    /*
-     * Check that WinSock is initialized; do not call it if not, to prevent
-     * system crashes. This can happen at exit time if the exit handler for
-     * WinSock ran before other exit handlers that want to use sockets.
-     */
+	/*
+	 * Create the async notification window with a new class. We must
+	 * create a new class to avoid a Windows 95 bug that causes us to get
+	 * the wrong message number for socket events if the message window is
+	 * a subclass of a static control.
+	 */
 
-    if (!SocketsEnabled()) {
-	*errorCodePtr = EFAULT;
-	return -1;
-    }
+	windowClass.style = 0;
+	windowClass.cbClsExtra = 0;
+	windowClass.cbWndExtra = 0;
+	windowClass.hInstance = TclWinGetTclInstance();
+	windowClass.hbrBackground = NULL;
+	windowClass.lpszMenuName = NULL;
+	windowClass.lpszClassName = classname;
+	windowClass.lpfnWndProc = SocketProc;
+	windowClass.hIcon = NULL;
+	windowClass.hCursor = NULL;
 
-    /*
-     * First check to see if EOF was already detected, to prevent calling the
-     * socket stack after the first time EOF is detected.
-     */
-
-    if (infoPtr->flags & SOCKET_EOF) {
-	return 0;
-    }
-
-    /*
-     * Check if there is an async connect running.
-     * For blocking sockets terminate connect, otherwise do one step.
-     * For a non blocking socket return EWOULDBLOCK if connect not terminated
-     */
-
-    if ( (infoPtr->flags & SOCKET_REENTER_PENDING)
-	    && !WaitForConnect(infoPtr, errorCodePtr,
-		! ( infoPtr->flags & TCP_ASYNC_SOCKET ))) {
-	return -1;
-    }
-
-    /*
-     * No EOF, and it is connected, so try to read more from the socket. Note
-     * that we clear the FD_READ bit because read events are level triggered
-     * so a new event will be generated if there is still data available to be
-     * read. We have to simulate blocking behavior here since we are always
-     * using non-blocking sockets.
-     */
-
-    while (1) {
-	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
-		(WPARAM) UNSELECT, (LPARAM) infoPtr);
-	/* single fd operation: this proc is only called for a connected socket. */
-	bytesRead = recv(infoPtr->sockets->fd, buf, toRead, 0);
-	infoPtr->readyEvents &= ~(FD_READ);
+	if (!RegisterClass(&windowClass)) {
+	    TclWinConvertError(GetLastError());
+	    goto initFailure;
+	}
 
 	/*
-	 * Check for end-of-file condition or successful read.
+	 * Initialize the winsock library and check the interface version
+	 * actually loaded. We only ask for the 1.1 interface and do require
+	 * that it not be less than 1.1.
 	 */
 
-	if (bytesRead == 0) {
-	    infoPtr->flags |= SOCKET_EOF;
-	}
-	if (bytesRead != SOCKET_ERROR) {
-	    break;
+	err = WSAStartup((WORD) MAKEWORD(WSA_VERSION_MAJOR,WSA_VERSION_MINOR),
+		&wsaData);
+	if (err != 0) {
+	    TclWinConvertError(err);
+	    goto initFailure;
 	}
 
 	/*
-	 * If an error occurs after the FD_CLOSE has arrived, then ignore the
-	 * error and report an EOF.
+	 * Note the byte positions ae swapped for the comparison, so that
+	 * 0x0002 (2.0, MAKEWORD(2,0)) doesn't look less than 0x0101 (1.1). We
+	 * want the comparison to be 0x0200 < 0x0101.
 	 */
 
-	if (infoPtr->readyEvents & FD_CLOSE) {
-	    infoPtr->flags |= SOCKET_EOF;
-	    bytesRead = 0;
-	    break;
+	if (MAKEWORD(HIBYTE(wsaData.wVersion), LOBYTE(wsaData.wVersion))
+		< MAKEWORD(WSA_VERSION_MINOR, WSA_VERSION_MAJOR)) {
+	    TclWinConvertError(WSAVERNOTSUPPORTED);
+	    WSACleanup();
+	    goto initFailure;
 	}
+    }
 
-	error = WSAGetLastError();
+    /*
+     * Check for per-thread initialization.
+     */
 
-	/*
-	 * If an RST comes, then ignore the error and report an EOF just like
-	 * on unix.
-	 */
+    if (tsdPtr != NULL) {
+	return;
+    }
 
-	if (error == WSAECONNRESET) {
-	    infoPtr->flags |= SOCKET_EOF;
-	    bytesRead = 0;
-	    break;
-	}
+    /*
+     * OK, this thread has never done anything with sockets before.  Construct
+     * a worker thread to handle asynchronous events related to sockets
+     * assigned to _this_ thread.
+     */
 
-	/*
-	 * Check for error condition or underflow in non-blocking case.
-	 */
+    tsdPtr = TCL_TSD_INIT(&dataKey);
+    tsdPtr->pendingTcpState = NULL;
+    tsdPtr->socketList = NULL;
+    tsdPtr->hwnd       = NULL;
+    tsdPtr->threadId   = Tcl_GetCurrentThread();
+    tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
+    if (tsdPtr->readyEvent == NULL) {
+	goto initFailure;
+    }
+    tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL);
+    if (tsdPtr->socketListLock == NULL) {
+	goto initFailure;
+    }
+    tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, 0,
+	    &id);
+    if (tsdPtr->socketThread == NULL) {
+	goto initFailure;
+    }
 
-	if ((infoPtr->flags & TCP_ASYNC_SOCKET) || (error != WSAEWOULDBLOCK)) {
-	    TclWinConvertError(error);
-	    *errorCodePtr = Tcl_GetErrno();
-	    bytesRead = -1;
-	    break;
-	}
+    SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST);
 
-	/*
-	 * In the blocking case, wait until the file becomes readable or
-	 * closed and try again.
-	 */
+    /*
+     * Wait for the thread to signal when the window has been created and if
+     * it is ready to go.
+     */
 
-	if (!WaitForSocketEvent(infoPtr, FD_READ|FD_CLOSE, errorCodePtr)) {
-	    bytesRead = -1;
-	    break;
-	}
+    WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
+
+    if (tsdPtr->hwnd == NULL) {
+	goto initFailure;	/* Trouble creating the window. */
     }
 
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr);
+    Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
+    return;
 
-    return bytesRead;
+  initFailure:
+    TclpFinalizeSockets();
+    initialized = -1;
+    return;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TcpOutputProc --
+ * SocketsEnabled --
  *
- *	This function is called by the generic IO level to write data to a
- *	socket based channel.
+ *	Check that the WinSock was successfully initialized.
  *
  * Results:
- *	The number of bytes written or -1 on failure.
+ *	1 if it is.
  *
  * Side effects:
- *	Produces output on the socket.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
+    /* ARGSUSED */
 static int
-TcpOutputProc(
-    ClientData instanceData,	/* The socket state. */
-    const char *buf,		/* Where to get data. */
-    int toWrite,		/* Maximum number of bytes to write. */
-    int *errorCodePtr)		/* Where to store error codes. */
+SocketsEnabled(void)
 {
-    SocketInfo *infoPtr = instanceData;
-    int bytesWritten;
-    DWORD error;
-    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+    int enabled;
 
-    *errorCodePtr = 0;
+    Tcl_MutexLock(&socketMutex);
+    enabled = (initialized == 1);
+    Tcl_MutexUnlock(&socketMutex);
+    return enabled;
+}
 
-    /*
-     * Check that WinSock is initialized; do not call it if not, to prevent
-     * system crashes. This can happen at exit time if the exit handler for
-     * WinSock ran before other exit handlers that want to use sockets.
-     */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SocketExitHandler --
+ *
+ *	Callback invoked during exit clean up to delete the socket
+ *	communication window and to release the WinSock DLL.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    if (!SocketsEnabled()) {
-	*errorCodePtr = EFAULT;
-	return -1;
-    }
+    /* ARGSUSED */
+static void
+SocketExitHandler(
+    ClientData clientData)		/* Not used. */
+{
+    Tcl_MutexLock(&socketMutex);
 
     /*
-     * Check if there is an async connect running.
-     * For blocking sockets terminate connect, otherwise do one step.
-     * For a non blocking socket return EWOULDBLOCK if connect not terminated
+     * Make sure the socket event handling window is cleaned-up for, at
+     * most, this thread.
      */
 
-    if ( (infoPtr->flags & SOCKET_REENTER_PENDING)
-	    && !WaitForConnect(infoPtr, errorCodePtr,
-		! ( infoPtr->flags & TCP_ASYNC_SOCKET ))) {
-	return -1;
-    }
-
-    while (1) {
-	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
-		(WPARAM) UNSELECT, (LPARAM) infoPtr);
-
-	/* single fd operation: this proc is only called for a connected socket. */
-	bytesWritten = send(infoPtr->sockets->fd, buf, toWrite, 0);
-	if (bytesWritten != SOCKET_ERROR) {
-	    /*
-	     * Since Windows won't generate a new write event until we hit an
-	     * overflow condition, we need to force the event loop to poll
-	     * until the condition changes.
-	     */
-
-	    if (infoPtr->watchEvents & FD_WRITE) {
-		Tcl_Time blockTime = { 0, 0 };
-		Tcl_SetMaxBlockTime(&blockTime);
-	    }
-	    break;
-	}
-
-	/*
-	 * Check for error condition or overflow. In the event of overflow, we
-	 * need to clear the FD_WRITE flag so we can detect the next writable
-	 * event. Note that Windows only sends a new writable event after a
-	 * send fails with WSAEWOULDBLOCK.
-	 */
-
-	error = WSAGetLastError();
-	if (error == WSAEWOULDBLOCK) {
-	    infoPtr->readyEvents &= ~(FD_WRITE);
-	    if (infoPtr->flags & TCP_ASYNC_SOCKET) {
-		*errorCodePtr = EWOULDBLOCK;
-		bytesWritten = -1;
-		break;
-	    }
-	} else {
-	    TclWinConvertError(error);
-	    *errorCodePtr = Tcl_GetErrno();
-	    bytesWritten = -1;
-	    break;
-	}
-
-	/*
-	 * In the blocking case, wait until the file becomes writable or
-	 * closed and try again.
-	 */
-
-	if (!WaitForSocketEvent(infoPtr, FD_WRITE|FD_CLOSE, errorCodePtr)) {
-	    bytesWritten = -1;
-	    break;
-	}
-    }
-
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr);
-
-    return bytesWritten;
+    TclpFinalizeSockets();
+    UnregisterClass(classname, TclWinGetTclInstance());
+    WSACleanup();
+    initialized = 0;
+    Tcl_MutexUnlock(&socketMutex);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TcpSetOptionProc --
+ * SocketSetupProc --
  *
- *	Sets Tcp channel specific options.
+ *	This function is invoked before Tcl_DoOneEvent blocks waiting for an
+ *	event.
  *
  * Results:
- *	None, unless an error happens.
+ *	None.
  *
  * Side effects:
- *	Changes attributes of the socket at the system level.
+ *	Adjusts the block time if needed.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-TcpSetOptionProc(
-    ClientData instanceData,	/* Socket state. */
-    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
-    const char *optionName,	/* Name of the option to set. */
-    const char *value)		/* New value for option. */
+void
+SocketSetupProc(
+    ClientData data,		/* Not used. */
+    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
 {
-#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
-    SocketInfo *infoPtr = instanceData;
-    SOCKET sock;
-#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
+    TcpState *statePtr;
+    Tcl_Time blockTime = { 0, 0 };
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return;
+    }
 
     /*
-     * Check that WinSock is initialized; do not call it if not, to prevent
-     * system crashes. This can happen at exit time if the exit handler for
-     * WinSock ran before other exit handlers that want to use sockets.
+     * Check to see if there is a ready socket.	 If so, poll.
      */
-
-    if (!SocketsEnabled()) {
-	if (interp) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "winsock is not initialized", -1));
+    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+    for (statePtr = tsdPtr->socketList; statePtr != NULL;
+	    statePtr = statePtr->nextPtr) {
+	if (statePtr->readyEvents &
+	    (statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)
+	) {
+	    DEBUG("Tcl_SetMaxBlockTime");
+	    Tcl_SetMaxBlockTime(&blockTime);
+	    break;
 	}
-	return TCL_ERROR;
     }
+    SetEvent(tsdPtr->socketListLock);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SocketCheckProc --
+ *
+ *	This function is called by Tcl_DoOneEvent to check the socket event
+ *	source for events.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May queue an event.
+ *
+ *----------------------------------------------------------------------
+ */
 
-#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
-    #error "TCL_FEATURE_KEEPALIVE_NAGLE not reviewed for whether to treat infoPtr->sockets as single fd or list"
-    sock = infoPtr->sockets->fd;
+static void
+SocketCheckProc(
+    ClientData data,		/* Not used. */
+    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
+{
+    TcpState *statePtr;
+    SocketEvent *evPtr;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
-    if (!strcasecmp(optionName, "-keepalive")) {
-	BOOL val = FALSE;
-	int boolVar, rtn;
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return;
+    }
 
-	if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (boolVar) {
-	    val = TRUE;
-	}
-	rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
-		(const char *) &val, sizeof(BOOL));
-	if (rtn != 0) {
-	    TclWinConvertError(WSAGetLastError());
-	    if (interp) {
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"couldn't set socket option: %s",
-			Tcl_PosixError(interp)));
-	    }
-	    return TCL_ERROR;
-	}
-	return TCL_OK;
-    } else if (!strcasecmp(optionName, "-nagle")) {
-	BOOL val = FALSE;
-	int boolVar, rtn;
+    /*
+     * Queue events for any ready sockets that don't already have events
+     * queued (caused by persistent states that won't generate WinSock
+     * events).
+     */
 
-	if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (!boolVar) {
-	    val = TRUE;
-	}
-	rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY,
-		(const char *) &val, sizeof(BOOL));
-	if (rtn != 0) {
-	    TclWinConvertError(WSAGetLastError());
-	    if (interp) {
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"couldn't set socket option: %s",
-			Tcl_PosixError(interp)));
-	    }
-	    return TCL_ERROR;
+    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+    for (statePtr = tsdPtr->socketList; statePtr != NULL;
+	    statePtr = statePtr->nextPtr) {
+	DEBUG("Socket loop");
+	if ((statePtr->readyEvents &
+		(statePtr->watchEvents | FD_CONNECT | FD_ACCEPT))
+	    && !(statePtr->flags & SOCKET_PENDING)
+	) {
+	    DEBUG("Event found");
+	    statePtr->flags |= SOCKET_PENDING;
+	    evPtr = ckalloc(sizeof(SocketEvent));
+	    evPtr->header.proc = SocketEventProc;
+	    evPtr->socket = statePtr->sockets->fd;
+	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
 	}
-	return TCL_OK;
     }
-
-    return Tcl_BadChannelOption(interp, optionName, "keepalive nagle");
-#else
-    return Tcl_BadChannelOption(interp, optionName, "");
-#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
+    SetEvent(tsdPtr->socketListLock);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TcpGetOptionProc --
- *
- *	Computes an option value for a TCP socket based channel, or a list of
- *	all options and their values.
+ * SocketEventProc --
  *
- *	Note: This code is based on code contributed by John Haxby.
+ *	This function is called by Tcl_ServiceEvent when a socket event
+ *	reaches the front of the event queue. This function is responsible for
+ *	notifying the generic channel code.
  *
  * Results:
- *	A standard Tcl result. The value of the specified option or a list of
- *	all options and their values is returned in the supplied DString.
+ *	Returns 1 if the event was handled, meaning it should be removed from
+ *	the queue. Returns 0 if the event was not handled, meaning it should
+ *	stay on the queue. The only time the event isn't handled is if the
+ *	TCL_FILE_EVENTS flag bit isn't set.
  *
  * Side effects:
- *	None.
+ *	Whatever the channel callback functions do.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-TcpGetOptionProc(
-    ClientData instanceData,	/* Socket state. */
-    Tcl_Interp *interp,		/* For error reporting - can be NULL */
-    const char *optionName,	/* Name of the option to retrieve the value
-				 * for, or NULL to get all options and their
-				 * values. */
-    Tcl_DString *dsPtr)		/* Where to store the computed value;
-				 * initialized by caller. */
+SocketEventProc(
+    Tcl_Event *evPtr,		/* Event to service. */
+    int flags)			/* Flags that indicate what events to handle,
+				 * such as TCL_FILE_EVENTS. */
 {
-    SocketInfo *infoPtr = instanceData;
-    char host[NI_MAXHOST], port[NI_MAXSERV];
-    SOCKET sock;
-    size_t len = 0;
-    int reverseDNS = 0;
-#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"
+    TcpState *statePtr = NULL; /* DEBUG */
+    SocketEvent *eventPtr = (SocketEvent *) evPtr;
+    int mask = 0, events;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    TcpFdList *fds;
+    SOCKET newSocket;
+    address addr;
+    int len;
+
+    DEBUG("");
+    if (!(flags & TCL_FILE_EVENTS)) {
+	return 0;
+    }
 
     /*
-     * Check that WinSock is initialized; do not call it if not, to prevent
-     * system crashes. This can happen at exit time if the exit handler for
-     * WinSock ran before other exit handlers that want to use sockets.
+     * Find the specified socket on the socket list.
      */
 
-    if (!SocketsEnabled()) {
-	if (interp) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "winsock is not initialized", -1));
+    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+    for (statePtr = tsdPtr->socketList; statePtr != NULL;
+	    statePtr = statePtr->nextPtr) {
+	if (statePtr->sockets->fd == eventPtr->socket) {
+	    break;
 	}
-	return TCL_ERROR;
-    }
-
-    sock = infoPtr->sockets->fd;
-    if (optionName != NULL) {
-	len = strlen(optionName);
     }
 
-    if ((len > 1) && (optionName[1] == 'e') &&
-	    (strncmp(optionName, "-error", len) == 0)) {
+    /*
+     * Discard events that have gone stale.
+     */
 
-	if ( (infoPtr->flags & SOCKET_REENTER_PENDING) ) {
+    if (!statePtr) {
+        SetEvent(tsdPtr->socketListLock);
+	return 1;
+    }
 
-	    /*
-	     * Asyncroneous connect is running.
-	     * Process it one step without blocking.
-	     * Return its error or nothing if connect not
-	     * terminated.
-	     */
+    statePtr->flags &= ~SOCKET_PENDING;
 
-	    int errorCode;
-	    if (!WaitForConnect(infoPtr, &errorCode, 0)
-		    && errorCode != EWOULDBLOCK) {
-		/* connect terminated with error */
-		Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errorCode), -1);
-	    }
+    /* Continue async connect if pending and ready */
+    if ( statePtr->readyEvents & FD_CONNECT ) {
+	statePtr->readyEvents &= ~(FD_CONNECT);
+	DEBUG("FD_CONNECT");
+        if ( statePtr->flags & SOCKET_REENTER_PENDING ) {
+	    SetEvent(tsdPtr->socketListLock);
+	    CreateClientSocket(NULL, statePtr);
+	    return 1;
+	}
+    }
 
-	} else {
-	    int optlen;
-	    int ret;
-    	    DWORD err;
+    /*
+     * Handle connection requests directly.
+     */
+    if (statePtr->readyEvents & FD_ACCEPT) {
+	for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
 
 	    /*
-	     * 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;
-    }
+	    * Accept the incoming connection request.
+	    */
+	    len = sizeof(address);
 
-    if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
-	reverseDNS = NI_NUMERICHOST;
-    }
+	    newSocket = accept(fds->fd, &(addr.sa), &len);
 
-    if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
-	    (strncmp(optionName, "-peername", len) == 0))) {
-	address peername;
-	socklen_t size = sizeof(peername);
+	    /* On Tcl server sockets with multiple OS fds we loop over the fds trying
+	     * an accept() on each, so we expect INVALID_SOCKET.  There are also other
+	     * network stack conditions that can result in FD_ACCEPT but a subsequent
+	     * failure on accept() by the time we get around to it.
+	     * Access to sockets (acceptEventCount, readyEvents) in socketList
+	     * is still protected by the lock (prevents reintroduction of 
+	     * SF Tcl Bug 3056775.
+	     */
 
-	if (getpeername(sock, (LPSOCKADDR) &(peername.sa), &size) == 0) {
-	    if (len == 0) {
-		Tcl_DStringAppendElement(dsPtr, "-peername");
-		Tcl_DStringStartSublist(dsPtr);
+	    if (newSocket == INVALID_SOCKET) {
+		/* int err = WSAGetLastError(); */
+		continue;
 	    }
 
-	    getnameinfo(&(peername.sa), size, host, sizeof(host),
-		    NULL, 0, NI_NUMERICHOST);
-	    Tcl_DStringAppendElement(dsPtr, host);
-	    getnameinfo(&(peername.sa), size, host, sizeof(host),
-		    port, sizeof(port), reverseDNS | NI_NUMERICSERV);
-	    Tcl_DStringAppendElement(dsPtr, host);
-	    Tcl_DStringAppendElement(dsPtr, port);
-	    if (len == 0) {
-		Tcl_DStringEndSublist(dsPtr);
-	    } else {
-		return TCL_OK;
-	    }
-	} else {
 	    /*
-	     * getpeername failed - but if we were asked for all the options
-	     * (len==0), don't flag an error at that point because it could be
-	     * an fconfigure request on a server socket (such sockets have no
-	     * peer). {Copied from unix/tclUnixChan.c}
+	     * It is possible that more than one FD_ACCEPT has been sent, so an extra
+	     * count must be kept. Decrement the count, and reset the readyEvent bit
+	     * if the count is no longer > 0.
 	     */
+	    statePtr->acceptEventCount--;
 
-	    if (len) {
-		TclWinConvertError((DWORD) WSAGetLastError());
-		if (interp) {
-		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			    "can't get peername: %s",
-			    Tcl_PosixError(interp)));
-		}
-		return TCL_ERROR;
+	    if (statePtr->acceptEventCount <= 0) {
+		statePtr->readyEvents &= ~(FD_ACCEPT);
 	    }
-	}
-    }
 
-    if ((len == 0) || ((len > 1) && (optionName[1] == 's') &&
-	    (strncmp(optionName, "-sockname", len) == 0))) {
-	TcpFdList *fds;
-	address sockname;
-	socklen_t size;
-	int found = 0;
+	    SetEvent(tsdPtr->socketListLock);
 
-	if (len == 0) {
-	    Tcl_DStringAppendElement(dsPtr, "-sockname");
-	    Tcl_DStringStartSublist(dsPtr);
+	    /* Caution: TcpAccept() has the side-effect of evaluating the server
+	     * accept script (via AcceptCallbackProc() in tclIOCmd.c), which can
+	     * close the server socket and invalidate statePtr and fds.
+	     * If TcpAccept() accepts a socket we must return immediately and let
+	     * SocketCheckProc queue additional FD_ACCEPT events.
+	     */
+	    TcpAccept(fds, newSocket, addr);
+	    return 1;
 	}
-	for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
-	    sock = fds->fd;
-#ifdef DEBUGGING
-	    fprintf(stderr, "sock == %d\n", sock);
-#endif
-	    size = sizeof(sockname);
-	    if (getsockname(sock, &(sockname.sa), &size) >= 0) {
-		int flags = reverseDNS;
 
-		found = 1;
-		getnameinfo(&sockname.sa, size, host, sizeof(host),
-			NULL, 0, NI_NUMERICHOST);
-		Tcl_DStringAppendElement(dsPtr, host);
+	/* Loop terminated with no sockets accepted; clear the ready mask so 
+	 * we can detect the next connection request. Note that connection 
+	 * requests are level triggered, so if there is a request already 
+	 * pending, a new event will be generated.
+	 */
+	statePtr->acceptEventCount = 0;
+	statePtr->readyEvents &= ~(FD_ACCEPT);
 
-		/*
-		 * We don't want to resolve INADDR_ANY and sin6addr_any; they
-		 * can sometimes cause problems (and never have a name).
-		 */
-		flags |= NI_NUMERICSERV;
-		if (sockname.sa.sa_family == AF_INET) {
-		    if (sockname.sa4.sin_addr.s_addr == INADDR_ANY) {
-			flags |= NI_NUMERICHOST;
-		    }
-		} else if (sockname.sa.sa_family == AF_INET6) {
-		    if ((IN6_ARE_ADDR_EQUAL(&sockname.sa6.sin6_addr,
-				&in6addr_any)) ||
-			    (IN6_IS_ADDR_V4MAPPED(&sockname.sa6.sin6_addr)
-			    && sockname.sa6.sin6_addr.s6_addr[12] == 0
-			    && sockname.sa6.sin6_addr.s6_addr[13] == 0
-			    && sockname.sa6.sin6_addr.s6_addr[14] == 0
-			    && sockname.sa6.sin6_addr.s6_addr[15] == 0)) {
-			flags |= NI_NUMERICHOST;
-		    }
-		}
-		getnameinfo(&sockname.sa, size, host, sizeof(host),
-			port, sizeof(port), flags);
-		Tcl_DStringAppendElement(dsPtr, host);
-		Tcl_DStringAppendElement(dsPtr, port);
-	    }
-	}
-	if (found) {
-	    if (len == 0) {
-		Tcl_DStringEndSublist(dsPtr);
-	    } else {
-		return TCL_OK;
-	    }
-	} else {
-	    if (interp) {
-		TclWinConvertError((DWORD) WSAGetLastError());
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"can't get sockname: %s", Tcl_PosixError(interp)));
-	    }
-	    return TCL_ERROR;
-	}
+	SetEvent(tsdPtr->socketListLock);
+	return 1;
     }
 
-#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
-    if (len == 0 || !strncmp(optionName, "-keepalive", len)) {
-	int optlen;
-	BOOL opt = FALSE;
+    SetEvent(tsdPtr->socketListLock);
 
-	if (len == 0) {
-	    Tcl_DStringAppendElement(dsPtr, "-keepalive");
-	}
-	optlen = sizeof(BOOL);
-	getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&opt, &optlen);
-	if (opt) {
-	    Tcl_DStringAppendElement(dsPtr, "1");
-	} else {
-	    Tcl_DStringAppendElement(dsPtr, "0");
-	}
-	if (len > 0) {
-	    return TCL_OK;
-	}
-    }
+    /*
+     * Mask off unwanted events and compute the read/write mask so we can
+     * notify the channel.
+     */
+
+    events = statePtr->readyEvents & statePtr->watchEvents;
+
+    if (events & FD_CLOSE) {
+	/*
+	 * If the socket was closed and the channel is still interested in
+	 * read events, then we need to ensure that we keep polling for this
+	 * event until someone does something with the channel. Note that we
+	 * do this before calling Tcl_NotifyChannel so we don't have to watch
+	 * out for the channel being deleted out from under us. This may cause
+	 * a redundant trip through the event loop, but it's simpler than
+	 * trying to do unwind protection.
+	 */
+
+	Tcl_Time blockTime = { 0, 0 };
+
+	DEBUG("FD_CLOSE");
+	Tcl_SetMaxBlockTime(&blockTime);
+	mask |= TCL_READABLE|TCL_WRITABLE;
+    } else if (events & FD_READ) {
+	fd_set readFds;
+	struct timeval timeout;
 
-    if (len == 0 || !strncmp(optionName, "-nagle", len)) {
-	int optlen;
-	BOOL opt = FALSE;
+	/*
+	 * We must check to see if data is really available, since someone
+	 * could have consumed the data in the meantime. Turn off async
+	 * notification so select will work correctly. If the socket is still
+	 * readable, notify the channel driver, otherwise reset the async
+	 * select handler and keep waiting.
+	 */
+	DEBUG("FD_READ");
 
-	if (len == 0) {
-	    Tcl_DStringAppendElement(dsPtr, "-nagle");
-	}
-	optlen = sizeof(BOOL);
-	getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt, &optlen);
-	if (opt) {
-	    Tcl_DStringAppendElement(dsPtr, "0");
+	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+		(WPARAM) UNSELECT, (LPARAM) statePtr);
+
+	FD_ZERO(&readFds);
+	FD_SET(statePtr->sockets->fd, &readFds);
+	timeout.tv_usec = 0;
+	timeout.tv_sec = 0;
+
+	if (select(0, &readFds, NULL, NULL, &timeout) != 0) {
+	    mask |= TCL_READABLE;
 	} else {
-	    Tcl_DStringAppendElement(dsPtr, "1");
-	}
-	if (len > 0) {
-	    return TCL_OK;
+	    statePtr->readyEvents &= ~(FD_READ);
+	    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+		    (WPARAM) SELECT, (LPARAM) statePtr);
 	}
     }
-#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
-
-    if (len > 0) {
-#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
-	return Tcl_BadChannelOption(interp, optionName,
-		"peername sockname keepalive nagle");
-#else
-	return Tcl_BadChannelOption(interp, optionName, "peername sockname");
-#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
+    if (events & FD_WRITE) {
+	DEBUG("FD_WRITE");
+	mask |= TCL_WRITABLE;
     }
-
-    return TCL_OK;
+    if (mask) {
+	DEBUG("Calling Tcl_NotifyChannel...");
+	Tcl_NotifyChannel(statePtr->channel, mask);
+    }
+    DEBUG("returning...");
+    return 1;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TcpWatchProc --
+ * AddSocketInfoFd --
  *
- *	Informs the channel driver of the events that the generic channel code
- *	wishes to receive on this socket.
+ *	This function adds a SOCKET file descriptor to the 'sockets' linked 
+ *	list of a TcpState structure.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	May cause the notifier to poll if any of the specified conditions are
- *	already true.
+ *	None, except for allocation of memory.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-TcpWatchProc(
-    ClientData instanceData,	/* The socket state. */
-    int mask)			/* Events of interest; an OR-ed combination of
-				 * TCL_READABLE, TCL_WRITABLE and
-				 * TCL_EXCEPTION. */
+AddSocketInfoFd(
+    TcpState *statePtr, 
+    SOCKET socket)
 {
-    SocketInfo *infoPtr = instanceData;
+    TcpFdList *fds = statePtr->sockets;
 
-    DEBUG((mask & TCL_READABLE) ? "+r":"-r");
-    DEBUG((mask & TCL_WRITABLE) ? "+w":"-w");
+    if ( fds == NULL ) {
+	/* Add the first FD */
+	statePtr->sockets = ckalloc(sizeof(TcpFdList));
+	fds = statePtr->sockets;
+    } else {
+	/* Find end of list and append FD */
+	while ( fds->next != NULL ) {
+	    fds = fds->next;
+	}
+    
+	fds->next = ckalloc(sizeof(TcpFdList));
+	fds = fds->next;
+    }
 
-    /*
-     * Update the watch events mask. Only if the socket is not a server
-     * socket. [Bug 557878]
-     */
+    /* Populate new FD */
+    fds->fd = socket;
+    fds->statePtr = statePtr;
+    fds->next = NULL;
+}
 
-    if (!infoPtr->acceptProc) {
-	infoPtr->watchEvents = 0;
-	if (mask & TCL_READABLE) {
-	    infoPtr->watchEvents |= (FD_READ|FD_CLOSE);
-	}
-	if (mask & TCL_WRITABLE) {
-	    infoPtr->watchEvents |= (FD_WRITE|FD_CLOSE);
-	}
+    
+/*
+ *----------------------------------------------------------------------
+ *
+ * NewSocketInfo --
+ *
+ *	This function allocates and initializes a new TcpState structure.
+ *
+ * Results:
+ *	Returns a newly allocated TcpState.
+ *
+ * Side effects:
+ *	None, except for allocation of memory.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	/*
-	 * If there are any conditions already set, then tell the notifier to
-	 * poll rather than block.
-	 */
+static TcpState *
+NewSocketInfo(SOCKET socket)
+{
+    TcpState *statePtr = ckalloc(sizeof(TcpState));
 
-	if (infoPtr->readyEvents & infoPtr->watchEvents) {
-	    Tcl_Time blockTime = { 0, 0 };
+    memset(statePtr, 0, sizeof(TcpState));
 
-	    Tcl_SetMaxBlockTime(&blockTime);
-	}
-    }
+    /*
+     * TIP #218. Removed the code inserting the new structure into the global
+     * list. This is now handled in the thread action callbacks, and only
+     * there.
+     */
+
+    AddSocketInfoFd(statePtr, socket);
+
+    return statePtr;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TcpGetProc --
+ * WaitForSocketEvent --
  *
- *	Called from Tcl_GetChannelHandle to retrieve an OS handle from inside
- *	a TCP socket based channel.
+ *	Waits until one of the specified events occurs on a socket.
  *
  * Results:
- *	Returns TCL_OK with the socket in handlePtr.
+ *	Returns 1 on success or 0 on failure, with an error code in
+ *	errorCodePtr.
  *
  * Side effects:
- *	None.
+ *	Processes socket events off the system queue.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-TcpGetHandleProc(
-    ClientData instanceData,	/* The socket state. */
-    int direction,		/* Not used. */
-    ClientData *handlePtr)	/* Where to store the handle. */
+WaitForSocketEvent(
+    TcpState *statePtr,	/* Information about this socket. */
+    int events,			/* Events to look for. */
+    int *errorCodePtr)		/* Where to store errors? */
 {
-    SocketInfo *statePtr = instanceData;
+    int result = 1;
+    int oldMode;
+    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+    /*
+     * Be sure to disable event servicing so we are truly modal.
+     */
+    DEBUG("=============");
 
-    *handlePtr = INT2PTR(statePtr->sockets->fd);
-    return TCL_OK;
+    oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
+
+    /*
+     * Reset WSAAsyncSelect so we have a fresh set of events pending.
+     */
+
+    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT,
+	    (LPARAM) statePtr);
+    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+	    (LPARAM) statePtr);
+
+    while (1) {
+	if (statePtr->lastError) {
+	    *errorCodePtr = statePtr->lastError;
+	    result = 0;
+	    break;
+	} else if (statePtr->readyEvents & events) {
+	    break;
+	} else if (statePtr->flags & TCP_ASYNC_SOCKET) {
+	    *errorCodePtr = EWOULDBLOCK;
+	    result = 0;
+	    break;
+	}
+
+	/*
+	 * Wait until something happens.
+	 */
+
+	WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
+    }
+
+    (void) Tcl_SetServiceMode(oldMode);
+    return result;
 }
 
 /*
@@ -2844,7 +2967,7 @@ SocketProc(
 {
     int event, error;
     SOCKET socket;
-    SocketInfo *infoPtr = NULL; /* DEBUG */
+    TcpState *statePtr = NULL; /* DEBUG */
     int info_found = 0;
     TcpFdList *fds = NULL;
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
@@ -2901,27 +3024,27 @@ SocketProc(
 	 * eventState flag.
 	 */
 
-	for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
-		infoPtr = infoPtr->nextPtr) {
-    	    DEBUG("Cur InfoPtr");
-    	    if ( FindFDInList(infoPtr,socket) ) {
-    		info_found = 1;
-    		DEBUG("InfoPtr found");
-    		break;
-    	    }
-    	}
-    	/*
-    	 * Check if there is a pending info structure not jet in the
-    	 * list
-    	 */
-    	if ( !info_found
-    		&& tsdPtr->pendingSocketInfo != NULL
-    		&& FindFDInList(tsdPtr->pendingSocketInfo,socket) ) {
-    	    infoPtr = tsdPtr->pendingSocketInfo;
-    	    DEBUG("Pending InfoPtr found");
-    	    info_found = 1;
-    	}
-    	if (info_found) {
+	for (statePtr = tsdPtr->socketList; statePtr != NULL;
+		statePtr = statePtr->nextPtr) {
+	    DEBUG("Cur InfoPtr");
+	    if ( FindFDInList(statePtr,socket) ) {
+		info_found = 1;
+		DEBUG("InfoPtr found");
+		break;
+	    }
+	}
+	/*
+	 * Check if there is a pending info structure not jet in the
+	 * list
+	 */
+	if ( !info_found
+		&& tsdPtr->pendingTcpState != NULL
+		&& FindFDInList(tsdPtr->pendingTcpState,socket) ) {
+	    statePtr = tsdPtr->pendingTcpState;
+	    DEBUG("Pending InfoPtr found");
+	    info_found = 1;
+	}
+	if (info_found) {
 	    if (event & FD_READ) 
 		DEBUG("|->FD_READ");
 	    if (event & FD_WRITE) 
@@ -2937,11 +3060,11 @@ SocketProc(
 
 	    if (event & FD_CLOSE) {
 		DEBUG("FD_CLOSE");
-		infoPtr->acceptEventCount = 0;
-		infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
+		statePtr->acceptEventCount = 0;
+		statePtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
 	    } else if (event & FD_ACCEPT) {
 		DEBUG("FD_ACCEPT");
-		    infoPtr->acceptEventCount++;
+		    statePtr->acceptEventCount++;
 	    }
 
 	    if (event & FD_CONNECT) {
@@ -2952,13 +3075,13 @@ SocketProc(
 		 */
 		if (error != ERROR_SUCCESS) {
 		    TclWinConvertError((DWORD) error);
-		    infoPtr->lastError = Tcl_GetErrno();
+		    statePtr->lastError = Tcl_GetErrno();
 		}
 	    }
 	    /*
 	     * Inform main thread about signaled events
 	     */
-	    infoPtr->readyEvents |= event;
+	    statePtr->readyEvents |= event;
 
 	    /*
 	     * Wake up the Main Thread.
@@ -2971,20 +3094,20 @@ SocketProc(
 
     case SOCKET_SELECT:
 	DEBUG("SOCKET_SELECT");
-	infoPtr = (SocketInfo *) lParam;
-	for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
+	statePtr = (TcpState *) lParam;
+	for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
 #ifdef DEBUGGING
 	    fprintf(stderr,"loop over fd = %d\n",fds->fd);
 #endif
 	    if (wParam == SELECT) {
 		DEBUG("SELECT");
-		if (infoPtr->selectEvents & FD_READ) DEBUG("  READ");
-		if (infoPtr->selectEvents & FD_WRITE) DEBUG("  WRITE");
-		if (infoPtr->selectEvents & FD_CLOSE) DEBUG("  CLOSE");
-		if (infoPtr->selectEvents & FD_CONNECT) DEBUG("  CONNECT");
-		if (infoPtr->selectEvents & FD_ACCEPT) DEBUG("  ACCEPT");
+		if (statePtr->selectEvents & FD_READ) DEBUG("  READ");
+		if (statePtr->selectEvents & FD_WRITE) DEBUG("  WRITE");
+		if (statePtr->selectEvents & FD_CLOSE) DEBUG("  CLOSE");
+		if (statePtr->selectEvents & FD_CONNECT) DEBUG("  CONNECT");
+		if (statePtr->selectEvents & FD_ACCEPT) DEBUG("  ACCEPT");
 		WSAAsyncSelect(fds->fd, hwnd,
-			SOCKET_MESSAGE, infoPtr->selectEvents);
+			SOCKET_MESSAGE, statePtr->selectEvents);
 	    } else {
 		/*
 		 * Clear the selection mask
@@ -3023,11 +3146,11 @@ SocketProc(
 
 static int
 FindFDInList(
-    SocketInfo *infoPtr,
+    TcpState *statePtr,
     SOCKET socket)
 {
     TcpFdList *fds;
-    for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
+    for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
         #ifdef DEBUGGING
 	fprintf(stderr,"socket = %d, fd=%d\n",socket,fds);
 	#endif
@@ -3041,88 +3164,6 @@ FindFDInList(
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_GetHostName --
- *
- *	Returns the name of the local host.
- *
- * Results:
- *	A string containing the network name for this machine. The caller must
- *	not modify or free this string.
- *
- * Side effects:
- *	Caches the name to return for future calls.
- *
- *----------------------------------------------------------------------
- */
-
-const char *
-Tcl_GetHostName(void)
-{
-    return Tcl_GetString(TclGetProcessGlobalValue(&hostName));
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InitializeHostName --
- *
- *	This routine sets the process global value of the name of the local
- *	host on which the process is running.
- *
- * Results:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-InitializeHostName(
-    char **valuePtr,
-    int *lengthPtr,
-    Tcl_Encoding *encodingPtr)
-{
-    TCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1];
-    DWORD length = MAX_COMPUTERNAME_LENGTH + 1;
-    Tcl_DString ds;
-
-    if (GetComputerName(tbuf, &length) != 0) {
-	/*
-	 * Convert string from native to UTF then change to lowercase.
-	 */
-
-	Tcl_UtfToLower(Tcl_WinTCharToUtf(tbuf, -1, &ds));
-
-    } else {
-	Tcl_DStringInit(&ds);
-	if (TclpHasSockets(NULL) == TCL_OK) {
-	    /*
-	     * The buffer size of 256 is recommended by the MSDN page that
-	     * documents gethostname() as being always adequate.
-	     */
-
-	    Tcl_DString inDs;
-
-	    Tcl_DStringInit(&inDs);
-	    Tcl_DStringSetLength(&inDs, 256);
-	    if (gethostname(Tcl_DStringValue(&inDs),
-		    Tcl_DStringLength(&inDs)) == 0) {
-		Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1,
-			&ds);
-	    }
-	    Tcl_DStringFree(&inDs);
-	}
-    }
-
-    *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
-    *lengthPtr = Tcl_DStringLength(&ds);
-    *valuePtr = ckalloc((*lengthPtr) + 1);
-    memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1);
-    Tcl_DStringFree(&ds);
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * TclWinGetSockOpt, et al. --
  *
  *	These functions are wrappers that let us bind the WinSock API
@@ -3239,7 +3280,7 @@ TcpThreadActionProc(
     int action)
 {
     ThreadSpecificData *tsdPtr;
-    SocketInfo *infoPtr = instanceData;
+    TcpState *statePtr = instanceData;
     int notifyCmd;
 
     if (action == TCL_CHANNEL_THREAD_INSERT) {
@@ -3256,19 +3297,19 @@ TcpThreadActionProc(
 
 	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 	DEBUG("Inserting pointer to list");
-	infoPtr->nextPtr = tsdPtr->socketList;
-	tsdPtr->socketList = infoPtr;
+	statePtr->nextPtr = tsdPtr->socketList;
+	tsdPtr->socketList = statePtr;
 	
-	if (infoPtr == tsdPtr->pendingSocketInfo) {
+	if (statePtr == tsdPtr->pendingTcpState) {
 	    DEBUG("Clearing temporary info pointer");
-	    tsdPtr->pendingSocketInfo = NULL;
+	    tsdPtr->pendingTcpState = NULL;
 	}
 	
 	SetEvent(tsdPtr->socketListLock);
 
 	notifyCmd = SELECT;
     } else {
-	SocketInfo **nextPtrPtr;
+	TcpState **nextPtrPtr;
 	int removed = 0;
 
 	tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -3282,8 +3323,8 @@ TcpThreadActionProc(
 	DEBUG("Removing pointer from list");
 	for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL;
 		nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
-	    if ((*nextPtrPtr) == infoPtr) {
-		(*nextPtrPtr) = infoPtr->nextPtr;
+	    if ((*nextPtrPtr) == statePtr) {
+		(*nextPtrPtr) = statePtr->nextPtr;
 		removed = 1;
 		break;
 	    }
@@ -3309,7 +3350,7 @@ TcpThreadActionProc(
      */
 
     SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
-	    (WPARAM) notifyCmd, (LPARAM) infoPtr);
+	    (WPARAM) notifyCmd, (LPARAM) statePtr);
 }
 
 /*
@@ -3317,5 +3358,7 @@ TcpThreadActionProc(
  * mode: c
  * c-basic-offset: 4
  * fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
  * End:
  */
-- 
cgit v0.12


From 19de01829d8d5c466d392806d3b327ee49e20d58 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Fri, 14 Mar 2014 17:01:33 +0000
Subject: WaitForConnection like tclUnixSock.c, new option [fconfigure
 -connecting]

---
 win/tclWinSock.c | 76 +++++++++++++++++++++++++-------------------------------
 1 file changed, 34 insertions(+), 42 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index f65ea46..3d41bd3 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -260,7 +260,7 @@ static LRESULT CALLBACK	SocketProc(HWND hwnd, UINT message, WPARAM wParam,
 static int		SocketsEnabled(void);
 static void		TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr);
 static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr,
-			    int terminate_connect);
+			    int noblock);
 static int		WaitForSocketEvent(TcpState *statePtr, int events,
 			    int *errorCodePtr);
 static void		AddSocketInfoFd(TcpState *statePtr,  SOCKET socket);
@@ -556,19 +556,14 @@ TcpBlockModeProc(
  *
  * WaitForConnect --
  *
- *	Process an asyncroneous connect by other commands (gets... ).
- *	Do one connect step if pending as if the event loop would run.
- *
- *	Blocking commands may call in with terminate_connect to terminate
- *	the syncroneous connect syncroneously.
- *
- *	Ok is directly returned if no async connect is running.
+ *	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.
  *
  * Results:
- *	Returns 1 on success or 0 on failure, with a possix error code in
- *	errorCodePtr.
- *	If the connect is not terminated, errorCode is set to EWOULDBLOCK
- *	and 0 is returned.
+ * 	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.
@@ -581,7 +576,7 @@ static int
 WaitForConnect(
     TcpState *statePtr,		/* State of the socket. */
     int *errorCodePtr,		/* Where to store errors? */
-    int terminate_connect)	/* Should the connect be terminated? */
+    int noblock)		/* Don't wait, even for sockets in blocking mode */
 {
     int result;
     int oldMode;
@@ -591,7 +586,7 @@ WaitForConnect(
      * Check if an async connect is running. If not return ok
      */
     if ( !(statePtr->flags & SOCKET_REENTER_PENDING) )
-	return 1;
+	return 0;
     
     /*
      * Be sure to disable event servicing so we are truly modal.
@@ -615,8 +610,8 @@ WaitForConnect(
 	     * For blocking sockets disable async connect
 	     * as we continue now synchoneously
 	     */
-	    if ( terminate_connect ) {
-		statePtr->flags &= ~(TCP_ASYNC_CONNECT);
+	    if ( !(noblock || (statePtr->flags & TCP_ASYNC_SOCKET)) ) {
+		CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
 	    }
 
 	    /* Free list lock */
@@ -632,13 +627,13 @@ WaitForConnect(
 	    if (result == TCL_OK) {
 		if ( statePtr->flags & SOCKET_REENTER_PENDING ) {
 		    *errorCodePtr = EWOULDBLOCK;
-		    return 0;
+		    return -1;
 		}
-		return 1;
+		return 0;
 	    }
 	    /* error case */
 	    *errorCodePtr = Tcl_GetErrno();
-	    return 0;
+	    return -1;
 	}
 
         /* Free list lock */
@@ -648,9 +643,9 @@ WaitForConnect(
 	 * A non blocking socket waiting for an asyncronous connect
 	 * returns directly an error
 	 */
-	if ( ! terminate_connect ) {
+	if ( noblock || (statePtr->flags & TCP_ASYNC_SOCKET) ) {
 	    *errorCodePtr = EWOULDBLOCK;
-	    return 0;
+	    return -1;
 	}
 
 	/*
@@ -722,8 +717,7 @@ TcpInputProc(
      * For a non blocking socket return EWOULDBLOCK if connect not terminated
      */
 
-    if ( !WaitForConnect(statePtr, errorCodePtr,
-	    ! ( statePtr->flags & TCP_ASYNC_SOCKET ))) {
+    if (WaitForConnect(statePtr, errorCodePtr, 0) != 0) {
 	return -1;
     }
 
@@ -852,8 +846,7 @@ TcpOutputProc(
      * For a non blocking socket return EWOULDBLOCK if connect not terminated
      */
 
-    if ( !WaitForConnect(statePtr, errorCodePtr,
-	    ! ( statePtr->flags & TCP_ASYNC_SOCKET ))) {
+    if (WaitForConnect(statePtr, errorCodePtr, 0) != 0) {
 	return -1;
     }
 
@@ -1176,6 +1169,7 @@ TcpGetOptionProc(
     char host[NI_MAXHOST], port[NI_MAXSERV];
     SOCKET sock;
     size_t len = 0;
+    int errorCode;
     int reverseDNS = 0;
 #define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"
 
@@ -1193,6 +1187,9 @@ TcpGetOptionProc(
 	return TCL_ERROR;
     }
 
+    /* Go one step in async connect */
+    WaitForConnect(statePtr, &errorCode, 1);
+
     sock = statePtr->sockets->fd;
     if (optionName != NULL) {
 	len = strlen(optionName);
@@ -1201,23 +1198,10 @@ TcpGetOptionProc(
     if ((len > 1) && (optionName[1] == 'e') &&
 	    (strncmp(optionName, "-error", len) == 0)) {
 
-	if ( (statePtr->flags & SOCKET_REENTER_PENDING) ) {
-
-	    /*
-	     * Asyncroneous connect is running.
-	     * Process it one step without blocking.
-	     * Return its error or nothing if connect not
-	     * terminated.
-	     */
-
-	    int errorCode;
-	    if (!WaitForConnect(statePtr, &errorCode, 0)
-		    && errorCode != EWOULDBLOCK) {
-		/* connect terminated with error */
-		Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errorCode), -1);
-	    }
-
-	} else {
+	/*
+	* Do not return any errors if async connect is running
+	*/
+	if (! (statePtr->flags & SOCKET_REENTER_PENDING) ) {
 	    int optlen;
 	    int ret;
     	    DWORD err;
@@ -1246,6 +1230,14 @@ TcpGetOptionProc(
 	return TCL_OK;
     }
 
+    if ((len > 1) && (optionName[1] == 'c') &&
+	    (strncmp(optionName, "-connecting", len) == 0)) {
+
+        Tcl_DStringAppend(dsPtr,
+                        (statePtr->flags & SOCKET_REENTER_PENDING) ? "1" : "0", -1);
+        return TCL_OK;
+    }
+
     if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
 	reverseDNS = NI_NUMERICHOST;
     }
-- 
cgit v0.12


From b16e407595d059711eecc4f8a0a62a18294edff0 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 17 Mar 2014 17:56:47 +0000
Subject: Remove long dead "BAD_BLOCKING" support code so it no longer confuses
 people reading/editing this code.

---
 generic/tclIO.c | 133 +++++---------------------------------------------------
 generic/tclIO.h |  23 ----------
 2 files changed, 10 insertions(+), 146 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index b4f1c0c..0f894e4 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4873,42 +4873,18 @@ Tcl_ReadRaw(
 		ResetFlag(statePtr, CHANNEL_BLOCKED);
 	    }
 
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
 	    /*
-	     * [Bug 943274]. Better emulation of non-blocking channels for
-	     * channels without BlockModeProc, by keeping track of true
-	     * fileevents generated by the OS == Data waiting and reading if
-	     * and only if we are sure to have data.
+	     * Now go to the driver to get as much as is possible to
+	     * fill the remaining request. Do all the error handling by
+	     * ourselves. The code was stolen from 'GetInput' and
+	     * slightly adapted (different return value here).
+	     *
+	     * The case of 'bytesToRead == 0' at this point cannot
+	     * happen.
 	     */
 
-	    if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
-		    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
-		    !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
-		/*
-		 * We bypass the driver; it would block as no data is
-		 * available.
-		 */
-
-		nread = -1;
-		result = EWOULDBLOCK;
-	    } else {
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
-		/*
-		 * Now go to the driver to get as much as is possible to fill
-		 * the remaining request. Do all the error handling by
-		 * ourselves. The code was stolen from 'GetInput' and slightly
-		 * adapted (different return value here).
-		 *
-		 * The case of 'bytesToRead == 0' at this point cannot happen.
-		 */
-
-		nread = ChanRead(chanPtr, bufPtr + copied,
-			bytesToRead - copied, &result);
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-	    }
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
+	    nread = ChanRead(chanPtr, bufPtr + copied,
+		    bytesToRead - copied, &result);
 
 	    if (nread > 0) {
 		/*
@@ -4921,18 +4897,6 @@ Tcl_ReadRaw(
 		if (nread < (bytesToRead - copied)) {
 		    SetFlag(statePtr, CHANNEL_BLOCKED);
 		}
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-		if (nread <= (bytesToRead - copied)) {
-		    /*
-		     * [Bug 943274] We have read the available data, clear
-		     * flag.
-		     */
-
-		    ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
-		}
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
 	    } else if (nread == 0) {
 		SetFlag(statePtr, CHANNEL_EOF);
 		statePtr->inputEncodingFlags |= TCL_ENCODING_END;
@@ -6041,32 +6005,7 @@ GetInput(
 	return 0;
     }
 
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-    /*
-     * [SF Tcl Bug 943274]. Better emulation of non-blocking channels for
-     * channels without BlockModeProc, by keeping track of true fileevents
-     * generated by the OS == Data waiting and reading if and only if we are
-     * sure to have data.
-     */
-
-    if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
-	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
-	    !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
-	/*
-	 * Bypass the driver, it would block, as no data is available
-	 */
-
-	nread = -1;
-	result = EWOULDBLOCK;
-    } else {
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
-	nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead, &result);
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-    }
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
+    nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead, &result);
     if (nread > 0) {
 	bufPtr->nextAdded += nread;
 
@@ -6080,18 +6019,6 @@ GetInput(
 	if (nread < toRead) {
 	    SetFlag(statePtr, CHANNEL_BLOCKED);
 	}
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-	if (nread <= toRead) {
-	    /*
-	     * [SF Tcl Bug 943274] We have read the available data, clear
-	     * flag.
-	     */
-
-	    ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
-	}
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
     } else if (nread == 0) {
 	SetFlag(statePtr, CHANNEL_EOF);
 	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
@@ -7548,21 +7475,6 @@ Tcl_NotifyChannel(
     Channel *upChanPtr;
     const Tcl_ChannelType *upTypePtr;
 
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-    /*
-     * [SF Tcl Bug 943274] For a non-blocking channel without blockmodeproc we
-     * keep track of actual input coming from the OS so that we can do a
-     * credible imitation of non-blocking behaviour.
-     */
-
-    if ((mask & TCL_READABLE) &&
-	    (statePtr->flags & CHANNEL_NONBLOCKING) &&
-	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
-	    !(statePtr->flags & CHANNEL_TIMER_FEV)) {
-	SetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
-    }
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
     /*
      * In contrast to the other API functions this procedure walks towards the
      * top of a stack and not down from it.
@@ -7797,29 +7709,8 @@ ChannelTimerProc(
 	 */
 
 	statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,chanPtr);
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-	/*
-	 * Set the TIMER flag to notify the higher levels that the driver
-	 * might have no data for us. We do this only if we are in
-	 * non-blocking mode and the driver has no BlockModeProc because only
-	 * then we really don't know if the driver will block or not. A
-	 * similar test is done in "PeekAhead".
-	 */
-
-	if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
-	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) {
-	    SetFlag(statePtr, CHANNEL_TIMER_FEV);
-	}
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
 	Tcl_Preserve(statePtr);
 	Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-	ResetFlag(statePtr, CHANNEL_TIMER_FEV);
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
 	Tcl_Release(statePtr);
     } else {
 	statePtr->timer = NULL;
@@ -10381,10 +10272,6 @@ DumpFlags(
     ChanFlag('/', INPUT_SAW_CR);
     ChanFlag('D', CHANNEL_DEAD);
     ChanFlag('R', CHANNEL_RAW_MODE);
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-    ChanFlag('T', CHANNEL_TIMER_FEV);
-    ChanFlag('H', CHANNEL_HAS_MORE_DATA);
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
     ChanFlag('x', CHANNEL_INCLOSE);
 
     buf[i] ='\0';
diff --git a/generic/tclIO.h b/generic/tclIO.h
index a57d4c5..59754cf 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -271,29 +271,6 @@ typedef struct ChannelState {
 					 * changes. */
 #define CHANNEL_RAW_MODE	(1<<16)	/* When set, notes that the Raw API is
 					 * being used. */
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-#define CHANNEL_TIMER_FEV	(1<<17)	/* When set the event we are notified
-					 * by is a fileevent generated by a
-					 * timer. We don't know if the driver
-					 * has more data and should not try to
-					 * read from it. If the system needs
-					 * more than is in the buffers out
-					 * read routines will simulate a short
-					 * read (0 characters read) */
-#define CHANNEL_HAS_MORE_DATA   (1<<18) /* Set by NotifyChannel for a channel
-					 * if and only if the channel is
-					 * configured non-blocking, the driver
-					 * for said channel has no
-					 * blockmodeproc, and data has arrived
-					 * for reading at the OS level). A
-					 * GetInput will pass reading from the
-					 * driver if the channel is
-					 * non-blocking, without blockmode
-					 * proc and the flag has not been set.
-					 * A read will be performed if the
-					 * flag is set. This will reset the
-					 * flag as well. */
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
 
 #define CHANNEL_INCLOSE		(1<<19)	/* Channel is currently being closed.
 					 * Its structures are still live and
-- 
cgit v0.12


From 69b5edf8708c05f4abdb039c64ea28932478b400 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 19 Mar 2014 20:32:37 +0000
Subject: Complete rewrite of DoRead().

---
 generic/tclIO.c | 288 ++++++++++++++++++++++++++------------------------------
 1 file changed, 132 insertions(+), 156 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 0f894e4..2d22942 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -11,6 +11,7 @@
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
+#undef NDEBUG
 #include "tclInt.h"
 #include "tclIO.h"
 #include <assert.h>
@@ -173,8 +174,6 @@ static void		CleanupChannelHandlers(Tcl_Interp *interp,
 static int		CloseChannel(Tcl_Interp *interp, Channel *chanPtr,
 			    int errorCode);
 static void		CommonGetsCleanup(Channel *chanPtr);
-static int		CopyAndTranslateBuffer(ChannelState *statePtr,
-			    char *result, int space);
 static int		CopyBuffer(Channel *chanPtr, char *result, int space);
 static int		CopyData(CopyState *csPtr, int mask);
 static void		CopyEventProc(ClientData clientData, int mask);
@@ -188,7 +187,7 @@ static int		DetachChannel(Tcl_Interp *interp, Tcl_Channel chan);
 static void		DiscardInputQueued(ChannelState *statePtr,
 			    int discardSavedBuffers);
 static void		DiscardOutputQueued(ChannelState *chanPtr);
-static int		DoRead(Channel *chanPtr, char *srcPtr, int slen);
+static int		DoRead(Channel *chanPtr, char *dst, int bytesToRead);
 static int		DoReadChars(Channel *chan, Tcl_Obj *objPtr, int toRead,
 			    int appendFlag);
 static int		FilterInputBytes(Channel *chanPtr,
@@ -5363,7 +5362,7 @@ ReadChars(
 	     *	  record \r or \n yet.
 	     */
 
-	    assert(dstRead + 1 == dstDecoded);
+//	    assert(dstRead + 1 == dstDecoded);
 	    assert(dst[dstRead] == '\r');
 	    assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF);
 
@@ -5384,7 +5383,7 @@ ReadChars(
 
 	    assert(dstWrote == 0);
 	    assert(dstRead == 0);
-	    assert(dstDecoded == 1);
+//	    assert(dstDecoded == 1);
 
 	    /*
 	     * We decoded only the bare cr, and we cannot read a
@@ -5882,6 +5881,9 @@ DiscardInputQueued(
  *
  *	Reads input data from a device into a channel buffer.
  *
+ *	IMPORTANT!  This routine is only called on a chanPtr argument
+ *	that is the top channel of a stack!
+ *
  * Results:
  *	The return value is the Posix error code if an error occurred while
  *	reading from the file, or 0 otherwise.
@@ -8633,13 +8635,24 @@ CopyData(
  *
  * DoRead --
  *
- *	Reads a given number of bytes from a channel.
+ *	Stores up to "bytesToRead" bytes in memory pointed to by "dst".
+ *	These bytes come from reading the channel "chanPtr" and 
+ *	performing the configured translations.
  *
  *	No encoding conversions are applied to the bytes being read.
  *
  * Results:
- *	The number of characters read, or -1 on error. Use Tcl_GetErrno() to
- *	retrieve the error code for the error that occurred.
+ *	The number of bytes actually stored (<= bytesToRead),
+ * 	or -1 if there is an error in reading the channel.  Use
+ * 	Tcl_GetErrno() to retrieve the error code for the error
+ *	that occurred.
+ *
+ *	The number of bytes stored can be less than the number
+ * 	requested when
+ *	  - EOF is reached on the channel; or
+ *	  - the channel is non-blocking, and we've read all we can
+ *	    without blocking.
+ *	  - a channel reading error occurs (and we return -1)
  *
  * Side effects:
  *	May cause input to be buffered.
@@ -8650,186 +8663,149 @@ CopyData(
 static int
 DoRead(
     Channel *chanPtr,		/* The channel from which to read. */
-    char *bufPtr,		/* Where to store input read. */
-    int toRead)			/* Maximum number of bytes to read. */
+    char *dst,		/* Where to store input read. */
+    int bytesToRead)		/* Maximum number of bytes to read. */
 {
     ChannelState *statePtr = chanPtr->state;
-				/* State info for channel */
-    int copied;			/* How many characters were copied into the
-				 * result string? */
-    int copiedNow;		/* How many characters were copied from the
-				 * current input buffer? */
-    int result;			/* Of calling GetInput. */
+    char *p = dst;
 
-    /*
-     * If we have not encountered a sticky EOF, clear the EOF bit. Either way
-     * clear the BLOCKED bit. We want to discover these anew during each
-     * operation.
-     */
+    while (bytesToRead) {
+	/*
+	 * Each pass through the loop is intended to process up to 
+	 * one channel buffer.
+	 * 
+	 * First, if there is no full buffer, we attempt to 
+	 * create and/or fill one.
+	 */
 
-    if (!(statePtr->flags & CHANNEL_STICKY_EOF)) {
-	ResetFlag(statePtr, CHANNEL_EOF);
-    }
-    ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
+	ChannelBuffer *bufPtr = statePtr->inQueueHead;
 
-    for (copied = 0; copied < toRead; copied += copiedNow) {
-	copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied,
-		toRead - copied);
-	if (copiedNow == 0) {
-	    if (statePtr->flags & CHANNEL_EOF) {
-		goto done;
-	    }
-	    if (statePtr->flags & CHANNEL_BLOCKED) {
-		if (statePtr->flags & CHANNEL_NONBLOCKING) {
-		    goto done;
-		}
-		ResetFlag(statePtr, CHANNEL_BLOCKED);
+	if (statePtr->flags & CHANNEL_EOF
+		&& (bufPtr == NULL || IsBufferEmpty(bufPtr))) {
+	    break;
+	}
+
+	while (bufPtr == NULL || !IsBufferFull(bufPtr)) {
+	    int code;
+
+	    ResetFlag(statePtr, CHANNEL_BLOCKED);
+	moreData:
+	    code = GetInput(chanPtr);
+	    bufPtr = statePtr->inQueueHead;
+	    if (statePtr->flags & (CHANNEL_EOF|CHANNEL_BLOCKED)) {
+		/* Further reads cannot do any more */
+		break;
 	    }
-	    result = GetInput(chanPtr);
-	    if (result != 0) {
-		if (result != EAGAIN) {
-		    copied = -1;
-		}
-		goto done;
+	    
+	    if (code) {
+		/* Read error */
+		UpdateInterest(chanPtr);
+		return -1;
 	    }
 	}
-    }
 
-    ResetFlag(statePtr, CHANNEL_BLOCKED);
+	/* Here we know bufPtr != NULL */
+	int bytesRead = BytesLeft(bufPtr);
+	int bytesWritten = bytesToRead;
 
-    /*
-     * Update the notifier state so we don't block while there is still data
-     * in the buffers.
-     */
+	if (bytesRead == 0 && statePtr->flags & CHANNEL_NONBLOCKING
+		&& statePtr->flags & CHANNEL_BLOCKED) {
+	    break;
+	}
 
-  done:
-    UpdateInterest(chanPtr);
-    return copied;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CopyAndTranslateBuffer --
- *
- *	Copy at most one buffer of input to the result space, doing eol
- *	translations according to mode in effect currently.
- *
- * Results:
- *	Number of bytes stored in the result buffer (as opposed to the number
- *	of bytes read from the channel). May return zero if no input is
- *	available to be translated.
- *
- * Side effects:
- *	Consumes buffered input. May deallocate one buffer.
- *
- *----------------------------------------------------------------------
- */
+	TranslateInputEOL(statePtr, p, RemovePoint(bufPtr),
+		&bytesWritten, &bytesRead);
+	bufPtr->nextRemoved += bytesRead;
+	p += bytesWritten;
+	bytesToRead -= bytesWritten;
 
-static int
-CopyAndTranslateBuffer(
-    ChannelState *statePtr,	/* Channel state from which to read input. */
-    char *result,		/* Where to store the copied input. */
-    int space)			/* How many bytes are available in result to
-				 * store the copied input? */
-{
-    ChannelBuffer *bufPtr;	/* The buffer from which to copy bytes. */
-    int bytesInBuffer;		/* How many bytes are available to be copied
-				 * in the current input buffer? */
-    int copied;			/* How many characters were already copied
-				 * into the destination space? */
+	if (!IsBufferEmpty(bufPtr)) {
+	    /*
+	     * Buffer is not empty.  How can that be?
+	     *
+	     * 0) We stopped early because we got all the bytes
+	     *    we were seeking.  That's fine.
+	     */
 
-    /*
-     * If there is no input at all, return zero. The invariant is that either
-     * there is no buffer in the queue, or if the first buffer is empty, it is
-     * also the last buffer (and thus there is no input in the queue). Note
-     * also that if the buffer is empty, we leave it in the queue.
-     */
+	    if (bytesToRead == 0) {
+		UpdateInterest(chanPtr);
+		break;
+	    }
 
-    if (statePtr->inQueueHead == NULL) {
-	return 0;
-    }
-    bufPtr = statePtr->inQueueHead;
-    bytesInBuffer = BytesLeft(bufPtr);
-    if (bytesInBuffer == 0) {
-	return 0;
-    }
+	    /*
+	     * 1) We're @EOF because we saw eof char.
+	     */
 
-    copied = space;
-    TranslateInputEOL(statePtr, result, RemovePoint(bufPtr),
-	    &copied, &bytesInBuffer);
-    bufPtr->nextRemoved += bytesInBuffer;
+	    if (statePtr->inEofChar
+		    && RemovePoint(bufPtr)[0] == statePtr->inEofChar) {
+		UpdateInterest(chanPtr);
+		break;
+	    }
 
-    /*
-     * If the current buffer is empty recycle it.
-     */
+	    /*
+	     * 2) The buffer holds a \r while in CRLF translation, followed
+	     *    by either the end of the buffer, or the eof char.
+	     */
 
-    if (IsBufferEmpty(bufPtr)) {
-	statePtr->inQueueHead = bufPtr->nextPtr;
-	if (statePtr->inQueueHead == NULL) {
-	    statePtr->inQueueTail = NULL;
-	}
-	RecycleBuffer(statePtr, bufPtr, 0);
-    } else {
+	    assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF);
+	    assert(RemovePoint(bufPtr)[0] == '\r');
 
-	if (copied > 0) {
-	    return copied;
-	}
+	    if (BytesLeft(bufPtr) > 1) {
 
-	if (statePtr->inEofChar
-		&& RemovePoint(bufPtr)[0] == statePtr->inEofChar) {
-	    return 0;
-	}
+		/* TODO: shift this to TIEOL */
+		assert(statePtr->inEofChar);
+		assert(RemovePoint(bufPtr)[1] == statePtr->inEofChar);
 
-	if (BytesLeft(bufPtr) == 1) {
+		bufPtr->nextRemoved++;
+		*p++ = '\r';
+		bytesToRead--;
+		UpdateInterest(chanPtr);
+		break;
+	    }
 
-	    ChannelBuffer *nextPtr = bufPtr->nextPtr;
+	    assert(BytesLeft(bufPtr) == 1);
 
-	    if (nextPtr == NULL) {
+	    if (bufPtr->nextPtr == NULL) {
+		/* There's no more buffered data.... */
 
 		if (statePtr->flags & CHANNEL_EOF) {
-		    *result = '\r';
-		    bufPtr->nextRemoved += 1;
-		    return 1;
-		}
+		    /* ...and there never will be. */
 
-		SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
-		return 0;
+		    *p++ = '\r';
+		    bytesToRead--;
+		    bufPtr->nextRemoved++;
+		} else if (statePtr->flags & CHANNEL_BLOCKED) {
+		    /* ...and we cannot get more now. */
+		    SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
+		    UpdateInterest(chanPtr);
+		    break;
+		} else {
+		    /* ... so we need to get some. */
+		    goto moreData;
+		}
 	    }
 
-	    nextPtr->nextRemoved -= 1;
-	    memcpy(RemovePoint(nextPtr), RemovePoint(bufPtr), 1);
-	    RecycleBuffer(statePtr, bufPtr, 0);
-	    statePtr->inQueueHead = nextPtr;
-	    return 0;
-	}
+	    if (bufPtr->nextPtr) {
+		/* There's a next buffer.  Shift orphan \r to it. */
 
-	if (statePtr->inEofChar
-		&& RemovePoint(bufPtr)[1] == statePtr->inEofChar) {
-	    *result = '\r';
-	    bufPtr->nextRemoved += 1;
-	    return 1;
+		ChannelBuffer *nextPtr = bufPtr->nextPtr;
+
+		nextPtr->nextRemoved -= 1;
+		RemovePoint(nextPtr)[0] = '\r';
+		bufPtr->nextRemoved++;
+	    }
 	}
-	/*
-	 * Buffer is not empty.  How can that be?
-	 * 0) We stopped early due to the value of "space".
-	 * 	=> copied > 0 and all is fine.
-	 * 1) We saw eof char and stopped the translation copy.
-	 *	=> if (copied > 0) or ((copied == 0) and @ eof char),
-	 *		return is fine.
-	 * 2) The buffer holds a \r while in CRLF translation, followed
-	 *    by either the end of the buffer, or the eof char.
-	 */
 
+	if (IsBufferEmpty(bufPtr)) {
+	    statePtr->inQueueHead = bufPtr->nextPtr;
+	    if (statePtr->inQueueHead == NULL) {
+		statePtr->inQueueTail = NULL;
+	    }
+	    RecycleBuffer(statePtr, bufPtr, 0);
+	}
     }
 
-    /*
-     * Return the number of characters copied into the result buffer. This may
-     * be different from the number of bytes consumed, because of EOL
-     * translations.
-     */
-
-    return copied;
+    return (int)(p - dst);
 }
 
 /*
-- 
cgit v0.12


From a174107efac416856e4183ea90821edac8c266b2 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 19 Mar 2014 21:43:31 +0000
Subject: Let TranslateInputEOL handle the "\r$eofChar" sequence in CRLF mode.

---
 generic/tclIO.c | 44 +++++++++++++++++---------------------------
 1 file changed, 17 insertions(+), 27 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 2d22942..267b659 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5362,7 +5362,7 @@ ReadChars(
 	     *	  record \r or \n yet.
 	     */
 
-//	    assert(dstRead + 1 == dstDecoded);
+	    assert(dstRead + 1 == dstDecoded);
 	    assert(dst[dstRead] == '\r');
 	    assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF);
 
@@ -5383,7 +5383,7 @@ ReadChars(
 
 	    assert(dstWrote == 0);
 	    assert(dstRead == 0);
-//	    assert(dstDecoded == 1);
+	    assert(dstDecoded == 1);
 
 	    /*
 	     * We decoded only the bare cr, and we cannot read a
@@ -5620,10 +5620,14 @@ TranslateInputEOL(
 	    src += numBytes; srcLen -= numBytes;
 	    if (srcLen == 1) {
 		/* valid src bytes end in \r */
-		lesser = 0;
-		break;
-	    }
-	    if (src[1] == '\n') {
+		if (eof) {
+		    *dst++ = '\r';
+		    src++; srcLen--;
+		} else {
+		    lesser = 0;
+		    break;
+		}
+	    } else if (src[1] == '\n') {
 		*dst++ = '\n';
 		src += 2; srcLen -= 2;
 	    } else {
@@ -8708,11 +8712,6 @@ DoRead(
 	int bytesRead = BytesLeft(bufPtr);
 	int bytesWritten = bytesToRead;
 
-	if (bytesRead == 0 && statePtr->flags & CHANNEL_NONBLOCKING
-		&& statePtr->flags & CHANNEL_BLOCKED) {
-	    break;
-	}
-
 	TranslateInputEOL(statePtr, p, RemovePoint(bufPtr),
 		&bytesWritten, &bytesRead);
 	bufPtr->nextRemoved += bytesRead;
@@ -8743,26 +8742,12 @@ DoRead(
 	    }
 
 	    /*
-	     * 2) The buffer holds a \r while in CRLF translation, followed
-	     *    by either the end of the buffer, or the eof char.
+	     * 2) The buffer holds a \r while in CRLF translation,
+	     *    followed by the end of the buffer.
 	     */
 
 	    assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF);
 	    assert(RemovePoint(bufPtr)[0] == '\r');
-
-	    if (BytesLeft(bufPtr) > 1) {
-
-		/* TODO: shift this to TIEOL */
-		assert(statePtr->inEofChar);
-		assert(RemovePoint(bufPtr)[1] == statePtr->inEofChar);
-
-		bufPtr->nextRemoved++;
-		*p++ = '\r';
-		bytesToRead--;
-		UpdateInterest(chanPtr);
-		break;
-	    }
-
 	    assert(BytesLeft(bufPtr) == 1);
 
 	    if (bufPtr->nextPtr == NULL) {
@@ -8803,6 +8788,11 @@ DoRead(
 	    }
 	    RecycleBuffer(statePtr, bufPtr, 0);
 	}
+
+	if (statePtr->flags & CHANNEL_NONBLOCKING
+		&& statePtr->flags & CHANNEL_BLOCKED) {
+	    break;
+	}
     }
 
     return (int)(p - dst);
-- 
cgit v0.12


From afc78cdb50eea22471934dad252ce914c1bf492b Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 20 Mar 2014 09:22:29 +0000
Subject: Proposed fix for [2f7cbd01c3].

---
 unix/configure | 24 ++++++++++--------------
 unix/tcl.m4    | 24 ++++++++++--------------
 2 files changed, 20 insertions(+), 28 deletions(-)

diff --git a/unix/configure b/unix/configure
index 6800fe2..55127c2 100755
--- a/unix/configure
+++ b/unix/configure
@@ -7639,15 +7639,6 @@ fi
 
 fi
 
-	    case $system in
-	    FreeBSD-3.*)
-	    	# FreeBSD-3 doesn't handle version numbers with dots.
-	    	UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
-	    	SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so'
-	    	TCL_LIB_VERSIONS_OK=nodots
-		;;
-	    esac
-	    ;;
 	FreeBSD-*)
 	    # This configuration from FreeBSD Ports.
 	    SHLIB_CFLAGS="-fPIC"
@@ -7672,11 +7663,16 @@ fi
 		LDFLAGS="$LDFLAGS $PTHREAD_LIBS"
 fi
 
-	    # Version numbers are dot-stripped by system policy.
-	    TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .`
-	    UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
-	    SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1'
-	    TCL_LIB_VERSIONS_OK=nodots
+	    case $system in
+	    FreeBSD-3.*)
+		# Version numbers are dot-stripped by system policy.
+		TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .`
+		UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
+		SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so'
+		TCL_LIB_VERSIONS_OK=nodots
+		;;
+	    esac
+	    ;;
 	    ;;
 	Darwin-*)
 	    CFLAGS_OPTIMIZE="-Os"
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index c57111b..afe20dc 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -1550,15 +1550,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 		CFLAGS="$CFLAGS -pthread"
 	    	LDFLAGS="$LDFLAGS -pthread"
 	    ])
-	    case $system in
-	    FreeBSD-3.*)
-	    	# FreeBSD-3 doesn't handle version numbers with dots.
-	    	UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
-	    	SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so'
-	    	TCL_LIB_VERSIONS_OK=nodots
-		;;
-	    esac
-	    ;;
 	FreeBSD-*)
 	    # This configuration from FreeBSD Ports.
 	    SHLIB_CFLAGS="-fPIC"
@@ -1577,11 +1568,16 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 		LIBS=`echo $LIBS | sed s/-pthread//`
 		CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
 		LDFLAGS="$LDFLAGS $PTHREAD_LIBS"])
-	    # Version numbers are dot-stripped by system policy.
-	    TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .`
-	    UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
-	    SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1'
-	    TCL_LIB_VERSIONS_OK=nodots
+	    case $system in
+	    FreeBSD-3.*)
+		# Version numbers are dot-stripped by system policy.
+		TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .`
+		UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
+		SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so'
+		TCL_LIB_VERSIONS_OK=nodots
+		;;
+	    esac
+	    ;;
 	    ;;
 	Darwin-*)
 	    CFLAGS_OPTIMIZE="-Os"
-- 
cgit v0.12


From eae6f97866efd02f09d961bf695047a3b47ac961 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 20 Mar 2014 16:31:11 +0000
Subject: Use assertions about the pushback buffers to simplify their handling.
 Mark several things left TODO.  Some tidying.

---
 generic/tclIO.c | 60 +++++++++++++++++++++++++++++++++++----------------------
 1 file changed, 37 insertions(+), 23 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 267b659..b423bcc 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -6,6 +6,7 @@
  *
  * Copyright (c) 1998-2000 Ajuba Solutions
  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Contributions from Don Porter, NIST, 2014. (not subject to US copyright)
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -1679,17 +1680,17 @@ Tcl_StackChannel(
      */
 
     if (((mask & TCL_READABLE) != 0) && (statePtr->inQueueHead != NULL)) {
+
 	/*
-	 * Remark: It is possible that the channel buffers contain data from
-	 * some earlier push-backs.
+	 * When statePtr->inQueueHead is not NULL, we know
+	 * prevChanPtr->inQueueHead must be NULL.
 	 */
 
-	statePtr->inQueueTail->nextPtr = prevChanPtr->inQueueHead;
-	prevChanPtr->inQueueHead = statePtr->inQueueHead;
+	assert(prevChanPtr->inQueueHead == NULL);
+	assert(prevChanPtr->inQueueTail == NULL);
 
-	if (prevChanPtr->inQueueTail == NULL) {
-	    prevChanPtr->inQueueTail = statePtr->inQueueTail;
-	}
+	prevChanPtr->inQueueHead = statePtr->inQueueHead;
+	prevChanPtr->inQueueTail = statePtr->inQueueTail;
 
 	statePtr->inQueueHead = NULL;
 	statePtr->inQueueTail = NULL;
@@ -2254,6 +2255,7 @@ RecycleBuffer(
     }
 
     /*
+     * TODO
      * Only save buffers which are at least as big as the requested buffersize
      * for the channel. This is to honor dynamic changes of the buffersize
      * made by the user.
@@ -3696,9 +3698,7 @@ Write(
 		&statePtr->outputEncodingState, dst,
 		dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL);
 
-	    if (srcRead != nlLen) {
-		Tcl_Panic("Can This Happen?");
-	    }
+	    assert (srcRead == nlLen);
 
 	    bufPtr->nextAdded += dstWrote;
 	    src++;
@@ -4837,6 +4837,7 @@ Tcl_ReadRaw(
     int nread, result, copied, copiedNow;
 
     /*
+     * TODO VERIFY
      * The check below does too much because it will reject a call to this
      * function with a channel which is part of an 'fcopy'. But we have to
      * allow this here or else the chaining in the transformation drivers will
@@ -5925,16 +5926,11 @@ GetInput(
      * channel in the stack and use them. They can be the result of a
      * transformation which went away without reading all the information
      * placed in the area when it was stacked.
-     *
-     * Two possibilities for the state: No buffers in it, or a single empty
-     * buffer. In the latter case we can recycle it now.
      */
 
     if (chanPtr->inQueueHead != NULL) {
-	if (statePtr->inQueueHead != NULL) {
-	    RecycleBuffer(statePtr, statePtr->inQueueHead, 0);
-	    statePtr->inQueueHead = NULL;
-	}
+
+	assert(statePtr->inQueueHead == NULL);
 
 	statePtr->inQueueHead = chanPtr->inQueueHead;
 	statePtr->inQueueTail = chanPtr->inQueueTail;
@@ -5962,6 +5958,7 @@ GetInput(
 	statePtr->saveInBufPtr = NULL;
 
 	/*
+	 * TODO
 	 * Check the actual buffersize against the requested buffersize.
 	 * Buffers which are smaller than requested are squashed. This is done
 	 * to honor dynamic changes of the buffersize made by the user.
@@ -5979,6 +5976,7 @@ GetInput(
 	bufPtr->nextPtr = NULL;
 
 	/*
+	 * TODO
 	 * SF #427196: Use the actual size of the buffer to determine the
 	 * number of bytes to read from the channel and not the size for new
 	 * buffers. They can be different if the buffersize was changed
@@ -6003,6 +6001,7 @@ GetInput(
     }
 
     /*
+     * TODO 
      * If EOF is set, we should avoid calling the driver because on some
      * platforms it is impossible to read from a device after EOF.
      */
@@ -6524,6 +6523,7 @@ CheckChannelErrors(
 
     if (direction == TCL_READABLE) {
 	/*
+	 * TODO
 	 * If we have not encountered a sticky EOF, clear the EOF bit (sticky
 	 * EOF is set if we have seen the input eofChar, to prevent reading
 	 * beyond the eofChar). Also, always clear the BLOCKED bit. We want to
@@ -6739,6 +6739,7 @@ Tcl_SetChannelBufferSize(
     ChannelState *statePtr;	/* State of real channel structure. */
 
     /*
+     * TODO
      * Clip the buffer size to force it into the [1,1M] range
      */
 
@@ -7375,6 +7376,7 @@ Tcl_SetChannelOption(
     }
 
     /*
+     * TODO
      * If bufsize changes, need to get rid of old utility buffer.
      */
 
@@ -8677,18 +8679,23 @@ DoRead(
 	/*
 	 * Each pass through the loop is intended to process up to 
 	 * one channel buffer.
-	 * 
-	 * First, if there is no full buffer, we attempt to 
-	 * create and/or fill one.
 	 */
 
+	int bytesRead, bytesWritten;
 	ChannelBuffer *bufPtr = statePtr->inQueueHead;
 
+	/*
+	 * When there's no buffered data to read, and we're at EOF,
+	 * escape to the caller.
+	 */
+
 	if (statePtr->flags & CHANNEL_EOF
 		&& (bufPtr == NULL || IsBufferEmpty(bufPtr))) {
 	    break;
 	}
 
+	/* If there is no full buffer, attempt to create and/or fill one. */
+
 	while (bufPtr == NULL || !IsBufferFull(bufPtr)) {
 	    int code;
 
@@ -8696,6 +8703,9 @@ DoRead(
 	moreData:
 	    code = GetInput(chanPtr);
 	    bufPtr = statePtr->inQueueHead;
+
+	    assert (bufPtr != NULL);
+
 	    if (statePtr->flags & (CHANNEL_EOF|CHANNEL_BLOCKED)) {
 		/* Further reads cannot do any more */
 		break;
@@ -8706,11 +8716,14 @@ DoRead(
 		UpdateInterest(chanPtr);
 		return -1;
 	    }
+
+	    assert (IsBufferFull(bufPtr));
 	}
 
-	/* Here we know bufPtr != NULL */
-	int bytesRead = BytesLeft(bufPtr);
-	int bytesWritten = bytesToRead;
+	assert (bufPtr != NULL);
+
+	bytesRead = BytesLeft(bufPtr);
+	bytesWritten = bytesToRead;
 
 	TranslateInputEOL(statePtr, p, RemovePoint(bufPtr),
 		&bytesWritten, &bytesRead);
@@ -10155,6 +10168,7 @@ SetChannelFromAny(
     }
     if (objPtr->typePtr == &chanObjType) {
 	/*
+	 * TODO: TAINT Flag and dup'd channel values?
 	 * The channel is valid until any call to DetachChannel occurs.
 	 * Ensure consistency checks are done.
 	 */
-- 
cgit v0.12


From 8c3da02c3e41f1b7e029ed7633e250646fe7ec82 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 20 Mar 2014 19:25:11 +0000
Subject: Stop routine clearing of CHANNEL_EOF.  Only clear when there's a
 reason (seek, eofchar change, ungets).  Otherwise, once you hit EOF you stay
 there.

---
 generic/tclIO.c | 24 ++++++------------------
 1 file changed, 6 insertions(+), 18 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index b423bcc..1a56811 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4837,7 +4837,6 @@ Tcl_ReadRaw(
     int nread, result, copied, copiedNow;
 
     /*
-     * TODO VERIFY
      * The check below does too much because it will reject a call to this
      * function with a channel which is part of an 'fcopy'. But we have to
      * allow this here or else the chaining in the transformation drivers will
@@ -5742,16 +5741,11 @@ Tcl_Ungets(
     statePtr->flags = flags;
 
     /*
-     * If we have encountered a sticky EOF, just punt without storing (sticky
-     * EOF is set if we have seen the input eofChar, to prevent reading beyond
-     * the eofChar). Otherwise, clear the EOF flags, and clear the BLOCKED
-     * bit. We want to discover these conditions anew in each operation.
+     * Clear the EOF flags, and clear the BLOCKED bit.
      */
 
-    if (statePtr->flags & CHANNEL_STICKY_EOF) {
-	goto done;
-    }
-    ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_EOF);
+    ResetFlag(statePtr,
+	    CHANNEL_BLOCKED | CHANNEL_STICKY_EOF | CHANNEL_EOF | INPUT_SAW_CR);
 
     bufPtr = AllocChannelBuffer(len);
     memcpy(InsertPoint(bufPtr), str, (size_t) len);
@@ -6001,7 +5995,7 @@ GetInput(
     }
 
     /*
-     * TODO 
+     * 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.
      */
@@ -6523,16 +6517,10 @@ CheckChannelErrors(
 
     if (direction == TCL_READABLE) {
 	/*
-	 * TODO
-	 * If we have not encountered a sticky EOF, clear the EOF bit (sticky
-	 * EOF is set if we have seen the input eofChar, to prevent reading
-	 * beyond the eofChar). Also, always clear the BLOCKED bit. We want to
-	 * discover these conditions anew in each operation.
+	 * Clear the BLOCKED bit. We want to discover this condition
+	 * anew in each operation.
 	 */
 
-	if ((statePtr->flags & CHANNEL_STICKY_EOF) == 0) {
-	    ResetFlag(statePtr, CHANNEL_EOF);
-	}
 	ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
     }
 
-- 
cgit v0.12


From 60a84571795909d2b51dff06349107716ae3ab6d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 20 Mar 2014 20:18:20 +0000
Subject: Don't allow buffer recycling to prevent or delay buffersize
 shrinkage.

---
 generic/tclIO.c | 68 ++++++++++++++++++++++++---------------------------------
 1 file changed, 28 insertions(+), 40 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 1a56811..e7653f6 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -2255,13 +2255,12 @@ RecycleBuffer(
     }
 
     /*
-     * TODO
-     * Only save buffers which are at least as big as the requested buffersize
-     * for the channel. This is to honor dynamic changes of the buffersize
+     * Only save buffers which have the requested buffersize for the
+     * channel. This is to honor dynamic changes of the buffersize
      * made by the user.
      */
 
-    if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) {
+    if ((bufPtr->bufLength - BUFFER_PADDING) != statePtr->bufSize) {
 	ckfree((char *) bufPtr);
 	return;
     }
@@ -5952,14 +5951,13 @@ GetInput(
 	statePtr->saveInBufPtr = NULL;
 
 	/*
-	 * TODO
 	 * Check the actual buffersize against the requested buffersize.
-	 * Buffers which are smaller than requested are squashed. This is done
+	 * Saved buffers of the wrong size are squashed. This is done
 	 * to honor dynamic changes of the buffersize made by the user.
 	 */
 
 	if ((bufPtr != NULL)
-		&& (bufPtr->bufLength - BUFFER_PADDING < statePtr->bufSize)) {
+		&& (bufPtr->bufLength - BUFFER_PADDING != statePtr->bufSize)) {
 	    ckfree((char *) bufPtr);
 	    bufPtr = NULL;
 	}
@@ -5969,22 +5967,8 @@ GetInput(
 	}
 	bufPtr->nextPtr = NULL;
 
-	/*
-	 * TODO
-	 * SF #427196: Use the actual size of the buffer to determine the
-	 * number of bytes to read from the channel and not the size for new
-	 * buffers. They can be different if the buffersize was changed
-	 * between reads.
-	 *
-	 * Note: This affects performance negatively if the buffersize was
-	 * extended but this small buffer is reused for all subsequent reads.
-	 * The system never uses buffers with the requested bigger size in
-	 * that case. An adjunct patch could try and delete all unused buffers
-	 * it encounters and which are smaller than the formally requested
-	 * buffersize.
-	 */
-
 	toRead = SpaceLeft(bufPtr);
+	assert(toRead == statePtr->bufSize);
 
 	if (statePtr->inQueueTail == NULL) {
 	    statePtr->inQueueHead = bufPtr;
@@ -6727,7 +6711,6 @@ Tcl_SetChannelBufferSize(
     ChannelState *statePtr;	/* State of real channel structure. */
 
     /*
-     * TODO
      * Clip the buffer size to force it into the [1,1M] range
      */
 
@@ -6738,7 +6721,27 @@ Tcl_SetChannelBufferSize(
     }
 
     statePtr = ((Channel *) chan)->state;
+
+    if (statePtr->bufSize == sz) {
+	return;
+    }
     statePtr->bufSize = sz;
+
+    /*
+     * If bufsize changes, need to get rid of old utility buffer.
+     */
+
+    if (statePtr->saveInBufPtr != NULL) {
+	RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1);
+	statePtr->saveInBufPtr = NULL;
+    }
+    if ((statePtr->inQueueHead != NULL)
+	    && (statePtr->inQueueHead->nextPtr == NULL)
+	    && IsBufferEmpty(statePtr->inQueueHead)) {
+	RecycleBuffer(statePtr, statePtr->inQueueHead, 1);
+	statePtr->inQueueHead = NULL;
+	statePtr->inQueueTail = NULL;
+    }
 }
 
 /*
@@ -7172,6 +7175,7 @@ Tcl_SetChannelOption(
 	    return TCL_ERROR;
 	}
 	Tcl_SetChannelBufferSize(chan, newBufferSize);
+	return TCL_OK;
     } else if (HaveOpt(2, "-encoding")) {
 	Tcl_Encoding encoding;
 
@@ -7202,6 +7206,7 @@ Tcl_SetChannelOption(
 	statePtr->outputEncodingFlags = TCL_ENCODING_START;
 	ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
 	UpdateInterest(chanPtr);
+	return TCL_OK;
     } else if (HaveOpt(2, "-eofchar")) {
 	if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
 	    return TCL_ERROR;
@@ -7363,23 +7368,6 @@ Tcl_SetChannelOption(
 	return Tcl_BadChannelOption(interp, optionName, NULL);
     }
 
-    /*
-     * TODO
-     * If bufsize changes, need to get rid of old utility buffer.
-     */
-
-    if (statePtr->saveInBufPtr != NULL) {
-	RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1);
-	statePtr->saveInBufPtr = NULL;
-    }
-    if ((statePtr->inQueueHead != NULL)
-	    && (statePtr->inQueueHead->nextPtr == NULL)
-	    && IsBufferEmpty(statePtr->inQueueHead)) {
-	RecycleBuffer(statePtr, statePtr->inQueueHead, 1);
-	statePtr->inQueueHead = NULL;
-	statePtr->inQueueTail = NULL;
-    }
-
     return TCL_OK;
 }
 
-- 
cgit v0.12


From 32fea5e38c09de7b9f9f19c93074ccdb8a6520d7 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 20 Mar 2014 23:21:48 +0000
Subject: Both callers of ChanRead() have simlar epilogs.  Shift that into
 ChanRead and refactor.

---
 generic/tclIO.c | 123 +++++++++++++++++++++++---------------------------------
 1 file changed, 50 insertions(+), 73 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index e7653f6..18dab5a 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -348,15 +348,39 @@ static inline int
 ChanRead(
     Channel *chanPtr,
     char *dst,
-    int dstSize,
-    int *errnoPtr)
+    int dstSize)
 {
+    int bytesRead, result;
+
     if (WillRead(chanPtr) < 0) {
         return -1;
     }
 
-    return chanPtr->typePtr->inputProc(chanPtr->instanceData, dst, dstSize,
-	    errnoPtr);
+    bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData,
+	    dst, dstSize, &result);
+
+    if (bytesRead > 0) {
+	/*
+	 * If we get a short read, signal up that we may be BLOCKED. We should
+	 * avoid calling the driver because on some platforms we will block in
+	 * the low level reading code even though the channel is set into
+	 * nonblocking mode.
+	 */
+
+	if (bytesRead < dstSize) {
+	    SetFlag(chanPtr->state, CHANNEL_BLOCKED);
+	}
+    } else if (bytesRead == 0) {
+	SetFlag(chanPtr->state, CHANNEL_EOF);
+	chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END;
+    } else { /* bytesRead < 0 */
+	if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
+	    SetFlag(chanPtr->state, CHANNEL_BLOCKED);
+	    result = EAGAIN;
+	}
+	Tcl_SetErrno(result);
+    }
+    return bytesRead;
 }
 
 static inline Tcl_WideInt
@@ -4833,7 +4857,7 @@ Tcl_ReadRaw(
     Channel *chanPtr = (Channel *) chan;
     ChannelState *statePtr = chanPtr->state;
 				/* State info for channel */
-    int nread, result, copied, copiedNow;
+    int nread, copied, copiedNow;
 
     /*
      * The check below does too much because it will reject a call to this
@@ -4862,11 +4886,11 @@ Tcl_ReadRaw(
 		bytesToRead - copied);
 	if (copiedNow == 0) {
 	    if (statePtr->flags & CHANNEL_EOF) {
-		goto done;
+		break;
 	    }
 	    if (statePtr->flags & CHANNEL_BLOCKED) {
 		if (statePtr->flags & CHANNEL_NONBLOCKING) {
-		    goto done;
+		    break;
 		}
 		ResetFlag(statePtr, CHANNEL_BLOCKED);
 	    }
@@ -4881,48 +4905,21 @@ Tcl_ReadRaw(
 	     * happen.
 	     */
 
-	    nread = ChanRead(chanPtr, bufPtr + copied,
-		    bytesToRead - copied, &result);
-
-	    if (nread > 0) {
-		/*
-		 * If we get a short read, signal up that we may be BLOCKED.
-		 * We should avoid calling the driver because on some
-		 * platforms we will block in the low level reading code even
-		 * though the channel is set into nonblocking mode.
-		 */
-
-		if (nread < (bytesToRead - copied)) {
-		    SetFlag(statePtr, CHANNEL_BLOCKED);
-		}
-	    } else if (nread == 0) {
-		SetFlag(statePtr, CHANNEL_EOF);
-		statePtr->inputEncodingFlags |= TCL_ENCODING_END;
-
-	    } else if (nread < 0) {
-		if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
-		    if (copied > 0) {
-			/*
-			 * Information that was copied earlier has precedence
-			 * over EAGAIN/WOULDBLOCK handling.
-			 */
-
-			return copied;
-		    }
+	    nread = ChanRead(chanPtr, bufPtr+copied, bytesToRead-copied);
 
-		    SetFlag(statePtr, CHANNEL_BLOCKED);
-		    result = EAGAIN;
+	    if (nread < 0) {
+		if (statePtr->flags & CHANNEL_BLOCKED && copied > 0) {
+		    ResetFlag(statePtr, CHANNEL_BLOCKED);
+		    break;
 		}
-
-		Tcl_SetErrno(result);
 		return -1;
 	    }
 
-	    return copied + nread;
+	    copied += nread;
+	    break;
 	}
     }
 
-  done:
     return copied;
 }
 
@@ -5019,7 +5016,7 @@ DoReadChars(
     ChannelState *statePtr = chanPtr->state;
 				/* State info for channel */
     ChannelBuffer *bufPtr;
-    int factor, copied, copiedNow, result;
+    int factor, copied, copiedNow;
     Tcl_Encoding encoding;
     int binaryMode;
 #define UTF_EXPANSION_FACTOR	1024
@@ -5090,9 +5087,8 @@ DoReadChars(
 		}
 		ResetFlag(statePtr, CHANNEL_BLOCKED);
 	    }
-	    result = GetInput(chanPtr);
-	    if (result != 0) {
-		if (result == EAGAIN) {
+	    if (GetInput(chanPtr) != 0) {
+		if (statePtr->flags & CHANNEL_BLOCKED) {
 		    break;
 		}
 		copied = -1;
@@ -5883,8 +5879,9 @@ DiscardInputQueued(
  *	that is the top channel of a stack!
  *
  * Results:
- *	The return value is the Posix error code if an error occurred while
- *	reading from the file, or 0 otherwise.
+ *	The return value is 0 to indicate success, or -1 if an error
+ * 	occurred while reading from the channel.  Call Tcl_GetErrno()
+ *	to get the Posix error code.
  *
  * Side effects:
  *	Reads from the underlying device.
@@ -5897,7 +5894,6 @@ GetInput(
     Channel *chanPtr)		/* Channel to read input from. */
 {
     int toRead;			/* How much to read? */
-    int result;			/* Of calling driver. */
     int nread;			/* How much was read from channel? */
     ChannelBuffer *bufPtr;	/* New buffer to add to input queue. */
     ChannelState *statePtr = chanPtr->state;
@@ -5911,7 +5907,8 @@ GetInput(
      */
 
     if (CheckForDeadChannel(NULL, statePtr)) {
-	return EINVAL;
+	Tcl_SetErrno(EINVAL);
+	return -1;
     }
 
     /*
@@ -5988,31 +5985,11 @@ GetInput(
 	return 0;
     }
 
-    nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead, &result);
-    if (nread > 0) {
-	bufPtr->nextAdded += nread;
-
-	/*
-	 * If we get a short read, signal up that we may be BLOCKED. We should
-	 * avoid calling the driver because on some platforms we will block in
-	 * the low level reading code even though the channel is set into
-	 * nonblocking mode.
-	 */
-
-	if (nread < toRead) {
-	    SetFlag(statePtr, CHANNEL_BLOCKED);
-	}
-    } else if (nread == 0) {
-	SetFlag(statePtr, CHANNEL_EOF);
-	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
-    } else if (nread < 0) {
-	if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
-	    SetFlag(statePtr, CHANNEL_BLOCKED);
-	    result = EAGAIN;
-	}
-	Tcl_SetErrno(result);
-	return result;
+    nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead);
+    if (nread < 0) {
+	return -1;
     }
+    bufPtr->nextAdded += nread;
     return 0;
 }
 
-- 
cgit v0.12


From f27a277c1e1c06a9ddd1c93606a9d884c8d844d7 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 21 Mar 2014 02:36:47 +0000
Subject: Documentation header for ChanRead()

---
 generic/tclIO.c | 25 +++++++++++++++++++++++--
 1 file changed, 23 insertions(+), 2 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 18dab5a..6e5dc05 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -342,9 +342,30 @@ static Tcl_ObjType chanObjType = {
 #define MAX_CHANNEL_BUFFER_SIZE (1024*1024)
 
 /*
- * ChanRead, dropped here by a time traveler, see 8.6
+ *---------------------------------------------------------------------------
+ *
+ * ChanRead --
+ *
+ *	Read up to bytes using the inputProc of chanPtr, store them at dst,
+ *	and return the number of bytes stored.
+ *
+ * Results:
+ *	The return value of the driver inputProc, 
+ *	  - number of bytes stored at dst, or
+ *	  - -1 on error, with a Posix error code available to the
+ *	    caller by calling Tcl_GetErrno().
+ *
+ * Side effects:
+ *	The CHANNEL_BLOCKED and CHANNEL_EOF flags of the channel
+ *	state are set as appropriate.
+ *	On EOF, the inputEncodingFlags are set to perform ending
+ *	operations on decoding.
+ *	TODO - Is this really the right place for that?
+ *
+ *---------------------------------------------------------------------------
  */
-static inline int
+
+static int
 ChanRead(
     Channel *chanPtr,
     char *dst,
-- 
cgit v0.12


From e21cda73652e2cf4a060a0411e779935b427a154 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 21 Mar 2014 12:56:46 +0000
Subject: io-34.21 - fix bugs in normally skipped test. io-35.18b - knownBug is
 not buggy on this branch.

---
 tests/io.test | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/tests/io.test b/tests/io.test
index cedb337..7f1a357 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -41,7 +41,7 @@ testConstraint testthread       [llength [info commands testthread]]
 
 # You need a *very* special environment to do some tests.  In
 # particular, many file systems do not support large-files...
-testConstraint largefileSupport 0
+testConstraint largefileSupport 1
 
 # some tests can only be run is umask is 2
 # if "umask" cannot be run, the tests will be skipped.
@@ -4433,10 +4433,10 @@ test io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport} {
     puts -nonewline $f abcdef
     lappend l [tell $f]
     close $f
-    lappend l [file size $f]
+    lappend l [file size $path(test3)]
     # truncate...
     close [open $path(test3) w]
-    lappend l [file size $f]
+    lappend l [file size $path(test3)]
     set l
 } {0 6 6 4294967296 4294967302 4294967302 0}
 
@@ -4729,7 +4729,7 @@ test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} -body {
     close $f
     list $s $l $e [scan [string index $in end] %c]
 } -result {9 8 1 13}
-test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} -constraints knownBug -body {
+test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} -body {
     file delete $path(test1)
     set f [open $path(test1) w]
     fconfigure $f -translation cr -eofchar \x1a
-- 
cgit v0.12


From 657b902a0e5afa5596833584329b653f7c0f277d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 21 Mar 2014 12:57:58 +0000
Subject: Fixup ChanRead() header.  Note (dstSize > 0) precondition.

---
 generic/tclIO.c | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 6e5dc05..e7eaefa 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -346,8 +346,8 @@ static Tcl_ObjType chanObjType = {
  *
  * ChanRead --
  *
- *	Read up to bytes using the inputProc of chanPtr, store them at dst,
- *	and return the number of bytes stored.
+ *	Read up to dstsize bytes using the inputProc of chanPtr, store
+ *	them at dst, and return the number of bytes stored.
  *
  * Results:
  *	The return value of the driver inputProc, 
@@ -373,6 +373,12 @@ ChanRead(
 {
     int bytesRead, result;
 
+    /*
+     * If the caller asked for zero bytes, we'd force the inputProc
+     * to return zero bytes, and then misinterpret that as EOF
+     */
+    assert(dstSize > 0);
+
     if (WillRead(chanPtr) < 0) {
         return -1;
     }
-- 
cgit v0.12


From 5bd5d7b876314f563f1ac021424b7f79f45196dd Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 21 Mar 2014 12:58:29 +0000
Subject: Restore default suppression of large file test.

---
 tests/io.test | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/io.test b/tests/io.test
index 7f1a357..bfe6051 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -41,7 +41,7 @@ testConstraint testthread       [llength [info commands testthread]]
 
 # You need a *very* special environment to do some tests.  In
 # particular, many file systems do not support large-files...
-testConstraint largefileSupport 1
+testConstraint largefileSupport 0
 
 # some tests can only be run is umask is 2
 # if "umask" cannot be run, the tests will be skipped.
-- 
cgit v0.12


From 6b106c4d93bfc4a452a3cf9d78aa3ee25761e553 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 21 Mar 2014 13:20:06 +0000
Subject: Convert "impossible" test to a "knownBug" test.  Exposes a segfault!

---
 tests/ioCmd.test | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 768a748..8f0bfbf 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -1927,6 +1927,8 @@ test iocmd-32.0 {origin interpreter of moved channel gone} -match glob -body {
 
 test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -match glob -body {
 
+    # This test segfaults;  Ought to fix that.
+
     set ida [interp create];#puts <<$ida>>
     set idb [interp create];#puts <<$idb>>
 
@@ -1940,13 +1942,12 @@ test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -m
 	proc foo {args} {
 	    oninit; onfinal; track;
 	    # destroy interpreter during channel access
-	    # Actually not possible for an interp to destroy itself.
-	    interp delete {}
-	    return}
+	    suicide}
 	set chan [chan create {r w} foo]
 	fconfigure $chan -buffering none
 	set chan
     }]
+    interp alias $ida suicide {} interp delete $ida
 
     # Move channel to 2nd thread.
     interp eval $ida [list testchannel cut    $chan]
@@ -1965,7 +1966,7 @@ test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -m
 	set res
     }]
     set res
-} -constraints {testchannel impossible} \
+} -constraints {testchannel knownBug} \
     -result {Owner lost}
 
 test iocmd-32.2 {delete interp of reflected chan} {
-- 
cgit v0.12


From f715783b1bff0fe44a894ff26049debf8cb184f2 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 21 Mar 2014 13:40:58 +0000
Subject: Added comment explaining the "knownBug"

---
 tests/iogt.test | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/tests/iogt.test b/tests/iogt.test
index 3882ecc..3b94747 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -916,6 +916,15 @@ test iogt-6.0 {Push back} testchannel {
 } {xxx}
 
 test iogt-6.1 {Push back and up} {testchannel knownBug} {
+
+    # This test demonstrates the bug/misfeature in the stacked
+    # channel implementation that data can be discarded if it is
+    # read into the buffers of one channel in the stack, and then
+    # that channel is popped before anything above it reads.
+    #
+    # This bug can be worked around by always setting -buffersize
+    # to 1, but who wants to do that?
+
     set f [open $path(dummy) r]
 
     # contents of dummy = "abcdefghi..."
-- 
cgit v0.12


From 129e8e28a57eb14bc1a2c5e06dd60f90124ab2bf Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 21 Mar 2014 14:07:40 +0000
Subject: Correct namespace bugs in normally skipped tests. Constrain them as
 "knownBug" rather than "unknownFailure".

---
 tests/iogt.test | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

diff --git a/tests/iogt.test b/tests/iogt.test
index 3b94747..0a25418 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -159,8 +159,8 @@ proc fevent {fdelay idelay blocks script data} {
 
     #puts stdout ">>>>>" ; flush stdout
 
-    uplevel #0 set sock $sk
-    set res [uplevel #0 $script]
+    uplevel 1 set sock $sk
+    set res [uplevel 1 $script]
 
     catch {close $sk}
     return $res
@@ -634,7 +634,7 @@ delete/write {} *ignored*}
 
 
 test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
-	{testchannel unknownFailure} {
+	{testchannel knownBug} {
     # This test to check the validity of aquired Tcl_Channel references is
     # not possible because even a backgrounded fcopy will immediately start
     # to copy data, without waiting for the event loop. This is done only in
@@ -651,6 +651,7 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
     set fin  [open $path(dummy) r]
 
     fevent 1000 500 {20 20 20 10 1 1} {
+	variable copy
 	close $fin
 
 	set          fout [open dummyout w]
@@ -688,7 +689,7 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
 } {1 {create/write create/read write flush/write flush/read delete/write delete/read}}
 
 
-test iogt-4.0 {fileevent readable, after transform} {testchannel unknownFailure} {
+test iogt-4.0 {fileevent readable, after transform} {testchannel knownBug} {
     set fin  [open $path(dummy) r]
     set data [read $fin]
     close $fin
@@ -718,10 +719,11 @@ test iogt-4.0 {fileevent readable, after transform} {testchannel unknownFailure}
     }
 
     fevent 1000 500 {20 20 20 10 1} {
+	variable stop
 	audit_flow trail   -attach $sock
 	rblocks_t  rbuf trail 23 -attach $sock
 
-	fileevent $sock readable [list Get $sock]
+	fileevent $sock readable [namespace code [list Get $sock]]
 
 	flush $sock ; # now, or fcopy will error us out
 	# But the 1 second delay should be enough to
@@ -819,7 +821,7 @@ delete/write {} *ignored*
 delete/read {} *ignored*}  ; # catch unescaped quote "
 
 
-test iogt-5.0 {EOF simulation} {testchannel unknownFailure} {
+test iogt-5.0 {EOF simulation} {testchannel knownBug} {
     set fin  [open $path(dummy)    r]
     set fout [open $path(dummyout) w]
 
-- 
cgit v0.12


From 2266861ddbdc18e12918eb94efeefc37edc894f8 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 21 Mar 2014 14:45:00 +0000
Subject: missing declaration

---
 generic/tclIO.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index e7eaefa..a62f80e 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -165,6 +165,7 @@ typedef struct CloseCallback {
 
 static ChannelBuffer *	AllocChannelBuffer(int length);
 static void		ChannelTimerProc(ClientData clientData);
+static int		ChanRead(Channel *chanPtr, char *dst, int dstSize);
 static int		CheckChannelErrors(ChannelState *statePtr,
 			    int direction);
 static int		CheckForDeadChannel(Tcl_Interp *interp,
-- 
cgit v0.12


From 72ae8dccf119510f1b175a9a2243a87069cef308 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 21 Mar 2014 17:11:32 +0000
Subject: Added comments raising questions about possible updates to channel
 drivers on Windows.

---
 win/tclWinChan.c    | 4 ++++
 win/tclWinConsole.c | 7 +++++++
 win/tclWinPipe.c    | 6 ++++++
 3 files changed, 17 insertions(+)

diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index c63aaa7..48acacb 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -662,6 +662,10 @@ FileInputProc(
     *errorCode = 0;
 
     /*
+     * TODO: This comment appears to be out of date.  We *do* have a
+     * console driver, over in tclWinConsole.c.  After some Windows
+     * developer confirms, this comment should be revised.
+     *
      * Note that we will block on reads from a console buffer until a full
      * line has been entered. The only way I know of to get around this is to
      * write a console driver. We should probably do this at some point, but
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index 0ec22c5..6630083 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.c
@@ -756,6 +756,13 @@ ConsoleInputProc(
 
     if (ReadConsoleBytes(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize,
 	    &count) == TRUE) {
+	/*
+	 * TODO: This potentially writes beyond the limits specified
+	 * by the caller.  In practice this is harmless, since all writes
+	 * are into ChannelBuffers, and those have padding, but still
+	 * ought to remove this, unless some Windows wizard can give
+	 * a reason not to.  
+	 */
 	buf[count] = '\0';
 	return count;
     }
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 77fc776..a9eec6d 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -82,6 +82,12 @@ static ProcInfo *procList;
 #define PIPE_EXTRABYTE	(1<<3)	/* The reader thread has consumed one byte. */
 
 /*
+ * TODO: It appears the whole EXTRABYTE machinery is in place to support
+ * outdated Win 95 systems.  If this can be confirmed, much code can be
+ * deleted.
+ */
+
+/*
  * This structure describes per-instance data for a pipe based channel.
  */
 
-- 
cgit v0.12


From ce028f5b60d1cf34a689f2781b9ac15280d09eb2 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Sat, 22 Mar 2014 16:14:26 +0000
Subject: Bug [336441ed59]: Buffer infoPtr between socket creation and
 insertion into info structure in thread local memory. Backported fix from
 commit [65b320b464] from branch "bug-[13d3af3ad5]".

---
 win/tclWinSock.c | 213 ++++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 140 insertions(+), 73 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 9fa01c9..f0b210e 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -167,6 +167,10 @@ typedef struct {
 				 * socketThread has been initialized and has
 				 * started. */
     HANDLE socketListLock;	/* Win32 Event to lock the socketList */
+    SocketInfo *pendingSocketInfo;
+				/* This socket is opened but not jet in the
+				 * list. This value is also checked by
+				 * the event structure. */
     SocketInfo *socketList;	/* Every open socket in this thread has an
 				 * entry on this list. */
 } ThreadSpecificData;
@@ -329,6 +333,7 @@ InitSockets(void)
 
     if (tsdPtr == NULL) {
 	tsdPtr = TCL_TSD_INIT(&dataKey);
+	tsdPtr->pendingSocketInfo = NULL;
 	tsdPtr->socketList = NULL;
 	tsdPtr->hwnd       = NULL;
 	tsdPtr->threadId   = Tcl_GetCurrentThread();
@@ -923,12 +928,10 @@ CreateSocket(
 				 * asynchronously. */
 {
     u_long flag = 1;		/* Indicates nonblocking mode. */
-    int asyncConnect = 0;	/* Will be 1 if async connect is in
-				 * progress. */
     SOCKADDR_IN sockaddr;	/* Socket address */
     SOCKADDR_IN mysockaddr;	/* Socket address for client */
     SOCKET sock = INVALID_SOCKET;
-    SocketInfo *infoPtr;	/* The returned value. */
+    SocketInfo *infoPtr=NULL;	/* The returned value. */
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
 	    TclThreadDataKeyGet(&dataKey);
 
@@ -1007,6 +1010,15 @@ CreateSocket(
 	infoPtr->selectEvents = FD_ACCEPT;
 	infoPtr->watchEvents |= FD_ACCEPT;
 
+	/*
+	 * Register for interest in events in the select mask. Note that this
+	 * automatically places the socket into non-blocking mode.
+	 */
+    
+	ioctlsocket(sock, (long) FIONBIO, &flag);
+	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+		(LPARAM) infoPtr);
+
     } else {
 	/*
 	 * Try to bind to a local port, if specified.
@@ -1020,14 +1032,48 @@ CreateSocket(
 	}
 
 	/*
+	 * Allocate socket info structure
+	 */
+
+	infoPtr = NewSocketInfo(sock);
+
+	/*
 	 * Set the socket into nonblocking mode if the connect should be done
-	 * in the background.
+	 * in the background. Activate connect notification.
 	 */
 
 	if (async) {
-	    if (ioctlsocket(sock, (long) FIONBIO, &flag) == SOCKET_ERROR) {
-		goto error;
-	    }
+
+	    /* get infoPtr lock */
+	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+
+	    /*
+	     * Buffer new infoPtr in the tsd memory as long as it is not in
+	     * the info list. This allows the event procedure to process the
+	     * event.
+	     */
+
+	    tsdPtr->pendingSocketInfo = infoPtr;
+
+	    /*
+	     * Set connect mask to connect events
+	     * This is activated by a SOCKET_SELECT message to the notifier
+	     * thread.
+	     */
+
+	    infoPtr->selectEvents |= FD_CONNECT | FD_READ | FD_WRITE | FD_CLOSE;
+	    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
+	    
+	    /*
+	     * Free list lock
+	     */
+	    SetEvent(tsdPtr->socketListLock);
+
+	    /* activate accept notification and put in async mode */
+	    ioctlsocket(sock, (long) FIONBIO, &flag);
+	    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+	            (LPARAM) infoPtr);
+
 	}
 
 	/*
@@ -1045,35 +1091,26 @@ CreateSocket(
 	     * The connection is progressing in the background.
 	     */
 
-	    asyncConnect = 1;
-	}
+	} else {
 
-	/*
-	 * Add this socket to the global list of sockets.
-	 */
+	    /*
+	     * Set up the select mask for read/write events. If the connect
+	     * attempt has not completed, include connect events.
+	     */
 
-	infoPtr = NewSocketInfo(sock);
+	    infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
 
-	/*
-	 * Set up the select mask for read/write events. If the connect
-	 * attempt has not completed, include connect events.
-	 */
+	    /*
+	     * Register for interest in events in the select mask. Note that this
+	     * automatically places the socket into non-blocking mode.
+	     */
 
-	infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
-	if (asyncConnect) {
-	    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
-	    infoPtr->selectEvents |= FD_CONNECT;
+	    ioctlsocket(sock, (long) FIONBIO, &flag);
+	    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+		    (LPARAM) infoPtr);
 	}
     }
 
-    /*
-     * Register for interest in events in the select mask. Note that this
-     * automatically places the socket into non-blocking mode.
-     */
-
-    ioctlsocket(sock, (long) FIONBIO, &flag);
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) infoPtr);
-
     return infoPtr;
 
   error:
@@ -1082,7 +1119,17 @@ CreateSocket(
 	Tcl_AppendResult(interp, "couldn't open socket: ",
 		Tcl_PosixError(interp), NULL);
     }
-    if (sock != INVALID_SOCKET) {
+    /*
+     * Clear the tsd socket list pointer if we did not wait for
+     * the FD_CONNECT asyncroneously
+     */
+    tsdPtr->pendingSocketInfo = NULL;
+    if (infoPtr != NULL) {
+	/*
+	 * Free the allocated socket info structure and close the socket
+	 */
+	TcpCloseProc(infoPtr, interp);
+    } else if (sock != INVALID_SOCKET) {
 	closesocket(sock);
     }
     return NULL;
@@ -1482,7 +1529,7 @@ TcpAccept(
     SetHandleInformation((HANDLE) newSocket, HANDLE_FLAG_INHERIT, 0);
 
     /*
-     * Add this socket to the global list of sockets.
+     * Allocate socket info structure
      */
 
     newInfoPtr = NewSocketInfo(newSocket);
@@ -2248,6 +2295,7 @@ SocketProc(
     int event, error;
     SOCKET socket;
     SocketInfo *infoPtr;
+    int info_found = 0;
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
 #ifdef _WIN64
 	    GetWindowLongPtr(hwnd, GWLP_USERDATA);
@@ -2293,58 +2341,72 @@ SocketProc(
 	for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
 		infoPtr = infoPtr->nextPtr) {
 	    if (infoPtr->socket == socket) {
-		/*
-		 * Update the socket state.
-		 *
-		 * A count of FD_ACCEPTS is stored, so if an FD_CLOSE event
-		 * happens, then clear the FD_ACCEPT count. Otherwise,
-		 * increment the count if the current event is an FD_ACCEPT.
-		 */
+		info_found = 1;
+		break;
+	    }
+	}
+	/*
+	 * Check if there is a pending info structure not jet in the
+	 * list
+	 */
+	if ( !info_found
+		&& tsdPtr->pendingSocketInfo != NULL
+		&& tsdPtr->pendingSocketInfo->socket ==socket ) {
+	    infoPtr = tsdPtr->pendingSocketInfo;
+	    info_found = 1;
+	}
+	if (info_found) {
 
-		if (event & FD_CLOSE) {
-		    infoPtr->acceptEventCount = 0;
-		    infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
-		} else if (event & FD_ACCEPT) {
-		    infoPtr->acceptEventCount++;
-		}
+	    /*
+	     * Update the socket state.
+	     *
+	     * A count of FD_ACCEPTS is stored, so if an FD_CLOSE event
+	     * happens, then clear the FD_ACCEPT count. Otherwise,
+	     * increment the count if the current event is an FD_ACCEPT.
+	     */
 
-		if (event & FD_CONNECT) {
-		    /*
-		     * The socket is now connected, clear the async connect
-		     * flag.
-		     */
+	    if (event & FD_CLOSE) {
+	        infoPtr->acceptEventCount = 0;
+	        infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
+	    } else if (event & FD_ACCEPT) {
+		infoPtr->acceptEventCount++;
+	    }
 
-		    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+	    if (event & FD_CONNECT) {
+		/*
+		 * The socket is now connected, clear the async connect
+		 * flag.
+		 */
 
-		    /*
-		     * Remember any error that occurred so we can report
-		     * connection failures.
-		     */
+		infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+
+		/*
+		 * Remember any error that occurred so we can report
+		 * connection failures.
+		 */
 
-		    if (error != ERROR_SUCCESS) {
-			TclWinConvertWSAError((DWORD) error);
-			infoPtr->lastError = Tcl_GetErrno();
-		    }
+		if (error != ERROR_SUCCESS) {
+		    TclWinConvertWSAError((DWORD) error);
+		    infoPtr->lastError = Tcl_GetErrno();
 		}
+	    }
 
-		if (infoPtr->flags & SOCKET_ASYNC_CONNECT) {
-		    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
-		    if (error != ERROR_SUCCESS) {
-			TclWinConvertWSAError((DWORD) error);
-			infoPtr->lastError = Tcl_GetErrno();
-		    }
-		    infoPtr->readyEvents |= FD_WRITE;
+	    if (infoPtr->flags & SOCKET_ASYNC_CONNECT) {
+		infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
+		if (error != ERROR_SUCCESS) {
+		    TclWinConvertWSAError((DWORD) error);
+		    infoPtr->lastError = Tcl_GetErrno();
 		}
-		infoPtr->readyEvents |= event;
+		infoPtr->readyEvents |= FD_WRITE;
+	    }
+	    infoPtr->readyEvents |= event;
 
-		/*
-		 * Wake up the Main Thread.
-		 */
+	    /*
+	     * Wake up the Main Thread.
+	     */
 
-		SetEvent(tsdPtr->readyEvent);
-		Tcl_ThreadAlert(tsdPtr->threadId);
-		break;
-	    }
+	    SetEvent(tsdPtr->readyEvent);
+	    Tcl_ThreadAlert(tsdPtr->threadId);
 	}
 	SetEvent(tsdPtr->socketListLock);
 	break;
@@ -2580,6 +2642,11 @@ TcpThreadActionProc(
 	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 	infoPtr->nextPtr = tsdPtr->socketList;
 	tsdPtr->socketList = infoPtr;
+	
+	if (infoPtr == tsdPtr->pendingSocketInfo) {
+	    tsdPtr->pendingSocketInfo = NULL;
+	}
+	
 	SetEvent(tsdPtr->socketListLock);
 
 	notifyCmd = SELECT;
-- 
cgit v0.12


From c12228d755f6bbc24681d68ad69ae7b7dfde5ba4 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Sun, 23 Mar 2014 11:31:59 +0000
Subject: Be shure tsd pointer to the info structure is invalidated before
 memory free

---
 win/tclWinSock.c | 35 ++++++++++++++++++++++++++++-------
 1 file changed, 28 insertions(+), 7 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index f0b210e..6633b89 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -820,7 +820,7 @@ TcpCloseProc(
     SocketInfo *infoPtr = (SocketInfo *) instanceData;
     /* TIP #218 */
     int errorCode = 0;
-    /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     /*
      * Check that WinSock is initialized; do not call it if not, to prevent
@@ -842,6 +842,23 @@ TcpCloseProc(
     }
 
     /*
+     * Clear an eventual tsd info list pointer.
+     * This may be called, if an async socket connect fails or is closed
+     * between connect and thread action callback.
+     */
+    if (tsdPtr->pendingSocketInfo != NULL
+	    && tsdPtr->pendingSocketInfo == infoPtr) {
+
+	/* get infoPtr lock, because this concerns the notifier thread */
+	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+
+	tsdPtr->pendingSocketInfo = NULL;
+
+	/* Free list lock */
+	SetEvent(tsdPtr->socketListLock);
+    }
+
+    /*
      * TIP #218. Removed the code removing the structure from the global
      * socket list. This is now done by the thread action callbacks, and only
      * there. This happens before this code is called. We can free without
@@ -1051,6 +1068,8 @@ CreateSocket(
 	     * Buffer new infoPtr in the tsd memory as long as it is not in
 	     * the info list. This allows the event procedure to process the
 	     * event.
+	     * Bugfig for 336441ed59 to not ignore notifications until the
+	     * infoPtr is in the list..
 	     */
 
 	    tsdPtr->pendingSocketInfo = infoPtr;
@@ -1069,7 +1088,11 @@ CreateSocket(
 	     */
 	    SetEvent(tsdPtr->socketListLock);
 
-	    /* activate accept notification and put in async mode */
+	    /*
+	     * Activate accept notification and put in async mode
+	     * Bug 336441ed59: activate notification before connect
+	     * so we do not miss a notification of a fialed connect.
+	     */
 	    ioctlsocket(sock, (long) FIONBIO, &flag);
 	    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
 	            (LPARAM) infoPtr);
@@ -1119,17 +1142,15 @@ CreateSocket(
 	Tcl_AppendResult(interp, "couldn't open socket: ",
 		Tcl_PosixError(interp), NULL);
     }
-    /*
-     * Clear the tsd socket list pointer if we did not wait for
-     * the FD_CONNECT asyncroneously
-     */
-    tsdPtr->pendingSocketInfo = NULL;
     if (infoPtr != NULL) {
 	/*
 	 * Free the allocated socket info structure and close the socket
 	 */
 	TcpCloseProc(infoPtr, interp);
     } else if (sock != INVALID_SOCKET) {
+	/*
+	 * No socket structure jet - just close
+	 */
 	closesocket(sock);
     }
     return NULL;
-- 
cgit v0.12


From 8a2617f3adce19edcb1ff2f8099bf33435f9701d Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Sun, 23 Mar 2014 11:42:35 +0000
Subject: Be sure tsd pointer to the info structure is invalidated before
 memory free

---
 win/tclWinSock.c | 21 ++++++++++++++++++++-
 1 file changed, 20 insertions(+), 1 deletion(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 3d41bd3..b1e2768 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -935,7 +935,7 @@ TcpCloseProc(
     TcpState *statePtr = instanceData;
     /* TIP #218 */
     int errorCode = 0;
-    /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     /*
      * Check that WinSock is initialized; do not call it if not, to prevent
@@ -970,6 +970,23 @@ TcpCloseProc(
     }
 
     /*
+     * Clear an eventual tsd info list pointer.
+     * This may be called, if an async socket connect fails or is closed
+     * between connect and thread action callback.
+     */
+    if (tsdPtr->pendingTcpState != NULL
+	    && tsdPtr->pendingTcpState == statePtr) {
+
+	/* get infoPtr lock, because this concerns the notifier thread */
+	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+
+	tsdPtr->pendingTcpState = NULL;
+
+	/* Free list lock */
+	SetEvent(tsdPtr->socketListLock);
+    }
+
+    /*
      * TIP #218. Removed the code removing the structure from the global
      * socket list. This is now done by the thread action callbacks, and only
      * there. This happens before this code is called. We can free without
@@ -1644,6 +1661,8 @@ CreateClientSocket(
 		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 
 		/*
+		 * Bugfig for 336441ed59 to not ignore notifications until the
+		 * infoPtr is in the list.
 		 * Check if my statePtr is already in the tsdPtr->socketList
 		 * It is set after this call by TcpThreadActionProc and is set
 		 * on a second round.
-- 
cgit v0.12


From 6db3b6dd9d1acdae281ff36db51632a2efbf1853 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Mon, 24 Mar 2014 11:03:04 +0000
Subject: Fire also readable event on final async connect failure. Armor
 WaitForSocketEvent by access signal against notifier thread access.

---
 win/tclWinSock.c | 129 ++++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 84 insertions(+), 45 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index b1e2768..91f9e8c 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -181,7 +181,7 @@ struct TcpState {
     struct addrinfo *myaddr;	/* Iterator over myaddrlist. */
     int status;                 /* Cache status of async socket. */
     int cachedBlocking;         /* Cache blocking mode of async socket. */
-    int lastError;		/* Error code from last message.
+    int connectError;		/* Async connect error set by notifier thread.
 				 * Set by notifier thread, access must be
 				 * protected by semaphore */
     struct TcpState *nextPtr;	/* The next socket on the per-thread socket
@@ -199,10 +199,13 @@ struct TcpState {
 					 * socket. */
 #define SOCKET_PENDING		(1<<3)	/* A message has been sent for this
 					 * socket */
-#define SOCKET_REENTER_PENDING	(1<<4)	/* CreateClientSocket was called to
+#define TCP_ASYNC_CONNECT_REENTER_PENDING   (1<<4)
+					/* CreateClientSocket 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 */
 
 /*
  * The following structure is what is added to the Tcl event queue when a
@@ -585,7 +588,7 @@ WaitForConnect(
     /*
      * Check if an async connect is running. If not return ok
      */
-    if ( !(statePtr->flags & SOCKET_REENTER_PENDING) )
+    if ( !(statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING) )
 	return 0;
     
     /*
@@ -625,7 +628,7 @@ WaitForConnect(
 
 	    /* Succesfully connected or async connect restarted */
 	    if (result == TCL_OK) {
-		if ( statePtr->flags & SOCKET_REENTER_PENDING ) {
+		if ( statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING ) {
 		    *errorCodePtr = EWOULDBLOCK;
 		    return -1;
 		}
@@ -1218,7 +1221,7 @@ TcpGetOptionProc(
 	/*
 	* Do not return any errors if async connect is running
 	*/
-	if (! (statePtr->flags & SOCKET_REENTER_PENDING) ) {
+	if (! (statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING) ) {
 	    int optlen;
 	    int ret;
     	    DWORD err;
@@ -1250,8 +1253,9 @@ TcpGetOptionProc(
     if ((len > 1) && (optionName[1] == 'c') &&
 	    (strncmp(optionName, "-connecting", len) == 0)) {
 
-        Tcl_DStringAppend(dsPtr,
-                        (statePtr->flags & SOCKET_REENTER_PENDING) ? "1" : "0", -1);
+	Tcl_DStringAppend(dsPtr,
+		(statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING)
+		? "1" : "0", -1);
         return TCL_OK;
     }
 
@@ -1609,7 +1613,7 @@ CreateClientSocket(
 	    /*
 	     * Reset last error from last try
 	     */
-	    statePtr->lastError = 0;
+	    statePtr->connectError = 0;
 	    Tcl_SetErrno(0);
 	    
 	    statePtr->sockets->fd = socket(statePtr->myaddr->ai_family, SOCK_STREAM, 0);
@@ -1719,7 +1723,7 @@ CreateClientSocket(
 		/*
 		 * Remember that we jump back behind this next round
 		 */
-		statePtr->flags |= SOCKET_REENTER_PENDING;
+		statePtr->flags |= TCP_ASYNC_CONNECT_REENTER_PENDING;
 		return TCL_OK;
 
 	    reenter:
@@ -1730,18 +1734,18 @@ CreateClientSocket(
 		 *
 		 * Clear the reenter flag
 		 */
-		statePtr->flags &= ~(SOCKET_REENTER_PENDING);
+		statePtr->flags &= ~(TCP_ASYNC_CONNECT_REENTER_PENDING);
 		/* get statePtr lock */
 		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 		/* Get signaled connect error */
-		Tcl_SetErrno(statePtr->lastError);
+		Tcl_SetErrno(statePtr->connectError);
 		/* Clear eventual connect flag */
 		statePtr->selectEvents &= ~(FD_CONNECT);
 		/* Free list lock */
 		SetEvent(tsdPtr->socketListLock);
 	    }
 #ifdef DEBUGGING
-	    fprintf(stderr, "lastError: %d\n", Tcl_GetErrno());
+	    fprintf(stderr, "connectError: %d\n", Tcl_GetErrno());
 #endif
 	    /*
 	     * Clear the tsd socket list pointer if we did not wait for
@@ -1760,8 +1764,6 @@ out:
      * Socket connected or connection failed
      */
     DEBUG("connected or finally failed");
-    /* Clear async flag (not really necessary, not used any more) */
-    statePtr->flags &= ~(TCP_ASYNC_CONNECT);
 
     /*
      * Final connect failure
@@ -1797,12 +1799,14 @@ out:
 	    /*
 	     * Set up the select mask for read/write events.
 	     */
-	    DEBUG("selectEvents = FD_WRITE for fail writable");    
-	    statePtr->selectEvents = FD_WRITE;
+	    DEBUG("selectEvents = FD_WRITE/FD_READ for connect fail");    
+	    statePtr->selectEvents = FD_WRITE|FD_READ;
 	    /* get statePtr lock */
 	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-	    /* Clear eventual connect flag */
-	    statePtr->readyEvents |= FD_WRITE;
+	    /* Signal ready readable and writable events */
+	    statePtr->readyEvents |= FD_WRITE | FD_READ;
+	    /* Flag error to event routine */
+	    statePtr->flags |= TCP_ASYNC_CONNECT_FAILED;
 	    /* Free list lock */
 	    SetEvent(tsdPtr->socketListLock);
 	}
@@ -2607,7 +2611,7 @@ SocketEventProc(
     if ( statePtr->readyEvents & FD_CONNECT ) {
 	statePtr->readyEvents &= ~(FD_CONNECT);
 	DEBUG("FD_CONNECT");
-        if ( statePtr->flags & SOCKET_REENTER_PENDING ) {
+	if ( statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING ) {
 	    SetEvent(tsdPtr->socketListLock);
 	    CreateClientSocket(NULL, statePtr);
 	    return 1;
@@ -2702,38 +2706,59 @@ SocketEventProc(
 	Tcl_SetMaxBlockTime(&blockTime);
 	mask |= TCL_READABLE|TCL_WRITABLE;
     } else if (events & FD_READ) {
-	fd_set readFds;
-	struct timeval timeout;
 
 	/*
-	 * We must check to see if data is really available, since someone
-	 * could have consumed the data in the meantime. Turn off async
-	 * notification so select will work correctly. If the socket is still
-	 * readable, notify the channel driver, otherwise reset the async
-	 * select handler and keep waiting.
+	 * Throw the readable event if an async connect failed.
 	 */
-	DEBUG("FD_READ");
 
-	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
-		(WPARAM) UNSELECT, (LPARAM) statePtr);
+	if ( statePtr->flags & TCP_ASYNC_CONNECT_FAILED ) {
 
-	FD_ZERO(&readFds);
-	FD_SET(statePtr->sockets->fd, &readFds);
-	timeout.tv_usec = 0;
-	timeout.tv_sec = 0;
-
-	if (select(0, &readFds, NULL, NULL, &timeout) != 0) {
 	    mask |= TCL_READABLE;
+	    
 	} else {
-	    statePtr->readyEvents &= ~(FD_READ);
+	    fd_set readFds;
+	    struct timeval timeout;
+
+	    /*
+	     * We must check to see if data is really available, since someone
+	     * could have consumed the data in the meantime. Turn off async
+	     * notification so select will work correctly. If the socket is still
+	     * readable, notify the channel driver, otherwise reset the async
+	     * select handler and keep waiting.
+	     */
+	    DEBUG("FD_READ");
+
 	    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
-		    (WPARAM) SELECT, (LPARAM) statePtr);
+		    (WPARAM) UNSELECT, (LPARAM) statePtr);
+
+	    FD_ZERO(&readFds);
+	    FD_SET(statePtr->sockets->fd, &readFds);
+	    timeout.tv_usec = 0;
+	    timeout.tv_sec = 0;
+
+	    if (select(0, &readFds, NULL, NULL, &timeout) != 0) {
+		mask |= TCL_READABLE;
+	    } else {
+		statePtr->readyEvents &= ~(FD_READ);
+		SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+			(WPARAM) SELECT, (LPARAM) statePtr);
+	    }
 	}
     }
+
+    /*
+     * writable event
+     */
+
     if (events & FD_WRITE) {
 	DEBUG("FD_WRITE");
 	mask |= TCL_WRITABLE;
     }
+    
+    /*
+     * Call registered event procedures
+     */
+     
     if (mask) {
 	DEBUG("Calling Tcl_NotifyChannel...");
 	Tcl_NotifyChannel(statePtr->channel, mask);
@@ -2827,6 +2852,7 @@ NewSocketInfo(SOCKET socket)
  * WaitForSocketEvent --
  *
  *	Waits until one of the specified events occurs on a socket.
+ *	For event FD_CONNECT use WaitForConnect.
  *
  * Results:
  *	Returns 1 on success or 0 on failure, with an error code in
@@ -2841,7 +2867,9 @@ NewSocketInfo(SOCKET socket)
 static int
 WaitForSocketEvent(
     TcpState *statePtr,	/* Information about this socket. */
-    int events,			/* Events to look for. */
+    int events,			/* Events to look for. May be one of
+				 * FD_READ or FD_WRITE.
+				 */
     int *errorCodePtr)		/* Where to store errors? */
 {
     int result = 1;
@@ -2864,13 +2892,24 @@ WaitForSocketEvent(
 	    (LPARAM) statePtr);
 
     while (1) {
-	if (statePtr->lastError) {
-	    *errorCodePtr = statePtr->lastError;
-	    result = 0;
-	    break;
-	} else if (statePtr->readyEvents & events) {
+	int event_found;
+
+	/* get statePtr lock */
+	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
+	
+	/* Check if event occured */
+	event_found = (statePtr->readyEvents & events);
+
+	/* Free list lock */
+	SetEvent(tsdPtr->socketListLock);
+
+	/* exit loop if event occured */
+	if (event_found) {
 	    break;
-	} else if (statePtr->flags & TCP_ASYNC_SOCKET) {
+	}
+	
+	/* Exit loop if event did not occur but this is a non-blocking channel */
+	if (statePtr->flags & TCP_ASYNC_SOCKET) {
 	    *errorCodePtr = EWOULDBLOCK;
 	    result = 0;
 	    break;
@@ -3086,7 +3125,7 @@ SocketProc(
 		 */
 		if (error != ERROR_SUCCESS) {
 		    TclWinConvertError((DWORD) error);
-		    statePtr->lastError = Tcl_GetErrno();
+		    statePtr->connectError = Tcl_GetErrno();
 		}
 	    }
 	    /*
-- 
cgit v0.12


From 870ed20799fc0d228ffcf6e7add98824b0182950 Mon Sep 17 00:00:00 2001
From: ferrieux <ferrieux@users.sourceforge.net>
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 3b6523dd1f6ce2e08932508cf276ca55d04872e6 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 26 Mar 2014 10:37:57 +0000
Subject: Implementation of [b42b208ba4]: file attributes -readonly on Cygwin.
 For completeness, implemented -archive, -hidden and -system as well.

---
 unix/tclUnixFCmd.c | 185 +++++++++++++++++++++++++++++++++++++++++++++++++----
 unix/tclUnixPort.h |   3 +
 2 files changed, 174 insertions(+), 14 deletions(-)

diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index e270b6a..259c7e5 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -91,10 +91,10 @@ static int		SetPermissionsAttribute(Tcl_Interp *interp,
 			    Tcl_Obj *attributePtr);
 static int		GetModeFromPermString(Tcl_Interp *interp,
 			    const char *modeStringPtr, mode_t *modePtr);
-#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
-static int		GetReadOnlyAttribute(Tcl_Interp *interp, int objIndex,
+#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__)
+static int		GetUnixFileAttributes(Tcl_Interp *interp, int objIndex,
 			    Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr);
-static int		SetReadOnlyAttribute(Tcl_Interp *interp, int objIndex,
+static int		SetUnixFileAttributes(Tcl_Interp *interp, int objIndex,
 			    Tcl_Obj *fileName, Tcl_Obj *attributePtr);
 #endif
 
@@ -124,10 +124,20 @@ extern const char *const tclpFileAttrStrings[];
 
 #else /* !DJGPP */
 enum {
-    UNIX_GROUP_ATTRIBUTE, UNIX_OWNER_ATTRIBUTE, UNIX_PERMISSIONS_ATTRIBUTE,
-#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
+#if defined(__CYGWIN__)
+    UNIX_ARCHIVE_ATTRIBUTE,
+#endif
+    UNIX_GROUP_ATTRIBUTE,
+#if defined(__CYGWIN__)
+    UNIX_HIDDEN_ATTRIBUTE,
+#endif
+    UNIX_OWNER_ATTRIBUTE, UNIX_PERMISSIONS_ATTRIBUTE,
+#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__)
     UNIX_READONLY_ATTRIBUTE,
 #endif
+#if defined(__CYGWIN__)
+    UNIX_SYSTEM_ATTRIBUTE,
+#endif
 #ifdef MAC_OSX_TCL
     MACOSX_CREATOR_ATTRIBUTE, MACOSX_TYPE_ATTRIBUTE, MACOSX_HIDDEN_ATTRIBUTE,
     MACOSX_RSRCLENGTH_ATTRIBUTE,
@@ -137,10 +147,20 @@ enum {
 
 MODULE_SCOPE const char *const tclpFileAttrStrings[];
 const char *const tclpFileAttrStrings[] = {
-    "-group", "-owner", "-permissions",
-#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
+#if defined(__CYGWIN__)
+    "-archive",
+#endif
+    "-group",
+#if defined(__CYGWIN__)
+    "-hidden",
+#endif
+    "-owner", "-permissions",
+#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__)
     "-readonly",
 #endif
+#if defined(__CYGWIN__)
+    "-system",
+#endif
 #ifdef MAC_OSX_TCL
     "-creator", "-type", "-hidden", "-rsrclength",
 #endif
@@ -149,11 +169,20 @@ const char *const tclpFileAttrStrings[] = {
 
 MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[];
 const TclFileAttrProcs tclpFileAttrProcs[] = {
+#if defined(__CYGWIN__)
+    {GetUnixFileAttributes, SetUnixFileAttributes},
+#endif
     {GetGroupAttribute, SetGroupAttribute},
+#if defined(__CYGWIN__)
+    {GetUnixFileAttributes, SetUnixFileAttributes},
+#endif
     {GetOwnerAttribute, SetOwnerAttribute},
     {GetPermissionsAttribute, SetPermissionsAttribute},
-#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
-    {GetReadOnlyAttribute, SetReadOnlyAttribute},
+#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__)
+    {GetUnixFileAttributes, SetUnixFileAttributes},
+#endif
+#if defined(__CYGWIN__)
+    {GetUnixFileAttributes, SetUnixFileAttributes},
 #endif
 #ifdef MAC_OSX_TCL
     {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
@@ -2246,11 +2275,139 @@ DefaultTempDir(void)
     return TCL_TEMPORARY_FILE_DIRECTORY;
 }
 
-#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
+#if defined(__CYGWIN__)
+
+static void
+StatError(
+    Tcl_Interp *interp,		/* The interp that has the error */
+    Tcl_Obj *fileName)		/* The name of the file which caused the
+				 * error. */
+{
+    TclWinConvertError(GetLastError());
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s",
+	    TclGetString(fileName), Tcl_PosixError(interp)));
+}
+
+static WCHAR *
+winPathFromNative(
+    const char *native)
+{
+	int size;
+	WCHAR *winPath;
+
+    size = cygwin_conv_path(1, native, NULL, 0);
+    winPath = ckalloc(size);
+    cygwin_conv_path(1, native, winPath, size);
+
+    return winPath;
+}
+
+static const int attributeArray[] = {
+    0x20, 0, 2, 0, 0, 1, 4};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetUnixFileAttributes
+ *
+ *	Gets the readonly attribute of a file.
+ *
+ * Results:
+ *	Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr if there
+ *	is no error. The object will have ref count 0.
+ *
+ * Side effects:
+ *	A new object is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetUnixFileAttributes(
+    Tcl_Interp *interp,		/* The interp we are using for errors. */
+    int objIndex,		/* The index of the attribute. */
+    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
+    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
+{
+    int fileAttributes;
+    const char *native = Tcl_FSGetNativePath(fileName);
+    WCHAR *winPath = winPathFromNative(native);
+
+    fileAttributes = GetFileAttributesW(winPath);
+    ckfree(winPath);
+
+    if (fileAttributes == -1) {
+	StatError(interp, fileName);
+	return TCL_ERROR;
+    }
+
+    *attributePtrPtr = Tcl_NewIntObj((fileAttributes&attributeArray[objIndex])!=0);
+
+    return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * SetUnixFileAttributes
+ *
+ *	Sets the readonly attribute of a file.
+ *
+ * Results:
+ *	Standard TCL result.
+ *
+ * Side effects:
+ *	The readonly attribute of the file is changed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+SetUnixFileAttributes(
+    Tcl_Interp *interp,	    /* The interp we are using for errors. */
+    int objIndex,           /* The index of the attribute. */
+    Tcl_Obj *fileName,      /* The name of the file (UTF-8). */
+    Tcl_Obj *attributePtr)  /* The attribute to set. */
+{
+    int yesNo, fileAttributes;
+    const char *native;
+    WCHAR *winPath;
+
+    if (Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    native = Tcl_FSGetNativePath(fileName);
+    winPath = winPathFromNative(native);
+
+    fileAttributes = GetFileAttributesW(winPath);
+
+    if (fileAttributes == -1) {
+	ckfree(winPath);
+	StatError(interp, fileName);
+	return TCL_ERROR;
+    }
+
+    if (yesNo) {
+	fileAttributes |= attributeArray[objIndex];
+    } else {
+	fileAttributes &= ~attributeArray[objIndex];
+    }
+
+    if (!SetFileAttributesW(winPath, fileAttributes)) {
+	ckfree(winPath);
+	StatError(interp, fileName);
+	return TCL_ERROR;
+    }
+
+	ckfree(winPath);
+    return TCL_OK;
+}
+#elif defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
 /*
  *----------------------------------------------------------------------
  *
- * GetReadOnlyAttribute
+ * GetUnixFileAttributes
  *
  *	Gets the readonly attribute (user immutable flag) of a file.
  *
@@ -2265,7 +2422,7 @@ DefaultTempDir(void)
  */
 
 static int
-GetReadOnlyAttribute(
+GetUnixFileAttributes(
     Tcl_Interp *interp,		/* The interp we are using for errors. */
     int objIndex,		/* The index of the attribute. */
     Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
@@ -2293,7 +2450,7 @@ GetReadOnlyAttribute(
 /*
  *---------------------------------------------------------------------------
  *
- * SetReadOnlyAttribute
+ * SetUnixFileAttributes
  *
  *	Sets the readonly attribute (user immutable flag) of a file.
  *
@@ -2307,7 +2464,7 @@ GetReadOnlyAttribute(
  */
 
 static int
-SetReadOnlyAttribute(
+SetUnixFileAttributes(
     Tcl_Interp *interp,		/* The interp we are using for errors. */
     int objIndex,		/* The index of the attribute. */
     Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index 2ade1c0..f64d453 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -93,6 +93,9 @@ typedef off_t		Tcl_SeekOffset;
 	    WCHAR *, int);
     __declspec(dllimport) extern __stdcall void OutputDebugStringW(const WCHAR *);
     __declspec(dllimport) extern __stdcall int IsDebuggerPresent();
+    __declspec(dllimport) extern __stdcall int GetLastError();
+    __declspec(dllimport) extern __stdcall int GetFileAttributesW(const WCHAR *);
+    __declspec(dllimport) extern __stdcall int SetFileAttributesW(const WCHAR *, int);
 
     __declspec(dllimport) extern int cygwin_conv_path(int, const void *, void *, int);
     __declspec(dllimport) extern int cygwin_conv_path_list(int, const void *, void *, int);
-- 
cgit v0.12


From 07ba2fc47f5d9c888ccb11ca3666f215159b5f45 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 26 Mar 2014 14:34:56 +0000
Subject: Only write back file attributes if any of them really changed.

---
 unix/tclUnixFCmd.c | 23 +++++++++++------------
 win/tclWinFCmd.c   |  7 ++++---
 2 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index 259c7e5..3b1b6ca 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -2289,11 +2289,12 @@ StatError(
 }
 
 static WCHAR *
-winPathFromNative(
-    const char *native)
+winPathFromObj(
+    Tcl_Obj *fileName)
 {
-	int size;
-	WCHAR *winPath;
+    int size;
+    const char *native =  Tcl_FSGetNativePath(fileName);
+    WCHAR *winPath;
 
     size = cygwin_conv_path(1, native, NULL, 0);
     winPath = ckalloc(size);
@@ -2330,8 +2331,7 @@ GetUnixFileAttributes(
     Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
 {
     int fileAttributes;
-    const char *native = Tcl_FSGetNativePath(fileName);
-    WCHAR *winPath = winPathFromNative(native);
+    WCHAR *winPath = winPathFromObj(fileName);
 
     fileAttributes = GetFileAttributesW(winPath);
     ckfree(winPath);
@@ -2369,18 +2369,16 @@ SetUnixFileAttributes(
     Tcl_Obj *fileName,      /* The name of the file (UTF-8). */
     Tcl_Obj *attributePtr)  /* The attribute to set. */
 {
-    int yesNo, fileAttributes;
-    const char *native;
+    int yesNo, fileAttributes, old;
     WCHAR *winPath;
 
     if (Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo) != TCL_OK) {
 	return TCL_ERROR;
     }
 
-    native = Tcl_FSGetNativePath(fileName);
-    winPath = winPathFromNative(native);
+    winPath = winPathFromObj(fileName);
 
-    fileAttributes = GetFileAttributesW(winPath);
+    fileAttributes = old = GetFileAttributesW(winPath);
 
     if (fileAttributes == -1) {
 	ckfree(winPath);
@@ -2394,7 +2392,8 @@ SetUnixFileAttributes(
 	fileAttributes &= ~attributeArray[objIndex];
     }
 
-    if (!SetFileAttributesW(winPath, fileAttributes)) {
+    if ((fileAttributes != old)
+	    && !SetFileAttributesW(winPath, fileAttributes)) {
 	ckfree(winPath);
 	StatError(interp, fileName);
 	return TCL_ERROR;
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 2700cb3..f14d9ff 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -1825,12 +1825,12 @@ SetWinFileAttributes(
     Tcl_Obj *fileName,		/* The name of the file. */
     Tcl_Obj *attributePtr)	/* The new value of the attribute. */
 {
-    DWORD fileAttributes;
+    DWORD fileAttributes, old;
     int yesNo, result;
     const TCHAR *nativeName;
 
     nativeName = Tcl_FSGetNativePath(fileName);
-    fileAttributes = GetFileAttributes(nativeName);
+    fileAttributes = old = GetFileAttributes(nativeName);
 
     if (fileAttributes == 0xffffffff) {
 	StatError(interp, fileName);
@@ -1848,7 +1848,8 @@ SetWinFileAttributes(
 	fileAttributes &= ~(attributeArray[objIndex]);
     }
 
-    if (!SetFileAttributes(nativeName, fileAttributes)) {
+    if ((fileAttributes != old)
+	    && !SetFileAttributes(nativeName, fileAttributes)) {
 	StatError(interp, fileName);
 	return TCL_ERROR;
     }
-- 
cgit v0.12


From 8868d903d92c976f3c5eb3ea4a4a98862de6e6c0 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 27 Mar 2014 16:27:09 +0000
Subject: New test iortrans-4.8.1 exposes segfault bug [721ec69271].

---
 tests/ioTrans.test | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)

diff --git a/tests/ioTrans.test b/tests/ioTrans.test
index 5a8874c..b21d894 100644
--- a/tests/ioTrans.test
+++ b/tests/ioTrans.test
@@ -540,6 +540,25 @@ test iortrans-4.8 {chan read, read, bug 2921116} -setup {
     rename foo {}
 } -result {{read rt* {test data
 }} file*}
+test iortrans-4.8.1 {chan read, bug 721ec69271} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {fd args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	# Kill and recreate transform while it is operating
+	chan pop $fd
+	chan push $fd [list foo $fd]
+    }
+    set c [chan push [set c [tempchan]] [list foo $c]]
+    chan configure $c -buffersize 2
+    lappend res [read $c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{read rt* {test data
+}} file*}
 test iortrans-4.9 {chan read, gets, bug 2921116} -setup {
     set res {}
 } -match glob -body {
-- 
cgit v0.12


From faf7effffed566ae286f67f982029e5d7748cd40 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 27 Mar 2014 16:44:04 +0000
Subject: Test iogt-2.4 is another segfault demo for [721ec69271].

---
 tests/iogt.test | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)

diff --git a/tests/iogt.test b/tests/iogt.test
index 3882ecc..d54ae04 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -242,6 +242,26 @@ proc id_fulltrail {var op data} {
     return $res
 }
 
+proc id_torture {chan op data} {
+    switch -- $op {
+	create/write -
+	create/read  -
+	delete/write -
+	delete/read  -
+	clear_read   {;#ignore}
+	flush/write -
+	flush/read  -
+	write       -
+	read        {
+	    testchannel unstack $chan
+	    testchannel transform $chan \
+		-command [namespace code [list id_torture $chan]]
+	    return $data
+	}
+	query/maxRead {return -1}
+    }
+}
+
 proc counter {var op data} {
     variable $var
     upvar 0 $var n
@@ -364,6 +384,10 @@ proc audit_flow {var -attach channel} {
     testchannel transform $channel -command [namespace code [list id_fulltrail $var]]
 }
 
+proc torture {-attach channel} {
+    testchannel transform $channel -command [namespace code [list id_torture $channel]]
+}
+
 proc stopafter {var n -attach channel} {
     variable $var
     upvar 0 $var vn
@@ -632,6 +656,15 @@ delete/read {} *ignored*
 flush/write {} {}
 delete/write {} *ignored*}
 
+test iogt-2.4 {basic I/O, mixed trail} {testchannel} {
+    set fh [open $path(dummy) r]
+    torture -attach $fh
+    chan configure $fh -buffersize 2
+    set x [read $fh]
+    testchannel unstack $fh
+    close   $fh
+    set x
+} {}
 
 test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
 	{testchannel unknownFailure} {
-- 
cgit v0.12


From bb3eb0aaa60aba47a0e857fa2e34e5eb7ba8263f Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 27 Mar 2014 19:14:01 +0000
Subject: Test iocmd-23.11 demos another segfault.

---
 tests/ioCmd.test | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 768a748..262be9b 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -1013,6 +1013,21 @@ test iocmd-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glo
     rename foo {}
     unset res
 } -result {{read rc* 4096} {} 0}
+test iocmd-23.11 {chan read, close pulls the rug out} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	set args [lassign $args sub id]
+	if {$sub ne "read"} {return}
+	close $id
+	return {}
+    }
+    set c [chan create {r} foo]
+    note [read $c]
+    close $c
+    rename foo {}
+    set res
+} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
 
 # --- === *** ###########################
 # method write
-- 
cgit v0.12


From 06f376eefe2af7c3eb3f8131dacd6bc296a2fb71 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 27 Mar 2014 21:35:57 +0000
Subject: Minimal patch to fix iocmd-23.11.  Might not be the best fix, but is
 *a* fix.

---
 generic/tclIO.c      | 23 ++++++++++++++++++++---
 generic/tclIORChan.c |  2 ++
 tests/ioCmd.test     |  3 +--
 3 files changed, 23 insertions(+), 5 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 3636861..c43e61e 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -3852,6 +3852,7 @@ Tcl_GetsObj(
      */
 
     chanPtr = statePtr->topChanPtr;
+    Tcl_Preserve(chanPtr);
 
     bufPtr = statePtr->inQueueHead;
     encoding = statePtr->encoding;
@@ -4144,6 +4145,7 @@ Tcl_GetsObj(
 
   done:
     UpdateInterest(chanPtr);
+    Tcl_Release(chanPtr);
     return copiedTotal;
 }
 
@@ -4189,6 +4191,7 @@ TclGetsObjBinary(
      */
 
     chanPtr = statePtr->topChanPtr;
+    Tcl_Preserve(chanPtr);
 
     bufPtr = statePtr->inQueueHead;
 
@@ -4388,6 +4391,7 @@ TclGetsObjBinary(
 
   done:
     UpdateInterest(chanPtr);
+    Tcl_Release(chanPtr);
     return copiedTotal;
 }
 
@@ -4860,6 +4864,7 @@ Tcl_ReadRaw(
      * requests more bytes.
      */
 
+    Tcl_Preserve(chanPtr);
     for (copied = 0; copied < bytesToRead; copied += copiedNow) {
 	copiedNow = CopyBuffer(chanPtr, bufPtr + copied,
 		bytesToRead - copied);
@@ -4946,7 +4951,7 @@ Tcl_ReadRaw(
 			 * over EAGAIN/WOULDBLOCK handling.
 			 */
 
-			return copied;
+			goto done;
 		    }
 
 		    SetFlag(statePtr, CHANNEL_BLOCKED);
@@ -4954,14 +4959,17 @@ Tcl_ReadRaw(
 		}
 
 		Tcl_SetErrno(result);
-		return -1;
+		copied = -1;
+		goto done;
 	    }
 
-	    return copied + nread;
+	    copied += nread;
+	    goto done;
 	}
     }
 
   done:
+    Tcl_Release(chanPtr);
     return copied;
 }
 
@@ -5069,6 +5077,7 @@ DoReadChars(
     chanPtr = statePtr->topChanPtr;
     encoding = statePtr->encoding;
     factor = UTF_EXPANSION_FACTOR;
+    Tcl_Preserve(chanPtr);
 
     if (appendFlag == 0) {
 	if (encoding == NULL) {
@@ -5158,6 +5167,7 @@ DoReadChars(
 
   done:
     UpdateInterest(chanPtr);
+    Tcl_Release(chanPtr);
     return copied;
 }
 
@@ -7700,6 +7710,11 @@ UpdateInterest(
 				/* State info for channel */
     int mask = statePtr->interestMask;
 
+    if (chanPtr->typePtr == NULL) {
+	/* Do not update interest on a closed channel */
+	return;
+    }
+
     /*
      * If there are flushed buffers waiting to be written, then we need to
      * watch for the channel to become writable.
@@ -8785,6 +8800,7 @@ DoRead(
      * operation.
      */
 
+    Tcl_Preserve(chanPtr);
     if (!(statePtr->flags & CHANNEL_STICKY_EOF)) {
 	ResetFlag(statePtr, CHANNEL_EOF);
     }
@@ -8822,6 +8838,7 @@ DoRead(
 
   done:
     UpdateInterest(chanPtr);
+    Tcl_Release(chanPtr);
     return copied;
 }
 
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index ca3ab4b..affed02 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -571,6 +571,7 @@ TclChanCreateObjCmd(
     chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
 	    mode);
     rcPtr->chan = chan;
+    Tcl_Preserve(chan);
     chanPtr = (Channel *) chan;
 
     /*
@@ -2145,6 +2146,7 @@ FreeReflectedChannel(
 
 	ckfree((char*) chanPtr->typePtr);
     }
+    Tcl_Release(chanPtr);
 
     n = rcPtr->argc - 2;
     for (i=0; i<n; i++) {
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 262be9b..bdf0fb3 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -1024,10 +1024,9 @@ test iocmd-23.11 {chan read, close pulls the rug out} -match glob -body {
     }
     set c [chan create {r} foo]
     note [read $c]
-    close $c
     rename foo {}
     set res
-} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
+} -result {{read rc* 4096} {}}
 
 # --- === *** ###########################
 # method write
-- 
cgit v0.12


From c85fe58264794439fe6057b5d98428a033774bcc Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 31 Mar 2014 15:23:30 +0000
Subject: Cherry-pick [c54059aaad] from trunk: Added support for reporting
 TEA-like info via pkg-config. Add missing @TCL_LIB_FLAG@ (derived from ticket
 [5bcb5026ad])

---
 unix/Makefile.in  | 10 +++++++---
 unix/configure    |  3 ++-
 unix/configure.in |  1 +
 unix/tcl.pc.in    | 15 +++++++++++++++
 4 files changed, 25 insertions(+), 4 deletions(-)
 create mode 100644 unix/tcl.pc.in

diff --git a/unix/Makefile.in b/unix/Makefile.in
index c7caf5b..746abde 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -736,6 +736,9 @@ install-binaries: binaries
 	    @INSTALL_STUB_LIB@ ; \
 	fi
 	@EXTRA_INSTALL_BINARIES@
+	@echo "Installing pkg-config file to $(LIB_INSTALL_DIR)/pkgconfig/"
+	@mkdir -p $(LIB_INSTALL_DIR)/pkgconfig
+	@$(INSTALL_DATA) tcl.pc $(LIB_INSTALL_DIR)/pkgconfig/tcl.pc
 
 install-libraries: libraries $(INSTALL_TZDATA) install-msgs
 	@for i in "$(INCLUDE_INSTALL_DIR)" "$(SCRIPT_INSTALL_DIR)"; \
@@ -905,7 +908,8 @@ clean:
 
 distclean: clean
 	rm -rf Makefile config.status config.cache config.log tclConfig.sh \
-		$(PACKAGE).* prototype tclConfig.h *.plist Tcl.framework
+		$(PACKAGE).* prototype tclConfig.h *.plist Tcl.framework \
+		tcl.pc
 	cd dltest ; $(MAKE) distclean
 
 depend:
@@ -1657,7 +1661,7 @@ $(UNIX_DIR)/tclConfig.h.in: $(MAC_OSX_DIR)/configure
 	cd $(MAC_OSX_DIR); autoheader; touch $@
 
 EOLFIX=$(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl
-dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(MAC_OSX_DIR)/configure genstubs
+dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(MAC_OSX_DIR)/configure genstubs
 	rm -rf $(DISTDIR)
 	mkdir -p $(DISTDIR)/unix
 	cp -p $(UNIX_DIR)/*.[ch] $(DISTDIR)/unix
@@ -1668,7 +1672,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(MAC_OSX_DIR)/configure
 		$(UNIX_DIR)/tclConfig.sh.in $(UNIX_DIR)/install-sh \
 		$(UNIX_DIR)/README $(UNIX_DIR)/ldAix $(UNIX_DIR)/tcl.spec \
 		$(UNIX_DIR)/installManPage $(UNIX_DIR)/tclConfig.h.in \
-		$(DISTDIR)/unix
+		$(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix
 	chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in
 	chmod 775 $(DISTDIR)/unix/ldAix
 	@mkdir $(DISTDIR)/generic
diff --git a/unix/configure b/unix/configure
index 1b2ea41..02a3725 100755
--- a/unix/configure
+++ b/unix/configure
@@ -18915,7 +18915,7 @@ TCL_SHARED_BUILD=${SHARED_BUILD}
 
 
 
-                              ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in"
+                              ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in"
 
 cat >confcache <<\_ACEOF
 # This file is a shell script that caches the results of configure
@@ -19469,6 +19469,7 @@ do
   "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile:../unix/Makefile.in" ;;
   "dltest/Makefile" ) CONFIG_FILES="$CONFIG_FILES dltest/Makefile:../unix/dltest/Makefile.in" ;;
   "tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh:../unix/tclConfig.sh.in" ;;
+  "tcl.pc" ) CONFIG_FILES="$CONFIG_FILES tcl.pc:../unix/tcl.pc.in" ;;
   "Tcl.framework" ) CONFIG_COMMANDS="$CONFIG_COMMANDS Tcl.framework" ;;
   *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
 echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
diff --git a/unix/configure.in b/unix/configure.in
index b5a09dd..318bcf8 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -940,5 +940,6 @@ AC_CONFIG_FILES([
     Makefile:../unix/Makefile.in
     dltest/Makefile:../unix/dltest/Makefile.in
     tclConfig.sh:../unix/tclConfig.sh.in
+    tcl.pc:../unix/tcl.pc.in
 ])
 AC_OUTPUT
diff --git a/unix/tcl.pc.in b/unix/tcl.pc.in
new file mode 100644
index 0000000..6b6fe44
--- /dev/null
+++ b/unix/tcl.pc.in
@@ -0,0 +1,15 @@
+# tcl pkg-config source file
+
+prefix=@prefix@
+exec_prefix=@exec_prefix@
+libdir=@libdir@
+includedir=@includedir@
+
+Name: Tool Command Language
+Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses.
+URL: http://www.tcl.tk/
+Version: @TCL_VERSION@
+Requires:
+Conflicts:
+Libs: -L${libdir} @TCL_LIB_FLAG@ @TCL_LIBS@
+Cflags: -I${includedir}
-- 
cgit v0.12


From 228bbc8713a27f21735f74e4ed4a4e77c8edf3c7 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Tue, 1 Apr 2014 09:52:34 +0000
Subject: Set return message in close if a flush error is reported (which may
 be an error from a background flush). Ticket [97069ea11a]

---
 generic/tclIO.c | 15 +++++++++++++--
 1 file changed, 13 insertions(+), 2 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index c43e61e..15fc8af 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -3209,9 +3209,20 @@ Tcl_Close(
 	    Tcl_SetObjResult(interp,
 			     Tcl_NewStringObj(Tcl_PosixError(interp), -1));
 	}
-	flushcode = -1;
+	return TCL_ERROR;
     }
-    if ((flushcode != 0) || (result != 0)) {
+    if (result != 0) {
+	return TCL_ERROR;
+    }
+    /*
+     * Bug 97069ea11a: set error message if a flush code is set
+     */
+    if (flushcode != 0) {
+	Tcl_SetErrno(flushcode);
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp,
+			     Tcl_NewStringObj(Tcl_PosixError(interp), -1));
+	}
 	return TCL_ERROR;
     }
     return TCL_OK;
-- 
cgit v0.12


From e14e7323ec0a1a11668d5ae89f1e4a102e4757b4 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Tue, 1 Apr 2014 11:31:49 +0000
Subject: Fix test failure socket-2.9: "1 {not owner}" instead of "1 {couldn't
 open socket address already in use}" by only setting returned error message
 if not jet set.

---
 generic/tclIO.c | 17 ++++++++---------
 1 file changed, 8 insertions(+), 9 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 15fc8af..9e675c6 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -3211,18 +3211,17 @@ Tcl_Close(
 	}
 	return TCL_ERROR;
     }
-    if (result != 0) {
-	return TCL_ERROR;
-    }
     /*
-     * Bug 97069ea11a: set error message if a flush code is set
+     * Bug 97069ea11a: set error message if a flush code is set and no error
+     * message set up to now.
      */
-    if (flushcode != 0) {
+    if (flushcode != 0 && interp != NULL
+	    && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp)) ) {
 	Tcl_SetErrno(flushcode);
-	if (interp != NULL) {
-	    Tcl_SetObjResult(interp,
-			     Tcl_NewStringObj(Tcl_PosixError(interp), -1));
-	}
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj(Tcl_PosixError(interp), -1));
+    }
+    if ((flushcode != 0) || (result != 0)) {
 	return TCL_ERROR;
     }
     return TCL_OK;
-- 
cgit v0.12


From bbc3bb7823030f97cb3f96d7a76ccf49b0245545 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Tue, 1 Apr 2014 12:16:39 +0000
Subject: Removed thread debugging printf messages

---
 win/tclWinSock.c | 123 ++++++-------------------------------------------------
 1 file changed, 13 insertions(+), 110 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 91f9e8c..1b252e0 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -50,14 +50,6 @@
 
 #include "tclWinInt.h"
 
-//#define DEBUGGING
-#ifdef DEBUGGING
-#define DEBUG(x) fprintf(stderr, ">>> %p %s(%d): %s<<<\n", \
-			    statePtr, __FUNCTION__, __LINE__, x)
-#else
-#define DEBUG(x)
-#endif
-
 /*
  * Which version of the winsock API do we want?
  */
@@ -318,6 +310,10 @@ static TclInitProcessGlobalValueProc InitializeHostName;
 static ProcessGlobalValue hostName =
 	{0, 0, NULL, NULL, InitializeHostName, NULL, NULL};
 
+/*
+ * Address print debug functions
+ */
+#if 0
 void printaddrinfo(struct addrinfo *ai, char *prefix)
 {
     char host[NI_MAXHOST], port[NI_MAXSERV];
@@ -325,9 +321,6 @@ void printaddrinfo(struct addrinfo *ai, char *prefix)
 		host, sizeof(host),
 		port, sizeof(port),
 		NI_NUMERICHOST|NI_NUMERICSERV);
-#ifdef DEBUGGING
-    fprintf(stderr,"%s: [%s]:%s\n", prefix, host, port);
-#endif
 }
 void printaddrinfolist(struct addrinfo *addrlist, char *prefix)
 {
@@ -336,6 +329,7 @@ void printaddrinfolist(struct addrinfo *addrlist, char *prefix)
 	printaddrinfo(ai, prefix);
     }
 }
+#endif
 
 /*
  *----------------------------------------------------------------------
@@ -1319,9 +1313,6 @@ TcpGetOptionProc(
 	}
 	for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
 	    sock = fds->fd;
-#ifdef DEBUGGING
-	    fprintf(stderr, "sock == %d\n", sock);
-#endif
 	    size = sizeof(sockname);
 	    if (getsockname(sock, &(sockname.sa), &size) >= 0) {
 		int flags = reverseDNS;
@@ -1452,9 +1443,6 @@ TcpWatchProc(
 {
     TcpState *statePtr = instanceData;
 
-    DEBUG((mask & TCL_READABLE) ? "+r":"-r");
-    DEBUG((mask & TCL_WRITABLE) ? "+w":"-w");
-
     /*
      * Update the watch events mask. Only if the socket is not a server
      * socket. [Bug 557878]
@@ -1567,13 +1555,8 @@ CreateClientSocket(
     int async_callback = statePtr->sockets->fd != INVALID_SOCKET;
     ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
     
-    DEBUG(async_connect ? "async connect" : "sync connect");
-
     if (async_callback) {
-	DEBUG("subsequent call");
         goto reenter;
-    } else {
-	DEBUG("first call");
     }
     
     for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL;
@@ -1582,28 +1565,20 @@ CreateClientSocket(
         for (statePtr->myaddr = statePtr->myaddrlist; statePtr->myaddr != NULL;
 	     statePtr->myaddr = statePtr->myaddr->ai_next) {
 
-	    DEBUG("inner loop");
-
 	    /*
 	     * No need to try combinations of local and remote addresses
 	     * of different families.
 	     */
 
 	    if (statePtr->myaddr->ai_family != statePtr->addr->ai_family) {
-		DEBUG("family mismatch");
 		continue;
 	    }
 
-	    DEBUG(statePtr->myaddr->ai_family == AF_INET ? "IPv4" : "IPv6");
-	    printaddrinfo(statePtr->myaddr, "~~ from");
-	    printaddrinfo(statePtr->addr,   "~~   to");
-
             /*
              * Close the socket if it is still open from the last unsuccessful
              * iteration.
              */	    
 	    if (statePtr->sockets->fd != INVALID_SOCKET) {
-		DEBUG("closesocket");
 		closesocket(statePtr->sockets->fd);
 	    }
 
@@ -1623,14 +1598,10 @@ CreateClientSocket(
 
 	    /* continue on socket creation error */
 	    if (statePtr->sockets->fd == INVALID_SOCKET) {
-		DEBUG("socket() failed");
 		TclWinConvertError((DWORD) WSAGetLastError());
 		continue;
 	    }
-	    
-#ifdef DEBUGGING
-	    fprintf(stderr, "Client socket %d created\n", statePtr->sockets->fd);
-#endif
+
 	    /*
 	     * Win-NT has a misfeature that sockets are inherited in child
 	     * processes by default. Turn off the inherit bit.
@@ -1650,7 +1621,6 @@ CreateClientSocket(
 
 	    if (bind(statePtr->sockets->fd, statePtr->myaddr->ai_addr,
 			statePtr->myaddr->ai_addrlen) == SOCKET_ERROR) {
-		DEBUG("bind() failed");
 		TclWinConvertError((DWORD) WSAGetLastError());
 		continue;
 	    }
@@ -1706,7 +1676,6 @@ CreateClientSocket(
 	     * Attempt to connect to the remote socket.
 	     */
 	    
-	    DEBUG("connect()");
 	    connect(statePtr->sockets->fd, statePtr->addr->ai_addr,
 		    statePtr->addr->ai_addrlen);
 
@@ -1717,8 +1686,6 @@ CreateClientSocket(
 		/*
 		 * Asynchroneous connect
 		 */
-		DEBUG("WSAEWOULDBLOCK");
-
 
 		/*
 		 * Remember that we jump back behind this next round
@@ -1727,7 +1694,6 @@ CreateClientSocket(
 		return TCL_OK;
 
 	    reenter:
-		DEBUG("reenter");
 		/*
 		 * Re-entry point for async connect after connect event or
 		 * blocking operation
@@ -1744,9 +1710,7 @@ CreateClientSocket(
 		/* Free list lock */
 		SetEvent(tsdPtr->socketListLock);
 	    }
-#ifdef DEBUGGING
-	    fprintf(stderr, "connectError: %d\n", Tcl_GetErrno());
-#endif
+
 	    /*
 	     * Clear the tsd socket list pointer if we did not wait for
 	     * the FD_CONNECT asyncroneously
@@ -1763,11 +1727,6 @@ out:
     /*
      * Socket connected or connection failed
      */
-    DEBUG("connected or finally failed");
-
-    /*
-     * Final connect failure
-     */
 
     if ( Tcl_GetErrno() == 0 ) {
 	/*
@@ -1776,7 +1735,6 @@ out:
 	/*
 	 * Set up the select mask for read/write events.
 	 */
-	DEBUG("selectEvents = FD_READ | FD_WRITE | FD_CLOSE");    
 	statePtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
         
 	/*
@@ -1790,7 +1748,6 @@ out:
 	/*
 	 * Connect failed
 	 */
-	DEBUG("ERRNO");
 
 	/*
 	 * For async connect schedule a writable event to report the fail.
@@ -1799,7 +1756,6 @@ out:
 	    /*
 	     * Set up the select mask for read/write events.
 	     */
-	    DEBUG("selectEvents = FD_WRITE/FD_READ for connect fail");    
 	    statePtr->selectEvents = FD_WRITE|FD_READ;
 	    /* get statePtr lock */
 	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
@@ -1885,8 +1841,6 @@ Tcl_OpenTcpClient(
         }
         return NULL;
     }
-    printaddrinfolist(myaddrlist, "local");
-    printaddrinfolist(addrlist, "remote");
 
     statePtr = NewSocketInfo(INVALID_SOCKET);
     statePtr->addrlist = addrlist;
@@ -1898,7 +1852,6 @@ Tcl_OpenTcpClient(
     /*
      * Create a new client socket and wrap it in a channel.
      */
-    DEBUG("");
     if (CreateClientSocket(interp, statePtr) != TCL_OK) {
 	TcpCloseProc(statePtr, NULL);
 	return NULL;
@@ -2480,7 +2433,6 @@ SocketSetupProc(
 	if (statePtr->readyEvents &
 	    (statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)
 	) {
-	    DEBUG("Tcl_SetMaxBlockTime");
 	    Tcl_SetMaxBlockTime(&blockTime);
 	    break;
 	}
@@ -2527,12 +2479,10 @@ SocketCheckProc(
     WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
     for (statePtr = tsdPtr->socketList; statePtr != NULL;
 	    statePtr = statePtr->nextPtr) {
-	DEBUG("Socket loop");
 	if ((statePtr->readyEvents &
 		(statePtr->watchEvents | FD_CONNECT | FD_ACCEPT))
 	    && !(statePtr->flags & SOCKET_PENDING)
 	) {
-	    DEBUG("Event found");
 	    statePtr->flags |= SOCKET_PENDING;
 	    evPtr = ckalloc(sizeof(SocketEvent));
 	    evPtr->header.proc = SocketEventProc;
@@ -2570,7 +2520,7 @@ SocketEventProc(
     int flags)			/* Flags that indicate what events to handle,
 				 * such as TCL_FILE_EVENTS. */
 {
-    TcpState *statePtr = NULL; /* DEBUG */
+    TcpState *statePtr;
     SocketEvent *eventPtr = (SocketEvent *) evPtr;
     int mask = 0, events;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -2579,7 +2529,6 @@ SocketEventProc(
     address addr;
     int len;
 
-    DEBUG("");
     if (!(flags & TCL_FILE_EVENTS)) {
 	return 0;
     }
@@ -2610,7 +2559,6 @@ SocketEventProc(
     /* Continue async connect if pending and ready */
     if ( statePtr->readyEvents & FD_CONNECT ) {
 	statePtr->readyEvents &= ~(FD_CONNECT);
-	DEBUG("FD_CONNECT");
 	if ( statePtr->flags & TCP_ASYNC_CONNECT_REENTER_PENDING ) {
 	    SetEvent(tsdPtr->socketListLock);
 	    CreateClientSocket(NULL, statePtr);
@@ -2702,7 +2650,6 @@ SocketEventProc(
 
 	Tcl_Time blockTime = { 0, 0 };
 
-	DEBUG("FD_CLOSE");
 	Tcl_SetMaxBlockTime(&blockTime);
 	mask |= TCL_READABLE|TCL_WRITABLE;
     } else if (events & FD_READ) {
@@ -2722,11 +2669,10 @@ SocketEventProc(
 	    /*
 	     * We must check to see if data is really available, since someone
 	     * could have consumed the data in the meantime. Turn off async
-	     * notification so select will work correctly. If the socket is still
-	     * readable, notify the channel driver, otherwise reset the async
-	     * select handler and keep waiting.
+	     * notification so select will work correctly. If the socket is
+	     * still readable, notify the channel driver, otherwise reset the
+	     * async select handler and keep waiting.
 	     */
-	    DEBUG("FD_READ");
 
 	    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
 		    (WPARAM) UNSELECT, (LPARAM) statePtr);
@@ -2751,7 +2697,6 @@ SocketEventProc(
      */
 
     if (events & FD_WRITE) {
-	DEBUG("FD_WRITE");
 	mask |= TCL_WRITABLE;
     }
     
@@ -2760,10 +2705,8 @@ SocketEventProc(
      */
      
     if (mask) {
-	DEBUG("Calling Tcl_NotifyChannel...");
 	Tcl_NotifyChannel(statePtr->channel, mask);
     }
-    DEBUG("returning...");
     return 1;
 }
 
@@ -2878,7 +2821,6 @@ WaitForSocketEvent(
     /*
      * Be sure to disable event servicing so we are truly modal.
      */
-    DEBUG("=============");
 
     oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
 
@@ -3017,7 +2959,7 @@ SocketProc(
 {
     int event, error;
     SOCKET socket;
-    TcpState *statePtr = NULL; /* DEBUG */
+    TcpState *statePtr;
     int info_found = 0;
     TcpFdList *fds = NULL;
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
@@ -3056,17 +2998,6 @@ SocketProc(
 	error = WSAGETSELECTERROR(lParam);
 	socket = (SOCKET) wParam;
 
-        #ifdef DEBUGGING
-	fprintf(stderr,"event = %d, error=%d\n",event,error);
-	#endif
-	if (event & FD_READ) DEBUG("READ Event");
-	if (event & FD_WRITE) DEBUG("WRITE Event");
-	if (event & FD_CLOSE) DEBUG("CLOSE Event");
-	if (event & FD_CONNECT)
-	    DEBUG("CONNECT Event");
-	if (event & FD_ACCEPT) DEBUG("ACCEPT Event");
-
-	DEBUG("Get list lock");
 	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
 
 	/*
@@ -3076,10 +3007,8 @@ SocketProc(
 
 	for (statePtr = tsdPtr->socketList; statePtr != NULL;
 		statePtr = statePtr->nextPtr) {
-	    DEBUG("Cur InfoPtr");
 	    if ( FindFDInList(statePtr,socket) ) {
 		info_found = 1;
-		DEBUG("InfoPtr found");
 		break;
 	    }
 	}
@@ -3091,14 +3020,9 @@ SocketProc(
 		&& tsdPtr->pendingTcpState != NULL
 		&& FindFDInList(tsdPtr->pendingTcpState,socket) ) {
 	    statePtr = tsdPtr->pendingTcpState;
-	    DEBUG("Pending InfoPtr found");
 	    info_found = 1;
 	}
 	if (info_found) {
-	    if (event & FD_READ) 
-		DEBUG("|->FD_READ");
-	    if (event & FD_WRITE) 
-		DEBUG("|->FD_WRITE");
 
 	    /*
 	     * Update the socket state.
@@ -3109,16 +3033,13 @@ SocketProc(
 	     */
 
 	    if (event & FD_CLOSE) {
-		DEBUG("FD_CLOSE");
 		statePtr->acceptEventCount = 0;
 		statePtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
 	    } else if (event & FD_ACCEPT) {
-		DEBUG("FD_ACCEPT");
-		    statePtr->acceptEventCount++;
+		statePtr->acceptEventCount++;
 	    }
 
 	    if (event & FD_CONNECT) {
-		DEBUG("FD_CONNECT");
 		/*
 		 * Remember any error that occurred so we can report
 		 * connection failures.
@@ -3143,19 +3064,9 @@ SocketProc(
 	break;
 
     case SOCKET_SELECT:
-	DEBUG("SOCKET_SELECT");
 	statePtr = (TcpState *) lParam;
 	for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
-#ifdef DEBUGGING
-	    fprintf(stderr,"loop over fd = %d\n",fds->fd);
-#endif
 	    if (wParam == SELECT) {
-		DEBUG("SELECT");
-		if (statePtr->selectEvents & FD_READ) DEBUG("  READ");
-		if (statePtr->selectEvents & FD_WRITE) DEBUG("  WRITE");
-		if (statePtr->selectEvents & FD_CLOSE) DEBUG("  CLOSE");
-		if (statePtr->selectEvents & FD_CONNECT) DEBUG("  CONNECT");
-		if (statePtr->selectEvents & FD_ACCEPT) DEBUG("  ACCEPT");
 		WSAAsyncSelect(fds->fd, hwnd,
 			SOCKET_MESSAGE, statePtr->selectEvents);
 	    } else {
@@ -3163,14 +3074,12 @@ SocketProc(
 		 * Clear the selection mask
 		 */
 
-		DEBUG("!SELECT");
 		WSAAsyncSelect(fds->fd, hwnd, 0, 0);
 	    }
 	}
 	break;
 
     case SOCKET_TERMINATE:
-	    DEBUG("SOCKET_TERMINATE");
 	DestroyWindow(hwnd);
 	break;
     }
@@ -3201,9 +3110,6 @@ FindFDInList(
 {
     TcpFdList *fds;
     for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
-        #ifdef DEBUGGING
-	fprintf(stderr,"socket = %d, fd=%d\n",socket,fds);
-	#endif
 	if (fds->fd == socket) {
 	    return 1;
 	}
@@ -3346,12 +3252,10 @@ TcpThreadActionProc(
 	tsdPtr = TCL_TSD_INIT(&dataKey);
 
 	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-	DEBUG("Inserting pointer to list");
 	statePtr->nextPtr = tsdPtr->socketList;
 	tsdPtr->socketList = statePtr;
 	
 	if (statePtr == tsdPtr->pendingTcpState) {
-	    DEBUG("Clearing temporary info pointer");
 	    tsdPtr->pendingTcpState = NULL;
 	}
 	
@@ -3370,7 +3274,6 @@ TcpThreadActionProc(
 	 */
 
 	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
-	DEBUG("Removing pointer from list");
 	for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL;
 		nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
 	    if ((*nextPtrPtr) == statePtr) {
-- 
cgit v0.12


From a34d5fc9fb803e7cd3b123445f615018c2e1e23c Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Tue, 1 Apr 2014 12:17:36 +0000
Subject: Add test cases for Bug [97069ea11a].

---
 tests/socket.test | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

diff --git a/tests/socket.test b/tests/socket.test
index 0ae5abd..5a6d9cd 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -1672,6 +1672,33 @@ test socket-13.1 {Testing use of shared socket between two threads} \
 } -cleanup {
     removeFile script
 } -result {hello 1}
+test socket-14.11.0 {pending [socket -async] and blocking [puts], no listener, no flush} \
+    -constraints {socket} \
+    -body {
+        set sock [socket -async 169.254.0.0 42424]
+        fconfigure $sock -blocking 0
+        puts $sock ok
+        fileevent $sock writable {set x 1}
+        vwait x
+        close $sock
+    } -cleanup {
+        catch {close $sock}
+        unset x
+    } -result {host is unreachable} -returnCodes 1
+test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, flush} \
+    -constraints {socket} \
+    -body {
+        set sock [socket -async 169.254.0.0 42424]
+        fconfigure $sock -blocking 0
+        puts $sock ok
+        flush $sock
+        fileevent $sock writable {set x 1}
+        vwait x
+        close $sock
+    } -cleanup {
+        catch {close $sock}
+        catch {unset x}
+    } -result {host is unreachable} -returnCodes 1
 
 removeFile script1
 removeFile script2
-- 
cgit v0.12


From 8d1bb4056046a74a3f04fa04992d2eb9d7346776 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Tue, 1 Apr 2014 14:00:04 +0000
Subject: Centralize and clarify the user of 169.254.0.0 as a non-reachable
 address.

---
 tests/socket.test | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/tests/socket.test b/tests/socket.test
index 5a6d9cd..9ffe506 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -63,6 +63,12 @@
 package require tcltest 2
 namespace import -force ::tcltest::*
 
+# For some tests we need an IP address that never responds.
+# 169.254.0.0 seems to be a good candidate, because it is from a
+# reserved part of the zeroconf address space. Should it ever cause
+# any problems, a different known-unreachable adress can be set here.
+set unreachableIP 169.254.0.0
+
 # Some tests require the testthread and exec commands
 testConstraint testthread [llength [info commands testthread]]
 testConstraint exec [llength [info commands exec]]
@@ -1675,7 +1681,7 @@ test socket-13.1 {Testing use of shared socket between two threads} \
 test socket-14.11.0 {pending [socket -async] and blocking [puts], no listener, no flush} \
     -constraints {socket} \
     -body {
-        set sock [socket -async 169.254.0.0 42424]
+        set sock [socket -async $unreachableIP 42424]
         fconfigure $sock -blocking 0
         puts $sock ok
         fileevent $sock writable {set x 1}
@@ -1688,7 +1694,7 @@ test socket-14.11.0 {pending [socket -async] and blocking [puts], no listener, n
 test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, flush} \
     -constraints {socket} \
     -body {
-        set sock [socket -async 169.254.0.0 42424]
+        set sock [socket -async $unreachableIP 42424]
         fconfigure $sock -blocking 0
         puts $sock ok
         flush $sock
@@ -1697,7 +1703,7 @@ test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, f
         close $sock
     } -cleanup {
         catch {close $sock}
-        catch {unset x}
+        unset x
     } -result {host is unreachable} -returnCodes 1
 
 removeFile script1
-- 
cgit v0.12


From 8945be288772dd0087122837b2b4432109180088 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Wed, 2 Apr 2014 08:22:12 +0000
Subject: Marked all communication variables which are set by notifier thread
 with "volatile".

---
 win/tclWinSock.c | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 1b252e0..036f3b9 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -146,7 +146,7 @@ struct TcpState {
     int watchEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
 				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
 				 * indicate which events are interesting. */
-    int readyEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
+    volatile int readyEvents;	/* OR'ed combination of FD_READ, FD_WRITE,
 				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
 				 * indicate which events have occurred.
 				 * Set by notifier thread, access must be
@@ -155,7 +155,8 @@ struct TcpState {
 				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
 				 * indicate which events are currently being
 				 * selected. */
-    int acceptEventCount;	/* Count of the current number of FD_ACCEPTs
+    volatile int acceptEventCount;
+				/* Count of the current number of FD_ACCEPTs
 				 * that have arrived and not yet processed.
 				 * Set by notifier thread, access must be
 				 * protected by semaphore */
@@ -173,7 +174,7 @@ struct TcpState {
     struct addrinfo *myaddr;	/* Iterator over myaddrlist. */
     int status;                 /* Cache status of async socket. */
     int cachedBlocking;         /* Cache blocking mode of async socket. */
-    int connectError;		/* Async connect error set by notifier thread.
+    volatile int connectError;	/* Async connect error set by notifier thread.
 				 * Set by notifier thread, access must be
 				 * protected by semaphore */
     struct TcpState *nextPtr;	/* The next socket on the per-thread socket
-- 
cgit v0.12


From fa9b84b398d88714ceaa6410047ccead8f15b1c3 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Wed, 2 Apr 2014 08:35:02 +0000
Subject: Set all variables written by the notifier thread as volatile.

---
 win/tclWinSock.c | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 6633b89..e7b086a 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -98,29 +98,31 @@ static ProcessGlobalValue hostName = {
 /*
  * The following structure is used to store the data associated with each
  * socket.
+ * All members modified by the notifier thread are defined as volatile.
  */
 
 typedef struct SocketInfo {
     Tcl_Channel channel;	/* Channel associated with this socket. */
     SOCKET socket;		/* Windows SOCKET handle. */
-    int flags;			/* Bit field comprised of the flags described
+    volatile int flags;		/* Bit field comprised of the flags described
 				 * below. */
     int watchEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
 				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
 				 * indicate which events are interesting. */
-    int readyEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
+    volatile int readyEvents;	/* OR'ed combination of FD_READ, FD_WRITE,
 				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
 				 * indicate which events have occurred. */
     int selectEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
 				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
 				 * indicate which events are currently being
 				 * selected. */
-    int acceptEventCount;	/* Count of the current number of FD_ACCEPTs
+    volatile int acceptEventCount;
+				/* Count of the current number of FD_ACCEPTs
 				 * that have arrived and not yet processed. */
     Tcl_TcpAcceptProc *acceptProc;
 				/* Proc to call on accept. */
     ClientData acceptProcData;	/* The data for the accept proc. */
-    int lastError;		/* Error code from last message. */
+    volatile int lastError;	/* Error code from last message. */
     struct SocketInfo *nextPtr;	/* The next socket on the per-thread socket
 				 * list. */
 } SocketInfo;
-- 
cgit v0.12


From b5277efde02115a99b120d3a90fb1471c6aee409 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Wed, 2 Apr 2014 09:54:27 +0000
Subject: Test to demonstrate bug [336441ed59]. Depends on timing and will not
 always fire but is better than nothing. Reliable for me.

---
 tests/socket.test | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/tests/socket.test b/tests/socket.test
index 0ae5abd..218cce4 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -910,6 +910,22 @@ test socket-8.1 {testing -async flag on sockets} {socket} {
     set z
 } bye
 
+test socket-8.2 {testing writable event when quick failure} {socket win} {
+    # Test for bug 336441ed59 where a quick background fail was ignored
+
+    # Test only for windows as socket -async 255.255.255.255 fails directly
+    # on unix
+    
+    # The following connect should fail very quickly
+    set a1 [after 2000 {set x timeout}]
+    set s [socket -async 255.255.255.255 43434]
+    fileevent $s writable {set x writable}
+    vwait x
+    catch {close $s}
+    after cancel $a1
+    set x
+} writable
+
 test socket-9.1 {testing spurious events} {socket} {
     set len 0
     set spurious 0
-- 
cgit v0.12


From 3789b7493dc4baf577d118984bde1ea11cbe66e5 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Fri, 4 Apr 2014 08:29:51 +0000
Subject: Revert the tests for bug#97069ea11a from socket.test, because it is
 hard to test with the socket command in a platform-independent way. As the
 bug is in tclIOChan.c and should be tested there with a dummy channel driver
 that can reliably reproduce the situation that suppresses the error message.

---
 tests/socket.test | 33 ---------------------------------
 1 file changed, 33 deletions(-)

diff --git a/tests/socket.test b/tests/socket.test
index 9ffe506..0ae5abd 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -63,12 +63,6 @@
 package require tcltest 2
 namespace import -force ::tcltest::*
 
-# For some tests we need an IP address that never responds.
-# 169.254.0.0 seems to be a good candidate, because it is from a
-# reserved part of the zeroconf address space. Should it ever cause
-# any problems, a different known-unreachable adress can be set here.
-set unreachableIP 169.254.0.0
-
 # Some tests require the testthread and exec commands
 testConstraint testthread [llength [info commands testthread]]
 testConstraint exec [llength [info commands exec]]
@@ -1678,33 +1672,6 @@ test socket-13.1 {Testing use of shared socket between two threads} \
 } -cleanup {
     removeFile script
 } -result {hello 1}
-test socket-14.11.0 {pending [socket -async] and blocking [puts], no listener, no flush} \
-    -constraints {socket} \
-    -body {
-        set sock [socket -async $unreachableIP 42424]
-        fconfigure $sock -blocking 0
-        puts $sock ok
-        fileevent $sock writable {set x 1}
-        vwait x
-        close $sock
-    } -cleanup {
-        catch {close $sock}
-        unset x
-    } -result {host is unreachable} -returnCodes 1
-test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, flush} \
-    -constraints {socket} \
-    -body {
-        set sock [socket -async $unreachableIP 42424]
-        fconfigure $sock -blocking 0
-        puts $sock ok
-        flush $sock
-        fileevent $sock writable {set x 1}
-        vwait x
-        close $sock
-    } -cleanup {
-        catch {close $sock}
-        unset x
-    } -result {host is unreachable} -returnCodes 1
 
 removeFile script1
 removeFile script2
-- 
cgit v0.12


From 8978760b1a95d061dff0d9c3f0c8a997aa56998d Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Fri, 4 Apr 2014 08:51:58 +0000
Subject: Make the naming of TcpState variables consistent

---
 unix/tclUnixSock.c | 102 ++++++++++++++++++++++++++++-------------------------
 1 file changed, 53 insertions(+), 49 deletions(-)

diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index b26d707..466b231 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -991,21 +991,21 @@ TcpAsyncCallback(
 static int
 CreateClientSocket(
     Tcl_Interp *interp,		/* For error reporting; can be NULL. */
-    TcpState *state)
+    TcpState *statePtr)
 {
     socklen_t optlen;
-    int async_callback = (state->addr != NULL);
-    int ret = -1, error;
-    int async = state->flags & TCP_ASYNC_CONNECT;
+    int async_callback = (statePtr->addr != NULL);
+    int ret = -1, error = 0;
+    int async = statePtr->flags & TCP_ASYNC_CONNECT;
 
     if (async_callback) {
         goto reenter;
     }
 
-    for (state->addr = state->addrlist; state->addr != NULL;
-            state->addr = state->addr->ai_next) {
-        for (state->myaddr = state->myaddrlist; state->myaddr != NULL;
-                state->myaddr = state->myaddr->ai_next) {
+    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;
             
 	    /*
@@ -1013,7 +1013,7 @@ CreateClientSocket(
 	     * different families.
 	     */
 
-	    if (state->myaddr->ai_family != state->addr->ai_family) {
+	    if (statePtr->myaddr->ai_family != statePtr->addr->ai_family) {
 		continue;
 	    }
 
@@ -1022,14 +1022,14 @@ CreateClientSocket(
              * iteration.
              */
 
-            if (state->fds.fd >= 0) {
-		close(state->fds.fd);
-		state->fds.fd = -1;
+            if (statePtr->fds.fd >= 0) {
+		close(statePtr->fds.fd);
+		statePtr->fds.fd = -1;
                 errno = 0;
 	    }
 
-	    state->fds.fd = socket(state->addr->ai_family, SOCK_STREAM, 0);
-	    if (state->fds.fd < 0) {
+	    statePtr->fds.fd = socket(statePtr->addr->ai_family, SOCK_STREAM, 0);
+	    if (statePtr->fds.fd < 0) {
 		continue;
 	    }
 
@@ -1038,27 +1038,28 @@ CreateClientSocket(
 	     * inherited by child processes.
 	     */
 	    
-	    fcntl(state->fds.fd, F_SETFD, FD_CLOEXEC);
+	    fcntl(statePtr->fds.fd, F_SETFD, FD_CLOEXEC);
 	    
 	    /*
 	     * Set kernel space buffering
 	     */
 	    
-	    TclSockMinimumBuffers(INT2PTR(state->fds.fd), SOCKET_BUFSIZE);
+	    TclSockMinimumBuffers(INT2PTR(statePtr->fds.fd), SOCKET_BUFSIZE);
     
 	    if (async) {
-                ret = TclUnixSetBlockingMode(state->fds.fd,TCL_MODE_NONBLOCKING);
+                ret = TclUnixSetBlockingMode(statePtr->fds.fd,TCL_MODE_NONBLOCKING);
                 if (ret < 0) {
                     continue;
                 }
             }
 
             reuseaddr = 1;
-            (void) setsockopt(state->fds.fd, SOL_SOCKET, SO_REUSEADDR,
+            (void) setsockopt(statePtr->fds.fd, SOL_SOCKET, SO_REUSEADDR,
                     (char *) &reuseaddr, sizeof(reuseaddr));
-            ret = bind(state->fds.fd, state->myaddr->ai_addr,
-                    state->myaddr->ai_addrlen);
+            ret = bind(statePtr->fds.fd, statePtr->myaddr->ai_addr,
+                    statePtr->myaddr->ai_addrlen);
             if (ret < 0) {
+                error = errno;
                 continue;
             }
 
@@ -1069,16 +1070,17 @@ CreateClientSocket(
 	     * in being informed when the connect completes.
 	     */
 	    
-	    ret = connect(state->fds.fd, state->addr->ai_addr,
-                        state->addr->ai_addrlen);
-            error = errno;
+	    ret = connect(statePtr->fds.fd, statePtr->addr->ai_addr,
+                        statePtr->addr->ai_addrlen);
+            if (ret < 0) error = errno;
 	    if (ret < 0 && errno == EINPROGRESS) {
-                Tcl_CreateFileHandler(state->fds.fd,
-                        TCL_WRITABLE|TCL_EXCEPTION, TcpAsyncCallback, state);
+                Tcl_CreateFileHandler(statePtr->fds.fd,
+                        TCL_WRITABLE|TCL_EXCEPTION, TcpAsyncCallback, statePtr);
+                statePtr->error = errno = EWOULDBLOCK;
                 return TCL_OK;
 
             reenter:
-                Tcl_DeleteFileHandler(state->fds.fd);
+                Tcl_DeleteFileHandler(statePtr->fds.fd);
 
                 /*
                  * Read the error state from the socket to see if the async
@@ -1089,26 +1091,26 @@ CreateClientSocket(
 
                 optlen = sizeof(int);
 
-                getsockopt(state->fds.fd, SOL_SOCKET, SO_ERROR,
+                getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR,
                         (char *) &error, &optlen);
                 errno = error;
             }
-	    if (ret == 0 || errno == 0) {
+	    if (error == 0) {
 		goto out;
 	    }
 	}
     }
 
 out:
-    state->error = errno;
-    CLEAR_BITS(state->flags, TCP_ASYNC_CONNECT);
+    statePtr->error = error;
+    CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
     if (async_callback) {
         /*
          * An asynchonous connection has finally succeeded or failed.
          */
 
-        TcpWatchProc(state, state->filehandlers);
-        TclUnixSetBlockingMode(state->fds.fd, state->cachedBlocking);
+        TcpWatchProc(statePtr, statePtr->filehandlers);
+        TclUnixSetBlockingMode(statePtr->fds.fd, statePtr->cachedBlocking);
 
         /*
          * We need to forward the writable event that brought us here, bcasue
@@ -1119,8 +1121,9 @@ out:
          * the event mechanism one roundtrip through select().
          */
 
-        Tcl_NotifyChannel(state->channel, TCL_WRITABLE);
-    } else if (ret != 0) {
+        Tcl_NotifyChannel(statePtr->channel, TCL_WRITABLE);
+    }
+    if (error != 0) {
         /*
          * Failure for either a synchronous connection, or an async one that
          * failed before it could enter background mode, e.g. because an
@@ -1128,6 +1131,7 @@ out:
          */
 
         if (interp != NULL) {
+            errno = error;
             Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                     "couldn't open socket: %s", Tcl_PosixError(interp)));
         }
@@ -1164,7 +1168,7 @@ Tcl_OpenTcpClient(
 				 * connect. Otherwise we do a blocking
 				 * connect. */
 {
-    TcpState *state;
+    TcpState *statePtr;
     const char *errorMsg = NULL;
     struct addrinfo *addrlist = NULL, *myaddrlist = NULL;
     char channelName[SOCK_CHAN_LENGTH];
@@ -1189,32 +1193,32 @@ Tcl_OpenTcpClient(
     /*
      * Allocate a new TcpState for this socket.
      */
-    state = ckalloc(sizeof(TcpState));
-    memset(state, 0, sizeof(TcpState));
-    state->flags = async ? TCP_ASYNC_CONNECT : 0;
-    state->cachedBlocking = TCL_MODE_BLOCKING;
-    state->addrlist = addrlist;
-    state->myaddrlist = myaddrlist;
-    state->fds.fd = -1;
+    statePtr = ckalloc(sizeof(TcpState));
+    memset(statePtr, 0, sizeof(TcpState));
+    statePtr->flags = async ? TCP_ASYNC_CONNECT : 0;
+    statePtr->cachedBlocking = TCL_MODE_BLOCKING;
+    statePtr->addrlist = addrlist;
+    statePtr->myaddrlist = myaddrlist;
+    statePtr->fds.fd = -1;
 
     /*
      * Create a new client socket and wrap it in a channel.
      */
-    if (CreateClientSocket(interp, state) != TCL_OK) {
-        TcpCloseProc(state, NULL);
+    if (CreateClientSocket(interp, statePtr) != TCL_OK) {
+        TcpCloseProc(statePtr, NULL);
         return NULL;
     }
 
-    sprintf(channelName, SOCK_TEMPLATE, (long) state);
+    sprintf(channelName, SOCK_TEMPLATE, (long) statePtr);
 
-    state->channel = Tcl_CreateChannel(&tcpChannelType, channelName, state,
+    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr,
             (TCL_READABLE | TCL_WRITABLE));
-    if (Tcl_SetChannelOption(interp, state->channel, "-translation",
+    if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation",
 	    "auto crlf") == TCL_ERROR) {
-	Tcl_Close(NULL, state->channel);
+	Tcl_Close(NULL, statePtr->channel);
 	return NULL;
     }
-    return state->channel;
+    return statePtr->channel;
 }
 
 /*
-- 
cgit v0.12


From 053685ad2952fe7a83cf63ff28ec273862c903b3 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Fri, 4 Apr 2014 10:02:47 +0000
Subject:   *  Rework WaitForConnect() to fix synchronous completion of
 asynchronous connections.   *  Let TcpInputProc() and TcpOutputProc() fail
 before calling any I/O syscalls when an asynchronous connection has failed.  
 *  Adjust the tests accordingly.

---
 tests/socket.test  | 13 ++++++++-----
 unix/tclUnixSock.c | 54 ++++++++++++++++++++++++------------------------------
 2 files changed, 32 insertions(+), 35 deletions(-)

diff --git a/tests/socket.test b/tests/socket.test
index 61660cd..4fba2c3 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -1993,7 +1993,7 @@ test socket-14.7.2 {pending [socket -async] and blocking [gets], no listener} \
         list $x [fconfigure $sock -error]
     } -cleanup {
         close $sock
-    } -match glob -result {{error reading "sock*": socket is not connected} {connection refused}}
+    } -match glob -result {{error reading "sock*": connection refused} {}}
 test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IPv4} \
     -constraints {socket supported_inet supported_inet6} \
     -setup {
@@ -2055,10 +2055,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
         }
-        fconfigure $sock -error
+        list $x [fconfigure $sock -error]
     } -cleanup {
         close $sock
-    } -match glob -result {connection refused}
+    } -match glob -result {{error reading "sock*": connection refused} {}}
 test socket-14.9.0 {pending [socket -async] and blocking [puts], server is IPv4} \
     -constraints {socket supported_inet supported_inet6} \
     -setup {
@@ -2171,7 +2171,9 @@ test socket-14.11.0 {pending [socket -async] and blocking [puts], no listener, n
         vwait x
         close $sock
     } -cleanup {
-    } -result {broken pipe} -returnCodes 1
+        catch {close $sock}
+        unset x
+    } -result {connection refused} -returnCodes 1
 test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, flush} \
     -constraints {socket supported_inet supported_inet6} \
     -body {
@@ -2183,8 +2185,9 @@ test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, f
         vwait x
         close $sock
     } -cleanup {
+        catch {close $sock}
         unset x
-    } -result {broken pipe} -returnCodes 1
+    } -result {connection refused} -returnCodes 1
 test socket-14.12 {[socket -async] background progress triggered by [fconfigure -error]} \
     -constraints {socket supported_inet supported_inet6} \
     -body {
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 466b231..d4b7b62 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -128,8 +128,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 *errorCodePtr,
-			    int noblock);
+static int		WaitForConnect(TcpState *statePtr, int noblock);
 
 /*
  * This structure describes the channel type structure for TCP socket
@@ -399,41 +398,33 @@ 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 timeOut;		/* How long to wait. */
-    int state;			/* Of calling TclWaitForFile. */
-
     /*
      * If an asynchronous connect is in progress, attempt to wait for it to
      * complete before reading.
      */
 
     if (statePtr->flags & TCP_ASYNC_CONNECT) {
-	if (noblock || statePtr->flags & TCP_ASYNC_SOCKET) {
-	    timeOut = 0;
+	if (noblock || (statePtr->flags & TCP_ASYNC_SOCKET)) {
+            if (TclUnixWaitForFile(statePtr->fds.fd,
+                                    TCL_WRITABLE | TCL_EXCEPTION, 0) != 0) {
+                CreateClientSocket(NULL, statePtr);
+            }
 	} else {
-	    timeOut = -1;
-	    CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
-	}
-	errno = 0;
-	state = TclUnixWaitForFile(statePtr->fds.fd,
-		TCL_WRITABLE | TCL_EXCEPTION, timeOut);
-        if (state != 0) {
-            CreateClientSocket(NULL, statePtr);
-        }
-        if (statePtr->flags & TCP_ASYNC_CONNECT) {
-            /* We are still in progress, so ignore the result of the last
-             * attempt */
-	    *errorCodePtr = errno = EWOULDBLOCK;
-	    return -1;
+            while (statePtr->flags & TCP_ASYNC_CONNECT) {
+                if (TclUnixWaitForFile(statePtr->fds.fd,
+                                        TCL_WRITABLE | TCL_EXCEPTION, -1) != 0) {
+                    CreateClientSocket(NULL, statePtr);
+                }
+            }
         }
-	if (state & TCL_EXCEPTION) {
-	    return -1;
-	}
     }
-    return 0;
+    if (statePtr->error != 0) {
+        return -1;
+    } else {
+        return 0;
+    }
 }
 
 /*
@@ -471,7 +462,9 @@ TcpInputProc(
     int bytesRead;
 
     *errorCodePtr = 0;
-    if (WaitForConnect(statePtr, errorCodePtr, 0) != 0) {
+    if (WaitForConnect(statePtr, 0) != 0) {
+        *errorCodePtr = statePtr->error;
+        statePtr->error = 0;
 	return -1;
     }
     bytesRead = recv(statePtr->fds.fd, buf, (size_t) bufSize, 0);
@@ -521,7 +514,9 @@ TcpOutputProc(
     int written;
 
     *errorCodePtr = 0;
-    if (WaitForConnect(statePtr, errorCodePtr, 0) != 0) {
+    if (WaitForConnect(statePtr, 0) != 0) {
+        *errorCodePtr = statePtr->error;
+        statePtr->error = 0;
 	return -1;
     }
     written = send(statePtr->fds.fd, buf, (size_t) toWrite, 0);
@@ -748,9 +743,8 @@ TcpGetOptionProc(
 {
     TcpState *statePtr = instanceData;
     size_t len = 0;
-    int errorCode;
 
-    WaitForConnect(statePtr, &errorCode, 1);
+    WaitForConnect(statePtr, 1);
 
     if (optionName != NULL) {
 	len = strlen(optionName);
-- 
cgit v0.12


From a07a756335137e754bcd490da46a1cc1fd8df06c Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Fri, 4 Apr 2014 11:53:33 +0000
Subject: Add tests for bugs [336441ed59] and [581937ab1e] from
 core-8-5-branch.

---
 tests/socket.test | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)

diff --git a/tests/socket.test b/tests/socket.test
index 4fba2c3..e2e40f1 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -998,6 +998,35 @@ test socket_$af-8.1 {testing -async flag on sockets} -constraints [list socket s
     close $s1
 } -result bye
 
+test socket_$af-8.2 {testing writable event when quick failure} {socket win} {
+    # Test for bug 336441ed59 where a quick background fail was ignored
+
+    # Test only for windows as socket -async 255.255.255.255 fails directly
+    # on unix
+    
+    # The following connect should fail very quickly
+    set a1 [after 2000 {set x timeout}]
+    set s [socket -async 255.255.255.255 43434]
+    fileevent $s writable {set x writable}
+    vwait x
+    catch {close $s}
+    after cancel $a1
+    set x
+} writable
+
+test socket_$af-8.3 {testing fileevent readable on failed async socket connect} {socket} {
+    # Test for bug 581937ab1e
+
+    set a1 [after 5000 {set x timeout}]
+    # This connect should fail
+    set s [socket -async localhost [randport]]
+    fileevent $s readable {set x readable}
+    vwait x
+    catch {close $s}
+    after cancel $a1
+    set x
+} readable
+
 test socket_$af-9.1 {testing spurious events} -constraints [list socket supported_$af] -setup {
     set len 0
     set spurious 0
-- 
cgit v0.12


From a89a49e51557dc13104128a3692631f2edb5c712 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Fri, 4 Apr 2014 15:45:34 +0000
Subject: Fix/improve tests.

---
 tests/socket.test | 67 +++++++++++++++++++++++++------------------------------
 1 file changed, 30 insertions(+), 37 deletions(-)

diff --git a/tests/socket.test b/tests/socket.test
index e2e40f1..927e544 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -998,34 +998,36 @@ test socket_$af-8.1 {testing -async flag on sockets} -constraints [list socket s
     close $s1
 } -result bye
 
-test socket_$af-8.2 {testing writable event when quick failure} {socket win} {
+test socket_$af-8.2 {testing writable event when quick failure} -constraints [list socket win supported_$af] -body {
     # Test for bug 336441ed59 where a quick background fail was ignored
-
-    # Test only for windows as socket -async 255.255.255.255 fails directly
-    # on unix
+    
+    # Test only for windows as socket -async 255.255.255.255 fails
+    # directly on unix
     
     # The following connect should fail very quickly
     set a1 [after 2000 {set x timeout}]
-    set s [socket -async 255.255.255.255 43434]
+    set s [socket -async $localhost 43434]
     fileevent $s writable {set x writable}
     vwait x
+    set x
+} -cleanup {
     catch {close $s}
     after cancel $a1
-    set x
-} writable
+} -result writable
 
-test socket_$af-8.3 {testing fileevent readable on failed async socket connect} {socket} {
+test socket_$af-8.3 {testing fileevent readable on failed async socket connect} -constraints [list socket supported_$af] -body {
     # Test for bug 581937ab1e
-
+    
     set a1 [after 5000 {set x timeout}]
     # This connect should fail
     set s [socket -async localhost [randport]]
     fileevent $s readable {set x readable}
     vwait x
+    set x
+} -cleanup {
     catch {close $s}
     after cancel $a1
-    set x
-} readable
+} -result readable
 
 test socket_$af-9.1 {testing spurious events} -constraints [list socket supported_$af] -setup {
     set len 0
@@ -1602,8 +1604,8 @@ test socket_$af-12.2 {testing inheritance of client sockets} -setup {
     close $f
     # If the socket doesn't hit end-of-file in 10 seconds, the script1 process
     # must have inherited the client.
-    set failed 0
-    set after [after 10000 [list set failed 1]]
+    set timeout 0
+    set after [after 10000 {set x "client socket was inherited"}]
 } -constraints [list socket supported_$af stdio exec] -body {
     # Create the server socket
     set server [socket -server accept -myaddr $localhost 0]
@@ -1613,26 +1615,20 @@ test socket_$af-12.2 {testing inheritance of client sockets} -setup {
 	close $server
 	fileevent $file readable [list getdata $file]
 	fconfigure $file -buffering line -blocking 0
+        set ::f $file
     }
     proc getdata { file } {
 	# Read handler on the accepted socket.
-	global x failed
+	global x
 	set status [catch {read $file} data]
 	if {$status != 0} {
-	    set x {read failed, error was $data}
-	    catch { close $file }
+	    set x "read failed, error was $data"
 	} elseif {$data ne ""} {
 	} elseif {[fblocked $file]} {
 	} elseif {[eof $file]} {
-	    if {$failed} {
-		set x {client socket was inherited}
-	    } else {
-		set x {client socket was not inherited}
-	    }
-	    catch { close $file }
+            set x "client socket was not inherited"
 	} else {
-	    set x {impossible case}
-	    catch { close $file }
+	    set x "impossible case"
 	}
     }
     # Launch the script2 process
@@ -1642,6 +1638,8 @@ test socket_$af-12.2 {testing inheritance of client sockets} -setup {
     vwait x
     return $x
 } -cleanup {
+    fconfigure $f -blocking 1
+    close $f
     after cancel $after
     close $p
 } -result {client socket was not inherited}
@@ -1683,35 +1681,30 @@ test socket_$af-12.3 {testing inheritance of accepted sockets} -setup {
     # If the socket is still open after 5 seconds, the script1 process must
     # have inherited the accepted socket.
     set failed 0
-    set after [after 5000 [list set failed 1]]
+    set after [after 5000 [list set x "accepted socket was inherited"]]
     proc getdata { file } {
 	# Read handler on the client socket.
 	global x
 	global failed
 	set status [catch {read $file} data]
 	if {$status != 0} {
-	    set x {read failed, error was $data}
-	    catch { close $file }
+	    set x "read failed, error was $data"
 	} elseif {[string compare {} $data]} {
 	} elseif {[fblocked $file]} {
 	} elseif {[eof $file]} {
-	    if {$failed} {
-		set x {accepted socket was inherited}
-	    } else {
-		set x {accepted socket was not inherited}
-	    }
-	    catch { close $file }
+            set x "accepted socket was not inherited"
 	} else {
-	    set x {impossible case}
-	    catch { close $file }
+	    set x "impossible case"
 	}
 	return
     }
     vwait x
-    return $x
+    set x
 } -cleanup {
+    fconfigure $f -blocking 1
+    close $f
     after cancel $after
-    catch {close $p}
+    close $p
 } -result {accepted socket was not inherited}
 
 test socket_$af-13.1 {Testing use of shared socket between two threads} -body {
-- 
cgit v0.12


From f0c184a069af5733133ae8b053918986b4cff221 Mon Sep 17 00:00:00 2001
From: max <max@tclers.tk>
Date: Fri, 4 Apr 2014 15:56:48 +0000
Subject: Move tests 8.2 and 8.3 out of the IPv4/IPv6 loop to 14.13 and 14.14.

---
 tests/socket.test | 63 ++++++++++++++++++++++++++++---------------------------
 1 file changed, 32 insertions(+), 31 deletions(-)

diff --git a/tests/socket.test b/tests/socket.test
index 927e544..d36d2b3 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -998,37 +998,6 @@ test socket_$af-8.1 {testing -async flag on sockets} -constraints [list socket s
     close $s1
 } -result bye
 
-test socket_$af-8.2 {testing writable event when quick failure} -constraints [list socket win supported_$af] -body {
-    # Test for bug 336441ed59 where a quick background fail was ignored
-    
-    # Test only for windows as socket -async 255.255.255.255 fails
-    # directly on unix
-    
-    # The following connect should fail very quickly
-    set a1 [after 2000 {set x timeout}]
-    set s [socket -async $localhost 43434]
-    fileevent $s writable {set x writable}
-    vwait x
-    set x
-} -cleanup {
-    catch {close $s}
-    after cancel $a1
-} -result writable
-
-test socket_$af-8.3 {testing fileevent readable on failed async socket connect} -constraints [list socket supported_$af] -body {
-    # Test for bug 581937ab1e
-    
-    set a1 [after 5000 {set x timeout}]
-    # This connect should fail
-    set s [socket -async localhost [randport]]
-    fileevent $s readable {set x readable}
-    vwait x
-    set x
-} -cleanup {
-    catch {close $s}
-    after cancel $a1
-} -result readable
-
 test socket_$af-9.1 {testing spurious events} -constraints [list socket supported_$af] -setup {
     set len 0
     set spurious 0
@@ -2225,6 +2194,38 @@ 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 for bug 336441ed59 where a quick background fail was ignored
+    
+    # Test only for windows as socket -async 255.255.255.255 fails
+    # directly on unix
+    
+    # The following connect should fail very quickly
+    set a1 [after 2000 {set x timeout}]
+    set s [socket -async 255.255.255.255 43434]
+    fileevent $s writable {set x writable}
+    vwait x
+    set x
+} -cleanup {
+    catch {close $s}
+    after cancel $a1
+} -result writable
+
+test socket-14.14 {testing fileevent readable on failed async socket connect} -constraints [list socket] -body {
+    # Test for bug 581937ab1e
+    
+    set a1 [after 5000 {set x timeout}]
+    # This connect should fail
+    set s [socket -async localhost [randport]]
+    fileevent $s readable {set x readable}
+    vwait x
+    set x
+} -cleanup {
+    catch {close $s}
+    after cancel $a1
+} -result readable
+
+
 ::tcltest::cleanupTests
 flush stdout
 return
-- 
cgit v0.12


From 4b6ab47efdc71922068677ef074031e180f359d9 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
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 <harald.oehlmann@elmicron.de>
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 <harald.oehlmann@elmicron.de>
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 <max@tclers.tk>
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 <max@tclers.tk>
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 <harald.oehlmann@elmicron.de>
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 7e0a9605b9a1e3bc52ff27cdbc7311608f4cce18 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 8 Apr 2014 14:52:04 +0000
Subject: Provide full Tcl patchlevel to tcl.pc and move private libs to
 "Libs.private".

---
 unix/tcl.pc.in | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/unix/tcl.pc.in b/unix/tcl.pc.in
index 6b6fe44..b750300 100644
--- a/unix/tcl.pc.in
+++ b/unix/tcl.pc.in
@@ -8,8 +8,7 @@ includedir=@includedir@
 Name: Tool Command Language
 Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses.
 URL: http://www.tcl.tk/
-Version: @TCL_VERSION@
-Requires:
-Conflicts:
-Libs: -L${libdir} @TCL_LIB_FLAG@ @TCL_LIBS@
+Version: @TCL_VERSION@@TCL_PATCH_LEVEL@
+Libs: -L${libdir} @TCL_LIB_FLAG@
+Libs.private: @TCL_LIBS@
 Cflags: -I${includedir}
-- 
cgit v0.12


From bf345d6be59f6f513be07b6465487f137b9ac820 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
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 <max@tclers.tk>
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 da36dfe69e58aec61afac3c396af8cf6107b0ff1 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 10 Apr 2014 07:57:18 +0000
Subject: Fix bug [e663138a06]: Test failures in "string is"

---
 generic/tclExecute.c | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 41730d3..6394a60 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5990,6 +5990,15 @@ TEBCresume(
 	if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
 	    type1 = 0;
 	}
+#ifndef TCL_WIDE_INT_IS_LONG
+	else if (type1 == TCL_NUMBER_WIDE) {
+		/** See bug [e663138a06] */
+	    Tcl_WideInt value = (OBJ_AT_TOS)->internalRep.wideValue;
+	    if ((-value <= ULONG_MAX) && (value <= ULONG_MAX)) {
+		type1 = TCL_NUMBER_LONG;
+	    }
+	}
+#endif
 	TclNewIntObj(objResultPtr, type1);
 	TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
 	NEXT_INST_F(1, 1, 1);
-- 
cgit v0.12


From c5510a29171fa3a62f7a51af11bea2772bf10e3e Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 10 Apr 2014 13:32:14 +0000
Subject: [792641f95b]: Normalized win32 paths should never contain backslash.

---
 win/tclWinFCmd.c |  5 +++++
 win/tclWinFile.c | 15 ++++++---------
 2 files changed, 11 insertions(+), 9 deletions(-)

diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 8999831..441337e 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -1156,7 +1156,12 @@ DoRemoveJustDirectory(
 
   end:
     if (errorPtr != NULL) {
+	char *p;
 	Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
+	p = Tcl_DStringValue(errorPtr);
+	for (; *p; ++p) {
+	    if (*p == '\\') *p = '/';
+	}
     }
     return TCL_ERROR;
 
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 676c443..ed0c40f 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -3197,17 +3197,14 @@ TclNativeCreateNativeRep(
     }
 
     str = Tcl_GetStringFromObj(validPathPtr, &len);
-    if (str[0] == '/' && str[1] == '/' && str[2] == '?' && str[3] == '/') {
-	char *p;
-
-	for (p = str; p && *p; ++p) {
-	    if (*p == '/') {
-		*p = '\\';
-	    }
-	}
-    }
     Tcl_WinUtfToTChar(str, len, &ds);
     if (tclWinProcs->useWide) {
+	WCHAR *wp = (WCHAR *) Tcl_DStringValue(&ds);
+	for (; *wp; ++wp) {
+	    if (*wp=='/') {
+		*wp = '\\';
+	    }
+	}
 	len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
     } else {
 	len = Tcl_DStringLength(&ds) + sizeof(char);
-- 
cgit v0.12


From 09e3a3c56b5d44c637c6ed0593257e51461e8861 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 11 Apr 2014 08:23:44 +0000
Subject: Fix [3118489] for Windows only: NUL in filenames. This allows various
 characters to be used in win32 filenames which are normally invalid, as
 described here:
 [http://cygwin.com/cygwin-ug-net/using-specialnames.html#pathnames-specialchars].
 The Cygwin shell can handle those same filenames as well. In other shells
 (cmd.exe/mSys) or on the Windows desktop the filenames will look strange, but
 that's all.

---
 tests/cmdAH.test | 3 +++
 win/tclWinFile.c | 8 +++++---
 2 files changed, 8 insertions(+), 3 deletions(-)

diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 39e9ece..80706b6 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -141,6 +141,9 @@ test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup {
 } -cleanup {
     cd $dir
 } -result {/}
+test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -constraints win -returnCodes error -body {
+    cd .\0
+} -result "couldn't change working directory to \".\0\": no such file or directory"
 test cmdAH-2.7 {Tcl_ConcatObjCmd} {
     concat
 } {}
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 80d0915..c9b95a0 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -2897,7 +2897,7 @@ TclNativeCreateNativeRep(
     char *nativePathPtr, *str;
     Tcl_DString ds;
     Tcl_Obj *validPathPtr;
-    int len;
+    int len, i = 2;
     WCHAR *wp;
 
     if (TclFSCwdIsNative()) {
@@ -2927,8 +2927,10 @@ TclNativeCreateNativeRep(
     Tcl_WinUtfToTChar(str, len, &ds);
     len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
     wp = (WCHAR *) Tcl_DStringValue(&ds);
-    for (; *wp; ++wp) {
-	if (*wp=='/') {
+    for (i=sizeof(WCHAR); i<len; ++wp,i+=sizeof(WCHAR)) {
+	if ( (*wp < ' ') || wcschr(L"\"*<>|", *wp) ){
+	    *wp |= 0xF000;
+	}else if (*wp=='/') {
 	    *wp = '\\';
 	}
     }
-- 
cgit v0.12


From 7fb053c9643440e5075f5e513853c9efff0ae44d Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 11 Apr 2014 09:55:15 +0000
Subject: Fix [3118489]: NUL in filenames, now fixed for both Windows and UNIX.
 For consistancy, any NUL character in a filename prevents the native
 filesystem to generate a native file representation for it. Other filesystems
 than the native one may still accept it, but it's not recommended.

---
 tests/cmdAH.test   | 2 +-
 unix/tclUnixFile.c | 6 ++++++
 win/tclWinFile.c   | 9 +++++++++
 3 files changed, 16 insertions(+), 1 deletion(-)

diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 80706b6..04a86fa 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -141,7 +141,7 @@ test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup {
 } -cleanup {
     cd $dir
 } -result {/}
-test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -constraints win -returnCodes error -body {
+test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -returnCodes error -body {
     cd .\0
 } -result "couldn't change working directory to \".\0\": no such file or directory"
 test cmdAH-2.7 {Tcl_ConcatObjCmd} {
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 5bfe5d9..2cb0027 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -1105,6 +1105,12 @@ TclNativeCreateNativeRep(
     str = Tcl_GetStringFromObj(validPathPtr, &len);
     Tcl_UtfToExternalDString(NULL, str, len, &ds);
     len = Tcl_DStringLength(&ds) + sizeof(char);
+    if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) {
+	/* See bug [3118489]: NUL in filenames */
+	Tcl_DecrRefCount(validPathPtr);
+	Tcl_DStringFree(&ds);
+	return NULL;
+    }
     Tcl_DecrRefCount(validPathPtr);
     nativePathPtr = ckalloc(len);
     memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len);
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index c9b95a0..fc0ac9e 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -1816,6 +1816,9 @@ TclpObjChdir(
 
     nativePath = Tcl_FSGetNativePath(pathPtr);
 
+    if (!nativePath) {
+	return -1;
+    }
     result = SetCurrentDirectory(nativePath);
 
     if (result == 0) {
@@ -2929,6 +2932,12 @@ TclNativeCreateNativeRep(
     wp = (WCHAR *) Tcl_DStringValue(&ds);
     for (i=sizeof(WCHAR); i<len; ++wp,i+=sizeof(WCHAR)) {
 	if ( (*wp < ' ') || wcschr(L"\"*<>|", *wp) ){
+	    if (!*wp){
+		/* See bug [3118489]: NUL in filenames */
+		Tcl_DecrRefCount(validPathPtr);
+		Tcl_DStringFree(&ds);
+		return NULL;
+	    }
 	    *wp |= 0xF000;
 	}else if (*wp=='/') {
 	    *wp = '\\';
-- 
cgit v0.12


From 7b02be1867d1e46c5a4b5bc9f8925a4a6784c3fd Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 14 Apr 2014 18:45:04 +0000
Subject: [e663138a06] Fix the new INST_NUM_TYPE instruction so that the
 boundary cases of [string is] on integral values are computed right.  Code is
 now correct, though still suffers from a large amount of ugly.

---
 generic/tclExecute.c | 28 ++++++++++++++++++++++------
 1 file changed, 22 insertions(+), 6 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 6394a60..2c136d7 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5989,16 +5989,32 @@ TEBCresume(
     case INST_NUM_TYPE:
 	if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
 	    type1 = 0;
-	}
+	} else if (type1 == TCL_NUMBER_LONG) {
+	    /* value is between LONG_MIN and LONG_MAX */
+	    /* [string is integer] is -UINT_MAX to UINT_MAX range */
+	    int i;
+
+	    if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) != TCL_OK) {
+		type1 = TCL_NUMBER_WIDE;
+	    }
 #ifndef TCL_WIDE_INT_IS_LONG
-	else if (type1 == TCL_NUMBER_WIDE) {
-		/** See bug [e663138a06] */
-	    Tcl_WideInt value = (OBJ_AT_TOS)->internalRep.wideValue;
-	    if ((-value <= ULONG_MAX) && (value <= ULONG_MAX)) {
+	} else if (type1 == TCL_NUMBER_WIDE) {
+	    /* value is between WIDE_MIN and WIDE_MAX */
+	    /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
+	    int i;
+	    if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) {
 		type1 = TCL_NUMBER_LONG;
 	    }
-	}
 #endif
+	} else if (type1 == TCL_NUMBER_BIG) {
+	    /* value is an integer outside the WIDE_MIN to WIDE_MAX range */
+	    /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
+	    Tcl_WideInt w;
+
+	    if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
+		type1 = TCL_NUMBER_WIDE;
+	    }
+	}
 	TclNewIntObj(objResultPtr, type1);
 	TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
 	NEXT_INST_F(1, 1, 1);
-- 
cgit v0.12


From 363b6911107557283c7fec07e041e14c7af7eee3 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 15 Apr 2014 10:41:44 +0000
Subject: Test-cases which pick up the completion of bug-fix
 [e663138a06d98e48b5fbb42cc015cf1698f486cd|e663138a06]. Thanks, Don!

---
 tests/obj.test | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/obj.test b/tests/obj.test
index 71a39b4..151abfb 100644
--- a/tests/obj.test
+++ b/tests/obj.test
@@ -605,7 +605,7 @@ test obj-33.2 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
     set x 0xffff; append x ffff
     list [string is integer $x] [expr { wide($x) }]
 } {1 4294967295}
-test obj-33.3 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.3 {integer overflow on input} {
     set x 0x10000; append x 0000
     list [string is integer $x] [expr { wide($x) }]
 } {0 4294967296}
@@ -621,7 +621,7 @@ test obj-33.6 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
     set x -0xffff; append x ffff
     list [string is integer $x] [expr { wide($x) }]
 } {1 -4294967295}
-test obj-33.7 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.7 {integer overflow on input} {
     set x -0x10000; append x 0000
     list [string is integer $x] [expr { wide($x) }]
 } {0 -4294967296}
-- 
cgit v0.12


From d25403a5a8b4f784566eb15f30b46ed568efc478 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 15 Apr 2014 16:09:28 +0000
Subject: [88aef05cda] Stop reentrancy segfault in reflected channels by
 managing callbacks as (copies of) lists, not shared Tcl_Obj arrays.  Still
 could use cleanup and improvements.

---
 generic/tclIORChan.c | 22 ++++++++++++++++++++--
 tests/ioCmd.test     | 19 +++++++++++++++++++
 2 files changed, 39 insertions(+), 2 deletions(-)

diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index affed02..2d712a2 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -110,6 +110,7 @@ typedef struct {
 				 * plus 4 placeholders for method, channel,
 				 * and at most two varying (method specific)
 				 * words. */
+    Tcl_Obj *cmd;		/*  */
     int methods;		/* Bitmask of supported methods */
 
     /*
@@ -2044,6 +2045,10 @@ NewReflectedChannel(
      */
 
     /* ASSERT: cmdpfxObj is a Tcl List */
+    rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
+    Tcl_ListObjAppendElement(NULL, rcPtr->cmd, Tcl_NewObj());
+    Tcl_ListObjAppendElement(NULL, rcPtr->cmd, handleObj);
+    Tcl_IncrRefCount(rcPtr->cmd);
 
     Tcl_ListObjGetElements(interp, cmdpfxObj, &listc, &listv);
 
@@ -2158,6 +2163,7 @@ FreeReflectedChannel(
      */
 
     Tcl_DecrRefCount(rcPtr->argv[n+1]);
+    Tcl_DecrRefCount(rcPtr->cmd);
 
     ckfree((char*) rcPtr->argv);
     ckfree((char*) rcPtr);
@@ -2200,6 +2206,8 @@ InvokeTclMethod(
     Tcl_InterpState sr;		/* State of handler interp */
     int result;			/* Result code of method invokation */
     Tcl_Obj *resObj = NULL;	/* Result of method invokation. */
+    Tcl_Obj *cmd;
+    int len;
 
     if (!rcPtr->interp) {
 	/*
@@ -2236,6 +2244,11 @@ InvokeTclMethod(
     Tcl_IncrRefCount(methObj);
     rcPtr->argv[rcPtr->argc - 2] = methObj;
 
+    cmd = TclListObjCopy(NULL, rcPtr->cmd);
+    ListObjLength(cmd, len);
+    Tcl_ListObjReplace(NULL, cmd, len - 2, 1, 1, &methObj);
+
+
     /*
      * Append the additional argument containing method specific details
      * behind the channel id. If specified.
@@ -2244,9 +2257,11 @@ InvokeTclMethod(
     cmdc = rcPtr->argc;
     if (argOneObj) {
 	rcPtr->argv[cmdc] = argOneObj;
+	Tcl_ListObjAppendElement(NULL, cmd, argOneObj);
 	cmdc++;
 	if (argTwoObj) {
 	    rcPtr->argv[cmdc] = argTwoObj;
+	    Tcl_ListObjAppendElement(NULL, cmd, argTwoObj);
 	    cmdc++;
 	}
     }
@@ -2256,9 +2271,11 @@ InvokeTclMethod(
      * existing state intact.
      */
 
+    Tcl_IncrRefCount(cmd);
     sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
     Tcl_Preserve(rcPtr->interp);
-    result = Tcl_EvalObjv(rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL);
+//    result = Tcl_EvalObjv(rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL);
+    result = Tcl_GlobalEvalObj(rcPtr->interp, cmd);
 
     /*
      * We do not try to extract the result information if the caller has no
@@ -2284,7 +2301,7 @@ InvokeTclMethod(
 	     */
 
 	    if (result != TCL_ERROR) {
-		Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rcPtr->argv);
+//		Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rcPtr->argv);
 		int cmdLen;
 		const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
 
@@ -2303,6 +2320,7 @@ InvokeTclMethod(
 	}
 	Tcl_IncrRefCount(resObj);
     }
+    Tcl_DecrRefCount(cmd);
     Tcl_RestoreInterpState(rcPtr->interp, sr);
     Tcl_Release(rcPtr->interp);
 
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index bdf0fb3..f021ade 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -755,6 +755,25 @@ test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match g
     rename foo {}
     set res
 } -result {{} {initialize rc* {read write}} 1 {*all required methods*} {}}
+test iocmd-21.20 {Bug 88aef05cda} -setup {
+    proc foo {method chan args} {
+	switch -- $method blocking {
+	    chan configure $chan -blocking [lindex $args 0]
+	    return
+	} initialize {
+	    return {initialize finalize watch blocking read write
+		    configure cget cgetall}
+	} finalize {
+	    return
+	}
+    }
+    set ch [chan create {read write} foo]
+} -body {
+    list [catch {chan configure $ch -blocking 0} m] $m
+} -cleanup {
+    close $ch
+    rename foo {}
+} -match glob -result {1 {*nested eval*}}
 
 # --- --- --- --------- --------- ---------
 # Helper commands to record the arguments to handler methods.
-- 
cgit v0.12


From 630c5dd08faa0ca5deac0606be3ac1b36b82a6d3 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 15 Apr 2014 17:45:26 +0000
Subject: Purge (now unused) argc and argv fields.

---
 generic/tclIORChan.c | 110 ++-------------------------------------------------
 1 file changed, 3 insertions(+), 107 deletions(-)

diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 2d712a2..eaabdfb 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -91,26 +91,7 @@ typedef struct {
 #ifdef TCL_THREADS
     Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. */
 #endif
-
-    /* See [==] as well.
-     * Storage for the command prefix and the additional words required for
-     * the invocation of methods in the command handler.
-     *
-     * argv [0] ... [.] | [argc-2] [argc-1] | [argc]  [argc+2]
-     *      cmd ... pfx | method   chan     | detail1 detail2
-     *      ~~~~ CT ~~~            ~~ CT ~~
-     *
-     * CT = Belongs to the 'Command handler Thread'.
-     */
-
-    int argc;			/* Number of preallocated words - 2 */
-    Tcl_Obj **argv;		/* Preallocated array for calling the handler.
-				 * args[0] is placeholder for cmd word.
-				 * Followed by the arguments in the prefix,
-				 * plus 4 placeholders for method, channel,
-				 * and at most two varying (method specific)
-				 * words. */
-    Tcl_Obj *cmd;		/*  */
+    Tcl_Obj *cmd;		/* Callback command prefix */
     int methods;		/* Bitmask of supported methods */
 
     /*
@@ -2023,8 +2004,6 @@ NewReflectedChannel(
     Tcl_Obj *handleObj)
 {
     ReflectedChannel *rcPtr;
-    int i, listc;
-    Tcl_Obj **listv;
 
     rcPtr = (ReflectedChannel *) ckalloc(sizeof(ReflectedChannel));
 
@@ -2040,58 +2019,11 @@ NewReflectedChannel(
     rcPtr->mode = mode;
     rcPtr->interest = 0;		/* Initially no interest registered */
 
-    /*
-     * Method placeholder.
-     */
-
     /* ASSERT: cmdpfxObj is a Tcl List */
     rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
     Tcl_ListObjAppendElement(NULL, rcPtr->cmd, Tcl_NewObj());
     Tcl_ListObjAppendElement(NULL, rcPtr->cmd, handleObj);
     Tcl_IncrRefCount(rcPtr->cmd);
-
-    Tcl_ListObjGetElements(interp, cmdpfxObj, &listc, &listv);
-
-    /*
-     * See [==] as well.
-     * Storage for the command prefix and the additional words required for
-     * the invocation of methods in the command handler.
-     *
-     * listv [0] [listc-1] | [listc]  [listc+1] |
-     * argv  [0]   ... [.] | [argc-2] [argc-1]  | [argc]  [argc+2]
-     *       cmd   ... pfx | method   chan      | detail1 detail2
-     */
-
-    rcPtr->argc = listc + 2;
-    rcPtr->argv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * (listc+4));
-
-    /*
-     * Duplicate object references.
-     */
-
-    for (i=0; i<listc ; i++) {
-	Tcl_Obj *word = rcPtr->argv[i] = listv[i];
-
-	Tcl_IncrRefCount(word);
-    }
-
-    i++;				/* Skip placeholder for method */
-
-    /*
-     * [Bug 1667990]: See [x] in FreeReflectedChannel for release
-     */
-
-    rcPtr->argv[i] = handleObj;
-    Tcl_IncrRefCount(handleObj);
-
-    /*
-     * The next two objects are kept empty, varying arguments.
-     */
-
-    /*
-     * Initialization complete.
-     */
-
     return rcPtr;
 }
 
@@ -2142,7 +2074,6 @@ FreeReflectedChannel(
     ReflectedChannel *rcPtr)
 {
     Channel *chanPtr = (Channel *) rcPtr->chan;
-    int i, n;
 
     if (chanPtr->typePtr != &tclRChannelType) {
 	/*
@@ -2152,20 +2083,7 @@ FreeReflectedChannel(
 	ckfree((char*) chanPtr->typePtr);
     }
     Tcl_Release(chanPtr);
-
-    n = rcPtr->argc - 2;
-    for (i=0; i<n; i++) {
-	Tcl_DecrRefCount(rcPtr->argv[i]);
-    }
-
-    /*
-     * [Bug 1667990]: See [x] in NewReflectedChannel for lock. n+1 = argc-1.
-     */
-
-    Tcl_DecrRefCount(rcPtr->argv[n+1]);
     Tcl_DecrRefCount(rcPtr->cmd);
-
-    ckfree((char*) rcPtr->argv);
     ckfree((char*) rcPtr);
 }
 
@@ -2201,7 +2119,6 @@ InvokeTclMethod(
     Tcl_Obj *argTwoObj,		/* NULL'able */
     Tcl_Obj **resultObjPtr)	/* NULL'able */
 {
-    int cmdc;			/* #words in constructed command */
     Tcl_Obj *methObj = NULL;	/* Method name in object form */
     Tcl_InterpState sr;		/* State of handler interp */
     int result;			/* Result code of method invokation */
@@ -2236,33 +2153,24 @@ InvokeTclMethod(
      */
 
     /*
-     * Insert method into the pre-allocated area, after the command prefix,
+     * Insert method into the callback command, after the command prefix,
      * before the channel id.
      */
 
     methObj = Tcl_NewStringObj(method, -1);
-    Tcl_IncrRefCount(methObj);
-    rcPtr->argv[rcPtr->argc - 2] = methObj;
-
     cmd = TclListObjCopy(NULL, rcPtr->cmd);
     ListObjLength(cmd, len);
     Tcl_ListObjReplace(NULL, cmd, len - 2, 1, 1, &methObj);
 
-
     /*
      * Append the additional argument containing method specific details
      * behind the channel id. If specified.
      */
 
-    cmdc = rcPtr->argc;
     if (argOneObj) {
-	rcPtr->argv[cmdc] = argOneObj;
 	Tcl_ListObjAppendElement(NULL, cmd, argOneObj);
-	cmdc++;
 	if (argTwoObj) {
-	    rcPtr->argv[cmdc] = argTwoObj;
 	    Tcl_ListObjAppendElement(NULL, cmd, argTwoObj);
-	    cmdc++;
 	}
     }
 
@@ -2274,7 +2182,6 @@ InvokeTclMethod(
     Tcl_IncrRefCount(cmd);
     sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
     Tcl_Preserve(rcPtr->interp);
-//    result = Tcl_EvalObjv(rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL);
     result = Tcl_GlobalEvalObj(rcPtr->interp, cmd);
 
     /*
@@ -2301,7 +2208,6 @@ InvokeTclMethod(
 	     */
 
 	    if (result != TCL_ERROR) {
-//		Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rcPtr->argv);
 		int cmdLen;
 		const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
 
@@ -2325,16 +2231,6 @@ InvokeTclMethod(
     Tcl_Release(rcPtr->interp);
 
     /*
-     * Cleanup of the dynamic parts of the command.
-     *
-     * The detail objects survived the Tcl_EvalObjv without change because of
-     * the contract. Therefore there is no need to decrement the refcounts. Only
-     * the internal method object has to be disposed of.
-     */
-
-    Tcl_DecrRefCount(methObj);
-
-    /*
      * The resObj has a ref count of 1 at this location. This means that the
      * caller of InvokeTclMethod has to dispose of it (but only if it was
      * returned to it).
@@ -2857,7 +2753,7 @@ ForwardProc(
 	}
 
 	/*
-	 * Freeing is done here, in the origin thread, because the argv[]
+	 * Freeing is done here, in the origin thread, callback command
 	 * objects belong to this thread. Deallocating them in a different
 	 * thread is not allowed
 	 *
-- 
cgit v0.12


From 551367d26fffabaf2176de988521a98184f49ad0 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 16 Apr 2014 09:28:54 +0000
Subject: Upgrade from Winsock 1.1 to Winsock 2.2, which is always available on
 Win2000+. See:
 [http://msdn.microsoft.com/en-us/library/windows/desktop/ms742213%28v=vs.85%29.aspx]
 for details. Move winsock initialization to TclpInitPlatform(void), so we can
 be sure everywhere that we have an initialized winsock2. Stub entries for
 TclWinGetServByName/TclWinGetSockOpt/TclWinSetSockOpt are no longer necessary
 (will be removed in 9.0, but are kept in 8.x)

---
 generic/tclIntPlatDecls.h |  6 ++++
 win/tclWinInit.c          | 24 ++++++---------
 win/tclWinPort.h          |  9 ------
 win/tclWinSock.c          | 78 ++---------------------------------------------
 4 files changed, 19 insertions(+), 98 deletions(-)

diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index 80dd2ad..f935efb 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -849,7 +849,13 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
 
 #if defined(__WIN32__) || defined(__CYGWIN__)
 #   undef TclWinNToHS
+#   undef TclWinGetServByName
+#   undef TclWinGetSockOpt
+#   undef TclWinSetSockOpt
 #   define TclWinNToHS ntohs
+#   define TclWinGetServByName getservbyname
+#   define TclWinGetSockOpt getsockopt
+#   define TclWinSetSockOpt setsockopt
 #else
 #   undef TclpGetPid
 #   define TclpGetPid(pid) ((unsigned long) (pid))
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 2f3c7e8..4e860b2 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -113,8 +113,8 @@ static int		ToUtf(CONST WCHAR *wSrc, char *dst);
  *
  * TclpInitPlatform --
  *
- *	Initialize all the platform-dependant things like signals and
- *	floating-point error handling.
+ *	Initialize all the platform-dependant things like signals,
+ *	floating-point error handling and sockets.
  *
  *	Called at process initialization time.
  *
@@ -130,20 +130,16 @@ static int		ToUtf(CONST WCHAR *wSrc, char *dst);
 void
 TclpInitPlatform(void)
 {
-    tclPlatform = TCL_PLATFORM_WINDOWS;
+    WSADATA wsaData;
+    WORD wVersionRequested = MAKEWORD(2, 2);
 
-    /*
-     * The following code stops Windows 3.X and Windows NT 3.51 from
-     * automatically putting up Sharing Violation dialogs, e.g, when someone
-     * tries to access a file that is locked or a drive with no disk in it.
-     * Tcl already returns the appropriate error to the caller, and they can
-     * decide to put up their own dialog in response to that failure.
-     *
-     * Under 95 and NT 4.0, this is a NOOP because the system doesn't
-     * automatically put up dialogs when the above operations fail.
-     */
+    tclPlatform = TCL_PLATFORM_WINDOWS;
 
-    SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS);
+	/*
+	 * Initialize the winsock library. On Windows XP and higher this
+	 * can never fail.
+	 */
+	WSAStartup(wVersionRequested, &wsaData);
 
 #ifdef STATIC_BUILD
     /*
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index ec9e867..ea6d8f8 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -448,15 +448,6 @@ typedef DWORD_PTR * PDWORD_PTR;
 #define TclpSysRealloc(ptr, size)	((void*)HeapReAlloc(GetProcessHeap(), \
 					    (DWORD)0, (LPVOID)ptr, (DWORD)size))
 
-/*
- * The following defines map from standard socket names to our internal
- * wrappers that redirect through the winSock function table (see the
- * file tclWinSock.c).
- */
-
-#define getservbyname	TclWinGetServByName
-#define getsockopt	TclWinGetSockOpt
-#define setsockopt	TclWinSetSockOpt
 /* This type is not defined in the Windows headers */
 #define socklen_t       int
 
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index aa298f5..e18a3dd 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -263,8 +263,6 @@ static void
 InitSockets(void)
 {
     DWORD id;
-    WSADATA wsaData;
-    DWORD err;
     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
 	    TclThreadDataKeyGet(&dataKey);
 
@@ -295,38 +293,6 @@ InitSockets(void)
 	    goto initFailure;
 	}
 
-	/*
-	 * Initialize the winsock library and check the interface version
-	 * actually loaded. We only ask for the 1.1 interface and do require
-	 * that it not be less than 1.1.
-	 */
-
-#define WSA_VERSION_MAJOR 1
-#define WSA_VERSION_MINOR 1
-#define WSA_VERSION_REQD  MAKEWORD(WSA_VERSION_MAJOR, WSA_VERSION_MINOR)
-
-	err = WSAStartup((WORD)WSA_VERSION_REQD, &wsaData);
-	if (err != 0) {
-	    TclWinConvertWSAError(err);
-	    goto initFailure;
-	}
-
-	/*
-	 * Note the byte positions are swapped for the comparison, so that
-	 * 0x0002 (2.0, MAKEWORD(2,0)) doesn't look less than 0x0101 (1.1).
-	 * We want the comparison to be 0x0200 < 0x0101.
-	 */
-
-	if (MAKEWORD(HIBYTE(wsaData.wVersion), LOBYTE(wsaData.wVersion))
-		< MAKEWORD(WSA_VERSION_MINOR, WSA_VERSION_MAJOR)) {
-	    TclWinConvertWSAError(WSAVERNOTSUPPORTED);
-	    WSACleanup();
-	    goto initFailure;
-	}
-
-#undef WSA_VERSION_REQD
-#undef WSA_VERSION_MAJOR
-#undef WSA_VERSION_MINOR
     }
 
     /*
@@ -434,7 +400,6 @@ SocketExitHandler(
 
     TclpFinalizeSockets();
     UnregisterClass("TclSocket", TclWinGetTclInstance());
-    WSACleanup();
     initialized = 0;
     Tcl_MutexUnlock(&socketMutex);
 }
@@ -2564,71 +2529,34 @@ InitializeHostName(
  *----------------------------------------------------------------------
  */
 
+#undef TclWinGetSockOpt
 int
 TclWinGetSockOpt(SOCKET s, int level, int optname, char *optval,
 	int *optlen)
 {
-    /*
-     * Check that WinSock is initialized; do not call it if not, to prevent
-     * system crashes. This can happen at exit time if the exit handler for
-     * WinSock ran before other exit handlers that want to use sockets.
-     */
-
-    if (!SocketsEnabled()) {
-	return SOCKET_ERROR;
-    }
-
     return getsockopt(s, level, optname, optval, optlen);
 }
 
+#undef TclWinSetSockOpt
 int
 TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval,
     int optlen)
 {
-    /*
-     * Check that WinSock is initialized; do not call it if not, to prevent
-     * system crashes. This can happen at exit time if the exit handler for
-     * WinSock ran before other exit handlers that want to use sockets.
-     */
-
-    if (!SocketsEnabled()) {
-	return SOCKET_ERROR;
-    }
-
     return setsockopt(s, level, optname, optval, optlen);
 }
 
 char *
 TclpInetNtoa(struct in_addr addr)
 {
-    /*
-     * Check that WinSock is initialized; do not call it if not, to prevent
-     * system crashes. This can happen at exit time if the exit handler for
-     * WinSock ran before other exit handlers that want to use sockets.
-     */
-
-    if (!SocketsEnabled()) {
-        return NULL;
-    }
-
     return inet_ntoa(addr);
 }
 
+#undef TclWinGetServByName
 struct servent *
 TclWinGetServByName(
     const char *name,
     const char *proto)
 {
-    /*
-     * Check that WinSock is initialized; do not call it if not, to prevent
-     * system crashes. This can happen at exit time if the exit handler for
-     * WinSock ran before other exit handlers that want to use sockets.
-     */
-
-    if (!SocketsEnabled()) {
-	return NULL;
-    }
-
     return getservbyname(name, proto);
 }
 
-- 
cgit v0.12


From ba983af978b8a50b61dd8dbebf32bdeed71a9837 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 16 Apr 2014 11:20:54 +0000
Subject: Remove unused variable, don't use deprecated function, some
 formatting.

---
 generic/tclIORChan.c |  2 +-
 win/tclWinInit.c     | 10 +++++-----
 win/tclWinSock.c     |  4 ++--
 3 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 16dc1ed..29819b6 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -2324,7 +2324,7 @@ InvokeTclMethod(
     Tcl_IncrRefCount(cmd);
     sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
     Tcl_Preserve(rcPtr->interp);
-    result = Tcl_GlobalEvalObj(rcPtr->interp, cmd);
+    result = Tcl_EvalObjEx(rcPtr->interp, cmd, TCL_EVAL_GLOBAL);
 
     /*
      * We do not try to extract the result information if the caller has no
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index d90d57a..8b600f6 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -135,11 +135,11 @@ TclpInitPlatform(void)
 
     tclPlatform = TCL_PLATFORM_WINDOWS;
 
-	/*
-	 * Initialize the winsock library. On Windows XP and higher this
-	 * can never fail.
-	 */
-	WSAStartup(wVersionRequested, &wsaData);
+    /*
+     * Initialize the winsock library. On Windows XP and higher this
+     * can never fail.
+     */
+    WSAStartup(wVersionRequested, &wsaData);
 
 #ifdef STATIC_BUILD
     /*
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 8881cf2..3990111 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -280,7 +280,7 @@ static const Tcl_ChannelType tcpChannelType = {
 static void
 InitSockets(void)
 {
-    DWORD id, err;
+    DWORD id;
     ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
 
     if (!initialized) {
@@ -2414,7 +2414,7 @@ SocketThread(
  *
  * Side effects:
  *	The flags for the given socket are updated to reflect the event that
- *	occured.
+ *	occurred.
  *
  *----------------------------------------------------------------------
  */
-- 
cgit v0.12


From 219058913602b9ddb2ddfbe5a9cac941272d7207 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Wed, 16 Apr 2014 13:18:56 +0000
Subject: Segmentation fault using some functions of tcl::clock, fixed, belong
 to ticket [d19a30db57]

---
 generic/tclClock.c | 39 +++++++++++++++++++++------------------
 1 file changed, 21 insertions(+), 18 deletions(-)

diff --git a/generic/tclClock.c b/generic/tclClock.c
index 5b95ae6..3ec94fb 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -548,19 +548,22 @@ ClockGetjuliandayfromerayearmonthdayObjCmd (
     }
     dict = objv[1];
     if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
+		 || fieldPtr == NULL
 	    || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
 		&era) != TCL_OK
-	    || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR],
-		&fieldPtr) != TCL_OK
+	    || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR], &fieldPtr) != TCL_OK
+		 || fieldPtr == NULL
 	    || TclGetIntFromObj(interp, fieldPtr, &(fields.year)) != TCL_OK
-	    || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH],
-		&fieldPtr) != TCL_OK
+	    || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH],	&fieldPtr) != TCL_OK
+		 || fieldPtr == NULL
 	    || TclGetIntFromObj(interp, fieldPtr, &(fields.month)) != TCL_OK
-	    || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH],
-		&fieldPtr) != TCL_OK
+	    || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH], &fieldPtr) != TCL_OK
+		 || fieldPtr == NULL
 	    || TclGetIntFromObj(interp, fieldPtr,
 		&(fields.dayOfMonth)) != TCL_OK
 	    || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
+    if (fieldPtr == NULL)
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
 	return TCL_ERROR;
     }
     fields.era = era;
@@ -639,21 +642,21 @@ ClockGetjuliandayfromerayearweekdayObjCmd (
     }
     dict = objv[1];
     if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
+		 || fieldPtr == NULL
 	    || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
 		&era) != TCL_OK
-	    || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR],
-		&fieldPtr) != TCL_OK
-	    || TclGetIntFromObj(interp, fieldPtr,
-		&(fields.iso8601Year)) != TCL_OK
-	    || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK],
-		&fieldPtr) != TCL_OK
-	    || TclGetIntFromObj(interp, fieldPtr,
-		&(fields.iso8601Week)) != TCL_OK
-	    || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK],
-		&fieldPtr) != TCL_OK
-	    || TclGetIntFromObj(interp, fieldPtr,
-		&(fields.dayOfWeek)) != TCL_OK
+	    || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR], &fieldPtr) != TCL_OK
+		 || fieldPtr == NULL
+	    || TclGetIntFromObj(interp, fieldPtr, &(fields.iso8601Year)) != TCL_OK
+	    || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK], &fieldPtr) != TCL_OK
+		 || fieldPtr == NULL
+	    || TclGetIntFromObj(interp, fieldPtr, &(fields.iso8601Week)) != TCL_OK
+	    || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK], &fieldPtr) != TCL_OK
+		 || fieldPtr == NULL
+	    || TclGetIntFromObj(interp, fieldPtr, &(fields.dayOfWeek)) != TCL_OK
 	    || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
+    if (fieldPtr == NULL)
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
 	return TCL_ERROR;
     }
     fields.era = era;
-- 
cgit v0.12


From 79c0ebdad2faa35f18303ba802eba9897e04e144 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 16 Apr 2014 14:04:02 +0000
Subject: Fix compiler warnings in win32/cygwin build.

---
 generic/tclIntPlatDecls.h |  2 +-
 generic/tclStubInit.c     | 18 +++++++++++++-----
 2 files changed, 14 insertions(+), 6 deletions(-)

diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index f935efb..fc20d09 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -847,7 +847,7 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
 #undef TclpLocaltime_unix
 #undef TclpGmtime_unix
 
-#if defined(__WIN32__) || defined(__CYGWIN__)
+#if defined(__WIN32__)
 #   undef TclWinNToHS
 #   undef TclWinGetServByName
 #   undef TclWinGetSockOpt
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 99f3e4b..6499bc2 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -33,6 +33,9 @@
 #undef Tcl_CreateHashEntry
 #undef TclpGetPid
 #undef TclSockMinimumBuffers
+#undef TclWinGetServByName
+#undef TclWinGetSockOpt
+#undef TclWinSetSockOpt
 #define TclUnusedStubEntry NULL
 
 /*
@@ -104,7 +107,8 @@ TclpIsAtty(int fd)
     return isatty(fd);
 }
 
-int
+#define TclWinGetPlatformId winGetPlatformId
+static int
 TclWinGetPlatformId()
 {
     /* Don't bother to determine the real platform on cygwin,
@@ -120,27 +124,31 @@ void *TclWinGetTclInstance()
     return hInstance;
 }
 
-int
+#define TclWinSetSockOpt winSetSockOpt
+static int
 TclWinSetSockOpt(SOCKET s, int level, int optname,
 	    const char *optval, int optlen)
 {
     return setsockopt((int) s, level, optname, optval, optlen);
 }
 
-int
+#define TclWinGetSockOpt winGetSockOpt
+static int
 TclWinGetSockOpt(SOCKET s, int level, int optname,
 	    char *optval, int *optlen)
 {
     return getsockopt((int) s, level, optname, optval, optlen);
 }
 
-struct servent *
+#define TclWinGetServByName winGetServByName
+static struct servent *
 TclWinGetServByName(const char *name, const char *proto)
 {
     return getservbyname(name, proto);
 }
 
-char *
+#define TclWinNoBackslash winNoBackslash
+static char *
 TclWinNoBackslash(char *path)
 {
     char *p;
-- 
cgit v0.12


From 605c8e8366d2242fdbc73a8322ec2e5e6fce73cf Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 16 Apr 2014 15:17:14 +0000
Subject: Test for [d19a30db57].

---
 tests/clock.test | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/tests/clock.test b/tests/clock.test
index fea1fc9..aef699e 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -36927,6 +36927,11 @@ test clock-67.1 {clock format, %% with a letter following [Bug 2819334]} {
     clock format [clock seconds] -format %%r
 } %r
 
+test clock-67.2 {Bug d19a30db57} -body {
+    # error, not segfault
+    tcl::clock::GetJulianDayFromEraYearMonthDay {} 2361222
+} -returnCodes error -match glob -result *
+
 # cleanup
 
 namespace delete ::testClock
-- 
cgit v0.12


From 672a809211f32f12d7127dae83940756c7fb567d Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Wed, 16 Apr 2014 15:30:37 +0000
Subject: Test for [d19a30db57] extended

---
 tests/clock.test | 1 +
 1 file changed, 1 insertion(+)

diff --git a/tests/clock.test b/tests/clock.test
index aef699e..56763bd 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -36930,6 +36930,7 @@ test clock-67.1 {clock format, %% with a letter following [Bug 2819334]} {
 test clock-67.2 {Bug d19a30db57} -body {
     # error, not segfault
     tcl::clock::GetJulianDayFromEraYearMonthDay {} 2361222
+    tcl::clock::GetJulianDayFromEraYearWeekDay {} 2361222
 } -returnCodes error -match glob -result *
 
 # cleanup
-- 
cgit v0.12


From ca6f13bb3001d560ccd18ff40400afca249ebe28 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 16 Apr 2014 15:37:26 +0000
Subject: Repair new test so all parts will be effective.

---
 tests/clock.test | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/tests/clock.test b/tests/clock.test
index 56763bd..7d62a60 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -36930,6 +36930,9 @@ test clock-67.1 {clock format, %% with a letter following [Bug 2819334]} {
 test clock-67.2 {Bug d19a30db57} -body {
     # error, not segfault
     tcl::clock::GetJulianDayFromEraYearMonthDay {} 2361222
+} -returnCodes error -match glob -result *
+test clock-67.3 {Bug d19a30db57} -body {
+    # error, not segfault
     tcl::clock::GetJulianDayFromEraYearWeekDay {} 2361222
 } -returnCodes error -match glob -result *
 
-- 
cgit v0.12


From a99f768a32b42d04735d090f7d6fd8a0f75bc8ec Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 17 Apr 2014 14:01:14 +0000
Subject: Remove all win95-specific test-cases, since Windows 95 is not
 supported any more.

---
 tests/fCmd.test    |  6 ----
 tests/http.test    | 12 +++----
 tests/winFCmd.test | 96 ++----------------------------------------------------
 tests/winFile.test | 18 ----------
 tests/winPipe.test |  8 -----
 5 files changed, 6 insertions(+), 134 deletions(-)

diff --git a/tests/fCmd.test b/tests/fCmd.test
index 8f27ad4..3d22b09 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -511,12 +511,6 @@ test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} -setup {
 } -returnCodes error -cleanup {
     testchmod 755 td1
 } -result {error renaming "tf1" to "td1/tf1": permission denied}
-test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} -setup {
-    cleanup
-} -constraints {win 95} -returnCodes error -body {
-    createfile tf1
-    file rename tf1 $long
-} -result [subst {error renaming "tf1" to "$long": file name too long}]
 test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} -setup {
     cleanup
 } -constraints {unix notRoot} -body {
diff --git a/tests/http.test b/tests/http.test
index a52cfb1..a0a26de 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -492,14 +492,10 @@ proc myProgress {token total current} {
     }
     set progress [list $total $current]
 }
-if 0 {
-    # This test hangs on Windows95 because the client never gets EOF
-    set httpLog 1
-    test http-4.6.1 {http::Event} knownBug {
-	set token [http::geturl $url -blocksize 50 -progress myProgress]
-	return $progress
-    } {111 111}
-}
+test http-4.6.1 {http::Event} knownBug {
+    set token [http::geturl $url -blocksize 50 -progress myProgress]
+    return $progress
+} {111 111}
 test http-4.7 {http::Event} -body {
     set token [http::geturl $url -keepalive 0 -progress myProgress]
     return $progress
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index 28a0e9f..bd50328 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.test
@@ -208,22 +208,11 @@ test winFCmd-1.13 {TclpRenameFile: errno: EACCES} -setup {
 } -constraints {win win2000orXP testfile} -body {
     testfile mv nul tf1
 } -returnCodes error -result EINVAL
-test winFCmd-1.13.1 {TclpRenameFile: errno: EACCES} -setup {
+test winFCmd-1.14 {TclpRenameFile: errno: EACCES} -setup {
     cleanup
 } -constraints {win nt winOlderThan2000 testfile} -body {
     testfile mv nul tf1
 } -returnCodes error -result EACCES
-test winFCmd-1.13.2 {TclpRenameFile: errno: ENOENT} -setup {
-    cleanup
-} -constraints {win 95 testfile} -body {
-    testfile mv nul tf1
-} -returnCodes error -result ENOENT
-test winFCmd-1.14 {TclpRenameFile: errno: EACCES} -setup {
-    cleanup
-} -constraints {win 95 testfile} -body {
-    createfile tf1
-    testfile mv tf1 nul
-} -returnCodes error -result EACCES
 test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} -setup {
     cleanup
 } -constraints {win nt testfile} -body {
@@ -257,11 +246,6 @@ test winFCmd-1.19.1 {TclpRenameFile: errno == EACCES} -setup {
 } -constraints {win nt winOlderThan2000 testfile} -body {
     testfile mv nul tf1
 } -returnCodes error -result EACCES
-test winFCmd-1.19.2 {TclpRenameFile: errno == ENOENT} -setup {
-    cleanup
-} -constraints {win 95 testfile} -body {
-    testfile mv nul tf1
-} -returnCodes error -result ENOENT
 test winFCmd-1.20 {TclpRenameFile: src is dir} -setup {
     cleanup
 } -constraints {win nt testfile} -body {
@@ -474,29 +458,14 @@ test winFCmd-2.6 {TclpCopyFile: errno: ENOENT} -setup {
 } -returnCodes error -result ENOENT
 test winFCmd-2.7 {TclpCopyFile: errno: EACCES} -setup {
     cleanup
-} -constraints {win 95 testfile} -body {
-    createfile tf1
-    set fd [open tf2 w]
-    testfile cp tf1 tf2
-} -cleanup {
-    close $fd
-    cleanup
-} -returnCodes error -result EACCES
-test winFCmd-2.8 {TclpCopyFile: errno: EACCES} -setup {
-    cleanup
 } -constraints {win win2000orXP testfile} -body {
     testfile cp nul tf1
 } -returnCodes error -result EINVAL
-test winFCmd-2.8.1 {TclpCopyFile: errno: EACCES} -setup {
+test winFCmd-2.8 {TclpCopyFile: errno: EACCES} -setup {
     cleanup
 } -constraints {win nt winOlderThan2000 testfile} -body {
     testfile cp nul tf1
 } -returnCodes error -result EACCES
-test winFCmd-2.9 {TclpCopyFile: errno: ENOENT} -setup {
-    cleanup
-} -constraints {win 95 testfile} -body {
-    testfile cp nul tf1
-} -returnCodes error -result ENOENT
 test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} -setup {
     cleanup
 } -constraints {win testfile} -body {
@@ -573,17 +542,6 @@ test winFCmd-2.17 {TclpCopyFile: dst is readonly} -setup {
     catch {testchmod 666 tf2}
     cleanup
 } -result {1 tf1}
-test winFCmd-2.18 {TclpCopyFile: still can't copy onto dst} -setup {
-    cleanup
-} -constraints {win 95 testfile testchmod} -body {
-    createfile tf1
-    createfile tf2
-    testchmod 000 tf2
-    set fd [open tf2]
-    set msg [list [catch {testfile cp tf1 tf2} msg] $msg]
-    close $fd
-    lappend msg [file writable tf2]
-} -result {1 EACCES 0}
 
 test winFCmd-3.1 {TclpDeleteFile: errno: EACCES} -body {
     testfile rm $cdfile $cdrom/dummy~~.fil
@@ -666,9 +624,6 @@ test winFCmd-3.11 {TclpDeleteFile: still can't remove path} -setup {
 test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} -body {
     testfile mkdir $cdrom/dummy~~.dir
 } -constraints {win nt cdrom testfile} -returnCodes error -result EACCES
-test winFCmd-4.2 {TclpCreateDirectory: errno: EACCES} -body {
-    testfile mkdir $cdrom/dummy~~.dir
-} -constraints {win 95 cdrom testfile} -returnCodes error -result ENOSPC
 test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} -setup {
     cleanup
 } -constraints {win testfile} -body {
@@ -764,11 +719,6 @@ test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup {
     catch {testchmod 666 td1}
     cleanup
 } -result {td1 EACCES}
-test winFCmd-6.10 {TclpRemoveDirectory: attr == -1} -setup {
-    cleanup
-} -constraints {win 95 testfile} -body {
-    testfile rmdir nul
-} -returnCodes error -result {nul EACCES}
 test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
     cleanup
 } -constraints {win nt testfile} -body {
@@ -776,16 +726,6 @@ test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
     # WinXP returns EEXIST, WinNT seems to return EACCES.  No policy
     # decision has been made as to which is correct.
 } -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
-# This next test has a very hokey way of matching...
-test winFCmd-6.12 {TclpRemoveDirectory: errno == EACCES} -setup {
-    cleanup
-} -constraints {win 95 testfile} -body {
-    createfile tf1
-    set res [catch {testfile rmdir tf1} msg]
-    # get rid of path
-    set msg [list [file tail [lindex $msg 0]] [lindex $msg 1]]
-    list $res $msg
-} -result {1 {tf1 ENOTDIR}}
 test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup {
     cleanup
 } -constraints {winVista testfile testchmod} -body {
@@ -798,16 +738,6 @@ test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup {
     cleanup
 } -returnCodes error -result {td1 EACCES}
 # This next test has a very hokey way of matching...
-test winFCmd-6.14 {TclpRemoveDirectory: check if empty dir} -setup {
-    cleanup
-} -constraints {win 95 testfile} -body {
-    file mkdir td1/td2
-    set res [catch {testfile rmdir td1} msg]
-    # get rid of path
-    set msg [list [file tail [lindex $msg 0]] [lindex $msg 1]]
-    list $res $msg
-} -result {1 {td1 EEXIST}}
-# This next test has a very hokey way of matching...
 test winFCmd-6.15 {TclpRemoveDirectory: !recursive} -setup {
     cleanup
 } -constraints {win testfile} -body {
@@ -887,11 +817,6 @@ test winFCmd-7.7 {TraverseWinTree: append \ to source if necessary} -setup {
 } -cleanup {
     cleanup
 } -result {tf1}
-test winFCmd-7.8 {TraverseWinTree: append \ to source if necessary} -body {
-    # cdrom can return either d:\ or D:/, but we only care about the errcode
-    testfile rmdir $cdrom/
-} -constraints {win 95 cdrom testfile} -returnCodes error -match glob \
-    -result {* EACCES} ; # was EEXIST, but changed for win98.
 test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} -body {
     testfile rmdir $cdrom/
 } -constraints {win nt cdrom testfile} -returnCodes error -match glob \
@@ -930,14 +855,6 @@ test winFCmd-7.13 {TraverseWinTree: append \ to target if necessary} -setup {
 } -cleanup {
     cleanup
 } -result {tf1}
-test winFCmd-7.14 {TraverseWinTree: append \ to target if necessary} -setup {
-    cleanup
-} -constraints {win 95 testfile} -body {
-    file mkdir td1
-    testfile cpdir td1 /
-} -cleanup {
-    cleanup
-} -returnCodes error -result {/ EEXIST}
 test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} -setup {
     cleanup
 } -constraints {win nt testfile} -body {
@@ -1038,15 +955,6 @@ test winFCmd-9.1 {TraversalDelete: DOTREE_F} -setup {
     createfile td1/tf1
     testfile rmdir -force td1
 } -result {}
-test winFCmd-9.2 {TraversalDelete: DOTREE_F} -setup {
-    cleanup
-} -constraints {win 95 testfile} -body {
-    file mkdir td1
-    set fd [open td1/tf1 w]
-    testfile rmdir -force td1
-} -cleanup {
-    close $fd
-} -returnCodes error -result {td1\tf1 EACCES}
 test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup {
     cleanup
 } -constraints {winVista testfile testchmod} -body {
diff --git a/tests/winFile.test b/tests/winFile.test
index fba9bcb..2c47f5f 100644
--- a/tests/winFile.test
+++ b/tests/winFile.test
@@ -37,24 +37,6 @@ test winFile-1.2 {TclpGetUserHome} -constraints {win nt nonPortable} -body {
     # The administrator account should always exist.
     glob ~administrator
 } -match glob -result *
-test winFile-1.3 {TclpGetUserHome} -constraints {win 95} -body {
-    # Find some user in system.ini and then see if they have a home.
-
-    set f [open $::env(windir)/system.ini]
-    while {[gets $f line] >= 0} {
-	if {$line ne {[Password Lists]}} {
-	    continue
-	}
-	gets $f
-	set name [lindex [split [gets $f] =] 0]
-	if {$name ne ""} {
-	    return [catch {glob ~$name}]
-	}
-    }
-    return 0 ;# didn't find anything...
-} -cleanup {
-    catch {close $f}
-} -result {0}
 test winFile-1.4 {TclpGetUserHome} {win nt nonPortable} {
     catch {glob ~stanton@workgroup}
 } {0}
diff --git a/tests/winPipe.test b/tests/winPipe.test
index d2e804d..9c6f94d 100644
--- a/tests/winPipe.test
+++ b/tests/winPipe.test
@@ -82,10 +82,6 @@ test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {win nt exec cat3
     exec [interpreter] $path(more) < $path(big) | $cat32 > $path(stdout) 2> $path(stderr)
     list [contents $path(stdout)] [contents $path(stderr)]
 } "{$big} stderr32"
-test winpipe-1.5 {32 bit comprehensive tests: a lot from pipe} {win 95 exec cat32} {
-    exec command /c type $path(big) |& $cat32 > $path(stdout) 2> $path(stderr)
-    list [contents $path(stdout)] [contents $path(stderr)]
-} "{$big} stderr32"
 test winpipe-1.6 {32 bit comprehensive tests: from console} \
 	{win cat32 AllocConsole} {
     # would block waiting for human input
@@ -174,10 +170,6 @@ test winpipe-1.21 {32 bit comprehensive tests: read/write application} \
     catch {close $f}
     set r
 } "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
-test winpipe-1.22 {Checking command.com for Win95/98 hanging} {win 95 exec} {
-    exec command.com /c dir /b
-    set result 1
-} 1
 
 test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} {
     proc readResults {f} {
-- 
cgit v0.12


From ffc78c758ef00181a0c05fb7086a07e4a4673cbc Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 17 Apr 2014 16:05:06 +0000
Subject: Simplify reflected channels. Instead of having two modes of Close
 operations and the need to choose between them with a special value of the
 methods field, when the initialize pass fails for some reason, simply do not
 create the channel so there's nothing that needs closing.  Then the methods
 field no longer holds anything used, so eliminate it.  All the methods
 checking is done by [chan create].

---
 generic/tclIORChan.c | 62 ++++++----------------------------------------------
 1 file changed, 7 insertions(+), 55 deletions(-)

diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index eaabdfb..a4d1ec5 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -92,7 +92,6 @@ typedef struct {
     Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. */
 #endif
     Tcl_Obj *cmd;		/* Callback command prefix */
-    int methods;		/* Bitmask of supported methods */
 
     /*
      * NOTE (9): Should we have predefined shared literals for the method
@@ -436,9 +435,7 @@ static int              ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj* resObj);
  * list-quoting to keep the words of the message together. See also [x].
  */
 
-static const char *msg_read_unsup = "{read not supported by Tcl driver}";
 static const char *msg_read_toomuch = "{read delivered more than requested}";
-static const char *msg_write_unsup = "{write not supported by Tcl driver}";
 static const char *msg_write_toomuch = "{write wrote more than requested}";
 static const char *msg_write_nothing = "{write wrote nothing}";
 static const char *msg_seek_beforestart = "{Tried to seek before origin}";
@@ -550,11 +547,6 @@ TclChanCreateObjCmd(
 
     rcId = NextHandle();
     rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId);
-    chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
-	    mode);
-    rcPtr->chan = chan;
-    Tcl_Preserve(chan);
-    chanPtr = (Channel *) chan;
 
     /*
      * Invoke 'initialize' and validate that the handler is present and ok.
@@ -657,7 +649,11 @@ TclChanCreateObjCmd(
      * Everything is fine now.
      */
 
-    rcPtr->methods = methods;
+    chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
+	    mode);
+    rcPtr->chan = chan;
+    Tcl_Preserve(chan);
+    chanPtr = (Channel *) chan;
 
     if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) {
 	/*
@@ -720,12 +716,8 @@ TclChanCreateObjCmd(
     return TCL_OK;
 
  error:
-    /*
-     * Signal to ReflectClose to not call 'finalize'.
-     */
-
-    rcPtr->methods = 0;
-    Tcl_Close(interp, chan);
+    Tcl_DecrRefCount(rcPtr->cmd);
+    ckfree((char*) rcPtr);
     return TCL_ERROR;
 
 #undef MODE
@@ -1069,18 +1061,6 @@ ReflectClose(
     }
 
     /*
-     * -- No -- ASSERT rcPtr->methods & FLAG(METH_FINAL)
-     *
-     * A cleaned method mask here implies that the channel creation was
-     * aborted, and "finalize" must not be called.
-     */
-
-    if (rcPtr->methods == 0) {
-        Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
-	return EOK;
-    }
-
-    /*
      * Are we in the correct thread?
      */
 
@@ -1176,18 +1156,6 @@ ReflectInput(
     Tcl_Obj *resObj;		/* Result data for 'read' */
 
     /*
-     * The following check can be done before thread redirection, because we
-     * are reading from an item which is readonly, i.e. will never change
-     * during the lifetime of the channel.
-     */
-
-    if (!(rcPtr->methods & FLAG(METH_READ))) {
-	SetChannelErrorStr(rcPtr->chan, msg_read_unsup);
-	*errorCodePtr = EINVAL;
-	return -1;
-    }
-
-    /*
      * Are we in the correct thread?
      */
 
@@ -1291,18 +1259,6 @@ ReflectOutput(
     int written;
 
     /*
-     * The following check can be done before thread redirection, because we
-     * are reading from an item which is readonly, i.e. will never change
-     * during the lifetime of the channel.
-     */
-
-    if (!(rcPtr->methods & FLAG(METH_WRITE))) {
-	SetChannelErrorStr(rcPtr->chan, msg_write_unsup);
-	*errorCodePtr = EINVAL;
-	return -1;
-    }
-
-    /*
      * Are we in the correct thread?
      */
 
@@ -1524,8 +1480,6 @@ ReflectWatch(
     ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
     Tcl_Obj *maskObj;
 
-    /* ASSERT rcPtr->methods & FLAG(METH_WATCH) */
-
     /*
      * We restrict the interest to what the channel can support. IOW there
      * will never be write events for a channel which is not writable.
@@ -2008,10 +1962,8 @@ NewReflectedChannel(
     rcPtr = (ReflectedChannel *) ckalloc(sizeof(ReflectedChannel));
 
     /* rcPtr->chan: Assigned by caller. Dummy data here. */
-    /* rcPtr->methods: Assigned by caller. Dummy data here. */
 
     rcPtr->chan = NULL;
-    rcPtr->methods = 0;
     rcPtr->interp = interp;
 #ifdef TCL_THREADS
     rcPtr->thread = Tcl_GetCurrentThread();
-- 
cgit v0.12


From 9814e7b3519b71ebace82cd8ca37748fc92b8185 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 17 Apr 2014 17:55:59 +0000
Subject: Reflected channels.  Keep a set of method names cached so we don't
 create new each operation, and we can benefit from any lookup info cached in
 intreps.

---
 generic/tclIORChan.c | 83 +++++++++++++++++++++++++++-------------------------
 1 file changed, 43 insertions(+), 40 deletions(-)

diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index a4d1ec5..17c1593 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -92,11 +92,8 @@ typedef struct {
     Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. */
 #endif
     Tcl_Obj *cmd;		/* Callback command prefix */
-
-    /*
-     * NOTE (9): Should we have predefined shared literals for the method
-     * names?
-     */
+    Tcl_Obj *methods;		/* Methods to append to command prefix */
+    Tcl_Obj *name;		/* Name of the channel as created */
 
     int mode;			/* Mask of R/W mode */
     int interest;		/* Mask of events the channel is interested
@@ -420,7 +417,7 @@ static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp,
 static Tcl_Obj *	NextHandle(void);
 static void		FreeReflectedChannel(ReflectedChannel *rcPtr);
 static int		InvokeTclMethod(ReflectedChannel *rcPtr,
-			    const char *method, Tcl_Obj *argOneObj,
+			    MethodName method, Tcl_Obj *argOneObj,
 			    Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);
 
 static ReflectedChannelMap *	GetReflectedChannelMap(Tcl_Interp *interp);
@@ -560,7 +557,7 @@ TclChanCreateObjCmd(
 
     modeObj = DecodeEventMask(mode);
     /* assert modeObj.refCount == 1 */
-    result = InvokeTclMethod(rcPtr, "initialize", modeObj, NULL, &resObj);
+    result = InvokeTclMethod(rcPtr, METH_INIT, modeObj, NULL, &resObj);
     Tcl_DecrRefCount(modeObj);
     if (result != TCL_OK) {
 	UnmarshallErrorResult(interp, resObj);
@@ -716,6 +713,8 @@ TclChanCreateObjCmd(
     return TCL_OK;
 
  error:
+    Tcl_DecrRefCount(rcPtr->name);
+    Tcl_DecrRefCount(rcPtr->methods);
     Tcl_DecrRefCount(rcPtr->cmd);
     ckfree((char*) rcPtr);
     return TCL_ERROR;
@@ -1081,7 +1080,7 @@ ReflectClose(
 	}
     } else {
 #endif
-	result = InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj);
+	result = InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj);
 	if ((result != TCL_OK) && (interp != NULL)) {
 	    Tcl_SetChannelErrorInterp(interp, resObj);
 	}
@@ -1193,7 +1192,7 @@ ReflectInput(
     toReadObj = Tcl_NewIntObj(toRead);
     Tcl_IncrRefCount(toReadObj);
 
-    if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK) {
+    if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) {
 	int code = ErrnoReturn (rcPtr, resObj);
 
 	if (code < 0) {
@@ -1296,7 +1295,7 @@ ReflectOutput(
     bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
     Tcl_IncrRefCount(bufObj);
 
-    if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+    if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
 	int code = ErrnoReturn(rcPtr, resObj);
 
 	if (code < 0) {
@@ -1409,7 +1408,7 @@ ReflectSeekWide(
     Tcl_IncrRefCount(offObj);
     Tcl_IncrRefCount(baseObj);
 
-    if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK) {
+    if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) {
 	Tcl_SetChannelError(rcPtr->chan, resObj);
         goto invalid;
     }
@@ -1522,7 +1521,7 @@ ReflectWatch(
 
     maskObj = DecodeEventMask(mask);
     /* assert maskObj.refCount == 1 */
-    (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL);
+    (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
     Tcl_DecrRefCount(maskObj);
 
     Tcl_Release(rcPtr);
@@ -1581,7 +1580,7 @@ ReflectBlock(
 
     Tcl_Preserve(rcPtr);
 
-    if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, &resObj) != TCL_OK) {
+    if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, &resObj) != TCL_OK) {
 	Tcl_SetChannelError(rcPtr->chan, resObj);
 	errorNum = EINVAL;
     } else {
@@ -1655,7 +1654,7 @@ ReflectSetOption(
     Tcl_IncrRefCount(optionObj);
     Tcl_IncrRefCount(valueObj);
 
-    result = InvokeTclMethod(rcPtr, "configure",optionObj,valueObj, &resObj);
+    result = InvokeTclMethod(rcPtr, METH_CONFIGURE,optionObj,valueObj, &resObj);
     if (result != TCL_OK) {
 	UnmarshallErrorResult(interp, resObj);
     }
@@ -1700,7 +1699,7 @@ ReflectGetOption(
     Tcl_Obj *resObj;		/* Result data for 'configure' */
     int listc, result = TCL_OK;
     Tcl_Obj **listv;
-    const char *method;
+    MethodName method;
 
     /*
      * Are we in the correct thread?
@@ -1739,14 +1738,14 @@ ReflectGetOption(
 	 * Retrieve all options.
 	 */
 
-	method = "cgetall";
+	method = METH_CGETALL;
 	optionObj = NULL;
     } else {
 	/*
 	 * Retrieve the value of one option.
 	 */
 
-	method = "cget";
+	method = METH_CGET;
 	optionObj = Tcl_NewStringObj(optionName, -1);
         Tcl_IncrRefCount(optionObj);
     }
@@ -1958,6 +1957,7 @@ NewReflectedChannel(
     Tcl_Obj *handleObj)
 {
     ReflectedChannel *rcPtr;
+    MethodName mn = METH_BLOCKING;
 
     rcPtr = (ReflectedChannel *) ckalloc(sizeof(ReflectedChannel));
 
@@ -1973,9 +1973,15 @@ NewReflectedChannel(
 
     /* ASSERT: cmdpfxObj is a Tcl List */
     rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
-    Tcl_ListObjAppendElement(NULL, rcPtr->cmd, Tcl_NewObj());
-    Tcl_ListObjAppendElement(NULL, rcPtr->cmd, handleObj);
     Tcl_IncrRefCount(rcPtr->cmd);
+    rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
+    while (mn <= METH_WRITE) {
+	Tcl_ListObjAppendElement(NULL, rcPtr->methods,
+		Tcl_NewStringObj(methodNames[mn++], -1));
+    }
+    Tcl_IncrRefCount(rcPtr->methods);
+    rcPtr->name = handleObj;
+    Tcl_IncrRefCount(rcPtr->name);
     return rcPtr;
 }
 
@@ -2035,6 +2041,8 @@ FreeReflectedChannel(
 	ckfree((char*) chanPtr->typePtr);
     }
     Tcl_Release(chanPtr);
+    Tcl_DecrRefCount(rcPtr->name);
+    Tcl_DecrRefCount(rcPtr->methods);
     Tcl_DecrRefCount(rcPtr->cmd);
     ckfree((char*) rcPtr);
 }
@@ -2066,7 +2074,7 @@ FreeReflectedChannel(
 static int
 InvokeTclMethod(
     ReflectedChannel *rcPtr,
-    const char *method,
+    MethodName method,
     Tcl_Obj *argOneObj,		/* NULL'able */
     Tcl_Obj *argTwoObj,		/* NULL'able */
     Tcl_Obj **resultObjPtr)	/* NULL'able */
@@ -2076,7 +2084,6 @@ InvokeTclMethod(
     int result;			/* Result code of method invokation */
     Tcl_Obj *resObj = NULL;	/* Result of method invokation. */
     Tcl_Obj *cmd;
-    int len;
 
     if (!rcPtr->interp) {
 	/*
@@ -2099,20 +2106,15 @@ InvokeTclMethod(
     }
 
     /*
-     * NOTE (5): Decide impl. issue: Cache objects with method names? Needs
-     * TSD data as reflections can be created in many different threads.
-     * NO: Caching of command resolutions means storage per channel.
-     */
-
-    /*
      * Insert method into the callback command, after the command prefix,
      * before the channel id.
      */
 
-    methObj = Tcl_NewStringObj(method, -1);
     cmd = TclListObjCopy(NULL, rcPtr->cmd);
-    ListObjLength(cmd, len);
-    Tcl_ListObjReplace(NULL, cmd, len - 2, 1, 1, &methObj);
+
+    Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
+    Tcl_ListObjAppendElement(NULL, cmd, methObj);
+    Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);
 
     /*
      * Append the additional argument containing method specific details
@@ -2173,7 +2175,8 @@ InvokeTclMethod(
 		result = TCL_ERROR;
 	    }
 	    Tcl_AppendObjToErrorInfo(rcPtr->interp, Tcl_ObjPrintf(
-		    "\n    (chan handler subcommand \"%s\")", method));
+		    "\n    (chan handler subcommand \"%s\")",
+		    methodNames[method]));
 	    resObj = MarshallError(rcPtr->interp);
 	}
 	Tcl_IncrRefCount(resObj);
@@ -2700,7 +2703,7 @@ ForwardProc(
 	 * No parameters/results.
 	 */
 
-	if (InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj)!=TCL_OK) {
+	if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) {
 	    ForwardSetObjError(paramPtr, resObj);
 	}
 
@@ -2732,7 +2735,7 @@ ForwardProc(
         Tcl_IncrRefCount(toReadObj);
 
         Tcl_Preserve(rcPtr);
-	if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK){
+	if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){
 	    int code = ErrnoReturn (rcPtr, resObj);
 
 	    if (code < 0) {
@@ -2772,7 +2775,7 @@ ForwardProc(
         Tcl_IncrRefCount(bufObj);
 
         Tcl_Preserve(rcPtr);
-	if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+	if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
 	    int code = ErrnoReturn(rcPtr, resObj);
 
 	    if (code < 0) {
@@ -2813,7 +2816,7 @@ ForwardProc(
         Tcl_IncrRefCount(baseObj);
 
         Tcl_Preserve(rcPtr);
-	if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK){
+	if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK){
 	    ForwardSetObjError(paramPtr, resObj);
 	    paramPtr->seek.offset = -1;
 	} else {
@@ -2847,7 +2850,7 @@ ForwardProc(
         /* assert maskObj.refCount == 1 */
 
         Tcl_Preserve(rcPtr);
-	(void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL);
+	(void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
 	Tcl_DecrRefCount(maskObj);
         Tcl_Release(rcPtr);
 	break;
@@ -2858,7 +2861,7 @@ ForwardProc(
         Tcl_IncrRefCount(blockObj);
 
         Tcl_Preserve(rcPtr);
-	if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL,
+	if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL,
 		&resObj) != TCL_OK) {
 	    ForwardSetObjError(paramPtr, resObj);
 	}
@@ -2874,7 +2877,7 @@ ForwardProc(
         Tcl_IncrRefCount(optionObj);
         Tcl_IncrRefCount(valueObj);
         Tcl_Preserve(rcPtr);
-	if (InvokeTclMethod(rcPtr, "configure", optionObj, valueObj,
+	if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj,
 		&resObj) != TCL_OK) {
 	    ForwardSetObjError(paramPtr, resObj);
 	}
@@ -2893,7 +2896,7 @@ ForwardProc(
         Tcl_IncrRefCount(optionObj);
 
         Tcl_Preserve(rcPtr);
-	if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){
+	if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){
 	    ForwardSetObjError(paramPtr, resObj);
 	} else {
 	    Tcl_DStringAppend(paramPtr->getOpt.value,
@@ -2910,7 +2913,7 @@ ForwardProc(
 	 */
 
         Tcl_Preserve(rcPtr);
-	if (InvokeTclMethod(rcPtr, "cgetall", NULL, NULL, &resObj) != TCL_OK){
+	if (InvokeTclMethod(rcPtr, METH_CGETALL, NULL, NULL, &resObj) != TCL_OK){
 	    ForwardSetObjError(paramPtr, resObj);
 	} else {
 	    /*
-- 
cgit v0.12


From 87f75437c09a8e8fbe5fe0eaa68200c773799e28 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 17 Apr 2014 19:58:41 +0000
Subject: Another test exposing another segfault.

---
 tests/ioCmd.test | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index f021ade..184f773 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -774,6 +774,22 @@ test iocmd-21.20 {Bug 88aef05cda} -setup {
     close $ch
     rename foo {}
 } -match glob -result {1 {*nested eval*}}
+test iocmd-21.21 {[close] in [read] segfaults} -setup {
+    proc foo {method chan args} {
+	switch -- $method initialize {
+	    return {initialize finalize watch read}
+	} finalize {} watch {} read {
+	    close $chan
+	    return a
+	}
+    }
+    set ch [chan create read foo]
+} -body {
+    read $ch 1
+} -cleanup {
+    close $ch
+    rename foo {}
+} -result a
 
 # --- --- --- --------- --------- ---------
 # Helper commands to record the arguments to handler methods.
-- 
cgit v0.12


From a07adf4d6d28771d9aa74ef06526e5fb3035f5c1 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 21 Apr 2014 18:55:41 +0000
Subject: Added a refcounting mechanism to ChannelBuffers.  Other edits to stop
 segfaults in tests iocmd-21.2[12].

---
 generic/tclIO.c    | 50 ++++++++++++++++++++++++++++++++++++++++++--------
 generic/tclIO.h    |  1 +
 generic/tclIOCmd.c |  3 +++
 tests/ioCmd.test   | 20 ++++++++++++++++++--
 4 files changed, 64 insertions(+), 10 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 9e675c6..a60c97d 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -162,6 +162,8 @@ typedef struct CloseCallback {
  */
 
 static ChannelBuffer *	AllocChannelBuffer(int length);
+static void		PreserveChannelBuffer(ChannelBuffer *bufPtr);
+static void		ReleaseChannelBuffer(ChannelBuffer *bufPtr);
 static void		ChannelTimerProc(ClientData clientData);
 static int		CheckChannelErrors(ChannelState *statePtr,
 			    int direction);
@@ -352,6 +354,7 @@ ChanRead(
     int *errnoPtr)
 {
     if (WillRead(chanPtr) < 0) {
+	*errnoPtr = Tcl_GetErrno();
         return -1;
     }
 
@@ -2216,8 +2219,26 @@ AllocChannelBuffer(
     bufPtr->nextRemoved	= BUFFER_PADDING;
     bufPtr->bufLength	= length + BUFFER_PADDING;
     bufPtr->nextPtr	= NULL;
+    bufPtr->refCount	= 1;
     return bufPtr;
 }
+
+static void
+PreserveChannelBuffer(
+    ChannelBuffer *bufPtr)
+{
+    bufPtr->refCount++;
+}
+
+static void
+ReleaseChannelBuffer(
+    ChannelBuffer *bufPtr)
+{
+    if (--bufPtr->refCount) {
+	return;
+    }
+    ckfree((char *) bufPtr);
+}
 
 /*
  *----------------------------------------------------------------------
@@ -2250,7 +2271,7 @@ RecycleBuffer(
      */
 
     if (mustDiscard) {
-	ckfree((char *) bufPtr);
+	ReleaseChannelBuffer(bufPtr);
 	return;
     }
 
@@ -2261,7 +2282,7 @@ RecycleBuffer(
      */
 
     if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) {
-	ckfree((char *) bufPtr);
+	ReleaseChannelBuffer(bufPtr);
 	return;
     }
 
@@ -2296,7 +2317,7 @@ RecycleBuffer(
      * If we reached this code we return the buffer to the OS.
      */
 
-    ckfree((char *) bufPtr);
+    ReleaseChannelBuffer(bufPtr);
     return;
 
   keepBuffer:
@@ -2470,6 +2491,7 @@ FlushChannel(
 	 * Produce the output on the channel.
 	 */
 
+	PreserveChannelBuffer(bufPtr);
 	toWrite = BytesLeft(bufPtr);
 	if (toWrite == 0) {
 	    written = 0;
@@ -2597,6 +2619,7 @@ FlushChannel(
 	    }
 	    RecycleBuffer(statePtr, bufPtr, 0);
 	}
+	ReleaseChannelBuffer(bufPtr);
     }	/* Closes "while (1)". */
 
     /*
@@ -2681,7 +2704,7 @@ CloseChannel(
      */
 
     if (statePtr->curOutPtr != NULL) {
-	ckfree((char *) statePtr->curOutPtr);
+	ReleaseChannelBuffer(statePtr->curOutPtr);
 	statePtr->curOutPtr = NULL;
     }
 
@@ -3566,6 +3589,11 @@ static void WillWrite(Channel *chanPtr)
 
 static int WillRead(Channel *chanPtr)
 {
+    if (chanPtr->typePtr == NULL) {
+	/* Prevent read attempts on a closed channel */
+	Tcl_SetErrno(EINVAL);
+	return -1;
+    }
     if ((chanPtr->typePtr->seekProc != NULL)
         && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
         if ((chanPtr->state->curOutPtr != NULL)
@@ -3652,6 +3680,7 @@ Write(
 	    bufPtr->nextAdded += saved;
 	    saved = 0;
 	}
+	PreserveChannelBuffer(bufPtr);
 	dst = InsertPoint(bufPtr);
 	dstLen = SpaceLeft(bufPtr);
 
@@ -3665,6 +3694,7 @@ Write(
 	
 	if ((result != TCL_OK) && (srcRead + dstWrote == 0)) {
 	    /* We're reading from invalid/incomplete UTF-8 */
+	    ReleaseChannelBuffer(bufPtr);
 	    if (total == 0) {
 		Tcl_SetErrno(EINVAL);
 		return -1;
@@ -3748,6 +3778,7 @@ Write(
 		needNlFlush = 0;
 	    }
 	}
+	ReleaseChannelBuffer(bufPtr);
     }
     if ((flushed < total) && (statePtr->flags & CHANNEL_UNBUFFERED ||
 	    (needNlFlush && statePtr->flags & CHANNEL_LINEBUFFERED))) {
@@ -5935,7 +5966,7 @@ DiscardInputQueued(
      */
 
     if (discardSavedBuffers && statePtr->saveInBufPtr != NULL) {
-	ckfree((char *) statePtr->saveInBufPtr);
+	ReleaseChannelBuffer(statePtr->saveInBufPtr);
 	statePtr->saveInBufPtr = NULL;
     }
 }
@@ -6028,7 +6059,7 @@ GetInput(
 
 	if ((bufPtr != NULL)
 		&& (bufPtr->bufLength - BUFFER_PADDING < statePtr->bufSize)) {
-	    ckfree((char *) bufPtr);
+	    ReleaseChannelBuffer(bufPtr);
 	    bufPtr = NULL;
 	}
 
@@ -6090,6 +6121,7 @@ GetInput(
     } else {
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
 
+	PreserveChannelBuffer(bufPtr);
 	nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead, &result);
 
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
@@ -6097,6 +6129,7 @@ GetInput(
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
 
     if (nread > 0) {
+	result = 0;
 	bufPtr->nextAdded += nread;
 
 	/*
@@ -6122,6 +6155,7 @@ GetInput(
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
 
     } else if (nread == 0) {
+	result = 0;
 	SetFlag(statePtr, CHANNEL_EOF);
 	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
     } else if (nread < 0) {
@@ -6130,9 +6164,9 @@ GetInput(
 	    result = EAGAIN;
 	}
 	Tcl_SetErrno(result);
-	return result;
     }
-    return 0;
+    ReleaseChannelBuffer(bufPtr);
+    return result;
 }
 
 /*
diff --git a/generic/tclIO.h b/generic/tclIO.h
index ebf2ef7..0ea7d1c 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -36,6 +36,7 @@
  */
 
 typedef struct ChannelBuffer {
+    int refCount;		/* Current uses count */
     int nextAdded;		/* The next position into which a character
 				 * will be put in the buffer. */
     int nextRemoved;		/* Position of next byte to be removed from
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 2958bc8..7e8e91a 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -447,6 +447,7 @@ Tcl_ReadObjCmd(
 
     resultPtr = Tcl_NewObj();
     Tcl_IncrRefCount(resultPtr);
+    Tcl_Preserve(chan);
     charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
     if (charactersRead < 0) {
 	/*
@@ -462,6 +463,7 @@ Tcl_ReadObjCmd(
 		    TclGetString(chanObjPtr), "\": ",
 		    Tcl_PosixError(interp), NULL);
 	}
+	Tcl_Release(chan);
 	Tcl_DecrRefCount(resultPtr);
 	return TCL_ERROR;
     }
@@ -480,6 +482,7 @@ Tcl_ReadObjCmd(
 	}
     }
     Tcl_SetObjResult(interp, resultPtr);
+    Tcl_Release(chan);
     Tcl_DecrRefCount(resultPtr);
     return TCL_OK;
 }
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 184f773..8bf32d2 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -785,11 +785,27 @@ test iocmd-21.21 {[close] in [read] segfaults} -setup {
     }
     set ch [chan create read foo]
 } -body {
-    read $ch 1
+    read $ch 0
 } -cleanup {
     close $ch
     rename foo {}
-} -result a
+} -result {}
+test iocmd-21.22 {[close] in [read] segfaults} -setup {
+    proc foo {method chan args} {
+	switch -- $method initialize {
+	    return {initialize finalize watch read}
+	} finalize {} watch {} read {
+	    catch {close $chan}
+	    return a
+	}
+    }
+    set ch [chan create read foo]
+} -body {
+    read $ch 1
+} -returnCodes error -cleanup {
+    catch {close $ch}
+    rename foo {}
+} -match glob -result {*invalid argument*}
 
 # --- --- --- --------- --------- ---------
 # Helper commands to record the arguments to handler methods.
-- 
cgit v0.12


From 192fce9c01c4ee3827aa8f54967764c18bdd5dca Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Tue, 22 Apr 2014 13:25:41 +0000
Subject: Memory leak after thread exit, fixed (alloc cache released by exit),
 belong to ticket [3493120]

Moved over to branch bug-3493120.  This is not ready
for the core-8-5-branch.  Segfaults all over the place
in a thread-enabled build on a CentOS system.
---
 generic/tclInt.h         |  1 +
 generic/tclThread.c      |  8 ++++++--
 generic/tclThreadAlloc.c | 27 +++++++++++++++++++++++++++
 3 files changed, 34 insertions(+), 2 deletions(-)

diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1348340..00b246b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2550,6 +2550,7 @@ MODULE_SCOPE void	TclFinalizeObjects(void);
 MODULE_SCOPE void	TclFinalizePreserve(void);
 MODULE_SCOPE void	TclFinalizeSynchronization(void);
 MODULE_SCOPE void	TclFinalizeThreadAlloc(void);
+MODULE_SCOPE void	TclFinalizeThreadAllocThread(void);
 MODULE_SCOPE void	TclFinalizeThreadData(void);
 MODULE_SCOPE void	TclFinalizeThreadObjects(void);
 MODULE_SCOPE double	TclFloor(mp_int *a);
diff --git a/generic/tclThread.c b/generic/tclThread.c
index 8384107..d6b5bcb 100644
--- a/generic/tclThread.c
+++ b/generic/tclThread.c
@@ -338,8 +338,9 @@ Tcl_ConditionFinalize(
  *
  * TclFinalizeThreadData --
  *
- *	This function cleans up the thread-local storage. This is called once
- *	for each thread.
+ *	This function cleans up the thread-local storage. Secondary, it cleans
+ *	thread alloc cache.
+ *	This is called once for each thread before thread exits.
  *
  * Results:
  *	None.
@@ -354,6 +355,9 @@ void
 TclFinalizeThreadData(void)
 {
     TclpFinalizeThreadDataThread();
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+    TclFinalizeThreadAllocThread();
+#endif
 }
 
 /*
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index 2e74fa7..106e908 100644
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -1012,6 +1012,33 @@ TclFinalizeThreadAlloc(void)
     TclpFreeAllocCache(NULL);
 }
 
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeThreadAllocThread --
+ *
+ *	This procedure is used to destroy single thread private resources used
+ *	in this file. 
+ * Called in TclpFinalizeThreadData when a thread exits (Tcl_FinalizeThread).
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeThreadAllocThread(void)
+{
+    Cache *cachePtr = TclpGetAllocCache();
+    if (cachePtr != NULL) {
+	TclpFreeAllocCache(cachePtr);
+    }
+}
+
 #else /* !(TCL_THREADS && USE_THREAD_ALLOC) */
 /*
  *----------------------------------------------------------------------
-- 
cgit v0.12


From 190e2f09e8fa5bc975ba496a5544b4dd853378f0 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 22 Apr 2014 14:57:44 +0000
Subject: Add refcounting and preservation to [testchannel transform] to stop
 segfault in test iogt-2.4.

---
 generic/tclIOGT.c | 122 +++++++++++++++++++++++++++++++++---------------------
 1 file changed, 75 insertions(+), 47 deletions(-)

diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index eed21fb..beddf4f 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -210,7 +210,27 @@ struct TransformChannelData {
 				 * a transformation of incoming data. Also
 				 * serves as buffer of all data not yet
 				 * consumed by the reader. */
+    int refCount;
 };
+
+static void
+PreserveData(
+    TransformChannelData *dataPtr)
+{
+    dataPtr->refCount++;
+}
+
+static void
+ReleaseData(
+    TransformChannelData *dataPtr)
+{
+    if (--dataPtr->refCount) {
+	return;
+    }
+    ResultClear(&dataPtr->result);
+    Tcl_DecrRefCount(dataPtr->command);
+    ckfree((char *) dataPtr);
+}
 
 /*
  *----------------------------------------------------------------------
@@ -240,6 +260,7 @@ TclChannelTransform(
     Channel *chanPtr;		/* The actual channel. */
     ChannelState *statePtr;	/* State info for channel. */
     int mode;			/* Read/write mode of the channel. */
+    int objc;
     TransformChannelData *dataPtr;
     Tcl_DString ds;
 
@@ -247,6 +268,12 @@ TclChannelTransform(
 	return TCL_ERROR;
     }
 
+    if (TCL_OK != Tcl_ListObjLength(interp, cmdObjPtr, &objc)) {
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("-command value is not a list", -1));
+	return TCL_ERROR;
+    }
+
     chanPtr = (Channel *) chan;
     statePtr = chanPtr->state;
     chanPtr = statePtr->topChanPtr;
@@ -261,6 +288,7 @@ TclChannelTransform(
 
     dataPtr = (TransformChannelData *) ckalloc(sizeof(TransformChannelData));
 
+    dataPtr->refCount = 1;
     Tcl_DStringInit(&ds);
     Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
     dataPtr->readIsFlushed = 0;
@@ -286,9 +314,7 @@ TclChannelTransform(
     if (dataPtr->self == NULL) {
 	Tcl_AppendResult(interp, "\nfailed to stack channel \"",
 		Tcl_GetChannelName(chan), "\"", NULL);
-	Tcl_DecrRefCount(dataPtr->command);
-	ResultClear(&dataPtr->result);
-	ckfree((char *) dataPtr);
+	ReleaseData(dataPtr);
 	return TCL_ERROR;
     }
 
@@ -296,9 +322,11 @@ TclChannelTransform(
      * At last initialize the transformation at the script level.
      */
 
+    PreserveData(dataPtr);
     if ((dataPtr->mode & TCL_WRITABLE) && ExecuteCallback(dataPtr, NULL,
 	    A_CREATE_WRITE, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK){
 	Tcl_UnstackChannel(interp, chan);
+	ReleaseData(dataPtr);
 	return TCL_ERROR;
     }
 
@@ -307,9 +335,11 @@ TclChannelTransform(
 	ExecuteCallback(dataPtr, NULL, A_DELETE_WRITE, NULL, 0, TRANSMIT_DONT,
 		P_NO_PRESERVE);
 	Tcl_UnstackChannel(interp, chan);
+	ReleaseData(dataPtr);
 	return TCL_ERROR;
     }
 
+    ReleaseData(dataPtr);
     return TCL_OK;
 }
 
@@ -350,7 +380,10 @@ ExecuteCallback(
     unsigned char *resBuf;
     Tcl_InterpState state = NULL;
     int res = TCL_OK;
-    Tcl_Obj *command = Tcl_DuplicateObj(dataPtr->command);
+    Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command);
+    Tcl_Interp *eval = dataPtr->interp;
+
+    Tcl_Preserve(eval);
 
     /*
      * Step 1, create the complete command to execute. Do this by appending
@@ -361,26 +394,18 @@ ExecuteCallback(
      */
 
     if (preserve == P_PRESERVE) {
-	state = Tcl_SaveInterpState(dataPtr->interp, res);
+	state = Tcl_SaveInterpState(eval, res);
     }
 
     Tcl_IncrRefCount(command);
-    res = Tcl_ListObjAppendElement(dataPtr->interp, command,
-	    Tcl_NewStringObj((char *) op, -1));
-    if (res != TCL_OK) {
-	goto cleanup;
-    }
+    Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, -1));
 
     /*
      * Use a byte-array to prevent the misinterpretation of binary data coming
      * through as UTF while at the tcl level.
      */
 
-    res = Tcl_ListObjAppendElement(dataPtr->interp, command,
-	    Tcl_NewByteArrayObj(buf, bufLen));
-    if (res != TCL_OK) {
-	goto cleanup;
-    }
+    Tcl_ListObjAppendElement(NULL, command, Tcl_NewByteArrayObj(buf, bufLen));
 
     /*
      * Step 2, execute the command at the global level of the interpreter used
@@ -390,13 +415,14 @@ ExecuteCallback(
      * current interpreter. Don't copy if in preservation mode.
      */
 
-    res = Tcl_EvalObjEx(dataPtr->interp, command, TCL_EVAL_GLOBAL);
+    res = Tcl_EvalObjEx(eval, command, TCL_EVAL_GLOBAL);
     Tcl_DecrRefCount(command);
     command = NULL;
 
-    if ((res != TCL_OK) && (interp != NULL) && (dataPtr->interp != interp)
+    if ((res != TCL_OK) && (interp != NULL) && (eval != interp)
 	    && (preserve == P_NO_PRESERVE)) {
-	Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp));
+	Tcl_SetObjResult(interp, Tcl_GetObjResult(eval));
+	Tcl_Release(eval);
 	return res;
     }
 
@@ -411,20 +437,20 @@ ExecuteCallback(
 	break;
 
     case TRANSMIT_DOWN:
-	resObj = Tcl_GetObjResult(dataPtr->interp);
+	resObj = Tcl_GetObjResult(eval);
 	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
 	Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf,
 		resLen);
 	break;
 
     case TRANSMIT_SELF:
-	resObj = Tcl_GetObjResult(dataPtr->interp);
+	resObj = Tcl_GetObjResult(eval);
 	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
 	Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen);
 	break;
 
     case TRANSMIT_IBUF:
-	resObj = Tcl_GetObjResult(dataPtr->interp);
+	resObj = Tcl_GetObjResult(eval);
 	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
 	ResultAdd(&dataPtr->result, resBuf, resLen);
 	break;
@@ -434,24 +460,16 @@ ExecuteCallback(
 	 * Interpret result as integer number.
 	 */
 
-	resObj = Tcl_GetObjResult(dataPtr->interp);
-	TclGetIntFromObj(dataPtr->interp, resObj, &dataPtr->maxRead);
+	resObj = Tcl_GetObjResult(eval);
+	TclGetIntFromObj(eval, resObj, &dataPtr->maxRead);
 	break;
     }
 
-    Tcl_ResetResult(dataPtr->interp);
-    if (preserve == P_PRESERVE) {
-	(void) Tcl_RestoreInterpState(dataPtr->interp, state);
-    }
-    return res;
-
-  cleanup:
+    Tcl_ResetResult(eval);
     if (preserve == P_PRESERVE) {
-	(void) Tcl_RestoreInterpState(dataPtr->interp, state);
-    }
-    if (command != NULL) {
-	Tcl_DecrRefCount(command);
+	(void) Tcl_RestoreInterpState(eval, state);
     }
+    Tcl_Release(eval);
     return res;
 }
 
@@ -535,6 +553,7 @@ TransformCloseProc(
      * system rely on (f.e. signaling the close to interested parties).
      */
 
+    PreserveData(dataPtr);
     if (dataPtr->mode & TCL_WRITABLE) {
 	ExecuteCallback(dataPtr, interp, A_FLUSH_WRITE, NULL, 0,
 		TRANSMIT_DOWN, P_PRESERVE);
@@ -554,14 +573,13 @@ TransformCloseProc(
 	ExecuteCallback(dataPtr, interp, A_DELETE_READ, NULL, 0,
 		TRANSMIT_DONT, P_PRESERVE);
     }
+    ReleaseData(dataPtr);
 
     /*
      * General cleanup.
      */
 
-    ResultClear(&dataPtr->result);
-    Tcl_DecrRefCount(dataPtr->command);
-    ckfree((char *) dataPtr);
+    ReleaseData(dataPtr);
     return TCL_OK;
 }
 
@@ -606,6 +624,7 @@ TransformInputProc(
     gotBytes = 0;
     downChan = Tcl_GetStackedChannel(dataPtr->self);
 
+    PreserveData(dataPtr);
     while (toRead > 0) {
 	/*
 	 * Loop until the request is satisfied (or no data is available from
@@ -623,7 +642,7 @@ TransformInputProc(
 	     * break out of the loop and return to the caller.
 	     */
 
-	    return gotBytes;
+	    break;
 	}
 
 	/*
@@ -647,7 +666,7 @@ TransformInputProc(
 	    }
 	} /* else: 'maxRead < 0' == Accept the current value of toRead. */
 	if (toRead <= 0) {
-	    return gotBytes;
+	    break;
 	}
 
 	/*
@@ -663,11 +682,12 @@ TransformInputProc(
 	     */
 
 	    if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
-		return gotBytes;
+		break;
 	    }
 
 	    *errorCodePtr = Tcl_GetErrno();
-	    return -1;
+	    gotBytes = -1;
+	    break;
 	} else if (read == 0) {
 	    /*
 	     * Check wether we hit on EOF in the underlying channel or not. If
@@ -682,9 +702,9 @@ TransformInputProc(
 	    if (!Tcl_Eof(downChan)) {
 		if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) {
 		    *errorCodePtr = EWOULDBLOCK;
-		    return -1;
+		    gotBytes = -1;
 		}
-		return gotBytes;
+		break;
 	    }
 
 	    if (dataPtr->readIsFlushed) {
@@ -692,7 +712,7 @@ TransformInputProc(
 		 * Already flushed, nothing to do anymore.
 		 */
 
-		return gotBytes;
+		break;
 	    }
 
 	    dataPtr->readIsFlushed = 1;
@@ -704,7 +724,7 @@ TransformInputProc(
 		 * We had nothing to flush.
 		 */
 
-		return gotBytes;
+		break;
 	    }
 
 	    continue;		/* at: while (toRead > 0) */
@@ -718,9 +738,11 @@ TransformInputProc(
 	if (ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read,
 		TRANSMIT_IBUF, P_PRESERVE) != TCL_OK) {
 	    *errorCodePtr = EINVAL;
-	    return -1;
+	    gotBytes = -1;
+	    break;
 	}
     } /* while toRead > 0 */
+    ReleaseData(dataPtr);
 
     return gotBytes;
 }
@@ -762,11 +784,13 @@ TransformOutputProc(
 	return 0;
     }
 
+    PreserveData(dataPtr);
     if (ExecuteCallback(dataPtr, NULL, A_WRITE, UCHARP(buf), toWrite,
 	    TRANSMIT_DOWN, P_NO_PRESERVE) != TCL_OK) {
 	*errorCodePtr = EINVAL;
-	return -1;
+	toWrite = -1;
     }
+    ReleaseData(dataPtr);
 
     return toWrite;
 }
@@ -819,6 +843,7 @@ TransformSeekProc(
      * request down, unchanged.
      */
 
+    PreserveData(dataPtr);
     if (dataPtr->mode & TCL_WRITABLE) {
 	ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
 		P_NO_PRESERVE);
@@ -830,6 +855,7 @@ TransformSeekProc(
 	ResultClear(&dataPtr->result);
 	dataPtr->readIsFlushed = 0;
     }
+    ReleaseData(dataPtr);
 
     return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode,
 	    errorCodePtr);
@@ -890,6 +916,7 @@ TransformWideSeekProc(
      * request down, unchanged.
      */
 
+    PreserveData(dataPtr);
     if (dataPtr->mode & TCL_WRITABLE) {
 	ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
 		P_NO_PRESERVE);
@@ -901,6 +928,7 @@ TransformWideSeekProc(
 	ResultClear(&dataPtr->result);
 	dataPtr->readIsFlushed = 0;
     }
+    ReleaseData(dataPtr);
 
     /*
      * If we have a wide seek capability, we should stick with that.
-- 
cgit v0.12


From f231f10b58b9f58583b664655b513d3f3ee0c382 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Wed, 23 Apr 2014 09:18:20 +0000
Subject: *nix segfault cleared: we should reset a thread key after freeing of
 alloc cache (in tclUnixThrd.c)

---
 unix/tclUnixThrd.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c
index ad36242..d30791d 100644
--- a/unix/tclUnixThrd.c
+++ b/unix/tclUnixThrd.c
@@ -814,6 +814,7 @@ TclpFreeAllocCache(
 	 */
 
 	TclFreeAllocCache(ptr);
+	pthread_setspecific(key, NULL);
 
     } else if (initialized) {
 	/*
-- 
cgit v0.12


From 790e5adaf4cabf6c9dcaa3d109427dbe18f786ff Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 24 Apr 2014 15:27:58 +0000
Subject: Make sure the ReflectedChannel struct is freed in the handler thread,
 where it was allocated.  This constraint allows the struct to safely hold
 Tcl_Obj values, which has been convenient for storing callback commands.

---
 generic/tclIORChan.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index e462f61..94428bb 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -1145,6 +1145,7 @@ ReflectClose(
 	    if (result != TCL_OK) {
 		FreeReceivedError(&p);
 	    }
+	    return EOK;
 	}
 #endif
 
@@ -1169,8 +1170,6 @@ ReflectClose(
 
         Tcl_DeleteEvents(ReflectEventDelete, rcPtr);
 
-        Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
-
 	if (result != TCL_OK) {
 	    PassReceivedErrorInterp(interp, &p);
 	}
@@ -2903,6 +2902,7 @@ ForwardProc(
                 Tcl_GetChannelName(rcPtr->chan));
 	Tcl_DeleteHashEntry(hPtr);
 
+	Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
 	break;
 
     case ForwardedInput: {
-- 
cgit v0.12


From 0781259dd17444340c1a926c4cd2b5ade72bfebe Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 25 Apr 2014 17:34:11 +0000
Subject: Test iortrans-4.8.2 demos an infinite loop.  Possible trouble with
 pushback buffers.

---
 generic/tclIO.c    |  5 +++++
 tests/ioTrans.test | 20 ++++++++++++++++++++
 2 files changed, 25 insertions(+)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index e6439ef..41ac1e1 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5611,6 +5611,11 @@ DoReadChars(
 		ResetFlag(statePtr, CHANNEL_BLOCKED);
 	    }
 	    result = GetInput(chanPtr);
+if (chanPtr != statePtr->topChanPtr) {
+Tcl_Release(chanPtr);
+chanPtr = statePtr->topChanPtr;
+Tcl_Preserve(chanPtr);
+}
 	    if (result != 0) {
 		if (result == EAGAIN) {
 		    break;
diff --git a/tests/ioTrans.test b/tests/ioTrans.test
index b21d894..3bbd170 100644
--- a/tests/ioTrans.test
+++ b/tests/ioTrans.test
@@ -559,6 +559,26 @@ test iortrans-4.8.1 {chan read, bug 721ec69271} -setup {
     rename foo {}
 } -result {{read rt* {test data
 }} file*}
+test iortrans-4.8.2 {chan read, bug 721ec69271} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {fd args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	# Kill and recreate transform while it is operating
+	chan pop $fd
+	chan push $fd [list foo $fd]
+	return x
+    }
+    set c [chan push [set c [tempchan]] [list foo $c]]
+    chan configure $c -buffersize 1
+    lappend res [read $c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{read rt* {test data
+}} file*}
 test iortrans-4.9 {chan read, gets, bug 2921116} -setup {
     set res {}
 } -match glob -body {
-- 
cgit v0.12


From 4119a864755c221944bcd1967b8243a2acc3d9aa Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 25 Apr 2014 19:51:36 +0000
Subject: Disable buffer recycling, which creates mysteries.

---
 generic/tclIO.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 41ac1e1..df863cc 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -2342,7 +2342,7 @@ RecycleBuffer(
      * Do we have to free the buffer to the OS?
      */
 
-    if (mustDiscard) {
+    if (1 || mustDiscard) {
 	ReleaseChannelBuffer(bufPtr);
 	return;
     }
-- 
cgit v0.12


From 1fc337bda0ffe4523e3a47f27077378b4c1349cf Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 25 Apr 2014 20:12:48 +0000
Subject: Disable buffer recycling to expose bugs for fixing.

---
 generic/tclIO.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index a60c97d..3f9ca0a 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -2270,7 +2270,7 @@ RecycleBuffer(
      * Do we have to free the buffer to the OS?
      */
 
-    if (mustDiscard) {
+    if (1 || mustDiscard) {
 	ReleaseChannelBuffer(bufPtr);
 	return;
     }
-- 
cgit v0.12


From 9a76d245a9dcf48449c6f147252a9be6b43abf09 Mon Sep 17 00:00:00 2001
From: ferrieux <ferrieux@users.sourceforge.net>
Date: Mon, 28 Apr 2014 20:28:10 +0000
Subject: Clarify fcopy manpage regarding its bidirectional uses. [1350564]

---
 doc/fcopy.n | 27 ++++++++++++++++++++++++---
 1 file changed, 24 insertions(+), 3 deletions(-)

diff --git a/doc/fcopy.n b/doc/fcopy.n
index ec3d5c6..071896c 100644
--- a/doc/fcopy.n
+++ b/doc/fcopy.n
@@ -46,8 +46,11 @@ non-blocking mode; the \fBfcopy\fR command takes care of that automatically.
 However, it is necessary to enter the event loop by using
 the \fBvwait\fR command or by using Tk.
 .PP
-You are not allowed to do other I/O operations with
-\fIinchan\fR or \fIoutchan\fR during a background \fBfcopy\fR.
+You are not allowed to do other input operations with \fIinchan\fR, or
+output operations with \fIoutchan\fR, during a background
+\fBfcopy\fR. The converse is entirely legitimate, as exhibited by the
+bidirectional fcopy example below.
+.PP
 If either \fIinchan\fR or \fIoutchan\fR get closed
 while the copy is in progress, the current copy is stopped
 and the command callback is \fInot\fR made.
@@ -57,7 +60,7 @@ then all data already queued for \fIoutchan\fR is written out.
 Note that \fIinchan\fR can become readable during a background copy.
 You should turn off any \fBfileevent\fR handlers during a background
 copy so those handlers do not interfere with the copy.
-Any I/O attempted by a \fBfileevent\fR handler will get a
+Any wrong-sided I/O attempted (by a \fBfileevent\fR handler or otherwise) will get a
 .QW "channel busy"
 error.
 .PP
@@ -149,6 +152,24 @@ set total 0
         -command [list CopyMore $in $out $chunk]
 vwait done
 .CE
+.PP
+The fourth example starts an asynchronous, bidirectional fcopy between
+two sockets. Those could also be pipes from two [open "|hal 9000" r+]
+(though their conversation would remain secret to the script, since
+all four fileevent slots are busy).
+.PP
+.CS
+set flows 2
+proc Done {dir args} {
+     global flows done
+     puts "$dir is over."
+     incr flows -1
+     if {$flows<=0} {set done 1}
+}
+\fBfcopy\fR $sok1 $sok2 -command [list Done UP]
+\fBfcopy\fR $sok2 $sok1 -command [list Done DOWN]
+vwait done
+.CE
 .SH "SEE ALSO"
 eof(n), fblocked(n), fconfigure(n), file(n)
 .SH KEYWORDS
-- 
cgit v0.12


From 0725c745416a8cfec6c72440cfc62d5fdc686f04 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 29 Apr 2014 15:54:03 +0000
Subject: Revise the logic for setting TCL_ENCODING_END in the
 outputEncodingFlags so it does not rely on buffer recycling.

---
 generic/tclIO.c | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 3f9ca0a..6ff8806 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -3142,7 +3142,8 @@ Tcl_Close(
 
     stickyError = 0;
 
-    if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
+    if ((statePtr->encoding != NULL)
+	    && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)
 	    && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
 	statePtr->outputEncodingFlags |= TCL_ENCODING_END;
 	if (WriteChars(chanPtr, "", 0) < 0) {
@@ -7330,7 +7331,8 @@ Tcl_SetChannelOption(
 	 * iso2022, the terminated escape sequence must write to the buffer.
 	 */
 
-	if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
+	if ((statePtr->encoding != NULL)
+		&& !(statePtr->outputEncodingFlags & TCL_ENCODING_START)
 		&& (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
 	    statePtr->outputEncodingFlags |= TCL_ENCODING_END;
 	    WriteChars(chanPtr, "", 0);
-- 
cgit v0.12


From 267c1eb9f4c15531f7bf4095ffb56151ad8f9203 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 29 Apr 2014 17:40:15 +0000
Subject: Make sure no shared ChannelBuffers get recycled.

---
 generic/tclIO.c | 11 +++++++++++
 1 file changed, 11 insertions(+)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 08d0d93..6831c47 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -164,6 +164,7 @@ typedef struct CloseCallback {
 static ChannelBuffer *	AllocChannelBuffer(int length);
 static void		PreserveChannelBuffer(ChannelBuffer *bufPtr);
 static void		ReleaseChannelBuffer(ChannelBuffer *bufPtr);
+static int		IsShared(ChannelBuffer *bufPtr);
 static void		ChannelTimerProc(ClientData clientData);
 static int		CheckChannelErrors(ChannelState *statePtr,
 			    int direction);
@@ -2239,6 +2240,13 @@ ReleaseChannelBuffer(
     }
     ckfree((char *) bufPtr);
 }
+
+static int
+IsShared(
+    ChannelBuffer *bufPtr)
+{
+    return bufPtr->refCount > 1;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -2269,6 +2277,9 @@ RecycleBuffer(
     /*
      * Do we have to free the buffer to the OS?
      */
+    if (IsShared(bufPtr)) {
+	mustDiscard = 1;
+    }
 
     if (mustDiscard) {
 	ReleaseChannelBuffer(bufPtr);
-- 
cgit v0.12


From 75c22ad9870b02a3a9b9d213a1d38a1e93a7f7e7 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 30 Apr 2014 19:12:37 +0000
Subject: Another segfault demo test, this one with [close] during [gets].

---
 tests/ioCmd.test | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 8bf32d2..d2c0173 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -806,6 +806,22 @@ test iocmd-21.22 {[close] in [read] segfaults} -setup {
     catch {close $ch}
     rename foo {}
 } -match glob -result {*invalid argument*}
+test iocmd-21.23 {[close] in [gets] segfaults} -setup {
+    proc foo {method chan args} {
+	switch -- $method initialize {
+	    return {initialize finalize watch read}
+	} finalize {} watch {} read {
+	    catch {close $chan}
+	    return \n
+	}
+    }
+    set ch [chan create read foo]
+} -body {
+    gets $ch
+} -returnCodes error -cleanup {
+    catch {close $ch}
+    rename foo {}
+} -match glob -result {*invalid argument*}
 
 # --- --- --- --------- --------- ---------
 # Helper commands to record the arguments to handler methods.
-- 
cgit v0.12


From 1264e873bbaae9d4328826b749e459e88b32e820 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 30 Apr 2014 19:33:21 +0000
Subject: Panic message to pinpoint the cause of iocmd-21.23 segfault.

---
 generic/tclIO.c | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 6831c47..0c9db67 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4570,6 +4570,9 @@ FilterInputBytes(
 	}
 	bufPtr = statePtr->inQueueTail;
 	gsPtr->bufPtr = bufPtr;
+	if (bufPtr == NULL) {
+	    Tcl_Panic("GetInput nuked buffers!");
+	}
     }
 
     /*
-- 
cgit v0.12


From 1c909a3352991d577a7164d5bb33dbe8d295ae67 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 30 Apr 2014 19:54:51 +0000
Subject: Stop the segfaults in [close] during [gets] tests. Not sure this is
 the right behavior, but it's better than crashing.

---
 generic/tclIO.c  | 23 ++++++++++++++---------
 tests/ioCmd.test | 21 +++++++++++++++++++--
 2 files changed, 33 insertions(+), 11 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 0c9db67..cd28a0e 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4163,12 +4163,12 @@ Tcl_GetsObj(
 
   restore:
     bufPtr = statePtr->inQueueHead;
-    if (bufPtr == NULL) {
-	Tcl_Panic("Tcl_GetsObj: restore reached with bufPtr==NULL");
+    if (bufPtr != NULL) {
+	bufPtr->nextRemoved = oldRemoved;
+	bufPtr = bufPtr->nextPtr;
     }
-    bufPtr->nextRemoved = oldRemoved;
 
-    for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
+    for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
 	bufPtr->nextRemoved = BUFFER_PADDING;
     }
     CommonGetsCleanup(chanPtr);
@@ -4298,6 +4298,9 @@ TclGetsObjBinary(
 		goto restore;
 	    }
 	    bufPtr = statePtr->inQueueTail;
+	    if (bufPtr == NULL) {
+		goto restore;
+	    }
 	}
 
 	dst = (unsigned char *) RemovePoint(bufPtr);
@@ -4410,12 +4413,12 @@ TclGetsObjBinary(
 
   restore:
     bufPtr = statePtr->inQueueHead;
-    if (bufPtr == NULL) {
-	Tcl_Panic("TclGetsObjBinary: restore reached with bufPtr==NULL");
+    if (bufPtr) {
+	bufPtr->nextRemoved = oldRemoved;
+	bufPtr = bufPtr->nextPtr;
     }
-    bufPtr->nextRemoved = oldRemoved;
 
-    for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
+    for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
 	bufPtr->nextRemoved = BUFFER_PADDING;
     }
     CommonGetsCleanup(chanPtr);
@@ -4571,7 +4574,9 @@ FilterInputBytes(
 	bufPtr = statePtr->inQueueTail;
 	gsPtr->bufPtr = bufPtr;
 	if (bufPtr == NULL) {
-	    Tcl_Panic("GetInput nuked buffers!");
+	    gsPtr->charsWrote = 0;
+	    gsPtr->rawRead = 0;
+	    return -1;
 	}
     }
 
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index d2c0173..bb133f9 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -818,10 +818,27 @@ test iocmd-21.23 {[close] in [gets] segfaults} -setup {
     set ch [chan create read foo]
 } -body {
     gets $ch
-} -returnCodes error -cleanup {
+} -cleanup {
     catch {close $ch}
     rename foo {}
-} -match glob -result {*invalid argument*}
+} -result {}
+test iocmd-21.24 {[close] in binary [gets] segfaults} -setup {
+    proc foo {method chan args} {
+	switch -- $method initialize {
+	    return {initialize finalize watch read}
+	} finalize {} watch {} read {
+	    catch {close $chan}
+	    return \n
+	}
+    }
+    set ch [chan create read foo]
+} -body {
+    chan configure $ch -translation binary
+    gets $ch
+} -cleanup {
+    catch {close $ch}
+    rename foo {}
+} -result {}
 
 # --- --- --- --------- --------- ---------
 # Helper commands to record the arguments to handler methods.
-- 
cgit v0.12


From 10d7a2ac566063ffdd10a932a0d610ae6ecd62dd Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 30 Apr 2014 21:24:39 +0000
Subject: [82e7f67325] Fix an evil refcount problem in compiled [string
 replace].

---
 generic/tclExecute.c  | 14 ++++++++++++--
 tests/stringComp.test | 34 +++++++++++++++++++++++++++++++++-
 2 files changed, 45 insertions(+), 3 deletions(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 2c136d7..4ecca5b 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5702,11 +5702,21 @@ TEBCresume(
 			length - toIdx);
 	    }
 	} else {
-	    objResultPtr = value3Ptr;
+	    /*
+	     * Be careful with splicing the stack in this case; we have a
+	     * refCount:1 object in value3Ptr and we want to append to it and
+	     * make it be the refCount:1 object at the top of the stack
+	     * afterwards. [Bug 82e7f67325]
+	     */
+
 	    if (toIdx < length) {
-		Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
+		Tcl_AppendUnicodeToObj(value3Ptr, ustring1 + toIdx + 1,
 			length - toIdx);
 	    }
+	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
+	    TclDecrRefCount(valuePtr);
+	    OBJ_AT_TOS = value3Ptr;	/* Tricky! */
+	    NEXT_INST_F(1, 0, 0);
 	}
 	TclDecrRefCount(value3Ptr);
 	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
diff --git a/tests/stringComp.test b/tests/stringComp.test
index 9e00ce7..39dac78 100644
--- a/tests/stringComp.test
+++ b/tests/stringComp.test
@@ -26,6 +26,22 @@ catch [list package require -exact Tcltest [info patchlevel]]
 # Some tests require the testobj command
 
 testConstraint testobj [expr {[info commands testobj] != {}}]
+testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+    proc getbytes {} {
+	set lines [split [memory info] \n]
+	return [lindex $lines 3 3]
+    }
+    proc leaktest {script {iterations 3}} {
+	set end [getbytes]
+	for {set i 0} {$i < $iterations} {incr i} {
+	    uplevel 1 $script
+	    set tmp $end
+	    set end [getbytes]
+	}
+	return [expr {$end - $tmp}]
+    }
+}
 
 test stringComp-1.1 {error conditions} {
     proc foo {} {string gorp a b}
@@ -687,7 +703,23 @@ test stringComp-12.1 {Bug 3588366: end-offsets before start} {
 ## not yet bc
 
 ## string replace
-## not yet bc
+test stringComp-14.1 {Bug 82e7f67325} {
+    apply {{} {
+	set a [join {a b} {}]
+	lappend b [string length [string replace ___! 0 2 $a]]
+	lappend b [string length [string replace ___! 0 2 $a[unset a]]]
+    }}
+} {3 3}
+test stringComp-14.2 {Bug 82e7f67325} {
+    # As in stringComp-14.1, but make sure we don't retain too many refs
+    leaktest {
+	apply {{} {
+	    set a [join {a b} {}]
+	    lappend b [string length [string replace ___! 0 2 $a]]
+	    lappend b [string length [string replace ___! 0 2 $a[unset a]]]
+	}}
+    }
+} {0}
 
 ## string tolower
 ## not yet bc
-- 
cgit v0.12


From 7df749abdc0780eb176e6fade94388d60cd8a0ef Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 30 Apr 2014 21:59:00 +0000
Subject: Better (safer) fix for [0e92c404f1]

---
 generic/tclCmdMZ.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 6fd468c..d106f53 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -2086,7 +2086,7 @@ StringRangeCmd(
      * Unicode string rep to get the range.
      */
 
-    if (objv[1]->typePtr == &tclByteArrayType) {
+    if (objv[1]->typePtr == &tclByteArrayType && (objv[1]->bytes==NULL)) {
 	string = Tcl_GetByteArrayFromObj(objv[1], &length);
 	length--;
     } else {
-- 
cgit v0.12


From f715c2fad2a69457bbcbdf99167c66a3f62ed3a5 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 1 May 2014 01:15:42 +0000
Subject: missing constraint

---
 tests/stringComp.test | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/stringComp.test b/tests/stringComp.test
index 39dac78..0d134b5 100644
--- a/tests/stringComp.test
+++ b/tests/stringComp.test
@@ -710,7 +710,7 @@ test stringComp-14.1 {Bug 82e7f67325} {
 	lappend b [string length [string replace ___! 0 2 $a[unset a]]]
     }}
 } {3 3}
-test stringComp-14.2 {Bug 82e7f67325} {
+test stringComp-14.2 {Bug 82e7f67325} memory {
     # As in stringComp-14.1, but make sure we don't retain too many refs
     leaktest {
 	apply {{} {
-- 
cgit v0.12


From 1c52941e5f67f7f374dbc110234bf18a7ac4844a Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 1 May 2014 07:38:27 +0000
Subject: Fix more corner-cases like
 [0e92c404f19ede5b2eb06e6db27647d3138cc56|0e92c404f1]: The only place where a
 type of &tclByteArrayType can be trusted is when determining its length,
 because the character length of a (UTF-8) string is always equal to the byte
 length of the byte array.

---
 generic/tclCmdMZ.c   | 12 ++++++------
 generic/tclExecute.c | 10 +++++-----
 generic/tclInt.h     | 18 ++++++++++++++++++
 generic/tclUtil.c    |  2 +-
 4 files changed, 30 insertions(+), 12 deletions(-)

diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index d106f53..70943e9 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1345,7 +1345,7 @@ StringIndexCmd(
      * Unicode string rep to get the index'th char.
      */
 
-    if (objv[1]->typePtr == &tclByteArrayType) {
+    if (TclIsPureByteArray(objv[1])) {
 	const unsigned char *string =
 		Tcl_GetByteArrayFromObj(objv[1], &length);
 
@@ -2086,7 +2086,7 @@ StringRangeCmd(
      * Unicode string rep to get the range.
      */
 
-    if (objv[1]->typePtr == &tclByteArrayType && (objv[1]->bytes==NULL)) {
+    if (TclIsPureByteArray(objv[1])) {
 	string = Tcl_GetByteArrayFromObj(objv[1], &length);
 	length--;
     } else {
@@ -2537,8 +2537,8 @@ StringEqualCmd(
 	return TCL_OK;
     }
 
-    if (!nocase && objv[0]->typePtr == &tclByteArrayType &&
-	    objv[1]->typePtr == &tclByteArrayType) {
+    if (!nocase && TclIsPureByteArray(objv[0]) &&
+	    TclIsPureByteArray(objv[1])) {
 	/*
 	 * Use binary versions of comparisons since that won't cause undue
 	 * type conversions and it is much faster. Only do this if we're
@@ -2684,8 +2684,8 @@ StringCmpCmd(
 	return TCL_OK;
     }
 
-    if (!nocase && objv[0]->typePtr == &tclByteArrayType &&
-	    objv[1]->typePtr == &tclByteArrayType) {
+    if (!nocase && TclIsPureByteArray(objv[0]) &&
+	    TclIsPureByteArray(objv[1])) {
 	/*
 	 * Use binary versions of comparisons since that won't cause undue
 	 * type conversions and it is much faster. Only do this if we're
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 2e396e8..c4f9836 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4235,8 +4235,8 @@ TclExecuteByteCode(
 	     */
 
 	    iResult = s1len = s2len = 0;
-	} else if ((valuePtr->typePtr == &tclByteArrayType)
-		&& (value2Ptr->typePtr == &tclByteArrayType)) {
+	} else if (TclIsPureByteArray(valuePtr)
+		&& TclIsPureByteArray(value2Ptr)) {
 	    s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
 	    s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
 	    iResult = memcmp(s1, s2,
@@ -4354,7 +4354,7 @@ TclExecuteByteCode(
 	 * use the Unicode string rep to get the index'th char.
 	 */
 
-	if (valuePtr->typePtr == &tclByteArrayType) {
+	if (TclIsPureByteArray(valuePtr)) {
 	    bytes = (char *)Tcl_GetByteArrayFromObj(valuePtr, &length);
 	} else {
 	    /*
@@ -4370,7 +4370,7 @@ TclExecuteByteCode(
 	}
 
 	if ((index >= 0) && (index < length)) {
-	    if (valuePtr->typePtr == &tclByteArrayType) {
+	    if (TclIsPureByteArray(valuePtr)) {
 		objResultPtr = Tcl_NewByteArrayObj((unsigned char *)
 			(&bytes[index]), 1);
 	    } else if (valuePtr->bytes && length == valuePtr->length) {
@@ -4422,7 +4422,7 @@ TclExecuteByteCode(
 	    ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
 	    match = TclUniCharMatch(ustring1, length1, ustring2, length2,
 		    nocase);
-	} else if ((valuePtr->typePtr == &tclByteArrayType) && !nocase) {
+	} else if (TclIsPureByteArray(valuePtr) && !nocase) {
 	    unsigned char *string1, *string2;
 	    int length1, length2;
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 00b246b..2353450 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3668,6 +3668,24 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, CONST char *file,
 
 /*
  *----------------------------------------------------------------
+ * Macro that encapsulates the logic that determines when it is safe to
+ * interpret a string as a byte array directly. In summary, the object must be
+ * a byte array and must not have a string representation (as the operations
+ * that it is used in are defined on strings, not byte arrays). Theoretically
+ * it is possible to also be efficient in the case where the object's bytes
+ * field is filled by generation from the byte array (c.f. list canonicality)
+ * but we don't do that at the moment since this is purely about efficiency.
+ * The ANSI C "prototype" for this macro is:
+ *
+ * MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
+ *----------------------------------------------------------------
+ */
+
+#define TclIsPureByteArray(objPtr) \
+	(((objPtr)->typePtr==&tclByteArrayType) && ((objPtr)->bytes==NULL))
+
+/*
+ *----------------------------------------------------------------
  * Macro used by the Tcl core to compare Unicode strings. On big-endian
  * systems we can use the more efficient memcmp, but this would not be
  * lexically correct on little-endian systems. The ANSI C "prototype" for
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 5f4cdae..8c6adfe 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -2334,7 +2334,7 @@ TclStringMatchObj(
 	udata = Tcl_GetUnicodeFromObj(strObj, &length);
 	uptn  = Tcl_GetUnicodeFromObj(ptnObj, &plen);
 	match = TclUniCharMatch(udata, length, uptn, plen, flags);
-    } else if ((strObj->typePtr == &tclByteArrayType) && !flags) {
+    } else if (TclIsPureByteArray(strObj) && !flags) {
 	unsigned char *data, *ptn;
 
 	data = Tcl_GetByteArrayFromObj(strObj, &length);
-- 
cgit v0.12


From f90303fa441e484833044f364aae0974a6a705d4 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 1 May 2014 09:11:09 +0000
Subject: make doubly sure that things which should be unshared stay unshared

---
 tests/stringComp.test | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/tests/stringComp.test b/tests/stringComp.test
index 0d134b5..165ef20 100644
--- a/tests/stringComp.test
+++ b/tests/stringComp.test
@@ -704,20 +704,20 @@ test stringComp-12.1 {Bug 3588366: end-offsets before start} {
 
 ## string replace
 test stringComp-14.1 {Bug 82e7f67325} {
-    apply {{} {
-	set a [join {a b} {}]
+    apply {x {
+	set a [join $x {}]
 	lappend b [string length [string replace ___! 0 2 $a]]
 	lappend b [string length [string replace ___! 0 2 $a[unset a]]]
-    }}
+    }} {a b}
 } {3 3}
 test stringComp-14.2 {Bug 82e7f67325} memory {
     # As in stringComp-14.1, but make sure we don't retain too many refs
     leaktest {
-	apply {{} {
-	    set a [join {a b} {}]
+	apply {x {
+	    set a [join $x {}]
 	    lappend b [string length [string replace ___! 0 2 $a]]
 	    lappend b [string length [string replace ___! 0 2 $a[unset a]]]
-	}}
+	}} {a b}
     }
 } {0}
 
-- 
cgit v0.12


From cf5a2fcdb5b8dd834e530641922f7ba5c841553f Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 1 May 2014 14:18:35 +0000
Subject: We must Preserve channels if we're going to use
 TclChanCaughtErrorBypass() to get error information after channel routines
 are called (and have possibly called for the channel to go away).

---
 generic/tclIOCmd.c | 26 ++++++++++++++++++++++----
 1 file changed, 22 insertions(+), 4 deletions(-)

diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 7e8e91a..b206303 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -177,6 +177,7 @@ Tcl_PutsObjCmd(
 	return TCL_ERROR;
     }
 
+    Tcl_Preserve(chan);
     result = Tcl_WriteObj(chan, string);
     if (result < 0) {
 	goto error;
@@ -187,6 +188,7 @@ Tcl_PutsObjCmd(
 	    goto error;
 	}
     }
+    Tcl_Release(chan);
     return TCL_OK;
 
     /*
@@ -202,6 +204,7 @@ Tcl_PutsObjCmd(
 		TclGetString(chanObjPtr), "\": ",
 		Tcl_PosixError(interp), NULL);
     }
+    Tcl_Release(chan);
     return TCL_ERROR;
 }
 
@@ -248,6 +251,7 @@ Tcl_FlushObjCmd(
 	return TCL_ERROR;
     }
 
+    Tcl_Preserve(chan);
     if (Tcl_Flush(chan) != TCL_OK) {
 	/*
 	 * TIP #219.
@@ -261,8 +265,10 @@ Tcl_FlushObjCmd(
 		    TclGetString(chanObjPtr), "\": ",
 		    Tcl_PosixError(interp), NULL);
 	}
+	Tcl_Release(chan);
 	return TCL_ERROR;
     }
+    Tcl_Release(chan);
     return TCL_OK;
 }
 
@@ -295,6 +301,7 @@ Tcl_GetsObjCmd(
     int lineLen;		/* Length of line just read. */
     int mode;			/* Mode in which channel is opened. */
     Tcl_Obj *linePtr, *chanObjPtr;
+    int code = TCL_OK;
 
     if ((objc != 2) && (objc != 3)) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
@@ -310,6 +317,7 @@ Tcl_GetsObjCmd(
 	return TCL_ERROR;
     }
 
+    Tcl_Preserve(chan);
     linePtr = Tcl_NewObj();
     lineLen = Tcl_GetsObj(chan, linePtr);
     if (lineLen < 0) {
@@ -329,7 +337,8 @@ Tcl_GetsObjCmd(
 			TclGetString(chanObjPtr), "\": ",
 			Tcl_PosixError(interp), NULL);
 	    }
-	    return TCL_ERROR;
+	    code = TCL_ERROR;
+	    goto done;
 	}
 	lineLen = -1;
     }
@@ -339,11 +348,12 @@ Tcl_GetsObjCmd(
 	    return TCL_ERROR;
 	}
 	Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
-	return TCL_OK;
     } else {
 	Tcl_SetObjResult(interp, linePtr);
     }
-    return TCL_OK;
+  done:
+    Tcl_Release(chan);
+    return code;
 }
 
 /*
@@ -542,6 +552,7 @@ Tcl_SeekObjCmd(
 	mode = modeArray[optionIndex];
     }
 
+    Tcl_Preserve(chan);
     result = Tcl_Seek(chan, offset, mode);
     if (result == Tcl_LongAsWide(-1)) {
 	/*
@@ -555,8 +566,10 @@ Tcl_SeekObjCmd(
 		    TclGetString(objv[1]), "\": ",
 		    Tcl_PosixError(interp), NULL);
 	}
+	Tcl_Release(chan);
 	return TCL_ERROR;
     }
+    Tcl_Release(chan);
     return TCL_OK;
 }
 
@@ -587,6 +600,7 @@ Tcl_TellObjCmd(
 {
     Tcl_Channel chan;		/* The channel to tell on. */
     Tcl_WideInt newLoc;
+    int code;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
@@ -602,6 +616,7 @@ Tcl_TellObjCmd(
 	return TCL_ERROR;
     }
 
+    Tcl_Preserve(chan);
     newLoc = Tcl_Tell(chan);
 
     /*
@@ -610,7 +625,10 @@ Tcl_TellObjCmd(
      * them into the regular interpreter result.
      */
 
-    if (TclChanCaughtErrorBypass(interp, chan)) {
+
+    code  = TclChanCaughtErrorBypass(interp, chan);
+    Tcl_Release(chan);
+    if (code) {
 	return TCL_ERROR;
     }
 
-- 
cgit v0.12


From b18161555e63f857014d2306adcb9fbcad3c6144 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 1 May 2014 16:33:39 +0000
Subject: Stop the segfault in iogt-2.4.  First by changing the
 UpdateInterest() call that triggers it.  "downChanPtr" may no longer be the
 right argument at that point.  Second, after ending the segfault, the test
 became an infinite loop (nested unstacking?!  whoa.), so revised the test to
 one that terminates (and passes).  Left behind a comment that the recursive
 unstacking case may require more examination.

---
 generic/tclIO.c | 9 ++++++++-
 tests/iogt.test | 2 +-
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 776ff12..a83cdcd 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -1876,6 +1876,13 @@ Tcl_UnstackChannel(
 	 * into the old structure.
 	 */
 
+	/*
+	 * TODO: Figure out how to handle the situation where the chan
+	 * operations called below by this unstacking operation cause
+	 * another unstacking recursively.  In that case the downChanPtr
+	 * value we're holding on to will not be the right thing.
+	 */
+
 	Channel *downChanPtr = chanPtr->downChanPtr;
 
 	/*
@@ -1980,7 +1987,7 @@ Tcl_UnstackChannel(
 	 */
 
 	Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
-	UpdateInterest(downChanPtr);
+	UpdateInterest(statePtr->topChanPtr);
 
 	if (result != 0) {
 	    Tcl_SetErrno(result);
diff --git a/tests/iogt.test b/tests/iogt.test
index bd3c67b..ded8bb9 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -228,7 +228,7 @@ proc id_torture {chan op data} {
 	delete/read  -
 	clear_read   {;#ignore}
 	flush/write -
-	flush/read  -
+	flush/read  {}
 	write       -
 	read        {
 	    testchannel unstack $chan
-- 
cgit v0.12


From 4f1714013f16d9993d2d68175d81fdb91ffc8190 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 2 May 2014 12:39:14 +0000
Subject: Re-enable buffer recycling.

---
 generic/tclIO.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index a83cdcd..8ae2fd2 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -2360,7 +2360,7 @@ RecycleBuffer(
 	mustDiscard = 1;
     }
 
-    if (1 || mustDiscard) {
+    if (mustDiscard) {
 	ReleaseChannelBuffer(bufPtr);
 	return;
     }
-- 
cgit v0.12


From 3452d681c93ec5cab5edc2d45bbd0d02f9beadb1 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 2 May 2014 13:02:48 +0000
Subject: Fully restore topChan resetting to accommodate self-restacking
 channels.

---
 generic/tclIO.c | 43 ++++++++++++++++++++++++++-----------------
 1 file changed, 26 insertions(+), 17 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 8ae2fd2..adea32e 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4554,9 +4554,12 @@ Tcl_GetsObj(
      * Regenerate the top channel, in case it was changed due to
      * self-modifying reflected transforms.
      */
-    /*
-    chanPtr = statePtr->topChanPtr;
-     */
+
+    if (chanPtr != statePtr->topChanPtr) {
+	Tcl_Release(chanPtr);
+	chanPtr = statePtr->topChanPtr;
+	Tcl_Preserve(chanPtr);
+    }
 
     bufPtr = gs.bufPtr;
     if (bufPtr == NULL) {
@@ -4590,9 +4593,11 @@ Tcl_GetsObj(
      * Regenerate the top channel, in case it was changed due to
      * self-modifying reflected transforms.
      */
-    /*
-    chanPtr = statePtr->topChanPtr;
-     */
+    if (chanPtr != statePtr->topChanPtr) {
+	Tcl_Release(chanPtr);
+	chanPtr = statePtr->topChanPtr;
+	Tcl_Preserve(chanPtr);
+    }
     bufPtr = statePtr->inQueueHead;
     if (bufPtr != NULL) {
 	bufPtr->nextRemoved = oldRemoved;
@@ -4632,9 +4637,11 @@ Tcl_GetsObj(
      * Regenerate the top channel, in case it was changed due to
      * self-modifying reflected transforms.
      */
-    /*
-    chanPtr = statePtr->topChanPtr;
-     */
+    if (chanPtr != statePtr->topChanPtr) {
+	Tcl_Release(chanPtr);
+	chanPtr = statePtr->topChanPtr;
+	Tcl_Preserve(chanPtr);
+    }
     UpdateInterest(chanPtr);
     Tcl_Release(chanPtr);
     return copiedTotal;
@@ -5638,11 +5645,11 @@ DoReadChars(
 		ResetFlag(statePtr, CHANNEL_BLOCKED);
 	    }
 	    result = GetInput(chanPtr);
-if (chanPtr != statePtr->topChanPtr) {
-Tcl_Release(chanPtr);
-chanPtr = statePtr->topChanPtr;
-Tcl_Preserve(chanPtr);
-}
+	    if (chanPtr != statePtr->topChanPtr) {
+		Tcl_Release(chanPtr);
+		chanPtr = statePtr->topChanPtr;
+		Tcl_Preserve(chanPtr);
+	    }
 	    if (result != 0) {
 		if (result == EAGAIN) {
 		    break;
@@ -5673,9 +5680,11 @@ Tcl_Preserve(chanPtr);
      * Regenerate the top channel, in case it was changed due to
      * self-modifying reflected transforms.
      */
-    /*
-    chanPtr = statePtr->topChanPtr;
-     */
+    if (chanPtr != statePtr->topChanPtr) {
+	Tcl_Release(chanPtr);
+	chanPtr = statePtr->topChanPtr;
+	Tcl_Preserve(chanPtr);
+    }
     UpdateInterest(chanPtr);
     Tcl_Release(chanPtr);
     return copied;
-- 
cgit v0.12


From ab2c4a52f1dbcc67939ad86233d21cf7fc38a5cd Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 2 May 2014 14:45:03 +0000
Subject: Add some comments about possible other self-restacking troubles.

---
 generic/tclIO.c | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index adea32e..58c7b3c 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -1747,6 +1747,10 @@ Tcl_StackChannel(
 	statePtr->csPtrR = NULL;
 	statePtr->csPtrW = NULL;
 
+	/*
+	 * TODO: Examine what can go wrong if Tcl_Flush() call disturbs
+	 * the stacking state of this channel during its operations.
+	 */
 	if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
 	    statePtr->csPtrR = csPtrR;
 	    statePtr->csPtrW = csPtrW;
@@ -9786,12 +9790,15 @@ StackSetBlockMode(
 {
     int result = 0;
     Tcl_DriverBlockModeProc *blockModeProc;
+    ChannelState *statePtr = chanPtr->state;
 
     /*
      * Start at the top of the channel stack
+     * TODO: Examine what can go wrong when blockModeProc calls
+     * disturb the stacking state of the channel.
      */
 
-    chanPtr = chanPtr->state->topChanPtr;
+    chanPtr = statePtr->topChanPtr;
     while (chanPtr != NULL) {
 	blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
 	if (blockModeProc != NULL) {
-- 
cgit v0.12


From 60ed1a9051fbb233b229facc524d7a2aed49a18b Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
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" <nijtmans@users.sourceforge.net>
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 b0f443a7d7b38c2220cfb1b1c0710a804f55c811 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 5 May 2014 09:17:46 +0000
Subject: Backport "GotFlag" macro from Tcl 8.6. Makes code more readable. No
 change in functionality.

---
 generic/tclIO.c | 186 +++++++++++++++++++++++++++-----------------------------
 1 file changed, 89 insertions(+), 97 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 46a17f5..2f652e7 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -298,6 +298,7 @@ static int WillRead(Channel *chanPtr);
 
 #define SetFlag(statePtr, flag)		((statePtr)->flags |= (flag))
 #define ResetFlag(statePtr, flag)	((statePtr)->flags &= ~(flag))
+#define GotFlag(statePtr, flag)		((statePtr)->flags & (flag))
 
 /*
  * Macro for testing whether a string (in optionName, length len) matches a
@@ -463,7 +464,7 @@ TclFinalizeIOSubsystem(void)
 		statePtr != NULL;
 		statePtr = statePtr->nextCSPtr) {
 	    chanPtr = statePtr->topChanPtr;
-	    if (!(statePtr->flags & (CHANNEL_INCLOSE|CHANNEL_CLOSED|CHANNEL_DEAD))) {
+	    if (!GotFlag(statePtr, CHANNEL_INCLOSE|CHANNEL_CLOSED|CHANNEL_DEAD)) {
 		active = 1;
 		break;
 	    }
@@ -560,6 +561,7 @@ Tcl_SetStdChannel(
     int type)			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
     switch (type) {
     case TCL_STDIN:
 	tsdPtr->stdinInitialized = 1;
@@ -676,11 +678,9 @@ Tcl_CreateCloseHandler(
     ClientData clientData)	/* Arbitrary data to pass to the close
 				 * callback. */
 {
-    ChannelState *statePtr;
+    ChannelState *statePtr = ((Channel *) chan)->state;
     CloseCallback *cbPtr;
 
-    statePtr = ((Channel *) chan)->state;
-
     cbPtr = (CloseCallback *) ckalloc(sizeof(CloseCallback));
     cbPtr->proc = proc;
     cbPtr->clientData = clientData;
@@ -716,10 +716,9 @@ Tcl_DeleteCloseHandler(
     ClientData clientData)	/* The callback data for the callback to
 				 * remove. */
 {
-    ChannelState *statePtr;
+    ChannelState *statePtr = ((Channel *) chan)->state;
     CloseCallback *cbPtr, *cbPrevPtr;
 
-    statePtr = ((Channel *) chan)->state;
     for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = NULL;
 	    cbPtr != NULL; cbPtr = cbPtr->nextPtr) {
 	if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
@@ -873,7 +872,7 @@ DeleteChannelTable(
 	SetFlag(statePtr, CHANNEL_TAINTED);
 	statePtr->refCount--;
 	if (statePtr->refCount <= 0) {
-	    if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+	    if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
 		(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
 	    }
 	}
@@ -1064,7 +1063,7 @@ Tcl_UnregisterChannel(
 
     statePtr = ((Channel *) chan)->state->bottomChanPtr->state;
 
-    if (statePtr->flags & CHANNEL_INCLOSE) {
+    if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
 	if (interp != NULL) {
 	    Tcl_AppendResult(interp, "Illegal recursive call to close "
 		    "through close-handler of channel", NULL);
@@ -1103,12 +1102,12 @@ Tcl_UnregisterChannel(
 	    SetFlag(statePtr, BUFFER_READY);
 	}
 	Tcl_Preserve((ClientData)statePtr);
-	if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+	if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
 	    /*
 	     * We don't want to re-enter Tcl_Close().
 	     */
 
-	    if (!(statePtr->flags & CHANNEL_CLOSED)) {
+	    if (!GotFlag(statePtr, CHANNEL_CLOSED)) {
 		if (Tcl_Close(interp, chan) != TCL_OK) {
 		    SetFlag(statePtr, CHANNEL_CLOSED);
 		    Tcl_Release((ClientData)statePtr);
@@ -1317,7 +1316,7 @@ Tcl_GetChannel(
     chanPtr = Tcl_GetHashValue(hPtr);
     chanPtr = chanPtr->state->bottomChanPtr;
     if (modePtr != NULL) {
-	*modePtr = (chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE));
+	*modePtr = chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE);
     }
 
     return (Tcl_Channel) chanPtr;
@@ -1365,7 +1364,7 @@ TclGetChannelFromObj(
     *channelPtr = (Tcl_Channel) (statePtr->bottomChanPtr);
 
     if (modePtr != NULL) {
-	*modePtr = (statePtr->flags & (TCL_READABLE|TCL_WRITABLE));
+	*modePtr = statePtr->flags & (TCL_READABLE|TCL_WRITABLE);
     }
 
     return TCL_OK;
@@ -1645,13 +1644,10 @@ Tcl_StackChannel(
      */
 
     if ((mask & TCL_WRITABLE) != 0) {
-        CopyState *csPtrR;
-        CopyState *csPtrW;
+	CopyState *csPtrR = statePtr->csPtrR;
+	CopyState *csPtrW = statePtr->csPtrW;
 
-        csPtrR           = statePtr->csPtrR;
 	statePtr->csPtrR = NULL;
-
-        csPtrW           = statePtr->csPtrW;
 	statePtr->csPtrW = NULL;
 
 	/*
@@ -1807,14 +1803,11 @@ Tcl_UnstackChannel(
 	 * CheckForChannelErrors inside.
 	 */
 
-	if (statePtr->flags & TCL_WRITABLE) {
-	    CopyState *csPtrR;
-	    CopyState *csPtrW;
+	if (GotFlag(statePtr, TCL_WRITABLE)) {
+	    CopyState *csPtrR = statePtr->csPtrR;
+	    CopyState *csPtrW = statePtr->csPtrW;
 
-	    csPtrR           = statePtr->csPtrR;
 	    statePtr->csPtrR = NULL;
-
-	    csPtrW           = statePtr->csPtrW;
 	    statePtr->csPtrW = NULL;
 
 	    if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) {
@@ -1851,16 +1844,14 @@ Tcl_UnstackChannel(
 	 * 'DiscardInputQueued' on that.
 	 */
 
-	if ((((statePtr->flags & TCL_READABLE) != 0)) &&
+	if (GotFlag(statePtr, TCL_READABLE) &&
 		((statePtr->inQueueHead != NULL) ||
 		(chanPtr->inQueueHead != NULL))) {
-
 	    if ((statePtr->inQueueHead != NULL) &&
 		    (chanPtr->inQueueHead != NULL)) {
 		statePtr->inQueueTail->nextPtr = chanPtr->inQueueHead;
 		statePtr->inQueueTail = chanPtr->inQueueTail;
 		statePtr->inQueueHead = statePtr->inQueueTail;
-
 	    } else if (chanPtr->inQueueHead != NULL) {
 		statePtr->inQueueHead = chanPtr->inQueueHead;
 		statePtr->inQueueTail = chanPtr->inQueueTail;
@@ -2312,7 +2303,7 @@ RecycleBuffer(
      * Only save buffers for the input queue if the channel is readable.
      */
 
-    if (statePtr->flags & TCL_READABLE) {
+    if (GotFlag(statePtr, TCL_READABLE)) {
 	if (statePtr->inQueueHead == NULL) {
 	    statePtr->inQueueHead = bufPtr;
 	    statePtr->inQueueTail = bufPtr;
@@ -2328,7 +2319,7 @@ RecycleBuffer(
      * Only save buffers for the output queue if the channel is writable.
      */
 
-    if (statePtr->flags & TCL_WRITABLE) {
+    if (GotFlag(statePtr, TCL_WRITABLE)) {
 	if (statePtr->curOutPtr == NULL) {
 	    statePtr->curOutPtr = bufPtr;
 	    goto keepBuffer;
@@ -2401,7 +2392,7 @@ CheckForDeadChannel(
     Tcl_Interp *interp,		/* For error reporting (can be NULL) */
     ChannelState *statePtr)	/* The channel state to check. */
 {
-    if (statePtr->flags & CHANNEL_DEAD) {
+    if (GotFlag(statePtr, CHANNEL_DEAD)) {
 	Tcl_SetErrno(EINVAL);
 	if (interp) {
 	    Tcl_AppendResult(interp,
@@ -2477,7 +2468,7 @@ FlushChannel(
 
 	if (((statePtr->curOutPtr != NULL) &&
 		IsBufferFull(statePtr->curOutPtr))
-		|| ((statePtr->flags & BUFFER_READY) &&
+		|| (GotFlag(statePtr, BUFFER_READY) &&
 			(statePtr->outQueueHead == NULL))) {
 	    ResetFlag(statePtr, BUFFER_READY);
 	    statePtr->curOutPtr->nextPtr = NULL;
@@ -2496,8 +2487,7 @@ FlushChannel(
 	 * is active, we just return without producing any output.
 	 */
 
-	if ((!calledFromAsyncFlush) &&
-		(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+	if (!calledFromAsyncFlush && GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
 	    return 0;
 	}
 
@@ -2551,7 +2541,7 @@ FlushChannel(
 		 * it's a tty channel (dup'ed underneath)
 		 */
 
-		if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+		if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
 		    SetFlag(statePtr, BG_FLUSH_SCHEDULED);
 		    UpdateInterest(chanPtr);
 		}
@@ -2651,7 +2641,7 @@ FlushChannel(
      * data has been flushed at the system level.
      */
 
-    if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+    if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
 	if (wroteSome) {
 	    return errorCode;
 	} else if (statePtr->outQueueHead == NULL) {
@@ -2667,7 +2657,7 @@ FlushChannel(
      * current output buffer.
      */
 
-    if ((statePtr->flags & CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
+    if (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
 	    (statePtr->outQueueHead == NULL) &&
 	    ((statePtr->curOutPtr == NULL) ||
 	    IsBufferEmpty(statePtr->curOutPtr))) {
@@ -2743,7 +2733,7 @@ CloseChannel(
      * device.
      */
 
-    if ((statePtr->outEofChar != 0) && (statePtr->flags & TCL_WRITABLE)) {
+    if ((statePtr->outEofChar != 0) && GotFlag(statePtr, TCL_WRITABLE)) {
 	int dummy;
 	char c = (char) statePtr->outEofChar;
 
@@ -3148,7 +3138,7 @@ Tcl_Close(
 	Tcl_Panic("called Tcl_Close on channel with refCount > 0");
     }
 
-    if (statePtr->flags & CHANNEL_INCLOSE) {
+    if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
 	if (interp) {
 	    Tcl_AppendResult(interp, "Illegal recursive call to close "
 		    "through close-handler of channel", NULL);
@@ -3673,7 +3663,7 @@ Write(
 
     endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);
 
-    if ((statePtr->flags & CHANNEL_LINEBUFFERED)
+    if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)
 	    || (statePtr->outputTranslation != TCL_TRANSLATE_LF)) {
 	nextNewLine = memchr(src, '\n', srcLen);
     }
@@ -3803,8 +3793,8 @@ Write(
 	}
 	ReleaseChannelBuffer(bufPtr);
     }
-    if ((flushed < total) && (statePtr->flags & CHANNEL_UNBUFFERED ||
-	    (needNlFlush && statePtr->flags & CHANNEL_LINEBUFFERED))) {
+    if ((flushed < total) && (GotFlag(statePtr, CHANNEL_UNBUFFERED) ||
+	    (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED)))) {
 	SetFlag(statePtr, BUFFER_READY);
 	if (FlushChannel(NULL, chanPtr, 0) != 0) {
 	    return -1;
@@ -4049,7 +4039,7 @@ Tcl_GetsObj(
 	case TCL_TRANSLATE_AUTO:
 	    eol = dst;
 	    skip = 1;
-	    if (statePtr->flags & INPUT_SAW_CR) {
+	    if (GotFlag(statePtr, INPUT_SAW_CR)) {
 		ResetFlag(statePtr, INPUT_SAW_CR);
 		if ((eol < dstEnd) && (*eol == '\n')) {
 		    /*
@@ -4117,7 +4107,7 @@ Tcl_GetsObj(
 	    SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
 	    statePtr->inputEncodingFlags |= TCL_ENCODING_END;
 	}
-	if (statePtr->flags & CHANNEL_EOF) {
+	if (GotFlag(statePtr, CHANNEL_EOF)) {
 	    skip = 0;
 	    eol = dstEnd;
 	    if (eol == objPtr->bytes + oldLength) {
@@ -4328,8 +4318,8 @@ TclGetsObjBinary(
 	     * device. Side effect is to allocate another channel buffer.
 	     */
 
-	    if (statePtr->flags & CHANNEL_BLOCKED) {
-		if (statePtr->flags & CHANNEL_NONBLOCKING) {
+	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
 		    goto restore;
 		}
 		ResetFlag(statePtr, CHANNEL_BLOCKED);
@@ -4383,7 +4373,7 @@ TclGetsObjBinary(
 	    SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
 	    statePtr->inputEncodingFlags |= TCL_ENCODING_END;
 	}
-	if (statePtr->flags & CHANNEL_EOF) {
+	if (GotFlag(statePtr, CHANNEL_EOF)) {
 	    skip = 0;
 	    eol = dstEnd;
 	    if ((dst == dstEnd) && (byteLen == oldLength)) {
@@ -4598,8 +4588,8 @@ FilterInputBytes(
 	 */
 
     read:
-	if (statePtr->flags & CHANNEL_BLOCKED) {
-	    if (statePtr->flags & CHANNEL_NONBLOCKING) {
+	if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+	    if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
 		gsPtr->charsWrote = 0;
 		gsPtr->rawRead = 0;
 		return -1;
@@ -4684,7 +4674,7 @@ FilterInputBytes(
 		 * returning those UTF-8 characters because a EOL might be
 		 * present in them.
 		 */
-	    } else if (statePtr->flags & CHANNEL_EOF) {
+	    } else if (GotFlag(statePtr, CHANNEL_EOF)) {
 		/*
 		 * There was a partial character followed by EOF on the
 		 * device. Fall through, returning that nothing was found.
@@ -4706,7 +4696,7 @@ FilterInputBytes(
 		statePtr->inQueueTail = nextPtr;
 	    }
 	    extra = rawLen - gsPtr->rawRead;
-	    memcpy(nextPtr->buf + BUFFER_PADDING - extra,
+	    memcpy(nextPtr->buf + (BUFFER_PADDING - extra),
 		    raw + gsPtr->rawRead, (size_t) extra);
 	    nextPtr->nextRemoved -= extra;
 	    bufPtr->nextAdded -= extra;
@@ -4773,7 +4763,7 @@ PeekAhead(
 
 		goto cleanup;
 	    }
-	    if ((statePtr->flags & CHANNEL_NONBLOCKING) == 0) {
+	    if (!GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
 		blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
 		if (blockModeProc == NULL) {
 		    /*
@@ -4970,11 +4960,11 @@ Tcl_ReadRaw(
 	copiedNow = CopyBuffer(chanPtr, bufPtr + copied,
 		bytesToRead - copied);
 	if (copiedNow == 0) {
-	    if (statePtr->flags & CHANNEL_EOF) {
+	    if (GotFlag(statePtr, CHANNEL_EOF)) {
 		goto done;
 	    }
-	    if (statePtr->flags & CHANNEL_BLOCKED) {
-		if (statePtr->flags & CHANNEL_NONBLOCKING) {
+	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
 		    goto done;
 		}
 		ResetFlag(statePtr, CHANNEL_BLOCKED);
@@ -4988,9 +4978,9 @@ Tcl_ReadRaw(
 	     * and only if we are sure to have data.
 	     */
 
-	    if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
+	    if (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
 		    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
-		    !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
+		    !GotFlag(statePtr, CHANNEL_HAS_MORE_DATA)) {
 		/*
 		 * We bypass the driver; it would block as no data is
 		 * available.
@@ -5231,11 +5221,11 @@ DoReadChars(
 	}
 
 	if (copiedNow < 0) {
-	    if (statePtr->flags & CHANNEL_EOF) {
+	    if (GotFlag(statePtr, CHANNEL_EOF)) {
 		break;
 	    }
-	    if (statePtr->flags & CHANNEL_BLOCKED) {
-		if (statePtr->flags & CHANNEL_NONBLOCKING) {
+	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
 		    break;
 		}
 		ResetFlag(statePtr, CHANNEL_BLOCKED);
@@ -5362,7 +5352,7 @@ ReadBytes(
     }
     dst += offset;
 
-    if (statePtr->flags & INPUT_NEED_NL) {
+    if (GotFlag(statePtr, INPUT_NEED_NL)) {
 	ResetFlag(statePtr, INPUT_NEED_NL);
 	if ((srcLen == 0) || (*src != '\n')) {
 	    *dst = '\r';
@@ -5543,7 +5533,7 @@ ReadChars(
     }
 
     oldState = statePtr->inputEncodingState;
-    if (statePtr->flags & INPUT_NEED_NL) {
+    if (GotFlag(statePtr, INPUT_NEED_NL)) {
 	/*
 	 * We want a '\n' because the last character we saw was '\r'.
 	 */
@@ -5809,7 +5799,7 @@ TranslateInputEOL(
 	srcEnd = srcStart + dstLen;
 	srcMax = srcStart + *srcLenPtr;
 
-	if ((statePtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
+	if (GotFlag(statePtr, INPUT_SAW_CR) && (src < srcMax)) {
 	    if (*src == '\n') {
 		src++;
 	    }
@@ -5914,7 +5904,7 @@ Tcl_Ungets(
      * bit. We want to discover these conditions anew in each operation.
      */
 
-    if (statePtr->flags & CHANNEL_STICKY_EOF) {
+    if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
 	goto done;
     }
     ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_EOF);
@@ -6171,7 +6161,7 @@ GetInput(
      * platforms it is impossible to read from a device after EOF.
      */
 
-    if (statePtr->flags & CHANNEL_EOF) {
+    if (GotFlag(statePtr, CHANNEL_EOF)) {
 	return 0;
     }
 
@@ -6183,9 +6173,9 @@ GetInput(
      * sure to have data.
      */
 
-    if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
+    if (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
 	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
-	    !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
+	    !GotFlag(statePtr, CHANNEL_HAS_MORE_DATA)) {
 	/*
 	 * Bypass the driver, it would block, as no data is available
 	 */
@@ -6355,14 +6345,14 @@ Tcl_Seek(
      */
 
     wasAsync = 0;
-    if (statePtr->flags & CHANNEL_NONBLOCKING) {
+    if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
 	wasAsync = 1;
 	result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
 	if (result != 0) {
 	    return Tcl_LongAsWide(-1);
 	}
 	ResetFlag(statePtr, CHANNEL_NONBLOCKING);
-	if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+	if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
 	    ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
 	}
     }
@@ -6698,8 +6688,7 @@ CheckChannelErrors(
      * order to drain data from stacked channels.
      */
 
-    if ((statePtr->flags & CHANNEL_CLOSED) &&
-	    ((flags & CHANNEL_RAW_MODE) == 0)) {
+    if (GotFlag(statePtr, CHANNEL_CLOSED) && !(flags & CHANNEL_RAW_MODE)) {
 	Tcl_SetErrno(EACCES);
 	return -1;
     }
@@ -6721,7 +6710,7 @@ CheckChannelErrors(
      * retrieving and transforming the data to copy.
      */
 
-    if (BUSY_STATE(statePtr,flags) && ((flags & CHANNEL_RAW_MODE) == 0)) {
+    if (BUSY_STATE(statePtr, flags) && ((flags & CHANNEL_RAW_MODE) == 0)) {
 	Tcl_SetErrno(EBUSY);
 	return -1;
     }
@@ -6734,7 +6723,7 @@ CheckChannelErrors(
 	 * discover these conditions anew in each operation.
 	 */
 
-	if ((statePtr->flags & CHANNEL_STICKY_EOF) == 0) {
+	if (!GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
 	    ResetFlag(statePtr, CHANNEL_EOF);
 	}
 	ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
@@ -6766,8 +6755,8 @@ Tcl_Eof(
     ChannelState *statePtr = ((Channel *) chan)->state;
 				/* State of real channel structure. */
 
-    return ((statePtr->flags & CHANNEL_STICKY_EOF) ||
-	    ((statePtr->flags & CHANNEL_EOF) &&
+    return (GotFlag(statePtr, CHANNEL_STICKY_EOF) ||
+	    (GotFlag(statePtr, CHANNEL_EOF) &&
 	    (Tcl_InputBuffered(chan) == 0))) ? 1 : 0;
 }
 
@@ -6794,7 +6783,7 @@ Tcl_InputBlocked(
     ChannelState *statePtr = ((Channel *) chan)->state;
 				/* State of real channel structure. */
 
-    return (statePtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
+    return GotFlag(statePtr, CHANNEL_BLOCKED) ? 1 : 0;
 }
 
 /*
@@ -7437,10 +7426,10 @@ Tcl_SetChannelOption(
 		ckfree((char *) argv);
 		return TCL_ERROR;
 	    }
-	    if (statePtr->flags & TCL_READABLE) {
+	    if (GotFlag(statePtr, TCL_READABLE)) {
 		statePtr->inEofChar = inValue;
 	    }
-	    if (statePtr->flags & TCL_WRITABLE) {
+	    if (GotFlag(statePtr, TCL_WRITABLE)) {
 		statePtr->outEofChar = outValue;
 	    }
 	} else {
@@ -7474,11 +7463,11 @@ Tcl_SetChannelOption(
 	}
 
 	if (argc == 1) {
-	    readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
-	    writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[0] : NULL;
+	    readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL;
+	    writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[0] : NULL;
 	} else if (argc == 2) {
-	    readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
-	    writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[1] : NULL;
+	    readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL;
+	    writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL;
 	} else {
 	    if (interp) {
 		Tcl_AppendResult(interp,
@@ -7694,9 +7683,9 @@ Tcl_NotifyChannel(
      */
 
     if ((mask & TCL_READABLE) &&
-	    (statePtr->flags & CHANNEL_NONBLOCKING) &&
+	    GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
 	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
-	    !(statePtr->flags & CHANNEL_TIMER_FEV)) {
+	    !GotFlag(statePtr, CHANNEL_TIMER_FEV)) {
 	SetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
     }
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
@@ -7759,7 +7748,7 @@ Tcl_NotifyChannel(
      * don't call any write handlers before the flush is complete.
      */
 
-    if ((statePtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
+    if (GotFlag(statePtr, BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
 	FlushChannel(NULL, chanPtr, 1);
 	mask &= ~TCL_WRITABLE;
     }
@@ -7839,7 +7828,7 @@ UpdateInterest(
      * watch for the channel to become writable.
      */
 
-    if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+    if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
 	mask |= TCL_WRITABLE;
     }
 
@@ -7851,7 +7840,7 @@ UpdateInterest(
      */
 
     if (mask & TCL_READABLE) {
-	if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
+	if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
 		&& (statePtr->inQueueHead != NULL)
 		&& IsBufferReady(statePtr->inQueueHead)) {
 	    mask &= ~TCL_READABLE;
@@ -7930,7 +7919,7 @@ ChannelTimerProc(
     ChannelState *statePtr = chanPtr->state;
 				/* State info for channel */
 
-    if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
+    if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
 	    && (statePtr->interestMask & TCL_READABLE)
 	    && (statePtr->inQueueHead != NULL)
 	    && IsBufferReady(statePtr->inQueueHead)) {
@@ -7950,14 +7939,14 @@ ChannelTimerProc(
 	 * similar test is done in "PeekAhead".
 	 */
 
-	if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
-	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) {
+	if (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
+		(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) {
 	    SetFlag(statePtr, CHANNEL_TIMER_FEV);
 	}
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
 
 	Tcl_Preserve(statePtr);
-	Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
+	Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);
 
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
 	ResetFlag(statePtr, CHANNEL_TIMER_FEV);
@@ -8920,7 +8909,7 @@ DoRead(
      */
 
     Tcl_Preserve(chanPtr);
-    if (!(statePtr->flags & CHANNEL_STICKY_EOF)) {
+    if (!GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
 	ResetFlag(statePtr, CHANNEL_EOF);
     }
     ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
@@ -8929,11 +8918,11 @@ DoRead(
 	copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied,
 		toRead - copied);
 	if (copiedNow == 0) {
-	    if (statePtr->flags & CHANNEL_EOF) {
+	    if (GotFlag(statePtr, CHANNEL_EOF)) {
 		goto done;
 	    }
-	    if (statePtr->flags & CHANNEL_BLOCKED) {
-		if (statePtr->flags & CHANNEL_NONBLOCKING) {
+	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
 		    goto done;
 		}
 		ResetFlag(statePtr, CHANNEL_BLOCKED);
@@ -9088,7 +9077,7 @@ CopyAndTranslateBuffer(
 	    curByte = *src;
 	    if (curByte == '\n') {
 		ResetFlag(statePtr, INPUT_SAW_CR);
-	    } else if (statePtr->flags & INPUT_SAW_CR) {
+	    } else if (GotFlag(statePtr, INPUT_SAW_CR)) {
 		ResetFlag(statePtr, INPUT_SAW_CR);
 		*dst = '\r';
 		dst++;
@@ -9131,7 +9120,7 @@ CopyAndTranslateBuffer(
 		*dst = '\n';
 		dst++;
 	    } else {
-		if ((curByte != '\n') || !(statePtr->flags & INPUT_SAW_CR)) {
+		if ((curByte != '\n') || !GotFlag(statePtr, INPUT_SAW_CR)) {
 		    *dst = (char) curByte;
 		    dst++;
 		}
@@ -10551,8 +10540,9 @@ SetChannelFromAny(
 	 * The channel is valid until any call to DetachChannel occurs.
 	 * Ensure consistency checks are done.
 	 */
-	statePtr  = GET_CHANNELSTATE(objPtr);
-	if (statePtr->flags & (CHANNEL_TAINTED|CHANNEL_CLOSED)) {
+
+	statePtr = GET_CHANNELSTATE(objPtr);
+	if (GotFlag(statePtr, CHANNEL_TAINTED|CHANNEL_CLOSED)) {
 	    ResetFlag(statePtr, CHANNEL_TAINTED);
 	    Tcl_Release((ClientData) statePtr);
 	    objPtr->typePtr = NULL;
@@ -10650,5 +10640,7 @@ DumpFlags(
  * mode: c
  * c-basic-offset: 4
  * fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
  * End:
  */
-- 
cgit v0.12


From 7d27109da91753ce0ed031d0c7c3eb095b0b7fed Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 5 May 2014 17:18:51 +0000
Subject: Segfaulting test (backport of iortrans-5.11).

---
 tests/iogt.test | 22 +++++++++++++++++++++-
 1 file changed, 21 insertions(+), 1 deletion(-)

diff --git a/tests/iogt.test b/tests/iogt.test
index d81acd6..abe4246 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -251,7 +251,17 @@ proc id_torture {chan op data} {
 	clear_read   {;#ignore}
 	flush/write -
 	flush/read  {}
-	write       -
+	write       {
+	    global level
+	    if {$level} {
+		return
+	    }
+	    incr level
+	    testchannel unstack $chan
+	    testchannel transform $chan \
+		-command [namespace code [list id_torture $chan]]
+	    return $data
+	}
 	read        {
 	    testchannel unstack $chan
 	    testchannel transform $chan \
@@ -665,6 +675,16 @@ test iogt-2.4 {basic I/O, mixed trail} {testchannel} {
     close   $fh
     set x
 } {}
+test iogt-2.5 {basic I/O, mixed trail} {testchannel} {
+    set ::level 0
+    set fh [open $path(dummyout) w]
+    torture -attach $fh
+    puts -nonewline $fh abcdef
+    flush $fh
+    testchannel unstack $fh
+    close   $fh
+    set x
+} {}
 
 test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
 	{testchannel unknownFailure} {
-- 
cgit v0.12


From d9866626fadb0a1c94f0317d07cb7dcb5dfd7c86 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
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<len; ++wp,i+=sizeof(WCHAR)) {
-	if ( (*wp < ' ') || wcschr(L"\"*<>|", *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<len; ++wp,i+=sizeof(WCHAR)) {
+	if ( (*wp < ' ') || wcschr(L"\"*:<>?|", *wp) ){
 	    if (!*wp){
 		/* See bug [3118489]: NUL in filenames */
 		Tcl_DecrRefCount(validPathPtr);
-- 
cgit v0.12


From 0fc3bdcc7e6bd2903a1e84017073bf39dff8a3ad Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 6 May 2014 13:56:29 +0000
Subject: Have to manage the lifetime of the self handle in testchannel
 transform.

---
 generic/tclIOGT.c | 15 +++++++++++++--
 tests/iogt.test   |  1 -
 2 files changed, 13 insertions(+), 3 deletions(-)

diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index beddf4f..c5372b1 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -298,7 +298,6 @@ TclChannelTransform(
     }
     Tcl_DStringFree(&ds);
 
-    dataPtr->self = chan;
     dataPtr->watchMask = 0;
     dataPtr->mode = mode;
     dataPtr->timer = NULL;
@@ -317,6 +316,7 @@ TclChannelTransform(
 	ReleaseData(dataPtr);
 	return TCL_ERROR;
     }
+    Tcl_Preserve(dataPtr->self);
 
     /*
      * At last initialize the transformation at the script level.
@@ -437,6 +437,9 @@ ExecuteCallback(
 	break;
 
     case TRANSMIT_DOWN:
+	if (dataPtr->self == NULL) {
+	    break;
+	}
 	resObj = Tcl_GetObjResult(eval);
 	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
 	Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf,
@@ -444,6 +447,9 @@ ExecuteCallback(
 	break;
 
     case TRANSMIT_SELF:
+	if (dataPtr->self == NULL) {
+	    break;
+	}
 	resObj = Tcl_GetObjResult(eval);
 	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
 	Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen);
@@ -579,6 +585,8 @@ TransformCloseProc(
      * General cleanup.
      */
 
+    Tcl_Release(dataPtr->self);
+    dataPtr->self = NULL;
     ReleaseData(dataPtr);
     return TCL_OK;
 }
@@ -614,7 +622,7 @@ TransformInputProc(
      * Should assert(dataPtr->mode & TCL_READABLE);
      */
 
-    if (toRead == 0) {
+    if (toRead == 0 || dataPtr->self == NULL) {
 	/*
 	 * Catch a no-op.
 	 */
@@ -1083,6 +1091,9 @@ TransformWatchProc(
      * unchanged.
      */
 
+    if (dataPtr->self == NULL) {
+	return;
+    }
     downChan = Tcl_GetStackedChannel(dataPtr->self);
 
     Tcl_GetChannelType(downChan)->watchProc(
diff --git a/tests/iogt.test b/tests/iogt.test
index abe4246..d4291b3 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -683,7 +683,6 @@ test iogt-2.5 {basic I/O, mixed trail} {testchannel} {
     flush $fh
     testchannel unstack $fh
     close   $fh
-    set x
 } {}
 
 test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
-- 
cgit v0.12


From e3ee9f9e15df60c47593c2b50c17fefef1909e1d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
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 <dgp@users.sourceforge.net>
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 e35a33106d2918d82903fa94e973f42fd5f28a1d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 6 May 2014 22:34:45 +0000
Subject: Stop memory leak in io-29.27.

---
 generic/tclIO.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 2f652e7..fc3722c 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -2613,6 +2613,7 @@ FlushChannel(
 	     */
 
 	    DiscardOutputQueued(statePtr);
+	    ReleaseChannelBuffer(bufPtr);
 	    continue;
 	} else {
 	    wroteSome = 1;
-- 
cgit v0.12


From 06da97fda1d8384b5700cf28a14998a15ca94c0a Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 6 May 2014 23:23:43 +0000
Subject: Stop memory leak in io-29.34

---
 generic/tclIO.c | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index fc3722c..b2b4e5c 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -2525,6 +2525,7 @@ FlushChannel(
 
 	    if (errorCode == EINTR) {
 		errorCode = 0;
+		ReleaseChannelBuffer(bufPtr);
 		continue;
 	    }
 
@@ -2546,6 +2547,7 @@ FlushChannel(
 		    UpdateInterest(chanPtr);
 		}
 		errorCode = 0;
+		ReleaseChannelBuffer(bufPtr);
 		break;
 	    }
 
-- 
cgit v0.12


From d9de529a706559caa6f3cadab3c54249eca3c8d9 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 6 May 2014 23:51:32 +0000
Subject: Stop leak in io-33.7.

---
 generic/tclIOCmd.c | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index b206303..afd6272 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -345,7 +345,8 @@ Tcl_GetsObjCmd(
     if (objc == 3) {
 	if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
 		TCL_LEAVE_ERR_MSG) == NULL) {
-	    return TCL_ERROR;
+	    code = TCL_ERROR;
+	    goto done;
 	}
 	Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
     } else {
-- 
cgit v0.12


From 5c31837bdf02ca496a7764d983b7186c62228026 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 7 May 2014 02:28:56 +0000
Subject: Stop leak in io-53.5.

---
 generic/tclIO.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index b2b4e5c..f2d1f44 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -3787,6 +3787,7 @@ Write(
 
 	if (IsBufferFull(bufPtr)) {
 	    if (FlushChannel(NULL, chanPtr, 0) != 0) {
+		ReleaseChannelBuffer(bufPtr);
 		return -1;
 	    }
 	    flushed += statePtr->bufSize;
-- 
cgit v0.12


From 228272365c7aec6154a3468e75f99981152c7a3c Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 7 May 2014 03:30:55 +0000
Subject: Stop leaks of cloned Tcl_ChannelTypes.

---
 generic/tclIORChan.c | 28 ++++++++++++++++++++--------
 1 file changed, 20 insertions(+), 8 deletions(-)

diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 17c1593..7630473 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -1019,6 +1019,7 @@ ReflectClose(
     Tcl_Obj *resObj;		/* Result data for 'close' */
     ReflectedChannelMap* rcmPtr; /* Map of reflected channels with handlers in this interp */
     Tcl_HashEntry* hPtr;         /* Entry in the above map */
+    Tcl_ChannelType *tctPtr;
 
     if (TclInThreadExit()) {
 	/*
@@ -1055,6 +1056,11 @@ ReflectClose(
 	}
 #endif
 
+	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
+	if (tctPtr && tctPtr != &tclRChannelType) {
+	    ckfree((char *)tctPtr);
+	    ((Channel *)rcPtr->chan)->typePtr = NULL;
+	}
         Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
 	return EOK;
     }
@@ -1118,6 +1124,11 @@ ReflectClose(
 	}
 #endif
 
+	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
+	if (tctPtr && tctPtr != &tclRChannelType) {
+	    ckfree((char *)tctPtr);
+	    ((Channel *)rcPtr->chan)->typePtr = NULL;
+	}
         Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
 #ifdef TCL_THREADS
     }
@@ -2033,13 +2044,6 @@ FreeReflectedChannel(
 {
     Channel *chanPtr = (Channel *) rcPtr->chan;
 
-    if (chanPtr->typePtr != &tclRChannelType) {
-	/*
-	 * Delete a cloned ChannelType structure.
-	 */
-
-	ckfree((char*) chanPtr->typePtr);
-    }
     Tcl_Release(chanPtr);
     Tcl_DecrRefCount(rcPtr->name);
     Tcl_DecrRefCount(rcPtr->methods);
@@ -2698,11 +2702,13 @@ ForwardProc(
 	 * call upon for the driver.
 	 */
 
-    case ForwardedClose:
+    case ForwardedClose: {
 	/*
 	 * No parameters/results.
 	 */
 
+	Tcl_ChannelType *tctPtr;
+
 	if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) {
 	    ForwardSetObjError(paramPtr, resObj);
 	}
@@ -2727,8 +2733,14 @@ ForwardProc(
 				  Tcl_GetChannelName (rcPtr->chan));
 	Tcl_DeleteHashEntry (hPtr);
 
+	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
+	if (tctPtr && tctPtr != &tclRChannelType) {
+	    ckfree((char *)tctPtr);
+	    ((Channel *)rcPtr->chan)->typePtr = NULL;
+	}
         Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
 	break;
+    }
 
     case ForwardedInput: {
 	Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead);
-- 
cgit v0.12


From 7c1d853a93ed3c14acece6af7b054bed1a22b67b Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 7 May 2014 22:19:30 +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 b3e1bee..84823e0 100644
--- a/doc/tclvars.n
+++ b/doc/tclvars.n
@@ -284,8 +284,8 @@ was compiled with threads enabled.
 \fBuser\fR
 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
 This gives the size of the native-machine word in bytes (strictly, it
-- 
cgit v0.12


From b622ae7f2419b531a196cd2fe0ac570f195bf030 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
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 48ae7e42c1bd6a104c78d737fd6b826a1a4ee7bd Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 8 May 2014 02:38:52 +0000
Subject: Stop leak in iocmd-21.22.

---
 generic/tclIO.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index f2d1f44..4628e90 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -3607,6 +3607,7 @@ static int WillRead(Channel *chanPtr)
 {
     if (chanPtr->typePtr == NULL) {
 	/* Prevent read attempts on a closed channel */
+        DiscardInputQueued(chanPtr->state, 0);
 	Tcl_SetErrno(EINVAL);
 	return -1;
     }
-- 
cgit v0.12


From 435b75fc24a85e806029ac4159863e6bf87b6412 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
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:
+    ** <http://msdn.microsoft.com/en-us/library/aa365247(VS.85).aspx#maxpath>
+    **/
+    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 "<drive>:/" or "<drive>:\",
+	 ** 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<len; ++wp,i+=sizeof(WCHAR)) {
-	if ( (*wp < ' ') || wcschr(L"\"*:<>?|", *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 <dgp@users.sourceforge.net>
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 <dgp@users.sourceforge.net>
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 <dgp@users.sourceforge.net>
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 777fc1f403ce2dd7dcf46cc42a059b0fe6363882 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 9 May 2014 10:08:56 +0000
Subject: Make Cygwin's "configure" work from another directory than /unix.
 (Not everything works this way!)

---
 unix/configure | 4 ++--
 unix/tcl.m4    | 4 ++--
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/unix/configure b/unix/configure
index 02a3725..d268647 100755
--- a/unix/configure
+++ b/unix/configure
@@ -7010,9 +7010,9 @@ echo "$as_me: error: CYGWIN compile is only supported with --enable-threads" >&2
 	    fi
 	    do64bit_ok=yes
 	    if test "x${SHARED_BUILD}" = "x1"; then
-		echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args"
+		echo "running cd ${TCL_SRC_DIR}/win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args"
 		# The eval makes quoting arguments work.
-		if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix
+		if cd ${TCL_SRC_DIR}/win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix
 		then :
 		else
 		    { echo "configure: error: configure failed for ../win" 1>&2; exit 1; }
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index 10408a8..b6c86b6 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -1266,9 +1266,9 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 	    fi
 	    do64bit_ok=yes
 	    if test "x${SHARED_BUILD}" = "x1"; then
-		echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args"
+		echo "running cd ${TCL_SRC_DIR}/win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args"
 		# The eval makes quoting arguments work.
-		if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix
+		if cd ${TCL_SRC_DIR}/win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix
 		then :
 		else
 		    { echo "configure: error: configure failed for ../win" 1>&2; exit 1; }
-- 
cgit v0.12


From d28769d37874fb207bec2ac0d3c8206c7ab566f8 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 9 May 2014 13:19:30 +0000
Subject: Test iocmd-32.1 is not "impossible" but after writing it properly it
 does segfault trying to use a deleted interp.  Fixed.

---
 generic/tclIORChan.c | 12 +++++++++++-
 tests/ioCmd.test     |  9 ++++-----
 2 files changed, 15 insertions(+), 6 deletions(-)

diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 7630473..3107f9e 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -438,8 +438,8 @@ static const char *msg_write_nothing = "{write wrote nothing}";
 static const char *msg_seek_beforestart = "{Tried to seek before origin}";
 #ifdef TCL_THREADS
 static const char *msg_send_originlost = "{Channel thread lost}";
-static const char *msg_send_dstlost    = "{Owner lost}";
 #endif /* TCL_THREADS */
+static const char *msg_send_dstlost    = "{Owner lost}";
 static const char *msg_dstlost    = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";
 
 /*
@@ -1302,6 +1302,7 @@ ReflectOutput(
     /* ASSERT: rcPtr->mode & TCL_WRITABLE */
 
     Tcl_Preserve(rcPtr);
+    Tcl_Preserve(rcPtr->interp);
 
     bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
     Tcl_IncrRefCount(bufObj);
@@ -1318,6 +1319,14 @@ ReflectOutput(
         goto invalid;
     }
 
+    if (Tcl_InterpDeleted(rcPtr->interp)) {
+	/*
+	 * The interp was destroyed during InvokeTclMethod().
+	 */
+
+	SetChannelErrorStr(rcPtr->chan, msg_send_dstlost);
+        goto invalid;
+    }
     if (Tcl_GetIntFromObj(rcPtr->interp, resObj, &written) != TCL_OK) {
 	Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
         goto invalid;
@@ -1347,6 +1356,7 @@ ReflectOutput(
  stop:
     Tcl_DecrRefCount(bufObj);
     Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
+    Tcl_Release(rcPtr->interp);
     Tcl_Release(rcPtr);
     return written;
  invalid:
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index bb133f9..5a76d48 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -2038,13 +2038,13 @@ test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -m
 	proc foo {args} {
 	    oninit; onfinal; track;
 	    # destroy interpreter during channel access
-	    # Actually not possible for an interp to destroy itself.
-	    interp delete {}
-	    return}
+	    suicide
+	}
 	set chan [chan create {r w} foo]
 	fconfigure $chan -buffering none
 	set chan
     }]
+    interp alias $ida suicide {} interp delete $ida
 
     # Move channel to 2nd thread.
     interp eval $ida [list testchannel cut    $chan]
@@ -2063,8 +2063,7 @@ test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -m
 	set res
     }]
     set res
-} -constraints {testchannel impossible} \
-    -result {Owner lost}
+} -constraints {testchannel} -result {Owner lost}
 
 test iocmd-32.2 {delete interp of reflected chan} {
     # Bug 3034840
-- 
cgit v0.12


From de5e889e3d84eb644ed791aea29fdb8e47972943 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 9 May 2014 16:31:06 +0000
Subject: Tests (chan)io-34.21 are constrained for largefileSupport, and that's
 disabled by default, which means never tested, which means the ridiculous
 bugs in them are never found and fixed.

Fixed the bugs, changed the default.  Large File Suppport (4GB) is
commonplace now.  Let those without it suffer a few failing tests reporting
that fact to them.
---
 tests/chanio.test | 6 +++---
 tests/io.test     | 6 +++---
 2 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/tests/chanio.test b/tests/chanio.test
index b195f7b..5ea7ec1 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -41,7 +41,7 @@ namespace eval ::tcl::test::io {
 
     # You need a *very* special environment to do some tests.  In
     # particular, many file systems do not support large-files...
-    testConstraint largefileSupport 0
+    testConstraint largefileSupport 1
 
     # some tests can only be run is umask is 2
     # if "umask" cannot be run, the tests will be skipped.
@@ -4427,10 +4427,10 @@ test chan-io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport} {
     chan puts -nonewline $f abcdef
     lappend l [chan tell $f]
     chan close $f
-    lappend l [file size $f]
+    lappend l [file size $path(test3)]
     # truncate...
     chan close [open $path(test3) w]
-    lappend l [file size $f]
+    lappend l [file size $path(test3)]
     set l
 } {0 6 6 4294967296 4294967302 4294967302 0}
 
diff --git a/tests/io.test b/tests/io.test
index 7707a28..7f1a357 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -41,7 +41,7 @@ testConstraint testthread       [llength [info commands testthread]]
 
 # You need a *very* special environment to do some tests.  In
 # particular, many file systems do not support large-files...
-testConstraint largefileSupport 0
+testConstraint largefileSupport 1
 
 # some tests can only be run is umask is 2
 # if "umask" cannot be run, the tests will be skipped.
@@ -4433,10 +4433,10 @@ test io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport} {
     puts -nonewline $f abcdef
     lappend l [tell $f]
     close $f
-    lappend l [file size $f]
+    lappend l [file size $path(test3)]
     # truncate...
     close [open $path(test3) w]
-    lappend l [file size $f]
+    lappend l [file size $path(test3)]
     set l
 } {0 6 6 4294967296 4294967302 4294967302 0}
 
-- 
cgit v0.12


From f008e78ace0135efe56f81d05155be120472df7e Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 9 May 2014 16:38:23 +0000
Subject: Added comment explaining the "knownBug" in iogt-6.1

---
 tests/iogt.test | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/tests/iogt.test b/tests/iogt.test
index d4291b3..20d7538 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -968,6 +968,15 @@ test iogt-6.0 {Push back} testchannel {
 } {xxx}
 
 test iogt-6.1 {Push back and up} {testchannel knownBug} {
+
+    # This test demonstrates the bug/misfeature in the stacked
+    # channel implementation that data can be discarded if it is
+    # read into the buffers of one channel in the stack, and then
+    # that channel is popped before anything above it reads.
+    #
+    # This bug can be worked around by always setting -buffersize
+    # to 1, but who wants to do that?
+
     set f [open $path(dummy) r]
 
     # contents of dummy = "abcdefghi..."
-- 
cgit v0.12


From 463d816181eb0f936be39e8bdd6a651b0ad9bd78 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 9 May 2014 16:55:34 +0000
Subject: Correct namespace bugs in normally skipped tests. Constrain them as
 "knownBug" rather than "unknownFailure".

---
 tests/iogt.test | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

diff --git a/tests/iogt.test b/tests/iogt.test
index 20d7538..0e2eb3c 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -159,8 +159,8 @@ proc fevent {fdelay idelay blocks script data} {
 
     #puts stdout ">>>>>" ; flush stdout
 
-    uplevel #0 set sock $sk
-    set res [uplevel #0 $script]
+    uplevel 1 set sock $sk
+    set res [uplevel 1 $script]
 
     catch {close $sk}
     return $res
@@ -686,7 +686,7 @@ test iogt-2.5 {basic I/O, mixed trail} {testchannel} {
 } {}
 
 test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
-	{testchannel unknownFailure} {
+	{testchannel knownBug} {
     # This test to check the validity of aquired Tcl_Channel references is
     # not possible because even a backgrounded fcopy will immediately start
     # to copy data, without waiting for the event loop. This is done only in
@@ -703,6 +703,7 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
     set fin  [open $path(dummy) r]
 
     fevent 1000 500 {20 20 20 10 1 1} {
+	variable copy
 	close $fin
 
 	set          fout [open dummyout w]
@@ -740,7 +741,7 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
 } {1 {create/write create/read write flush/write flush/read delete/write delete/read}}
 
 
-test iogt-4.0 {fileevent readable, after transform} {testchannel unknownFailure} {
+test iogt-4.0 {fileevent readable, after transform} {testchannel knownBug} {
     set fin  [open $path(dummy) r]
     set data [read $fin]
     close $fin
@@ -770,10 +771,11 @@ test iogt-4.0 {fileevent readable, after transform} {testchannel unknownFailure}
     }
 
     fevent 1000 500 {20 20 20 10 1} {
+	variable stop
 	audit_flow trail   -attach $sock
 	rblocks_t  rbuf trail 23 -attach $sock
 
-	fileevent $sock readable [list Get $sock]
+	fileevent $sock readable [namespace code [list Get $sock]]
 
 	flush $sock ; # now, or fcopy will error us out
 	# But the 1 second delay should be enough to
@@ -871,7 +873,7 @@ delete/write {} *ignored*
 delete/read {} *ignored*}  ; # catch unescaped quote "
 
 
-test iogt-5.0 {EOF simulation} {testchannel unknownFailure} {
+test iogt-5.0 {EOF simulation} {testchannel knownBug} {
     set fin  [open $path(dummy)    r]
     set fout [open $path(dummyout) w]
 
-- 
cgit v0.12


From f3283e67a3037b34b0a3811bab9e09333c13d8f4 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
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 <donal.k.fellows@manchester.ac.uk>
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" <nijtmans@users.sourceforge.net>
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 <dgp@users.sourceforge.net>
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 06285d2a11026ced76b58653449e181fd48ac13c Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 12 May 2014 21:50:55 +0000
Subject: Restore the largefileSupport constraint on Darwin, where tests
 (chan)io-34.21 take an unbearable 90 seconds each to complete.

---
 tests/chanio.test | 2 +-
 tests/io.test     | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/chanio.test b/tests/chanio.test
index 5ea7ec1..2f2540e 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -41,7 +41,7 @@ namespace eval ::tcl::test::io {
 
     # You need a *very* special environment to do some tests.  In
     # particular, many file systems do not support large-files...
-    testConstraint largefileSupport 1
+    testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}]
 
     # some tests can only be run is umask is 2
     # if "umask" cannot be run, the tests will be skipped.
diff --git a/tests/io.test b/tests/io.test
index 7f1a357..f692e43 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -41,7 +41,7 @@ testConstraint testthread       [llength [info commands testthread]]
 
 # You need a *very* special environment to do some tests.  In
 # particular, many file systems do not support large-files...
-testConstraint largefileSupport 1
+testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}]
 
 # some tests can only be run is umask is 2
 # if "umask" cannot be run, the tests will be skipped.
-- 
cgit v0.12


From b482771754f287160a211cfe25fb24e135b52101 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 13 May 2014 11:23:40 +0000
Subject: [958bc05fbe]: Clarify "clock format" using "%R"

---
 doc/clock.n | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/doc/clock.n b/doc/clock.n
index 7c4c3df..a0cc63e 100644
--- a/doc/clock.n
+++ b/doc/clock.n
@@ -626,8 +626,9 @@ On output, produces a locale-dependent time of day representation on a
 12-hour clock. On input, accepts whatever \fB%r\fR produces.
 .TP
 \fB%R\fR
-On output, produces a locale-dependent time of day representation on a
-24-hour clock. On input, accepts whatever \fB%R\fR produces.
+On output, the time in 24-hour notation (%H:%M). For a version
+including the seconds, see \fB%T\fR below. On input, accepts whatever
+\fB%R\fR produces.
 .TP
 \fB%s\fR
 On output, simply formats the \fItimeVal\fR argument as a decimal
-- 
cgit v0.12


From c3df58587ce6e9f21b652b23eb7f56f852a326f7 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 13 May 2014 18:24:23 +0000
Subject: Rework Tcl_ReadRaw() mostly taking things out of the loop that never
 repeat.

---
 generic/tclIO.c | 56 ++++++++++++++++++++------------------------------------
 1 file changed, 20 insertions(+), 36 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 41f555b..a82c36b 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4985,7 +4985,7 @@ Tcl_ReadRaw(
     Channel *chanPtr = (Channel *) chan;
     ChannelState *statePtr = chanPtr->state;
 				/* State info for channel */
-    int nread, copied, copiedNow;
+    int nread, copied, copiedNow = INT_MAX;
 
     /*
      * The check below does too much because it will reject a call to this
@@ -5010,44 +5010,28 @@ Tcl_ReadRaw(
      */
 
     Tcl_Preserve(chanPtr);
-    for (copied = 0; copied < bytesToRead; copied += copiedNow) {
-	copiedNow = CopyBuffer(chanPtr, bufPtr + copied,
-		bytesToRead - copied);
-	if (copiedNow == 0) {
-	    if (GotFlag(statePtr, CHANNEL_EOF)) {
-		break;
-	    }
-	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
-		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
-		    break;
-		}
-		ResetFlag(statePtr, CHANNEL_BLOCKED);
-	    }
-
-	    /*
-	     * Now go to the driver to get as much as is possible to
-	     * fill the remaining request. Do all the error handling by
-	     * ourselves. The code was stolen from 'GetInput' and
-	     * slightly adapted (different return value here).
-	     *
-	     * The case of 'bytesToRead == 0' at this point cannot
-	     * happen.
-	     */
+    for (copied = 0; bytesToRead > 0 && copiedNow > 0;
+	    bufPtr+=copiedNow, bytesToRead-=copiedNow, copied+=copiedNow) {
+	copiedNow = CopyBuffer(chanPtr, bufPtr, bytesToRead);
+    }
 
-	    nread = ChanRead(chanPtr, bufPtr + copied,
-		    bytesToRead - copied);
+    if (bytesToRead > 0) {
+	/*
+	 * Now go to the driver to get as much as is possible to
+	 * fill the remaining request.  Since we're directly filling
+	 * the caller's buffer, retain the blocked flag.
+	 */
 
-	    if (nread < 0) {
-		if (GotFlag(statePtr, CHANNEL_BLOCKED) && copied > 0) {
-/* TODO: comment out? */
-//		    ResetFlag(statePtr, CHANNEL_BLOCKED);
-		} else {
-		    copied = -1;
-		}
-	    } else {
-		copied += nread;
+	nread = ChanRead(chanPtr, bufPtr, bytesToRead);
+	if (nread < 0) {
+	    if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) {
+		copied = -1;
 	    }
-	    break;
+	} else {
+	    copied += nread;
+	}
+	if (copied != 0) {
+	    ResetFlag(statePtr, CHANNEL_EOF);
 	}
     }
 
-- 
cgit v0.12


From 5e610145644e54a301c3f508b6c6fb4dcf95f7b6 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 14 May 2014 09:11:42 +0000
Subject: Fix 3 test-cases which started failing on Windows

---
 tests/io.test | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/tests/io.test b/tests/io.test
index f692e43..b99c4e9 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -6825,6 +6825,7 @@ test io-52.12 {coverage of -translation auto} {
     set in [open $path(test1)]
     chan configure $in -buffersize 8
     set out [open $path(test2) w]
+    chan configure $out -translation lf
     fcopy $in $out
     close $in
     close $out
@@ -6839,6 +6840,7 @@ test io-52.13 {coverage of -translation cr} {
     set in [open $path(test1)]
     chan configure $in -buffersize 8 -translation cr
     set out [open $path(test2) w]
+    chan configure $out -translation lf
     fcopy $in $out
     close $in
     close $out
@@ -6853,6 +6855,7 @@ test io-52.14 {coverage of -translation crlf} {
     set in [open $path(test1)]
     chan configure $in -buffersize 8 -translation crlf
     set out [open $path(test2) w]
+    chan configure $out -translation lf
     fcopy $in $out
     close $in
     close $out
-- 
cgit v0.12


From 40646ad79cd332a232c9d5afea6f879222e9ccb9 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 15 May 2014 11:04:35 +0000
Subject: Push the setting and clearing of CHANNEL_BLOCKED flag to the more
 inner parts of the channel read machinery.

---
 generic/tclIO.c | 23 ++++++++++++-----------
 1 file changed, 12 insertions(+), 11 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index a82c36b..3416b64 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -383,6 +383,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;
     }
@@ -3944,6 +3949,9 @@ Tcl_GetsObj(
 	goto done;
     }
 
+    /* TODO: Locate better place(s) to reset this flag */
+    ResetFlag(statePtr, CHANNEL_BLOCKED);
+
     /*
      * A binary version of Tcl_GetsObj. This could also handle encodings that
      * are ascii-7 pure (iso8859, utf-8, ...) with a final encoding conversion
@@ -4377,7 +4385,6 @@ TclGetsObjBinary(
 		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
 		    goto restore;
 		}
-		ResetFlag(statePtr, CHANNEL_BLOCKED);
 	    }
 	    if (GetInput(chanPtr) != 0) {
 		goto restore;
@@ -4643,13 +4650,13 @@ FilterInputBytes(
 	 */
 
     read:
+	/* TODO: Move this check to the goto */
 	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;
@@ -5168,6 +5175,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) {
@@ -5202,7 +5211,6 @@ DoReadChars(
 		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
 		    break;
 		}
-		ResetFlag(statePtr, CHANNEL_BLOCKED);
 	    }
 	    result = GetInput(chanPtr);
 	    if (chanPtr != statePtr->topChanPtr) {
@@ -6619,12 +6627,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;
@@ -8801,9 +8804,7 @@ DoRead(
 	while (bufPtr == NULL || !IsBufferFull(bufPtr)) {
 	    int code;
 
-	    ResetFlag(statePtr, CHANNEL_BLOCKED);
 	moreData:
-
 	    code = GetInput(chanPtr);
 	    bufPtr = statePtr->inQueueHead;
 
-- 
cgit v0.12


From 47b1f4425678fcc051e9a75f59f6c4cd4f21b176 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 15 May 2014 14:54:45 +0000
Subject: Fix [3118489]: NUL in filenames. (On Windows, protect against invalid
 use of ':' in filenames as well)

---
 tests/cmdAH.test   |  3 +++
 unix/tclUnixFile.c |  6 ++++++
 win/tclWinFile.c   | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++++--
 3 files changed, 70 insertions(+), 2 deletions(-)

diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index dc61ac6..4ca90c6 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -104,6 +104,9 @@ test cmdAH-2.6.1 {Tcl_CdObjCmd} {
     list [catch {cd ""} msg] $msg
 } {1 {couldn't change working directory to "": no such file or directory}}
 
+test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -returnCodes error -body {
+    cd .\0
+} -result "couldn't change working directory to \".\0\": no such file or directory"
 test cmdAH-2.7 {Tcl_ConcatObjCmd} {
     concat
 } {}
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 29f1aba..c5f75a7 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -1111,6 +1111,12 @@ TclNativeCreateNativeRep(
     str = Tcl_GetStringFromObj(validPathPtr, &len);
     Tcl_UtfToExternalDString(NULL, str, len, &ds);
     len = Tcl_DStringLength(&ds) + sizeof(char);
+    if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) {
+	/* See bug [3118489]: NUL in filenames */
+	Tcl_DecrRefCount(validPathPtr);
+	Tcl_DStringFree(&ds);
+	return NULL;
+    }
     Tcl_DecrRefCount(validPathPtr);
     nativePathPtr = ckalloc((unsigned) len);
     memcpy((void*)nativePathPtr, (void*)Tcl_DStringValue(&ds), (size_t) len);
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index ed0c40f..9bf63b1 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -1856,6 +1856,9 @@ TclpObjChdir(
 
     nativePath = (const TCHAR *) Tcl_FSGetNativePath(pathPtr);
 
+    if (!nativePath) {
+	return -1;
+    }
     result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath);
 
     if (result == 0) {
@@ -3200,13 +3203,69 @@ TclNativeCreateNativeRep(
     Tcl_WinUtfToTChar(str, len, &ds);
     if (tclWinProcs->useWide) {
 	WCHAR *wp = (WCHAR *) Tcl_DStringValue(&ds);
-	for (; *wp; ++wp) {
-	    if (*wp=='/') {
+	len = Tcl_DStringLength(&ds)>>1;
+	/*
+	** If path starts with "//?/" or "\\?\" (extended path), translate
+	** any slashes to backslashes but accept the '?' as being valid.
+	*/
+	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;
+	    len -= 4;
+	}
+	/*
+	** If there is a drive prefix, the ':' must be considered valid.
+	**/
+	if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z'))
+		&& str[1]==':') {
+	    wp += 2;
+	    len -= 2;
+	}
+	while (len-->0) {
+	    if ((*wp < ' ') || wcschr(L"\"*:<>?|", *wp)) {
+		Tcl_DecrRefCount(validPathPtr);
+		Tcl_DStringFree(&ds);
+		return NULL;
+	    } else if (*wp=='/') {
 		*wp = '\\';
 	    }
+	    ++wp;
 	}
 	len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
     } else {
+	char *p = Tcl_DStringValue(&ds);
+	len = Tcl_DStringLength(&ds);
+	/*
+	** If path starts with "//?/" or "\\?\" (extended path), translate
+	** any slashes to backslashes but accept the '?' as being valid.
+	*/
+	if ((str[0]=='\\' || str[0]=='/') && (str[1]=='\\' || str[1]=='/')
+		&& str[2]=='?' && (str[3]=='\\' || str[3]=='/')) {
+	    p[0] = p[1] = p[3] = '\\';
+	    str += 4;
+	    p += 4;
+	    len -= 4;
+	}
+	/*
+	** If there is a drive prefix, the ':' must be considered valid.
+	**/
+	if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z'))
+		&& str[1]==':') {
+	    p += 2;
+	    len -= 2;
+	}
+	while (len-->0) {
+	    if ((*p < ' ') || strchr("\"*:<>?|", *p)) {
+		Tcl_DecrRefCount(validPathPtr);
+		Tcl_DStringFree(&ds);
+		return NULL;
+	    } else if (*p=='/') {
+		*p = '\\';
+	    }
+	    ++p;
+	}
 	len = Tcl_DStringLength(&ds) + sizeof(char);
     }
     Tcl_DecrRefCount(validPathPtr);
-- 
cgit v0.12


From 267fb4eebd7345f715153cea17de47c2396d31f8 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 15 May 2014 16:48:43 +0000
Subject: Portable test to demo bug otherwise seen only on Windows.

---
 tests/io.test | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/tests/io.test b/tests/io.test
index b99c4e9..b82f403 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -3960,6 +3960,26 @@ test io-32.11 {Tcl_Read from a pipe} {stdio openpipe} {
 } {{hello
 } {hello
 }}
+test io-32.11.1 {Tcl_Read from a pipe} {stdio openpipe} {
+    file delete $path(pipe)
+    set f1 [open $path(pipe) w]
+    puts $f1 {chan configure stdout -translation crlf}
+    puts $f1 {puts [gets stdin]}
+    puts $f1 {puts [gets stdin]}
+    close $f1
+    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
+    puts $f1 hello
+    flush $f1
+    set x ""
+    lappend x [read $f1 6]
+    puts $f1 hello
+    flush $f1
+    lappend x [read $f1]
+    close $f1
+    set x
+} {{hello
+} {hello
+}}
 test io-32.12 {Tcl_Read, -nonewline} {
     file delete $path(test1)
     set f1 [open $path(test1) w]
-- 
cgit v0.12


From 564d1813daa4ebd962bcafa76e4ce48659d16a26 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 15 May 2014 18:38:22 +0000
Subject: Branch to demo bug introduced in the parent commit.

---
 tests/io.test | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/tests/io.test b/tests/io.test
index c325809..b28566b 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -3960,6 +3960,26 @@ test io-32.11 {Tcl_Read from a pipe} {stdio openpipe} {
 } {{hello
 } {hello
 }}
+test io-32.11.1 {Tcl_Read from a pipe} {stdio openpipe} {
+    file delete $path(pipe)
+    set f1 [open $path(pipe) w]
+    puts $f1 {chan configure stdout -translation crlf}
+    puts $f1 {puts [gets stdin]}
+    puts $f1 {puts [gets stdin]}
+    close $f1
+    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
+    puts $f1 hello
+    flush $f1
+    set x ""
+    lappend x [read $f1 6]
+    puts $f1 hello
+    flush $f1
+    lappend x [read $f1]
+    close $f1
+    set x
+} {{hello
+} {hello
+}}
 test io-32.12 {Tcl_Read, -nonewline} {
     file delete $path(test1)
     set f1 [open $path(test1) w]
-- 
cgit v0.12


From 8019dad5cd3e9bb29762e4d700f067eed9873084 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 16 May 2014 12:56:01 +0000
Subject: More tests to demo the bug more directly.

---
 tests/io.test | 39 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 39 insertions(+)

diff --git a/tests/io.test b/tests/io.test
index b28566b..53b7105 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -1559,6 +1559,45 @@ test io-13.8 {TranslateInputEOL: auto mode: \r\n} {
     close $f
     set x
 } "abcd\ndef"
+test io-13.8.1 {TranslateInputEOL: auto mode: \r\n} {
+    set f [open $path(test1) w]
+    fconfigure $f -translation lf
+    puts -nonewline $f "abcd\r\ndef"
+    close $f
+    set f [open $path(test1)]
+    fconfigure $f -translation auto
+    set x {}
+    lappend x [read $f 5]
+    lappend x [read $f]
+    close $f
+    set x
+} [list "abcd\n" "def"]
+test io-13.8.2 {TranslateInputEOL: auto mode: \r\n} {
+    set f [open $path(test1) w]
+    fconfigure $f -translation lf
+    puts -nonewline $f "abcd\r\ndef"
+    close $f
+    set f [open $path(test1)]
+    fconfigure $f -translation auto -buffersize 6
+    set x {}
+    lappend x [read $f 5]
+    lappend x [read $f]
+    close $f
+    set x
+} [list "abcd\n" "def"]
+test io-13.8.3 {TranslateInputEOL: auto mode: \r\n} {
+    set f [open $path(test1) w]
+    fconfigure $f -translation lf
+    puts -nonewline $f "abcd\r\n\r\ndef"
+    close $f
+    set f [open $path(test1)]
+    fconfigure $f -translation auto -buffersize 7
+    set x {}
+    lappend x [read $f 5]
+    lappend x [read $f]
+    close $f
+    set x
+} [list "abcd\n" "\ndef"]
 test io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} {
     set f [open $path(test1) w]
     fconfigure $f -translation lf
-- 
cgit v0.12


From 4830ed53a3b546ff699230e332c0a6d4fecf5a24 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 16 May 2014 14:40:39 +0000
Subject: Bug fix - accept consumption of the trailing newline in crlf with no
 characters produced.  Also delete false assertions.

---
 generic/tclIO.c | 46 +++++++++++++++++++++++++++++++++++++---------
 1 file changed, 37 insertions(+), 9 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 139a05e..16fc685 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5400,7 +5400,6 @@ ReadChars(
 	     *	  record \r or \n yet.
 	     */
 
-	    assert(dstRead + 1 == dstDecoded);
 	    assert(dst[dstRead] == '\r');
 	    assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF);
 
@@ -5421,7 +5420,6 @@ ReadChars(
 
 	    assert(dstWrote == 0);
 	    assert(dstRead == 0);
-	    assert(dstDecoded == 1);
 
 	    /*
 	     * We decoded only the bare cr, and we cannot read a
@@ -5476,6 +5474,13 @@ ReadChars(
 		return 1;
 	    }
 
+	    /*
+	     * Revise the dstRead value so that the numChars calc
+	     * below correctly computes zero characters read.
+	     */
+
+	    dstRead = numChars;
+
 	    /* FALL THROUGH - get more data (dstWrote == 0) */
 	}
 
@@ -5502,16 +5507,38 @@ ReadChars(
 	}
 
 	if (dstWrote == 0) {
+	    ChannelBuffer *nextPtr;
 
-	    /*
-	     * We were not able to read any chars.  Maybe there were
-	     * not enough src bytes to decode into a char.  Maybe
-	     * a lone \r could not be translated (crlf mode).  Need
-	     * to combine any unused src bytes we have in the first
-	     * buffer with subsequent bytes to try again.
+	    /* We were not able to read any chars. */
+
+	    assert (numChars == 0);
+
+	    /* 
+	     * There is one situation where this is the correct final
+	     * result.  If the src buffer contains only a single \n
+	     * byte, and we are in TCL_TRANSLATE_AUTO mode, and
+	     * when the translation pass was made the INPUT_SAW_CR
+	     * flag was set on the channel.  In that case, the
+	     * correct behavior is to consume that \n and produce the
+	     * empty string.
+	     */
+
+	    if (dst[0] == '\n') {
+		assert(statePtr->inputTranslation == TCL_TRANSLATE_AUTO);
+		assert(dstRead == 1);
+
+		goto consume;
+	    }
+
+	    /* Otherwise, reading zero characters indicates there's
+	     * something incomplete at the end of the src buffer.
+	     * Maybe there were not enough src bytes to decode into
+	     * a char.  Maybe a lone \r could not be translated (crlf
+	     * mode).  Need to combine any unused src bytes we have
+	     * in the first buffer with subsequent bytes to try again.
 	     */
 
-	    ChannelBuffer *nextPtr = bufPtr->nextPtr;
+	    nextPtr = bufPtr->nextPtr;
 
 	    if (nextPtr == NULL) {
 		if (srcLen > 0) {
@@ -5548,6 +5575,7 @@ ReadChars(
 
 	statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
 
+    consume:
 	bufPtr->nextRemoved += srcRead;
 	if (dstWrote > srcRead + 1) {
 	    *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;
-- 
cgit v0.12


From 46b60b08860ef3c85c1dc0a9250fd1c499714a6a Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 16 May 2014 18:45:37 +0000
Subject: Move the resets and testings of the BLOCKED flag to where they make
 more sense.

---
 generic/tclIO.c | 39 +++++++++++++++++----------------------
 1 file changed, 17 insertions(+), 22 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index a5c77e8..a128d7c 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -3949,9 +3949,6 @@ Tcl_GetsObj(
 	goto done;
     }
 
-    /* TODO: Locate better place(s) to reset this flag */
-    ResetFlag(statePtr, CHANNEL_BLOCKED);
-
     /*
      * A binary version of Tcl_GetsObj. This could also handle encodings that
      * are ascii-7 pure (iso8859, utf-8, ...) with a final encoding conversion
@@ -4182,6 +4179,7 @@ Tcl_GetsObj(
 		Tcl_SetObjLength(objPtr, oldLength);
 		CommonGetsCleanup(chanPtr);
 		copiedTotal = -1;
+		ResetFlag(statePtr, CHANNEL_BLOCKED);
 		goto done;
 	    }
 	    goto gotEOL;
@@ -4381,10 +4379,9 @@ TclGetsObjBinary(
 	     * device. Side effect is to allocate another channel buffer.
 	     */
 
-	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
-		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
-		    goto restore;
-		}
+	    if (GotFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_NONBLOCKING)
+		    == (CHANNEL_BLOCKED|CHANNEL_NONBLOCKING)) {
+		goto restore;
 	    }
 	    if (GetInput(chanPtr) != 0) {
 		goto restore;
@@ -4447,6 +4444,7 @@ TclGetsObjBinary(
 		byteArray = Tcl_SetByteArrayLength(objPtr, oldLength);
 		CommonGetsCleanup(chanPtr);
 		copiedTotal = -1;
+		ResetFlag(statePtr, CHANNEL_BLOCKED);
 		goto done;
 	    }
 	    goto gotEOL;
@@ -4650,14 +4648,6 @@ FilterInputBytes(
 	 */
 
     read:
-	/* TODO: Move this check to the goto */
-	if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
-	    if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
-		gsPtr->charsWrote = 0;
-		gsPtr->rawRead = 0;
-		return -1;
-	    }
-	}
 	if (GetInput(chanPtr) != 0) {
 	    gsPtr->charsWrote = 0;
 	    gsPtr->rawRead = 0;
@@ -4745,9 +4735,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 {
@@ -5207,10 +5203,9 @@ DoReadChars(
 	    if (GotFlag(statePtr, CHANNEL_EOF)) {
 		break;
 	    }
-	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
-		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
-		    break;
-		}
+	    if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)
+		    == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) {
+		break;
 	    }
 	    result = GetInput(chanPtr);
 	    if (chanPtr != statePtr->topChanPtr) {
@@ -8935,8 +8930,8 @@ DoRead(
 	    RecycleBuffer(statePtr, bufPtr, 0);
 	}
 
-	if (GotFlag(statePtr, CHANNEL_NONBLOCKING)
-		&& GotFlag(statePtr, CHANNEL_BLOCKED)) {
+	if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)
+		== (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) {
 	    break;
 	}
     }
-- 
cgit v0.12


From 8899c7cda9cd674018d4cc5a807cdaa5076f0f02 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 16 May 2014 19:11:49 +0000
Subject: Improved use of EOF state to avoid worthless allocations.

---
 generic/tclIO.c | 22 ++++++++++++----------
 1 file changed, 12 insertions(+), 10 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index a128d7c..09fa55e 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -6079,6 +6079,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
@@ -6143,16 +6155,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);
 
-- 
cgit v0.12


From e14f3688ed41e7bcae1a5448ba213d5d8d063ecf Mon Sep 17 00:00:00 2001
From: ferrieux <ferrieux@users.sourceforge.net>
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 <dgp@users.sourceforge.net>
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 b09a6f570cb33adb2f0ec8b2475573e27fab88e5 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Sat, 17 May 2014 02:53:34 +0000
Subject: Repair broken tests iogt-2.[123]. What happened is that now that EOF
 flags no loger leak acros channel stack layers, an EOF in the bottom channel
 isn't detected in the top one until the ChanRead call at the top level
 actually returns 0 bytes.  This causes one more query/ma

---
 tests/iogt.test | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/tests/iogt.test b/tests/iogt.test
index 0e2eb3c..5fe3dc2 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -552,6 +552,7 @@ query/maxRead
 read
 query/maxRead
 flush/read
+query/maxRead
 delete/read
 --------
 create/write
@@ -604,6 +605,7 @@ read {
 }
 query/maxRead {} -1
 flush/read {} {}
+query/maxRead {} -1
 delete/read {} *ignored*
 --------
 create/write {} *ignored*
@@ -658,6 +660,7 @@ read {%^&*()_+-=
 }
 query/maxRead {} -1
 flush/read {} {}
+query/maxRead {} -1
 write %^&*()_+-= %^&*()_+-=
 write {
 } {
-- 
cgit v0.12


From acbdb9cde6294dbbac2559014328039d3cf8839e Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
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 f6becd63de09f3ad007bb2e1543cd21230242479 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Sat, 17 May 2014 03:32:27 +0000
Subject: Simplify the inputProc of [testchannel transform].

---
 generic/tclIOGT.c | 39 ++++++++++++++++++---------------------
 1 file changed, 18 insertions(+), 21 deletions(-)

diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index c5372b1..fe0a880 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -683,38 +683,35 @@ 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.
-	     */
 
-	    if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
+	    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.
+		 */
+
 		break;
 	    }
 
+	    /*
+	     * 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 055e5320555047ffa7b6a3c635374020ffbcd3ac Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
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 <dgp@users.sourceforge.net>
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 <dgp@users.sourceforge.net>
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 <max@tclers.tk>
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" <nijtmans@users.sourceforge.net>
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 <andrew.m.goth@gmail.com>
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 <andrew.m.goth@gmail.com>
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 <andrew.m.goth@gmail.com>
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 dced768bbaa8b761aa86cf4b8f086039502a7b7d Mon Sep 17 00:00:00 2001
From: andreask <andreask>
Date: Thu, 22 May 2014 17:17:12 +0000
Subject: Workarounds and fixes for wrapped executables on various platforms
 regarding the handling of wrapped dynamic libraries.

The basic flow of operation is to copy such libraries into a temp
file, hand them to the OS loader for processing, and then to delete
them immediately, to prevent them from being accessible to other
executables. On platforms where that is not possible the library is
left in place and things are arranged to delete it on regular process
exit.

An example of the latter are older revisions of HPUX which report that
the file is busy when trying to delete it. Younger revisions of HPUX
have changed to allow the deletion, but are also buggy, the OS loader
mangles its data structures so that a second library loaded in this
manner fails.

More recently it was found that Linux which is usually ok with
deleting the file and gets everything right shows the same trouble as
modern HPUX when the "docker" containerization system is involved, or
more specifically the AUFS in use there. Deleting the loaded library
file mangles data structures and breaks loading of the following
libraries. For a demonstration which does not involve Tcl at all see
the ticket

     https://github.com/dotcloud/docker/issues/1911

in the docker tracker.

This of course breaks the use of wrapped executables within docker
containers.

This commit introduces the function TclSkipUnlink() which centralizes
the handling of such exceptions to unlinking the library after unload,
and provides code handling the known cases. IOW HPUX is generally
forced to not unlink, and ditto when we detect that the copied library
file resides within an AUFS.

The latter must however be explicitly activated by setting the define
-DTCL_TEMPLOAD_NO_UNLINK during build. We still need proper configure
tests to set it on the relevant platforms (i.e. Linux).

The AUFS detection and handling can be overridden by the environment
variable TCL_TEMPLOAD_NO_UNLINK which can force the behaviour either
way (skip or not). In case the user knows best, or wishes to test if
the problem with AUFS has been fixed.
---
 generic/tclIOUtil.c | 87 ++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 86 insertions(+), 1 deletion(-)

diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 295e313..3d33992 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -24,6 +24,12 @@
 #endif
 #include "tclFileSystem.h"
 
+#ifdef TCL_TEMPLOAD_NO_UNLINK
+#ifndef NO_FSTATFS
+#include <sys/statfs.h>
+#endif
+#endif
+
 /*
  * struct FilesystemRecord --
  *
@@ -3149,6 +3155,83 @@ Tcl_FSLoadFile(
 typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
 	Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
 
+/*
+ * Workaround for issue with modern HPUX which do allow the unlink (no ETXTBSY
+ * error) yet somehow trash some internal data structures which prevents the
+ * second and further shared libraries from getting properly loaded. Only the
+ * first is ok. We try to get around the issue by not unlinking,
+ * i.e. emulating the behaviour of the older HPUX which denied removal.
+ *
+ * Doing the unlink is also an issue within docker containers, whose AUFS
+ * bungles this as well, see
+ *     https://github.com/dotcloud/docker/issues/1911
+ *
+ * For these situations the change below makes the execution of the unlink
+ * semi-controllable at runtime.
+ *
+ *     An AUFS filesystem (if it can be detected) will force avoidance of
+ *     unlink. The env variable TCL_TEMPLOAD_NO_UNLINK allows detection of a
+ *     users general request (unlink and not.
+ *
+ * By default the unlink is done (if not in AUFS). However if the variable is
+ * present and set to true (any integer > 0) then the unlink is skipped.
+ */
+
+int
+TclSkipUnlink (Tcl_Obj* shlibFile)
+{
+    /* Order of testing:
+     * 1. On hpux we generally want to skip unlink in general
+     *
+     * Outside of hpux then:
+     * 2. For a general user request   (TCL_TEMPLOAD_NO_UNLINK present, non-empty, => int)
+     * 3. For general AUFS environment (statfs, if available).
+     *
+     * Ad 2: This variable can disable/override the AUFS detection, i.e. for
+     * testing if a newer AUFS does not have the bug any more.
+     * 
+     * Ad 3: This is conditionally compiled in. Condition currently must be set manually.
+     *       This part needs proper tests in the configure(.in).
+     */
+
+#ifdef hpux
+    return 1;
+#else
+    int   skip = 0;
+    char* skipstr;
+
+    skipstr = getenv ("TCL_TEMPLOAD_NO_UNLINK");
+    if (skipstr && (skipstr[0] != '\0')) {
+	return atoi(skipstr);
+    }
+
+#ifdef TCL_TEMPLOAD_NO_UNLINK
+#ifndef NO_FSTATFS
+    {
+	struct statfs fs;
+	/* Have fstatfs. May not have the AUFS super magic ... Indeed our build
+	 * box is too old to have it directly in the headers. Define taken from
+	 *     http://mooon.googlecode.com/svn/trunk/linux_include/linux/aufs_type.h
+	 *     http://aufs.sourceforge.net/
+	 * Better reference will be gladly taken.
+	 */
+#ifndef AUFS_SUPER_MAGIC
+#define AUFS_SUPER_MAGIC ('a' << 24 | 'u' << 16 | 'f' << 8 | 's')
+#endif /* AUFS_SUPER_MAGIC */
+	if ((statfs(Tcl_GetString (shlibFile), &fs) == 0) &&
+	    (fs.f_type == AUFS_SUPER_MAGIC)) {
+	    return 1;
+	}
+    }
+#endif /* ... NO_FSTATFS */
+#endif /* ... TCL_TEMPLOAD_NO_UNLINK */
+
+    /* Fallback: !hpux, no EV override, no AUFS (detection, nor detected):
+     * Don't skip */
+    return 0;
+#endif /* hpux */
+}
+
 int
 TclLoadFile(
     Tcl_Interp *interp,		/* Used for error reporting. */
@@ -3353,7 +3436,9 @@ TclLoadFile(
      * avoids any worries about leaving the copy laying around on exit.
      */
 
-    if (Tcl_FSDeleteFile(copyToPtr) == TCL_OK) {
+    if (
+	!TclSkipUnlink (copyToPtr) &&
+	(Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) {
 	Tcl_DecrRefCount(copyToPtr);
 
 	/*
-- 
cgit v0.12


From a7c63b96168422c0fa7abd8e16091739acf350a5 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
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 34af92d1f5c5a77bb1ccb4bbd0658ab48805056d Mon Sep 17 00:00:00 2001
From: andreask <andreask>
Date: Fri, 23 May 2014 17:17:35 +0000
Subject: Followup on [72c54e1659]. Removed unused variable.

---
 generic/tclIOUtil.c | 1 -
 1 file changed, 1 deletion(-)

diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 3d33992..82ffd88 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -3197,7 +3197,6 @@ TclSkipUnlink (Tcl_Obj* shlibFile)
 #ifdef hpux
     return 1;
 #else
-    int   skip = 0;
     char* skipstr;
 
     skipstr = getenv ("TCL_TEMPLOAD_NO_UNLINK");
-- 
cgit v0.12


From 7e7fc66d0c49405ff64c193170207ba58c33301f Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Sat, 24 May 2014 19:56:37 +0000
Subject: Comment out lines of test io-53.4 that appear to do nothing of any
 value.

---
 tests/io.test | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/tests/io.test b/tests/io.test
index a2e2397..c7da8e6 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -7120,17 +7120,17 @@ 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(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
+#	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+]
-- 
cgit v0.12


From 00ef775fc158959acc2c14c5ff3568e1f86fe538 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 27 May 2014 13:28:41 +0000
Subject: Move code that can only matter in the first loop iteration out of the
 loop.

---
 generic/tclIO.c | 19 ++++++-------------
 1 file changed, 6 insertions(+), 13 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 9e1a723..4e325ba 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -2510,12 +2510,6 @@ FlushChannel(
 	return -1;
     }
 
-    /*
-     * Loop over the queued buffers and attempt to flush as much as possible
-     * of the queued output to the channel.
-     */
-
-    while (1) {
 	/*
 	 * If the queue is empty and there is a ready current buffer, OR if
 	 * the current buffer is full, then move the current buffer to the
@@ -2536,7 +2530,6 @@ FlushChannel(
 	    statePtr->outQueueTail = statePtr->curOutPtr;
 	    statePtr->curOutPtr = NULL;
 	}
-	bufPtr = statePtr->outQueueHead;
 
 	/*
 	 * If we are not being called from an async flush and an async flush
@@ -2547,13 +2540,13 @@ FlushChannel(
 	    return 0;
 	}
 
-	/*
-	 * If the output queue is still empty, break out of the while loop.
-	 */
+    /*
+     * Loop over the queued buffers and attempt to flush as much as possible
+     * of the queued output to the channel.
+     */
 
-	if (bufPtr == NULL) {
-	    break;	/* Out of the "while (1)". */
-	}
+    while (statePtr->outQueueHead) {
+	bufPtr = statePtr->outQueueHead;
 
 	/*
 	 * Produce the output on the channel.
-- 
cgit v0.12


From 1c2468956cac48003a15f5984176963d5135d340 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 28 May 2014 16:54:02 +0000
Subject: Increase size of test io-29.34 so that it more portably tests the
 case where the OS networking machinery gets backed up and blocks. Added
 several TODO comments on potential simplifications.

---
 generic/tclIO.c | 9 +++++++++
 tests/io.test   | 4 ++--
 2 files changed, 11 insertions(+), 2 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 4e325ba..9e0d7f1 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -2555,6 +2555,7 @@ FlushChannel(
 	PreserveChannelBuffer(bufPtr);
 	toWrite = BytesLeft(bufPtr);
 	if (toWrite == 0) {
+	    /* TODO: This cannot happen. */
 	    written = 0;
 	} else {
 	    written = (chanPtr->typePtr->outputProc)(chanPtr->instanceData,
@@ -2667,6 +2668,8 @@ FlushChannel(
 	    ReleaseChannelBuffer(bufPtr);
 	    continue;
 	} else {
+	    /* TODO: Consider detecting and reacting to short writes
+	     * on blocking channels.  Ought not happen.  See iocmd-24.2. */
 	    wroteSome = 1;
 	}
 
@@ -2700,6 +2703,12 @@ FlushChannel(
 	    ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
 	    (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. */
 	}
     }
 
diff --git a/tests/io.test b/tests/io.test
index c7da8e6..f1248b9 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -2786,7 +2786,7 @@ test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMa
     variable x running
     set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
     proc writelots {s l} {
-	for {set i 0} {$i < 2000} {incr i} {
+	for {set i 0} {$i < 9000} {incr i} {
 	    puts $s $l
 	}
     }
@@ -2817,7 +2817,7 @@ test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMa
     close $ss
     vwait [namespace which -variable x]
     set c
-} 2000
+} 9000
 test io-29.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket tempNotMac fileevent} {
     # On Mac, this test screws up sockets such that subsequent tests using port 2828
     # either cause errors or panic().
-- 
cgit v0.12


From d6e3f0435451305fe0e8da53490b9c56517db94f Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 28 May 2014 17:14:11 +0000
Subject: Expand the IsBufferFull() macro to check non-NULL bufPtr..

---
 generic/tclIO.c | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 9e0d7f1..17efa1e 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -12,6 +12,7 @@
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
+#undef NDEBUG
 #include "tclInt.h"
 #include "tclIO.h"
 #include <assert.h>
@@ -284,7 +285,7 @@ static int WillRead(Channel *chanPtr);
 
 #define IsBufferEmpty(bufPtr) ((bufPtr)->nextAdded == (bufPtr)->nextRemoved)
 
-#define IsBufferFull(bufPtr) ((bufPtr)->nextAdded >= (bufPtr)->bufLength)
+#define IsBufferFull(bufPtr) ((bufPtr) && (bufPtr)->nextAdded >= (bufPtr)->bufLength)
 
 #define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded > (bufPtr)->bufLength)
 
@@ -2516,8 +2517,7 @@ FlushChannel(
 	 * queue.
 	 */
 
-	if (((statePtr->curOutPtr != NULL) &&
-		IsBufferFull(statePtr->curOutPtr))
+	if (IsBufferFull(statePtr->curOutPtr)
 		|| (GotFlag(statePtr, BUFFER_READY) &&
 			(statePtr->outQueueHead == NULL))) {
 	    ResetFlag(statePtr, BUFFER_READY);
@@ -2531,6 +2531,8 @@ FlushChannel(
 	    statePtr->curOutPtr = NULL;
 	}
 
+    assert(!IsBufferFull(statePtr->curOutPtr));
+
 	/*
 	 * If we are not being called from an async flush and an async flush
 	 * is active, we just return without producing any output.
@@ -6122,9 +6124,8 @@ GetInput(
      */
 
     bufPtr = statePtr->inQueueTail;
-    if ((bufPtr != NULL) && !IsBufferFull(bufPtr)) {
-	toRead = SpaceLeft(bufPtr);
-    } else {
+
+    if ((bufPtr == NULL) || IsBufferFull(bufPtr)) {
 	bufPtr = statePtr->saveInBufPtr;
 	statePtr->saveInBufPtr = NULL;
 
@@ -6154,6 +6155,8 @@ GetInput(
 	    statePtr->inQueueTail->nextPtr = bufPtr;
 	}
 	statePtr->inQueueTail = bufPtr;
+    } else {
+	toRead = SpaceLeft(bufPtr);
     }
 
     PreserveChannelBuffer(bufPtr);
@@ -8827,7 +8830,7 @@ DoRead(
 
 	/* If there is no full buffer, attempt to create and/or fill one. */
 
-	while (bufPtr == NULL || !IsBufferFull(bufPtr)) {
+	while (!IsBufferFull(bufPtr)) {
 	    int code;
 
 	moreData:
-- 
cgit v0.12


From a6b4426c1c32f4aefd4a2dc2d6aa60a756d1a586 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 28 May 2014 18:24:56 +0000
Subject: Further simplifications to FlushChannel().  This makes clear the
 BUFFER_READY flag serves no necessary purpose, so it is removed.

---
 generic/tclIO.c | 114 +++++++++++++++++++-------------------------------------
 generic/tclIO.h |   5 ---
 2 files changed, 38 insertions(+), 81 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 17efa1e..911fa97 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -1149,15 +1149,6 @@ Tcl_UnregisterChannel(
      */
 
     if (statePtr->refCount <= 0) {
-	/*
-	 * Ensure that if there is another buffer, it gets flushed whether or
-	 * not we are doing a background flush.
-	 */
-
-	if ((statePtr->curOutPtr != NULL) &&
-		IsBufferReady(statePtr->curOutPtr)) {
-	    SetFlag(statePtr, BUFFER_READY);
-	}
 	Tcl_Preserve((ClientData)statePtr);
 	if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
 	    /*
@@ -2491,8 +2482,6 @@ FlushChannel(
     ChannelState *statePtr = chanPtr->state;
 				/* State of the channel stack. */
     ChannelBuffer *bufPtr;	/* Iterates over buffered output queue. */
-    int toWrite;		/* Amount of output data in current buffer
-				 * available to be written. */
     int written;		/* Amount of output data actually written in
 				 * current round. */
     int errorCode = 0;		/* Stores POSIX error codes from channel
@@ -2511,36 +2500,42 @@ FlushChannel(
 	return -1;
     }
 
-	/*
-	 * If the queue is empty and there is a ready current buffer, OR if
-	 * the current buffer is full, then move the current buffer to the
-	 * queue.
-	 */
+    /*
+     * Should we shift the current output buffer over to the output queue?
+     * First check that there are bytes in it.  If so then...
+     * If the output queue is empty, then yes, trusting the caller called
+     * us only when written bytes ought to be flushed.
+     * If the current output buffer is full, then yes, so we can meet
+     * the post-condition that on a successful return to caller we've
+     * left space in the current output buffer for more writing (the flush
+     * call was to make new room).
+     * Otherwise, no.  Keep the current output buffer where it is so more
+     * can be written to it, possibly filling it, to promote more efficient
+     * buffer usage.
+     */
 
-	if (IsBufferFull(statePtr->curOutPtr)
-		|| (GotFlag(statePtr, BUFFER_READY) &&
-			(statePtr->outQueueHead == NULL))) {
-	    ResetFlag(statePtr, BUFFER_READY);
-	    statePtr->curOutPtr->nextPtr = NULL;
-	    if (statePtr->outQueueHead == NULL) {
-		statePtr->outQueueHead = statePtr->curOutPtr;
-	    } else {
-		statePtr->outQueueTail->nextPtr = statePtr->curOutPtr;
-	    }
-	    statePtr->outQueueTail = statePtr->curOutPtr;
-	    statePtr->curOutPtr = NULL;
+    bufPtr = statePtr->curOutPtr;
+    if (bufPtr && BytesLeft(bufPtr) && /* Keep empties off queue */
+	    (statePtr->outQueueHead == NULL || IsBufferFull(bufPtr))) {
+	if (statePtr->outQueueHead == NULL) {
+	    statePtr->outQueueHead = bufPtr;
+	} else {
+	    statePtr->outQueueTail->nextPtr = bufPtr;
 	}
+	statePtr->outQueueTail = bufPtr;
+	statePtr->curOutPtr = NULL;
+    }
 
     assert(!IsBufferFull(statePtr->curOutPtr));
 
-	/*
-	 * If we are not being called from an async flush and an async flush
-	 * is active, we just return without producing any output.
-	 */
+    /*
+     * If we are not being called from an async flush and an async flush
+     * is active, we just return without producing any output.
+     */
 
-	if (!calledFromAsyncFlush && GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
-	    return 0;
-	}
+    if (!calledFromAsyncFlush && GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
+	return 0;
+    }
 
     /*
      * Loop over the queued buffers and attempt to flush as much as possible
@@ -2555,14 +2550,8 @@ FlushChannel(
 	 */
 
 	PreserveChannelBuffer(bufPtr);
-	toWrite = BytesLeft(bufPtr);
-	if (toWrite == 0) {
-	    /* TODO: This cannot happen. */
-	    written = 0;
-	} else {
-	    written = (chanPtr->typePtr->outputProc)(chanPtr->instanceData,
-		RemovePoint(bufPtr), toWrite, &errorCode);
-	}
+	written = (chanPtr->typePtr->outputProc)(chanPtr->instanceData,
+		RemovePoint(bufPtr), BytesLeft(bufPtr), &errorCode);
 
 	/*
 	 * If the write failed completely attempt to start the asynchronous
@@ -2668,7 +2657,7 @@ FlushChannel(
 
 	    DiscardOutputQueued(statePtr);
 	    ReleaseChannelBuffer(bufPtr);
-	    continue;
+	    break;
 	} else {
 	    /* TODO: Consider detecting and reacting to short writes
 	     * on blocking channels.  Ought not happen.  See iocmd-24.2. */
@@ -2689,7 +2678,7 @@ FlushChannel(
 	    RecycleBuffer(statePtr, bufPtr, 0);
 	}
 	ReleaseChannelBuffer(bufPtr);
-    }	/* Closes "while (1)". */
+    }	/* Closes "while". */
 
     /*
      * If we wrote some data while flushing in the background, we are done.
@@ -3256,14 +3245,6 @@ Tcl_Close(
     ResetFlag(statePtr, CHANNEL_INCLOSE);
 
     /*
-     * Ensure that the last output buffer will be flushed.
-     */
-
-    if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
-	SetFlag(statePtr, BUFFER_READY);
-    }
-
-    /*
      * If this channel supports it, close the read side, since we don't need
      * it anymore and this will help avoid deadlocks on some channel types.
      */
@@ -3673,10 +3654,10 @@ static int WillRead(Channel *chanPtr)
     }
     if ((chanPtr->typePtr->seekProc != NULL)
         && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
-        if ((chanPtr->state->curOutPtr != NULL)
-            && IsBufferReady(chanPtr->state->curOutPtr)) {
-            SetFlag(chanPtr->state, BUFFER_READY);
-        }
+
+	/* TODO: Consider when channel is nonblocking and this
+	 * FlushChannel() call may not finish the task of shoving
+	 * bytes out.  Then what? */
         if (FlushChannel(NULL, chanPtr, 0) != 0) {
             return -1;
         }
@@ -3858,7 +3839,6 @@ Write(
     }
     if ((flushed < total) && (GotFlag(statePtr, CHANNEL_UNBUFFERED) ||
 	    (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED)))) {
-	SetFlag(statePtr, BUFFER_READY);
 	if (FlushChannel(NULL, chanPtr, 0) != 0) {
 	    return -1;
 	}
@@ -5977,14 +5957,6 @@ Tcl_Flush(
 	return -1;
     }
 
-    /*
-     * Force current output buffer to be output also.
-     */
-
-    if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
-	SetFlag(statePtr, BUFFER_READY);
-    }
-
     result = FlushChannel(NULL, chanPtr, 0);
     if (result != 0) {
 	return TCL_ERROR;
@@ -6298,15 +6270,6 @@ Tcl_Seek(
     }
 
     /*
-     * If there is data buffered in statePtr->curOutPtr then mark the channel
-     * as ready to flush before invoking FlushChannel.
-     */
-
-    if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
-	SetFlag(statePtr, BUFFER_READY);
-    }
-
-    /*
      * If the flush fails we cannot recover the original position. In that
      * case the seek is not attempted because we do not know where the access
      * position is - instead we return the error. FlushChannel has already
@@ -10385,7 +10348,6 @@ DumpFlags(
     ChanFlag('n', CHANNEL_NONBLOCKING);
     ChanFlag('l', CHANNEL_LINEBUFFERED);
     ChanFlag('u', CHANNEL_UNBUFFERED);
-    ChanFlag('R', BUFFER_READY);
     ChanFlag('F', BG_FLUSH_SCHEDULED);
     ChanFlag('c', CHANNEL_CLOSED);
     ChanFlag('E', CHANNEL_EOF);
diff --git a/generic/tclIO.h b/generic/tclIO.h
index b8fb5be..59182ec 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -227,11 +227,6 @@ typedef struct ChannelState {
 					 * flushed after every newline. */
 #define CHANNEL_UNBUFFERED	(1<<5)	/* Output to the channel must always
 					 * be flushed immediately. */
-#define BUFFER_READY		(1<<6)	/* Current output buffer (the
-					 * curOutPtr field in the channel
-					 * structure) should be output as soon
-					 * as possible even though it may not
-					 * be full. */
 #define BG_FLUSH_SCHEDULED	(1<<7)	/* A background flush of the queued
 					 * output buffers has been
 					 * scheduled. */
-- 
cgit v0.12


From 8dc54fa3e0120b8916399d8eb7c07c8dbf3810cb Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 28 May 2014 18:49:02 +0000
Subject: Update comment to explain assumptions.

---
 generic/tclIO.c | 13 ++++++++++---
 1 file changed, 10 insertions(+), 3 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 911fa97..ccd5708 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -3655,9 +3655,16 @@ static int WillRead(Channel *chanPtr)
     if ((chanPtr->typePtr->seekProc != NULL)
         && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
 
-	/* TODO: Consider when channel is nonblocking and this
-	 * FlushChannel() call may not finish the task of shoving
-	 * bytes out.  Then what? */
+	/*
+	 * CAVEAT - The assumption here is that FlushChannel() will
+	 * push out the bytes of any writes that are in progress.
+	 * Since this is a seekable channel, we assume it is not one
+	 * that can block and force bg flushing.  Channels we know that
+	 * can do that -- sockets, pipes -- are not seekable.  If the
+	 * assumption is wrong, more drastic measures may be required here
+	 * like temporarily setting the channel into blocking mode.
+	 */
+
         if (FlushChannel(NULL, chanPtr, 0) != 0) {
             return -1;
         }
-- 
cgit v0.12


From 46ad08baa493c06c277895adba74c64fce774dd4 Mon Sep 17 00:00:00 2001
From: oehhar <harald.oehlmann@elmicron.de>
Date: Thu, 29 May 2014 14:56:10 +0000
Subject: Try not to loose FD_CONNECT by switching monitoring off.

---
 win/tclWinSock.c | 14 +++++++++-----
 1 file changed, 9 insertions(+), 5 deletions(-)

diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index e18a3dd..ae9ba17 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1239,13 +1239,17 @@ WaitForSocketEvent(
 
     /*
      * Reset WSAAsyncSelect so we have a fresh set of events pending.
+     * Don't do that if we are waiting for a connect as this may ignore
+     * a failed connect.
      */
 
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT,
-	    (LPARAM) infoPtr);
-
-    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
-	    (LPARAM) infoPtr);
+    if ( 0 == (events & FD_CONNECT) ) {
+        SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT,
+                (LPARAM) infoPtr);
+    
+        SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
+                (LPARAM) infoPtr);
+    }
 
     while (1) {
 	if (infoPtr->lastError) {
-- 
cgit v0.12


From ea994aa1957bd3faea8f4cdf2ae290d102ae1fe8 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
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 <max@tclers.tk>
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 <dgp@users.sourceforge.net>
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 <dgp@users.sourceforge.net>
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


From c519b689fd1cea30413a6f1d66639d46e0850606 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 3 Jun 2014 07:26:11 +0000
Subject: [1b0266d8bb] Working towards ensuring that all dict operations are
 sufficiently strict.

---
 generic/tclDictObj.c | 46 +++++++++++++++++++++-------------------------
 tests/dict.test      | 42 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 63 insertions(+), 25 deletions(-)

diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index e31d708..71d5f5d 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -1026,11 +1026,11 @@ Tcl_DictObjRemove(
 	}
     }
 
-    if (dictPtr->bytes != NULL) {
-	TclInvalidateStringRep(dictPtr);
-    }
     dict = dictPtr->internalRep.twoPtrValue.ptr1;
     if (DeleteChainEntry(dict, keyPtr)) {
+	if (dictPtr->bytes != NULL) {
+	    TclInvalidateStringRep(dictPtr);
+	}
 	dict->epoch++;
     }
     return TCL_OK;
@@ -1629,8 +1629,7 @@ DictReplaceCmd(
     Tcl_Obj *const *objv)
 {
     Tcl_Obj *dictPtr;
-    int i, result;
-    int allocatedDict = 0;
+    int i;
 
     if ((objc < 2) || (objc & 1)) {
 	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key value ...?");
@@ -1638,18 +1637,17 @@ DictReplaceCmd(
     }
 
     dictPtr = objv[1];
-    if (Tcl_IsShared(dictPtr)) {
-	dictPtr = Tcl_DuplicateObj(dictPtr);
-	allocatedDict = 1;
+    if (dictPtr->typePtr != &tclDictType) {
+	int result = SetDictFromAny(interp, dictPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
     }
     for (i=2 ; i<objc ; i+=2) {
-	result = Tcl_DictObjPut(interp, dictPtr, objv[i], objv[i+1]);
-	if (result != TCL_OK) {
-	    if (allocatedDict) {
-		TclDecrRefCount(dictPtr);
-	    }
-	    return TCL_ERROR;
+	if (Tcl_IsShared(dictPtr)) {
+	    dictPtr = Tcl_DuplicateObj(dictPtr);
 	}
+	(void) Tcl_DictObjPut(interp, dictPtr, objv[i], objv[i+1]);
     }
     Tcl_SetObjResult(interp, dictPtr);
     return TCL_OK;
@@ -1681,8 +1679,7 @@ DictRemoveCmd(
     Tcl_Obj *const *objv)
 {
     Tcl_Obj *dictPtr;
-    int i, result;
-    int allocatedDict = 0;
+    int i;
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?");
@@ -1690,18 +1687,17 @@ DictRemoveCmd(
     }
 
     dictPtr = objv[1];
-    if (Tcl_IsShared(dictPtr)) {
-	dictPtr = Tcl_DuplicateObj(dictPtr);
-	allocatedDict = 1;
+    if (dictPtr->typePtr != &tclDictType) {
+	int result = SetDictFromAny(interp, dictPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
     }
     for (i=2 ; i<objc ; i++) {
-	result = Tcl_DictObjRemove(interp, dictPtr, objv[i]);
-	if (result != TCL_OK) {
-	    if (allocatedDict) {
-		TclDecrRefCount(dictPtr);
-	    }
-	    return TCL_ERROR;
+	if (Tcl_IsShared(dictPtr)) {
+	    dictPtr = Tcl_DuplicateObj(dictPtr);
 	}
+	(void) Tcl_DictObjRemove(interp, dictPtr, objv[i]);
     }
     Tcl_SetObjResult(interp, dictPtr);
     return TCL_OK;
diff --git a/tests/dict.test b/tests/dict.test
index a583de8..1ccad7c 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -167,6 +167,18 @@ test dict-4.8 {dict replace command} -returnCodes error -body {
 } -result {missing value to go with key}
 test dict-4.9 {dict replace command} {dict replace [list a a] a b} {a b}
 test dict-4.10 {dict replace command} {dict replace [list a a] a b a c} {a c}
+test dict-4.11 {dict replace command: canonicality not forced} {
+    dict replace { a b c d }
+} { a b c d }
+test dict-4.12 {dict replace command: canonicality forced by update} {
+    dict replace { a b c d } a b
+} {a b c d}
+test dict-4.13 {dict replace command: type check is mandatory} -body {
+    dict replace { a b c d e }
+} -returnCodes error -result {missing value to go with key}
+test dict-4.14 {dict replace command: type check is mandatory} -body {
+    dict replace { a b {}c d }
+} -returnCodes error -result {list element in braces followed by "c" instead of space}
 
 test dict-5.1 {dict remove command} {dict remove {a b c d} a} {c d}
 test dict-5.2 {dict remove command} {dict remove {a b c d} c} {a b}
@@ -179,6 +191,21 @@ test dict-5.6 {dict remove command} {dict remove {a b} c} {a b}
 test dict-5.7 {dict remove command} -returnCodes error -body {
     dict remove
 } -result {wrong # args: should be "dict remove dictionary ?key ...?"}
+test dict-5.8 {dict remove command: canonicality not forced} {
+    dict remove { a b c d }
+} { a b c d }
+test dict-5.9 {dict remove command: canonicality not forced} {
+    dict remove { a b c d } e
+} { a b c d }
+test dict-5.10 {dict remove command: canonicality forced by update} {
+    dict remove { a b c d } c
+} {a b}
+test dict-5.11 {dict remove command: type check is mandatory} -body {
+    dict remove { a b c d e }
+} -returnCodes error -result {missing value to go with key}
+test dict-5.12 {dict remove command: type check is mandatory} -body {
+    dict remove { a b {}c d }
+} -returnCodes error -result {list element in braces followed by "c" instead of space}
 
 test dict-6.1 {dict keys command} {dict keys {a b}} a
 test dict-6.2 {dict keys command} {dict keys {c d}} c
@@ -1226,6 +1253,21 @@ test dict-20.19 {dict merge command} {
 test dict-20.20 {dict merge command} {
     apply {{} {dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -}}}
 } {a - c d e f 1 - 3 4}
+test dict-20.21 {dict merge command: canonicality not forced} {
+    dict merge { a b c d }
+} { a b c d }
+test dict-20.22 {dict merge command: canonicality not forced} {
+    dict merge { a b c d } {}
+} { a b c d }
+test dict-20.23 {dict merge command: canonicality forced by update} {
+    dict merge { a b c d } {a b}
+} {a b c d}
+test dict-20.24 {dict merge command: type check is mandatory} -body {
+    dict merge { a b c d e }
+} -returnCodes error -result {missing value to go with key}
+test dict-20.25 {dict merge command: type check is mandatory} -body {
+    dict merge { a b {}c d }
+} -returnCodes error -result {list element in braces followed by "c" instead of space}
 
 test dict-21.1 {dict update command} -returnCodes 1 -body {
     dict update
-- 
cgit v0.12


From da17af7ba7f217bb91eb381f5d3cc6ee1fe3d0ef Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 4 Jun 2014 03:25:44 +0000
Subject: Valgrind doesn't like use of uninitialized variables.

---
 unix/tclUnixSock.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 47d0681..a9323c4 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -1024,7 +1024,7 @@ TcpConnect(
 {
     socklen_t optlen;
     int async_callback = statePtr->flags & TCP_ASYNC_PENDING;
-    int ret = -1, error;
+    int ret = -1, error = errno;
     int async = statePtr->flags & TCP_ASYNC_CONNECT;
 
     if (async_callback) {
-- 
cgit v0.12


From a6f4af7b107ac8381f33d4da361aef7825bd7d6b Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 4 Jun 2014 08:15:26 +0000
Subject: more tests, cleaning up the code a bit

---
 generic/tclDictObj.c | 29 +++++++++++++----------------
 tests/dict.test      | 29 +++++++++++++++++++++++++++++
 2 files changed, 42 insertions(+), 16 deletions(-)

diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 71d5f5d..f3c582c 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -600,7 +600,7 @@ SetDictFromAny(
     Tcl_Obj *objPtr)
 {
     Tcl_HashEntry *hPtr;
-    int isNew, result;
+    int isNew;
     Dict *dict = ckalloc(sizeof(Dict));
 
     InitChainTable(dict);
@@ -651,10 +651,9 @@ SetDictFromAny(
 	    const char *elemStart;
 	    int elemSize, literal;
 
-	    result = TclFindElement(interp, nextElem, (limit - nextElem),
-		    &elemStart, &nextElem, &elemSize, &literal);
-	    if (result != TCL_OK) {
-		goto errorExit;
+	    if (TclFindElement(interp, nextElem, (limit - nextElem),
+		    &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
+		goto errorInFindElement;
 	    }
 	    if (elemStart == limit) {
 		break;
@@ -673,11 +672,10 @@ SetDictFromAny(
 			keyPtr->bytes);
 	    }
 
-	    result = TclFindElement(interp, nextElem, (limit - nextElem),
-		    &elemStart, &nextElem, &elemSize, &literal);
-	    if (result != TCL_OK) {
+	    if (TclFindElement(interp, nextElem, (limit - nextElem),
+		    &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
 		TclDecrRefCount(keyPtr);
-		goto errorExit;
+		goto errorInFindElement;
 	    }
 
 	    if (literal) {
@@ -722,16 +720,15 @@ SetDictFromAny(
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"missing value to go with key", -1));
 	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
-    }
-    result = TCL_ERROR;
-
-  errorExit:
-    if (interp != NULL) {
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
+    } else {
+    errorInFindElement:
+	if (interp != NULL) {
+	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
+	}
     }
     DeleteChainTable(dict);
     ckfree(dict);
-    return result;
+    return TCL_ERROR;
 }
 
 /*
diff --git a/tests/dict.test b/tests/dict.test
index 1ccad7c..ae6f42a 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -176,9 +176,38 @@ test dict-4.12 {dict replace command: canonicality forced by update} {
 test dict-4.13 {dict replace command: type check is mandatory} -body {
     dict replace { a b c d e }
 } -returnCodes error -result {missing value to go with key}
+test dict-4.13a {dict replace command: type check is mandatory} {
+    catch {dict replace { a b c d e }} -> opt
+    dict get $opt -errorcode
+} {TCL VALUE DICTIONARY}
 test dict-4.14 {dict replace command: type check is mandatory} -body {
     dict replace { a b {}c d }
 } -returnCodes error -result {list element in braces followed by "c" instead of space}
+test dict-4.14a {dict replace command: type check is mandatory} {
+    catch {dict replace { a b {}c d }} -> opt
+    dict get $opt -errorcode
+} {TCL VALUE DICTIONARY}
+test dict-4.15 {dict replace command: type check is mandatory} -body {
+    dict replace { a b ""c d }
+} -returnCodes error -result {list element in quotes followed by "c" instead of space}
+test dict-4.15a {dict replace command: type check is mandatory} {
+    catch {dict replace { a b ""c d }} -> opt
+    dict get $opt -errorcode
+} {TCL VALUE DICTIONARY}
+test dict-4.16 {dict replace command: type check is mandatory} -body {
+    dict replace " a b \"c d "
+} -returnCodes error -result {unmatched open quote in list}
+test dict-4.16a {dict replace command: type check is mandatory} {
+    catch {dict replace " a b \"c d "} -> opt
+    dict get $opt -errorcode
+} {TCL VALUE DICTIONARY}
+test dict-4.17 {dict replace command: type check is mandatory} -body {
+    dict replace " a b \{c d "
+} -returnCodes error -result {unmatched open brace in list}
+test dict-4.17a {dict replace command: type check is mandatory} {
+    catch {dict replace " a b \{c d "} -> opt
+    dict get $opt -errorcode
+} {TCL VALUE DICTIONARY}
 
 test dict-5.1 {dict remove command} {dict remove {a b c d} a} {c d}
 test dict-5.2 {dict remove command} {dict remove {a b c d} c} {a b}
-- 
cgit v0.12


From 22e5e3f23f66d83f09a06b80a22a8215ab1dfc24 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 4 Jun 2014 16:36:25 +0000
Subject: Revise DiscardOutput() to account for revisions to the loop in
 FlushChannel() which is its only caller.  We need to discard the curOutPtr
 buffer as well, and not count on another pass through the loop to attempt to
 flush it (and raise the same failure again?).

---
 generic/tclIO.c | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index ed94bfe..b7135e9 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -2415,6 +2415,11 @@ DiscardOutputQueued(
     }
     statePtr->outQueueHead = NULL;
     statePtr->outQueueTail = NULL;
+    bufPtr = statePtr->curOutPtr;
+    if (bufPtr && BytesLeft(bufPtr)) {
+	statePtr->curOutPtr = NULL;
+	RecycleBuffer(statePtr, bufPtr, 0);
+    }
 }
 
 /*
-- 
cgit v0.12


From 852f44abf1e24dce23b456d6cfa857bb5649300e Mon Sep 17 00:00:00 2001
From: andy <andrew.m.goth@gmail.com>
Date: Wed, 4 Jun 2014 21:45:29 +0000
Subject: Add missing calls to Tcl_DecrRefCount() in string object man page
 examples.

---
 doc/StringObj.3 | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/doc/StringObj.3 b/doc/StringObj.3
index d81f23d..cf8f6d3 100644
--- a/doc/StringObj.3
+++ b/doc/StringObj.3
@@ -293,6 +293,7 @@ of \fBTcl_Format\fR with functionality equivalent to:
 Tcl_Obj *newPtr = \fBTcl_Format\fR(interp, format, objc, objv);
 if (newPtr == NULL) return TCL_ERROR;
 \fBTcl_AppendObjToObj\fR(objPtr, newPtr);
+\fBTcl_DecrRefCount\fR(newPtr);
 return TCL_OK;
 .CE
 .PP
@@ -337,7 +338,9 @@ Compile-time protection may be provided by some compilers.
 of \fBTcl_ObjPrintf\fR with functionality equivalent to
 .PP
 .CS
-\fBTcl_AppendObjToObj\fR(objPtr, \fBTcl_ObjPrintf\fR(format, ...));
+Tcl_Obj *newPtr = \fBTcl_ObjPrintf\fR(format, ...);
+\fBTcl_AppendObjToObj\fR(objPtr, newPtr);
+\fBTcl_DecrRefCount\fR(newPtr);
 .CE
 .PP
 but with greater convenience and efficiency when the appending
-- 
cgit v0.12


From a17f5d02f8c3ec8babbb27325cba2039e56f1f10 Mon Sep 17 00:00:00 2001
From: andreask <andreask>
Date: Thu, 5 Jun 2014 00:22:59 +0000
Subject: Fixed a tricky interaction of IO system and encodings which could
 result in a panic.

The relevant function is ReadChars() (short RC in the following).

When the encoding and translation transforms deliver more characters
than were requested the iterative algorithm used by RC reduces the
value of "dstLimit" (= the number of bytes allowed to be copied into
the destination buffer) to force the next round to deliver less
characters, hopefully the number requested.

The existing code used the byte located just after the last wanted
character to determine the new limit. The resulting value could
_undershoot_ the best possible limit because Tcl_ExternalToUtf would
effectively reduce this limit further, by TCL_UTF_MAX+1, to have
enough space for a single multi-byte character in the buffer, and a
closing '\0' as well.

One effect of this were additional calls to ReadChars() to retrieve
the characters missed by a call with an undershot limit.

In the limit (sic) however this was also able to cause a full-blown
"Buffer Underflow" panic if the original request was for less than
TCL_UTF_MAX characters (*), and we are using a single-byte encoding
like iso-8859-1. Because then the undershot dstLimit would prevent the
next round from copying anything, and causing it to try and
consolidate the current buffer with the next buffer, thinking that it
had to merge a multi-byte character split across buffer boundaries.

(Ad *) For example because the previous call had undershot already and
left only such a small amount of characters behind!

The basic fix to the problem is to add TCL_UTF_MAX back to the limit,
like is done in all the (three) other places in RC setting a new
one. Note however that this naive fix may generate a new limit which
is the same as the old, or possibly larger. If that happens we act
very conservatively and reduce the limit by only one byte instead.

While I believe that this last conservative approach will never reduce
the limit to TCL_UTF_MAX or less before reaching a state where it
returnds the exact amount of requested characters I still added a
check against this situation anyway, causing a new panic if triggered.
---
 generic/tclIO.c | 23 +++++++++++++++++++++--
 1 file changed, 21 insertions(+), 2 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index b7135e9..e414668 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5596,9 +5596,27 @@ ReadChars(
 	    /* 
 	     * We read more chars than allowed.  Reset limits to
 	     * prevent that and try again.
+             *
+             * Note how we are adding back TCL_UTF_MAX to ensure that the
+             * Tcl_External2Utf invoked by the next round will have enough
+             * space in the destination for at least one multi-byte
+             * character. Without that nothing will be copied and the system
+             * will try to consolidate the entire current and next buffer,
+             * likely triggering the "Buffer Underflow" panic.
 	     */
 
-	    dstLimit = Tcl_UtfAtIndex(dst, charsToRead + 1) - dst;
+            int newLimit = Tcl_UtfAtIndex(dst, charsToRead + 1) - dst + TCL_UTF_MAX;
+
+            if (newLimit >= dstLimit) {
+                dstLimit --;
+            } else {
+                dstLimit = newLimit;
+            }
+
+            if (dstLimit <= TCL_UTF_MAX) {
+                Tcl_Panic ("Not enough space left for a single multi-byte character.");
+            }
+
 	    statePtr->flags = savedFlags;
 	    statePtr->inputEncodingFlags = savedIEFlags;
 	    statePtr->inputEncodingState = savedState;
@@ -5661,7 +5679,8 @@ ReadChars(
 	     */
 
 	    if (nextPtr->nextRemoved - srcLen < 0) {
-		Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough");
+		Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough (%d < %d)",
+                          nextPtr->nextRemoved, srcLen);
 	    }
 
 	    nextPtr->nextRemoved -= srcLen;
-- 
cgit v0.12


From 5e12990261375322a279069b4bc5110233068335 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 5 Jun 2014 15:17:29 +0000
Subject: When too many chars are read by ReadChars() and we trim the limits to
 get it right on the next pass, don't forget the TCL_UTF_MAX padding demanded
 by Tcl_ExternalToUtf().  (Thanks for finding that, aku!) Fix the factorPtr
 management.  It was just totaly wrong. The factor should be a ratio of the
 record of bytes read to the record of chars read. With those fixes, new test
 io-12.6 covers the "too many chars" code.

---
 generic/tclIO.c | 15 +++++++++++----
 tests/io.test   | 33 +++++++++++++++++++++++++++++++++
 2 files changed, 44 insertions(+), 4 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index b7135e9..308e7a9 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -5595,10 +5595,13 @@ ReadChars(
 
 	    /* 
 	     * We read more chars than allowed.  Reset limits to
-	     * prevent that and try again.
+	     * prevent that and try again.  Don't forget the extra
+	     * padding of TCL_UTF_MAX - 1 bytes demanded by the
+	     * Tcl_ExternalToUtf() call!
 	     */
 
-	    dstLimit = Tcl_UtfAtIndex(dst, charsToRead + 1) - dst;
+	    dstLimit = Tcl_UtfAtIndex(dst, charsToRead + 1) 
+		    + TCL_UTF_MAX - 1 - dst;
 	    statePtr->flags = savedFlags;
 	    statePtr->inputEncodingFlags = savedIEFlags;
 	    statePtr->inputEncodingState = savedState;
@@ -5676,8 +5679,12 @@ ReadChars(
 
     consume:
 	bufPtr->nextRemoved += srcRead;
-	if (dstWrote > srcRead + 1) {
-	    *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;
+	/*
+	 * If this read contained multibyte characters, revise factorPtr
+	 * so the next read will allocate bigger buffers.
+	 */
+	if (numChars && numChars < srcRead) {
+	    *factorPtr = srcRead * UTF_EXPANSION_FACTOR / numChars;
 	}
 	Tcl_SetObjLength(objPtr, numBytes + dstWrote);
 	return numChars;
diff --git a/tests/io.test b/tests/io.test
index f1248b9..a1625ba 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -1445,6 +1445,39 @@ test io-12.5 {ReadChars: fileevents on partial characters} {stdio openpipe filee
     lappend x [catch {close $f} msg] $msg
     set x
 } "{} timeout {} timeout \u7266 {} eof 0 {}"
+test io-12.6 {ReadChars: too many chars read} {
+    proc driver {cmd args} {
+        variable buffer
+        variable index
+        set chan [lindex $args 0]
+        switch -- $cmd {
+            initialize {
+                set index($chan) 0
+                set buffer($chan) [encoding convertto utf-8 \
+                        [string repeat \uBEEF 20][string repeat . 20]]
+                return {initialize finalize watch read}
+            }
+            finalize {
+                unset index($chan) buffer($chan)
+                return
+            }
+            watch {}
+            read {
+                set n [lindex $args 1]
+                set new [expr {$index($chan) + $n}]
+                set result [string range $buffer($chan) $index($chan) $new-1]
+                set index($chan) $new
+                return $result
+            }
+        }
+    }
+    set c [chan create read [namespace which driver]]
+    chan configure $c -encoding utf-8
+    while {![eof $c]} {
+        read $c 15
+    }
+    close $c
+} {}
 
 test io-13.1 {TranslateInputEOL: cr mode} {} {
     set f [open $path(test1) w]
-- 
cgit v0.12


From 2be0ba5d68aaf52c90586aa91cc877a835b58df3 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 5 Jun 2014 19:06:08 +0000
Subject: Test socket-2.12 covers the DiscardOutput() update.

---
 tests/socket.test | 40 +++++++++++++++++++++++++++++++++++++++-
 1 file changed, 39 insertions(+), 1 deletion(-)

diff --git a/tests/socket.test b/tests/socket.test
index 1b7c5fa..2953c39 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -577,7 +577,45 @@ test socket-2.11 {detecting new data} {socket} {
     close $sock
     set result
 } {a:one b: c:two}
-
+test socket-2.12 {} {socket stdio} {
+    file delete $path(script)
+    set f [open $path(script) w]
+    puts $f {
+	set server [socket -server accept_client 0]
+	puts [lindex [chan configure $server -sockname] 2]
+	proc accept_client { client host port } {
+	    chan configure $client -blocking  0 -buffering line
+	    write_line $client
+	}
+	proc write_line client {
+	    if { [catch { chan puts $client [string repeat . 720000]}] } {
+		puts [catch {chan close $client}]
+	    } else {
+		puts signal1
+		after 0 write_line $client
+	    }
+	}
+	chan event stdin readable {set forever now}
+	vwait forever
+	exit
+    }
+    close $f
+    set f [open "|[list [interpreter] $path(script)]" r+]
+    gets $f port
+    set sock [socket 127.0.0.1 $port]
+    chan event $sock readable [list read_lines $sock $f]
+    proc read_lines { sock pipe } {
+	gets $pipe
+	chan close $sock
+	chan event $pipe readable [list readpipe $pipe]
+    }
+    proc readpipe {pipe} {
+	while {![string is integer [set ::done [gets $pipe]]]} {}
+    }
+    vwait ::done
+    close $f
+    set ::done
+} 0
 
 test socket-3.1 {socket conflict} {socket stdio} {
     file delete $path(script)
-- 
cgit v0.12


From 860a7252bb242157af32c222cca494d3d9635bc4 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sat, 7 Jun 2014 14:18:40 +0000
Subject: Improved the error messages. We do not want parsing an invalid
 dictionary to give errors about lists! As compensation, we get greater
 precision in the errorcode.

---
 generic/tclDictObj.c |  14 +++----
 generic/tclInt.h     |   4 ++
 generic/tclUtil.c    | 105 +++++++++++++++++++++++++++++++++++++++++----------
 tests/dict.test      |  20 +++++-----
 4 files changed, 104 insertions(+), 39 deletions(-)

diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index f3c582c..77f66fb 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -651,9 +651,9 @@ SetDictFromAny(
 	    const char *elemStart;
 	    int elemSize, literal;
 
-	    if (TclFindElement(interp, nextElem, (limit - nextElem),
+	    if (TclFindDictElement(interp, nextElem, (limit - nextElem),
 		    &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
-		goto errorInFindElement;
+		goto errorInFindDictElement;
 	    }
 	    if (elemStart == limit) {
 		break;
@@ -672,10 +672,10 @@ SetDictFromAny(
 			keyPtr->bytes);
 	    }
 
-	    if (TclFindElement(interp, nextElem, (limit - nextElem),
+	    if (TclFindDictElement(interp, nextElem, (limit - nextElem),
 		    &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
 		TclDecrRefCount(keyPtr);
-		goto errorInFindElement;
+		goto errorInFindDictElement;
 	    }
 
 	    if (literal) {
@@ -720,12 +720,8 @@ SetDictFromAny(
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"missing value to go with key", -1));
 	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
-    } else {
-    errorInFindElement:
-	if (interp != NULL) {
-	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
-	}
     }
+  errorInFindDictElement:
     DeleteChainTable(dict);
     ckfree(dict);
     return TCL_ERROR;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index b1a368e..9a2e8dd 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2881,6 +2881,10 @@ MODULE_SCOPE void	TclContinuationsCopy(Tcl_Obj *objPtr,
 MODULE_SCOPE int	TclConvertElement(const char *src, int length,
 			    char *dst, int flags);
 MODULE_SCOPE void	TclDeleteNamespaceVars(Namespace *nsPtr);
+MODULE_SCOPE int	TclFindDictElement(Tcl_Interp *interp,
+			    const char *dict, int dictLength,
+			    const char **elementPtr, const char **nextPtr,
+			    int *sizePtr, int *literalPtr);
 /* TIP #280 - Modified token based evulation, with line information. */
 MODULE_SCOPE int	TclEvalEx(Tcl_Interp *interp, const char *script,
 			    int numBytes, int flags, int line,
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 2d00adf..ae3adae 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -111,7 +111,11 @@ static Tcl_HashTable *	GetThreadHash(Tcl_ThreadDataKey *keyPtr);
 static int		SetEndOffsetFromAny(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr);
 static void		UpdateStringOfEndOffset(Tcl_Obj *objPtr);
-
+static int		FindElement(Tcl_Interp *interp, const char *string,
+			    int stringLength, const char *typeStr,
+			    const char *typeCode, const char **elementPtr,
+			    const char **nextPtr, int *sizePtr,
+			    int *literalPtr);
 /*
  * The following is the Tcl object type definition for an object that
  * represents a list index in the form, "end-offset". It is used as a
@@ -237,7 +241,7 @@ const Tcl_ObjType tclEndOffsetType = {
  *   of either braces or quotes to delimit it.
  *
  * This collection of parsing rules is implemented in the routine
- * TclFindElement().
+ * FindElement().
  *
  * In order to produce lists that can be parsed by these rules, we need the
  * ability to distinguish between characters that are part of a list element
@@ -505,9 +509,70 @@ TclFindElement(
 				 * does not/does require a call to 
 				 * TclCopyAndCollapse() by the caller. */
 {
-    const char *p = list;
+    return FindElement(interp, list, listLength, "list", "LIST", elementPtr,
+	    nextPtr, sizePtr, literalPtr);
+}
+
+int
+TclFindDictElement(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
+				 * NULL, then no error message is left after
+				 * errors. */
+    const char *dict,		/* Points to the first byte of a string
+				 * containing a Tcl dictionary with zero or
+				 * more keys and values (possibly in
+				 * braces). */
+    int dictLength,		/* Number of bytes in the dict's string. */
+    const char **elementPtr,	/* Where to put address of first significant
+				 * character in the first element (i.e., key
+				 * or value) of dict. */
+    const char **nextPtr,	/* Fill in with location of character just
+				 * after all white space following end of
+				 * element (next arg or end of list). */
+    int *sizePtr,		/* If non-zero, fill in with size of
+				 * element. */
+    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
+				 * indicate that the substring of *sizePtr
+				 * bytes starting at **elementPtr is/is not
+				 * the literal key or value and therefore
+				 * does not/does require a call to 
+				 * TclCopyAndCollapse() by the caller. */
+{
+    return FindElement(interp, dict, dictLength, "dict", "DICTIONARY",
+	    elementPtr, nextPtr, sizePtr, literalPtr);
+}
+
+static int
+FindElement(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
+				 * NULL, then no error message is left after
+				 * errors. */
+    const char *string,		/* Points to the first byte of a string
+				 * containing a Tcl list or dictionary with
+				 * zero or more elements (possibly in
+				 * braces). */
+    int stringLength,		/* Number of bytes in the string. */
+    const char *typeStr,	/* The name of the type of thing we are
+				 * parsing, for error messages. */
+    const char *typeCode,	/* The type code for thing we are parsing, for
+				 * error messages. */
+    const char **elementPtr,	/* Where to put address of first significant
+				 * character in first element. */
+    const char **nextPtr,	/* Fill in with location of character just
+				 * after all white space following end of
+				 * argument (next arg or end of list/dict). */
+    int *sizePtr,		/* If non-zero, fill in with size of
+				 * element. */
+    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
+				 * indicate that the substring of *sizePtr
+				 * bytes starting at **elementPtr is/is not
+				 * the literal list/dict element and therefore
+				 * does not/does require a call to 
+				 * TclCopyAndCollapse() by the caller. */
+{
+    const char *p = string;
     const char *elemStart;	/* Points to first byte of first element. */
-    const char *limit;		/* Points just after list's last byte. */
+    const char *limit;		/* Points just after list/dict's last byte. */
     int openBraces = 0;		/* Brace nesting level during parse. */
     int inQuotes = 0;
     int size = 0;		/* lint. */
@@ -517,11 +582,11 @@ TclFindElement(
 
     /*
      * Skim off leading white space and check for an opening brace or quote.
-     * We treat embedded NULLs in the list as bytes belonging to a list
-     * element.
+     * We treat embedded NULLs in the list/dict as bytes belonging to a list 
+     * element (or dictionary key or value).
      */
 
-    limit = (list + listLength);
+    limit = (string + stringLength);
     while ((p < limit) && (TclIsSpaceProc(*p))) {
 	p++;
     }
@@ -582,9 +647,9 @@ TclFindElement(
 			p2++;
 		    }
 		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			    "list element in braces followed by \"%.*s\" "
-			    "instead of space", (int) (p2-p), p));
-		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "JUNK",
+			    "%s element in braces followed by \"%.*s\" "
+			    "instead of space", typeStr, (int) (p2-p), p));
+		    Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "JUNK",
 			    NULL);
 		}
 		return TCL_ERROR;
@@ -651,9 +716,9 @@ TclFindElement(
 			p2++;
 		    }
 		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			    "list element in quotes followed by \"%.*s\" "
-			    "instead of space", (int) (p2-p), p));
-		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "JUNK",
+			    "%s element in quotes followed by \"%.*s\" "
+			    "instead of space", typeStr, (int) (p2-p), p));
+		    Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "JUNK",
 			    NULL);
 		}
 		return TCL_ERROR;
@@ -664,23 +729,23 @@ TclFindElement(
     }
 
     /*
-     * End of list: terminate element.
+     * End of list/dict: terminate element.
      */
 
     if (p == limit) {
 	if (openBraces != 0) {
 	    if (interp != NULL) {
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"unmatched open brace in list", -1));
-		Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "BRACE",
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"unmatched open brace in %s", typeStr));
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "BRACE",
 			NULL);
 	    }
 	    return TCL_ERROR;
 	} else if (inQuotes) {
 	    if (interp != NULL) {
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"unmatched open quote in list", -1));
-		Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "QUOTE",
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"unmatched open quote in %s", typeStr));
+		Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "QUOTE",
 			NULL);
 	    }
 	    return TCL_ERROR;
diff --git a/tests/dict.test b/tests/dict.test
index ae6f42a..1439af9 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -182,32 +182,32 @@ test dict-4.13a {dict replace command: type check is mandatory} {
 } {TCL VALUE DICTIONARY}
 test dict-4.14 {dict replace command: type check is mandatory} -body {
     dict replace { a b {}c d }
-} -returnCodes error -result {list element in braces followed by "c" instead of space}
+} -returnCodes error -result {dict element in braces followed by "c" instead of space}
 test dict-4.14a {dict replace command: type check is mandatory} {
     catch {dict replace { a b {}c d }} -> opt
     dict get $opt -errorcode
-} {TCL VALUE DICTIONARY}
+} {TCL VALUE DICTIONARY JUNK}
 test dict-4.15 {dict replace command: type check is mandatory} -body {
     dict replace { a b ""c d }
-} -returnCodes error -result {list element in quotes followed by "c" instead of space}
+} -returnCodes error -result {dict element in quotes followed by "c" instead of space}
 test dict-4.15a {dict replace command: type check is mandatory} {
     catch {dict replace { a b ""c d }} -> opt
     dict get $opt -errorcode
-} {TCL VALUE DICTIONARY}
+} {TCL VALUE DICTIONARY JUNK}
 test dict-4.16 {dict replace command: type check is mandatory} -body {
     dict replace " a b \"c d "
-} -returnCodes error -result {unmatched open quote in list}
+} -returnCodes error -result {unmatched open quote in dict}
 test dict-4.16a {dict replace command: type check is mandatory} {
     catch {dict replace " a b \"c d "} -> opt
     dict get $opt -errorcode
-} {TCL VALUE DICTIONARY}
+} {TCL VALUE DICTIONARY QUOTE}
 test dict-4.17 {dict replace command: type check is mandatory} -body {
     dict replace " a b \{c d "
-} -returnCodes error -result {unmatched open brace in list}
+} -returnCodes error -result {unmatched open brace in dict}
 test dict-4.17a {dict replace command: type check is mandatory} {
     catch {dict replace " a b \{c d "} -> opt
     dict get $opt -errorcode
-} {TCL VALUE DICTIONARY}
+} {TCL VALUE DICTIONARY BRACE}
 
 test dict-5.1 {dict remove command} {dict remove {a b c d} a} {c d}
 test dict-5.2 {dict remove command} {dict remove {a b c d} c} {a b}
@@ -234,7 +234,7 @@ test dict-5.11 {dict remove command: type check is mandatory} -body {
 } -returnCodes error -result {missing value to go with key}
 test dict-5.12 {dict remove command: type check is mandatory} -body {
     dict remove { a b {}c d }
-} -returnCodes error -result {list element in braces followed by "c" instead of space}
+} -returnCodes error -result {dict element in braces followed by "c" instead of space}
 
 test dict-6.1 {dict keys command} {dict keys {a b}} a
 test dict-6.2 {dict keys command} {dict keys {c d}} c
@@ -1296,7 +1296,7 @@ test dict-20.24 {dict merge command: type check is mandatory} -body {
 } -returnCodes error -result {missing value to go with key}
 test dict-20.25 {dict merge command: type check is mandatory} -body {
     dict merge { a b {}c d }
-} -returnCodes error -result {list element in braces followed by "c" instead of space}
+} -returnCodes error -result {dict element in braces followed by "c" instead of space}
 
 test dict-21.1 {dict update command} -returnCodes 1 -body {
     dict update
-- 
cgit v0.12


From 663ac41bc26d89297ae57c994693aa6aa90227e4 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 11 Jun 2014 17:24:58 +0000
Subject: Workaround the broken select() in some Linux kernels that fails to
 report a writable state on a socket when an error condition (or remote close)
 is present.  Would be good to add actual test suite tests for this, but until
 then see demo scripts in the ticket 1758a0b603.

---
 unix/tclUnixChan.c | 55 +++++++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 52 insertions(+), 3 deletions(-)

diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c
index 93bb1fe..fc3c10f 100644
--- a/unix/tclUnixChan.c
+++ b/unix/tclUnixChan.c
@@ -150,6 +150,7 @@ typedef struct TcpState {
     int fd;			/* The socket itself. */
     int flags;			/* ORed combination of the bitfields defined
 				 * below. */
+    int interest;		/* Events types of interest. */
     Tcl_TcpAcceptProc *acceptProc;
 				/* Proc to call on accept. */
     ClientData acceptProcData;	/* The data for the accept proc. */
@@ -2198,6 +2199,30 @@ TcpGetOptionProc(
  */
 
 static void
+WrapNotify(
+    ClientData clientData,
+    int mask)
+{
+    TcpState *statePtr = (TcpState *) clientData;
+    int newmask = mask & statePtr->interest;
+
+    if (newmask == 0) {
+	/*
+	 * There was no overlap between the states the channel is
+	 * interested in notifications for, and the states that are
+	 * reported present on the file descriptor by select().  The
+	 * only way that can happen is when the channel is interested
+	 * in a writable condition, and only a readable state is reported
+	 * present (see TcpWatchProc() below).  In that case, signal back
+	 * to the caller the writable state, which is really an error
+	 * condition.
+	 */
+	newmask = TCL_WRITABLE;
+    }
+    Tcl_NotifyChannel(statePtr->channel, newmask);
+}
+
+static void
 TcpWatchProc(
     ClientData instanceData,	/* The socket state. */
     int mask)			/* Events of interest; an OR-ed combination of
@@ -2214,9 +2239,30 @@ TcpWatchProc(
 
     if (!statePtr->acceptProc) {
 	if (mask) {
-	    Tcl_CreateFileHandler(statePtr->fd, mask,
-		    (Tcl_FileProc *) Tcl_NotifyChannel,
-		    (ClientData) statePtr->channel);
+
+	    /*
+	     * Whether it is a bug or feature or otherwise, it is a fact
+	     * of life that on at least some Linux kernels select() fails
+	     * to report that a socket file descriptor is writable when
+	     * the other end of the socket is closed.  This is in contrast
+	     * to the guarantees Tcl makes that its channels become
+	     * writable and fire writable events on an error conditon.
+	     * This has caused a leak of file descriptors in a state of
+	     * background flushing.  See Tcl ticket 1758a0b603. 
+	     *
+	     * As a workaround, when our caller indicates an interest in
+	     * writable notifications, we must tell the notifier built
+	     * around select() that we are interested in the readable state
+	     * of the file descriptor as well, as that is the only reliable
+	     * means to get notified of error conditions.  Then it is the
+	     * task of WrapNotify() above to untangle the meaning of these
+	     * channel states and report the chan events as best it can.
+	     * We save a copy of the mask passed in to assist with that.
+	     */
+		
+	    statePtr->interest = mask;
+	    Tcl_CreateFileHandler(statePtr->fd, mask|TCL_READABLE,
+		    (Tcl_FileProc *) WrapNotify, (ClientData) statePtr);
 	} else {
 	    Tcl_DeleteFileHandler(statePtr->fd);
 	}
@@ -2404,6 +2450,7 @@ CreateSocket(
     if (asyncConnect) {
 	statePtr->flags = TCP_ASYNC_CONNECT;
     }
+    statePtr->interest = 0;
     statePtr->fd = sock;
 
     return statePtr;
@@ -2675,6 +2722,7 @@ MakeTcpClientChannelMode(
     statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
     statePtr->fd = PTR2INT(sock);
     statePtr->flags = 0;
+    statePtr->interest = 0;
     statePtr->acceptProc = NULL;
     statePtr->acceptProcData = NULL;
 
@@ -2792,6 +2840,7 @@ TcpAccept(
     newSockState = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
 
     newSockState->flags = 0;
+    newSockState->interest = 0;
     newSockState->fd = newsock;
     newSockState->acceptProc = NULL;
     newSockState->acceptProcData = NULL;
-- 
cgit v0.12


From 6eb1232f227042df7308c275bf6d0966ff7587e8 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 12 Jun 2014 13:36:18 +0000
Subject: Additional check for an error condition on the socket.

---
 unix/tclUnixChan.c | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c
index fc3c10f..1d60340 100644
--- a/unix/tclUnixChan.c
+++ b/unix/tclUnixChan.c
@@ -249,6 +249,7 @@ static int		TtySetOptionProc(ClientData instanceData,
 static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr);
 static Tcl_Channel	MakeTcpClientChannelMode(ClientData tcpSocket,
 			    int mode);
+static void		WrapNotify(ClientData clientData, int mask);
 
 /*
  * This structure describes the channel type structure for file based IO:
@@ -2215,8 +2216,13 @@ WrapNotify(
 	 * in a writable condition, and only a readable state is reported
 	 * present (see TcpWatchProc() below).  In that case, signal back
 	 * to the caller the writable state, which is really an error
-	 * condition.
+	 * condition.  As an extra check on that assumption, check for
+	 * a non-zero value of errno before reporting an artificial
+	 * writable state.
 	 */
+	if (errno == 0) {
+	    return;
+	}
 	newmask = TCL_WRITABLE;
     }
     Tcl_NotifyChannel(statePtr->channel, newmask);
-- 
cgit v0.12


From 2aea826894f2e787994224a7cd6b2f1023c42c4f Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 13 Jun 2014 21:15:13 +0000
Subject: Draft test for [1758a0b603].

---
 tests/socket.test | 41 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 41 insertions(+)

diff --git a/tests/socket.test b/tests/socket.test
index 2953c39..b390627 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -616,6 +616,47 @@ test socket-2.12 {} {socket stdio} {
     close $f
     set ::done
 } 0
+test socket-2.13 {Bug 1758a0b603} {socket stdio} {
+    file delete $path(script)
+    set f [open $path(script) w]
+    puts $f {
+	set server [socket -server accept 0]
+	puts [lindex [chan configure $server -sockname] 2]
+	proc accept { client host port } {
+	    chan configure $client -blocking  0 -buffering line -buffersize 1
+	    puts $client [string repeat . 720000]
+	    puts ready
+	    chan event $client writable [list setup $client]
+	}
+	proc setup client {
+	    chan event $client writable {set forever write}
+	    after 5 {set forever timeout}
+	}
+	vwait forever
+	puts $forever
+    }
+    close $f
+    set pipe [open |[list [interpreter] $path(script)] r]
+    gets $pipe port
+    set sock [socket localhost $port]
+    chan configure $sock -blocking  0 -buffering line
+    chan event $sock readable [list read_lines $sock $pipe ]
+    proc read_lines { sock pipe } {
+	gets $pipe
+	gets $sock line
+	after idle [list stop $sock $pipe]
+	chan event $sock readable {}
+    }
+    proc stop {sock pipe} {
+	variable done
+	close $sock
+	set done [gets $pipe]
+    }
+    variable done
+    vwait [namespace which -variable done]
+    close $pipe
+    set done
+} write
 
 test socket-3.1 {socket conflict} {socket stdio} {
     file delete $path(script)
-- 
cgit v0.12


From 92590b85097cd3682ec43080549d54bf7236ca76 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 15 Jun 2014 07:52:57 +0000
Subject: Make [dict replace] and [dict remove] guarantee result canonicality.

---
 generic/tclDictObj.c | 149 ++++++++++++++++++++++-----------------------------
 tests/dict.test      |  30 +++++++----
 2 files changed, 84 insertions(+), 95 deletions(-)

diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 77f66fb..a057b8a 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -770,10 +770,9 @@ TclTraceDictPath(
     Dict *dict, *newDict;
     int i;
 
-    if (dictPtr->typePtr != &tclDictType) {
-	if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
-	    return NULL;
-	}
+    if (dictPtr->typePtr != &tclDictType
+	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	return NULL;
     }
     dict = dictPtr->internalRep.twoPtrValue.ptr1;
     if (flags & DICT_PATH_UPDATE) {
@@ -811,10 +810,9 @@ TclTraceDictPath(
 	    Tcl_SetHashValue(hPtr, tmpObj);
 	} else {
 	    tmpObj = Tcl_GetHashValue(hPtr);
-	    if (tmpObj->typePtr != &tclDictType) {
-		if (SetDictFromAny(interp, tmpObj) != TCL_OK) {
-		    return NULL;
-		}
+	    if (tmpObj->typePtr != &tclDictType
+		    && SetDictFromAny(interp, tmpObj) != TCL_OK) {
+		return NULL;
 	    }
 	}
 
@@ -909,12 +907,9 @@ Tcl_DictObjPut(
 	Tcl_Panic("%s called with shared object", "Tcl_DictObjPut");
     }
 
-    if (dictPtr->typePtr != &tclDictType) {
-	int result = SetDictFromAny(interp, dictPtr);
-
-	if (result != TCL_OK) {
-	    return result;
-	}
+    if (dictPtr->typePtr != &tclDictType
+	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	return TCL_ERROR;
     }
 
     if (dictPtr->bytes != NULL) {
@@ -963,12 +958,10 @@ Tcl_DictObjGet(
     Dict *dict;
     Tcl_HashEntry *hPtr;
 
-    if (dictPtr->typePtr != &tclDictType) {
-	int result = SetDictFromAny(interp, dictPtr);
-	if (result != TCL_OK) {
-	    *valuePtrPtr = NULL;
-	    return result;
-	}
+    if (dictPtr->typePtr != &tclDictType
+	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	*valuePtrPtr = NULL;
+	return TCL_ERROR;
     }
 
     dict = dictPtr->internalRep.twoPtrValue.ptr1;
@@ -1012,11 +1005,9 @@ Tcl_DictObjRemove(
 	Tcl_Panic("%s called with shared object", "Tcl_DictObjRemove");
     }
 
-    if (dictPtr->typePtr != &tclDictType) {
-	int result = SetDictFromAny(interp, dictPtr);
-	if (result != TCL_OK) {
-	    return result;
-	}
+    if (dictPtr->typePtr != &tclDictType
+	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	return TCL_ERROR;
     }
 
     dict = dictPtr->internalRep.twoPtrValue.ptr1;
@@ -1055,11 +1046,9 @@ Tcl_DictObjSize(
 {
     Dict *dict;
 
-    if (dictPtr->typePtr != &tclDictType) {
-	int result = SetDictFromAny(interp, dictPtr);
-	if (result != TCL_OK) {
-	    return result;
-	}
+    if (dictPtr->typePtr != &tclDictType
+	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	return TCL_ERROR;
     }
 
     dict = dictPtr->internalRep.twoPtrValue.ptr1;
@@ -1109,12 +1098,9 @@ Tcl_DictObjFirst(
     Dict *dict;
     ChainEntry *cPtr;
 
-    if (dictPtr->typePtr != &tclDictType) {
-	int result = SetDictFromAny(interp, dictPtr);
-
-	if (result != TCL_OK) {
-	    return result;
-	}
+    if (dictPtr->typePtr != &tclDictType
+	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	return TCL_ERROR;
     }
 
     dict = dictPtr->internalRep.twoPtrValue.ptr1;
@@ -1497,7 +1483,7 @@ DictCreateCmd(
 	/*
 	 * The next command is assumed to never fail...
 	 */
-	Tcl_DictObjPut(interp, dictObj, objv[i], objv[i+1]);
+	Tcl_DictObjPut(NULL, dictObj, objv[i], objv[i+1]);
     }
     Tcl_SetObjResult(interp, dictObj);
     return TCL_OK;
@@ -1630,17 +1616,18 @@ DictReplaceCmd(
     }
 
     dictPtr = objv[1];
-    if (dictPtr->typePtr != &tclDictType) {
-	int result = SetDictFromAny(interp, dictPtr);
-	if (result != TCL_OK) {
-	    return result;
-	}
+    if (dictPtr->typePtr != &tclDictType
+	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (Tcl_IsShared(dictPtr)) {
+	dictPtr = Tcl_DuplicateObj(dictPtr);
+    }
+    if (dictPtr->bytes != NULL) {
+	TclInvalidateStringRep(dictPtr);
     }
     for (i=2 ; i<objc ; i+=2) {
-	if (Tcl_IsShared(dictPtr)) {
-	    dictPtr = Tcl_DuplicateObj(dictPtr);
-	}
-	(void) Tcl_DictObjPut(interp, dictPtr, objv[i], objv[i+1]);
+	Tcl_DictObjPut(NULL, dictPtr, objv[i], objv[i+1]);
     }
     Tcl_SetObjResult(interp, dictPtr);
     return TCL_OK;
@@ -1680,17 +1667,18 @@ DictRemoveCmd(
     }
 
     dictPtr = objv[1];
-    if (dictPtr->typePtr != &tclDictType) {
-	int result = SetDictFromAny(interp, dictPtr);
-	if (result != TCL_OK) {
-	    return result;
-	}
+    if (dictPtr->typePtr != &tclDictType
+	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (Tcl_IsShared(dictPtr)) {
+	dictPtr = Tcl_DuplicateObj(dictPtr);
+    }
+    if (dictPtr->bytes != NULL) {
+	TclInvalidateStringRep(dictPtr);
     }
     for (i=2 ; i<objc ; i++) {
-	if (Tcl_IsShared(dictPtr)) {
-	    dictPtr = Tcl_DuplicateObj(dictPtr);
-	}
-	(void) Tcl_DictObjRemove(interp, dictPtr, objv[i]);
+	Tcl_DictObjRemove(NULL, dictPtr, objv[i]);
     }
     Tcl_SetObjResult(interp, dictPtr);
     return TCL_OK;
@@ -1739,10 +1727,9 @@ DictMergeCmd(
      */
 
     targetObj = objv[1];
-    if (targetObj->typePtr != &tclDictType) {
-	if (SetDictFromAny(interp, targetObj) != TCL_OK) {
-	    return TCL_ERROR;
-	}
+    if (targetObj->typePtr != &tclDictType
+	    && SetDictFromAny(interp, targetObj) != TCL_OK) {
+	return TCL_ERROR;
     }
 
     if (objc == 2) {
@@ -1824,12 +1811,9 @@ DictKeysCmd(
      * need. [Bug 1705778, leak K04]
      */
 
-    if (objv[1]->typePtr != &tclDictType) {
-	int result = SetDictFromAny(interp, objv[1]);
-
-	if (result != TCL_OK) {
-	    return result;
-	}
+    if (objv[1]->typePtr != &tclDictType
+	    && SetDictFromAny(interp, objv[1]) != TCL_OK) {
+	return TCL_ERROR;
     }
 
     if (objc == 3) {
@@ -2045,11 +2029,9 @@ DictInfoCmd(
     }
 
     dictPtr = objv[1];
-    if (dictPtr->typePtr != &tclDictType) {
-	int result = SetDictFromAny(interp, dictPtr);
-	if (result != TCL_OK) {
-	    return result;
-	}
+    if (dictPtr->typePtr != &tclDictType
+	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	return TCL_ERROR;
     }
     dict = dictPtr->internalRep.twoPtrValue.ptr1;
 
@@ -2141,10 +2123,10 @@ DictIncrCmd(
 		 */
 
 		mp_clear(&increment);
-		Tcl_DictObjPut(interp, dictPtr, objv[2], objv[3]);
+		Tcl_DictObjPut(NULL, dictPtr, objv[2], objv[3]);
 	    }
 	} else {
-	    Tcl_DictObjPut(interp, dictPtr, objv[2], Tcl_NewIntObj(1));
+	    Tcl_DictObjPut(NULL, dictPtr, objv[2], Tcl_NewIntObj(1));
 	}
     } else {
 	/*
@@ -2153,7 +2135,7 @@ DictIncrCmd(
 
 	if (Tcl_IsShared(valuePtr)) {
 	    valuePtr = Tcl_DuplicateObj(valuePtr);
-	    Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
+	    Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
 	}
 	if (objc == 4) {
 	    code = TclIncrObj(interp, valuePtr, objv[3]);
@@ -2253,7 +2235,7 @@ DictLappendCmd(
     }
 
     if (allocatedValue) {
-	Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
+	Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
     } else if (dictPtr->bytes != NULL) {
 	TclInvalidateStringRep(dictPtr);
     }
@@ -2328,7 +2310,7 @@ DictAppendCmd(
 	Tcl_AppendObjToObj(valuePtr, objv[i]);
     }
 
-    Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
+    Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
 
     resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
 	    TCL_LEAVE_ERR_MSG);
@@ -2938,12 +2920,12 @@ DictFilterCmd(
 		Tcl_DictObjDone(&search);
 		Tcl_DictObjGet(interp, objv[1], objv[3], &valueObj);
 		if (valueObj != NULL) {
-		    Tcl_DictObjPut(interp, resultObj, objv[3], valueObj);
+		    Tcl_DictObjPut(NULL, resultObj, objv[3], valueObj);
 		}
 	    } else {
 		while (!done) {
 		    if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
-			Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+			Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
 		    }
 		    Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
 		}
@@ -2961,7 +2943,7 @@ DictFilterCmd(
 		for (i=3 ; i<objc ; i++) {
 		    pattern = TclGetString(objv[i]);
 		    if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
-			Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+			Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
 			break;		/* stop inner loop */
 		    }
 		}
@@ -2987,7 +2969,7 @@ DictFilterCmd(
 	    for (i=3 ; i<objc ; i++) {
 		pattern = TclGetString(objv[i]);
 		if (Tcl_StringMatch(TclGetString(valueObj), pattern)) {
-		    Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+		    Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
 		    break;		/* stop inner loop */
 		}
 	    }
@@ -3088,7 +3070,7 @@ DictFilterCmd(
 		}
 		TclDecrRefCount(boolObj);
 		if (satisfied) {
-		    Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
+		    Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
 		}
 		break;
 	    case TCL_BREAK:
@@ -3276,18 +3258,17 @@ FinalizeDictUpdate(
     for (i=0 ; i<objc ; i+=2) {
 	objPtr = Tcl_ObjGetVar2(interp, objv[i+1], NULL, 0);
 	if (objPtr == NULL) {
-	    Tcl_DictObjRemove(interp, dictPtr, objv[i]);
+	    Tcl_DictObjRemove(NULL, dictPtr, objv[i]);
 	} else if (objPtr == dictPtr) {
 	    /*
 	     * Someone is messing us around, trying to build a recursive
 	     * structure. [Bug 1786481]
 	     */
 
-	    Tcl_DictObjPut(interp, dictPtr, objv[i],
-		    Tcl_DuplicateObj(objPtr));
+	    Tcl_DictObjPut(NULL, dictPtr, objv[i], Tcl_DuplicateObj(objPtr));
 	} else {
 	    /* Shouldn't fail */
-	    Tcl_DictObjPut(interp, dictPtr, objv[i], objPtr);
+	    Tcl_DictObjPut(NULL, dictPtr, objv[i], objPtr);
 	}
     }
     TclDecrRefCount(argsObj);
diff --git a/tests/dict.test b/tests/dict.test
index 1439af9..642abd8 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -167,12 +167,12 @@ test dict-4.8 {dict replace command} -returnCodes error -body {
 } -result {missing value to go with key}
 test dict-4.9 {dict replace command} {dict replace [list a a] a b} {a b}
 test dict-4.10 {dict replace command} {dict replace [list a a] a b a c} {a c}
-test dict-4.11 {dict replace command: canonicality not forced} {
-    dict replace { a b c d }
-} { a b c d }
-test dict-4.12 {dict replace command: canonicality forced by update} {
-    dict replace { a b c d } a b
+test dict-4.11 {dict replace command: canonicality is forced} {
+    dict replace { a b  c d }
 } {a b c d}
+test dict-4.12 {dict replace command: canonicality is forced} {
+    dict replace {a b c d a e}
+} {a e c d}
 test dict-4.13 {dict replace command: type check is mandatory} -body {
     dict replace { a b c d e }
 } -returnCodes error -result {missing value to go with key}
@@ -208,6 +208,10 @@ test dict-4.17a {dict replace command: type check is mandatory} {
     catch {dict replace " a b \{c d "} -> opt
     dict get $opt -errorcode
 } {TCL VALUE DICTIONARY BRACE}
+test dict-4.18 {dict replace command: canonicality forcing doesn't leak} {
+    set example { a b  c d }
+    list $example [dict replace $example]
+} {{ a b  c d } {a b c d}}
 
 test dict-5.1 {dict remove command} {dict remove {a b c d} a} {c d}
 test dict-5.2 {dict remove command} {dict remove {a b c d} c} {a b}
@@ -220,12 +224,12 @@ test dict-5.6 {dict remove command} {dict remove {a b} c} {a b}
 test dict-5.7 {dict remove command} -returnCodes error -body {
     dict remove
 } -result {wrong # args: should be "dict remove dictionary ?key ...?"}
-test dict-5.8 {dict remove command: canonicality not forced} {
-    dict remove { a b c d }
-} { a b c d }
-test dict-5.9 {dict remove command: canonicality not forced} {
-    dict remove { a b c d } e
-} { a b c d }
+test dict-5.8 {dict remove command: canonicality is forced} {
+    dict remove { a b  c d }
+} {a b c d}
+test dict-5.9 {dict remove command: canonicality is forced} {
+    dict remove {a b c d a e}
+} {a e c d}
 test dict-5.10 {dict remove command: canonicality forced by update} {
     dict remove { a b c d } c
 } {a b}
@@ -235,6 +239,10 @@ test dict-5.11 {dict remove command: type check is mandatory} -body {
 test dict-5.12 {dict remove command: type check is mandatory} -body {
     dict remove { a b {}c d }
 } -returnCodes error -result {dict element in braces followed by "c" instead of space}
+test dict-5.13 {dict remove command: canonicality forcing doesn't leak} {
+    set example { a b  c d }
+    list $example [dict remove $example]
+} {{ a b  c d } {a b c d}}
 
 test dict-6.1 {dict keys command} {dict keys {a b}} a
 test dict-6.2 {dict keys command} {dict keys {c d}} c
-- 
cgit v0.12


From 47711b6d3c66481bf9105074470d52b186c9d53a Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 15 Jun 2014 16:11:56 +0000
Subject: Some more cleaning up

---
 generic/tclDictObj.c | 80 +++++++++++++++++++++++++++++-----------------------
 1 file changed, 44 insertions(+), 36 deletions(-)

diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index a057b8a..9e606f7 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -155,6 +155,13 @@ typedef struct Dict {
 } Dict;
 
 /*
+ * Accessor macro for converting between a Tcl_Obj* and a Dict. Note that this
+ * must be assignable as well as readable.
+ */
+
+#define DICT(dictObj)   (*((Dict **)&(dictObj)->internalRep.twoPtrValue.ptr1))
+
+/*
  * The structure below defines the dictionary object type by means of
  * functions that can be invoked by generic object code.
  */
@@ -312,6 +319,7 @@ DeleteChainEntry(
 	return 0;
     } else {
 	Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
+
 	TclDecrRefCount(valuePtr);
     }
 
@@ -361,7 +369,7 @@ DupDictInternalRep(
     Tcl_Obj *srcPtr,
     Tcl_Obj *copyPtr)
 {
-    Dict *oldDict = srcPtr->internalRep.twoPtrValue.ptr1;
+    Dict *oldDict = DICT(srcPtr);
     Dict *newDict = ckalloc(sizeof(Dict));
     ChainEntry *cPtr;
 
@@ -396,7 +404,7 @@ DupDictInternalRep(
      * Store in the object.
      */
 
-    copyPtr->internalRep.twoPtrValue.ptr1 = newDict;
+    DICT(copyPtr) = newDict;
     copyPtr->typePtr = &tclDictType;
 }
 
@@ -422,7 +430,7 @@ static void
 FreeDictInternalRep(
     Tcl_Obj *dictPtr)
 {
-    Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    Dict *dict = DICT(dictPtr);
 
     dict->refcount--;
     if (dict->refcount <= 0) {
@@ -487,7 +495,7 @@ UpdateStringOfDict(
 {
 #define LOCAL_SIZE 20
     int localFlags[LOCAL_SIZE], *flagPtr = NULL;
-    Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    Dict *dict = DICT(dictPtr);
     ChainEntry *cPtr;
     Tcl_Obj *keyPtr, *valuePtr;
     int i, length, bytesNeeded = 0;
@@ -711,7 +719,7 @@ SetDictFromAny(
     dict->epoch = 0;
     dict->chain = NULL;
     dict->refcount = 1;
-    objPtr->internalRep.twoPtrValue.ptr1 = dict;
+    DICT(objPtr) = dict;
     objPtr->typePtr = &tclDictType;
     return TCL_OK;
 
@@ -774,7 +782,7 @@ TclTraceDictPath(
 	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
 	return NULL;
     }
-    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    dict = DICT(dictPtr);
     if (flags & DICT_PATH_UPDATE) {
 	dict->chain = NULL;
     }
@@ -816,7 +824,7 @@ TclTraceDictPath(
 	    }
 	}
 
-	newDict = tmpObj->internalRep.twoPtrValue.ptr1;
+	newDict = DICT(tmpObj);
 	if (flags & DICT_PATH_UPDATE) {
 	    if (Tcl_IsShared(tmpObj)) {
 		TclDecrRefCount(tmpObj);
@@ -824,7 +832,7 @@ TclTraceDictPath(
 		Tcl_IncrRefCount(tmpObj);
 		Tcl_SetHashValue(hPtr, tmpObj);
 		dict->epoch++;
-		newDict = tmpObj->internalRep.twoPtrValue.ptr1;
+		newDict = DICT(tmpObj);
 	    }
 
 	    newDict->chain = dictPtr;
@@ -859,7 +867,7 @@ static void
 InvalidateDictChain(
     Tcl_Obj *dictObj)
 {
-    Dict *dict = dictObj->internalRep.twoPtrValue.ptr1;
+    Dict *dict = DICT(dictObj);
 
     do {
 	TclInvalidateStringRep(dictObj);
@@ -869,7 +877,7 @@ InvalidateDictChain(
 	    break;
 	}
 	dict->chain = NULL;
-	dict = dictObj->internalRep.twoPtrValue.ptr1;
+	dict = DICT(dictObj);
     } while (dict != NULL);
 }
 
@@ -915,7 +923,7 @@ Tcl_DictObjPut(
     if (dictPtr->bytes != NULL) {
 	TclInvalidateStringRep(dictPtr);
     }
-    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    dict = DICT(dictPtr);
     hPtr = CreateChainEntry(dict, keyPtr, &isNew);
     Tcl_IncrRefCount(valuePtr);
     if (!isNew) {
@@ -964,7 +972,7 @@ Tcl_DictObjGet(
 	return TCL_ERROR;
     }
 
-    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    dict = DICT(dictPtr);
     hPtr = Tcl_FindHashEntry(&dict->table, keyPtr);
     if (hPtr == NULL) {
 	*valuePtrPtr = NULL;
@@ -1010,7 +1018,7 @@ Tcl_DictObjRemove(
 	return TCL_ERROR;
     }
 
-    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    dict = DICT(dictPtr);
     if (DeleteChainEntry(dict, keyPtr)) {
 	if (dictPtr->bytes != NULL) {
 	    TclInvalidateStringRep(dictPtr);
@@ -1051,7 +1059,7 @@ Tcl_DictObjSize(
 	return TCL_ERROR;
     }
 
-    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    dict = DICT(dictPtr);
     *sizePtr = dict->table.numEntries;
     return TCL_OK;
 }
@@ -1103,7 +1111,7 @@ Tcl_DictObjFirst(
 	return TCL_ERROR;
     }
 
-    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    dict = DICT(dictPtr);
     cPtr = dict->entryChainHead;
     if (cPtr == NULL) {
 	searchPtr->epoch = -1;
@@ -1278,11 +1286,12 @@ Tcl_DictObjPutKeyList(
 	return TCL_ERROR;
     }
 
-    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    dict = DICT(dictPtr);
     hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
     Tcl_IncrRefCount(valuePtr);
     if (!isNew) {
 	Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);
+
 	TclDecrRefCount(oldValuePtr);
     }
     Tcl_SetHashValue(hPtr, valuePtr);
@@ -1334,7 +1343,7 @@ Tcl_DictObjRemoveKeyList(
 	return TCL_ERROR;
     }
 
-    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    dict = DICT(dictPtr);
     DeleteChainEntry(dict, keyv[keyc-1]);
     InvalidateDictChain(dictPtr);
     return TCL_OK;
@@ -1380,7 +1389,7 @@ Tcl_NewDictObj(void)
     dict->epoch = 0;
     dict->chain = NULL;
     dict->refcount = 1;
-    dictPtr->internalRep.twoPtrValue.ptr1 = dict;
+    DICT(dictPtr) = dict;
     dictPtr->typePtr = &tclDictType;
     return dictPtr;
 #endif
@@ -1429,7 +1438,7 @@ Tcl_DbNewDictObj(
     dict->epoch = 0;
     dict->chain = NULL;
     dict->refcount = 1;
-    dictPtr->internalRep.twoPtrValue.ptr1 = dict;
+    DICT(dictPtr) = dict;
     dictPtr->typePtr = &tclDictType;
     return dictPtr;
 #else /* !TCL_MEM_DEBUG */
@@ -2033,7 +2042,7 @@ DictInfoCmd(
 	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
 	return TCL_ERROR;
     }
-    dict = dictPtr->internalRep.twoPtrValue.ptr1;
+    dict = DICT(dictPtr);
 
     statsStr = Tcl_HashStats(&dict->table);
     Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1));
@@ -2144,7 +2153,7 @@ DictIncrCmd(
 
 	    Tcl_IncrRefCount(incrPtr);
 	    code = TclIncrObj(interp, valuePtr, incrPtr);
-	    Tcl_DecrRefCount(incrPtr);
+	    TclDecrRefCount(incrPtr);
 	}
     }
     if (code == TCL_OK) {
@@ -2157,7 +2166,7 @@ DictIncrCmd(
 	    Tcl_SetObjResult(interp, valuePtr);
 	}
     } else if (dictPtr->refCount == 0) {
-	Tcl_DecrRefCount(dictPtr);
+	TclDecrRefCount(dictPtr);
     }
     return code;
 }
@@ -2300,10 +2309,8 @@ DictAppendCmd(
 
     if (valuePtr == NULL) {
 	TclNewObj(valuePtr);
-    } else {
-	if (Tcl_IsShared(valuePtr)) {
-	    valuePtr = Tcl_DuplicateObj(valuePtr);
-	}
+    } else if (Tcl_IsShared(valuePtr)) {
+	valuePtr = Tcl_DuplicateObj(valuePtr);
     }
 
     for (i=3 ; i<objc ; i++) {
@@ -2368,6 +2375,7 @@ DictForNRCmd(
     if (varc != 2) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"must have exactly two variable names", -1));
+	Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "for", NULL);
 	return TCL_ERROR;
     }
     searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch));
@@ -2401,12 +2409,14 @@ DictForNRCmd(
      */
 
     Tcl_IncrRefCount(valueObj);
-    if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) {
+    if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
+	    TCL_LEAVE_ERR_MSG) == NULL) {
 	TclDecrRefCount(valueObj);
 	goto error;
     }
     TclDecrRefCount(valueObj);
-    if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) {
+    if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
+	    TCL_LEAVE_ERR_MSG) == NULL) {
 	goto error;
     }
 
@@ -2559,6 +2569,7 @@ DictMapNRCmd(
     if (varc != 2) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"must have exactly two variable names", -1));
+	Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "map", NULL);
 	return TCL_ERROR;
     }
     storagePtr = TclStackAlloc(interp, sizeof(DictMapStorage));
@@ -2997,6 +3008,7 @@ DictFilterCmd(
 	if (varc != 2) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "must have exactly two variable names", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "filter", NULL);
 	    return TCL_ERROR;
 	}
 	keyVarObj = varv[0];
@@ -3035,19 +3047,15 @@ DictFilterCmd(
 	    Tcl_IncrRefCount(valueObj);
 	    if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
 		    TCL_LEAVE_ERR_MSG) == NULL) {
-		Tcl_ResetResult(interp);
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"couldn't set key variable: \"%s\"",
-			TclGetString(keyVarObj)));
+		Tcl_AddErrorInfo(interp, 
+			"\n    (\"dict filter\" filter script key variable)");
 		result = TCL_ERROR;
 		goto abnormalResult;
 	    }
 	    if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
 		    TCL_LEAVE_ERR_MSG) == NULL) {
-		Tcl_ResetResult(interp);
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"couldn't set value variable: \"%s\"",
-			TclGetString(valueVarObj)));
+		Tcl_AddErrorInfo(interp, 
+			"\n    (\"dict filter\" filter script value variable)");
 		result = TCL_ERROR;
 		goto abnormalResult;
 	    }
-- 
cgit v0.12


From 640e2ec713b76bb00fd43767bfd1171b07b69bde Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 15 Jun 2014 16:50:32 +0000
Subject: [cb042d294e] Improve consistency of [dict] wrong-args error messages.

---
 doc/dict.n           | 10 +++++-----
 generic/tclDictObj.c | 20 ++++++++++----------
 tests/dict.test      | 52 ++++++++++++++++++++++++++--------------------------
 3 files changed, 41 insertions(+), 41 deletions(-)

diff --git a/doc/dict.n b/doc/dict.n
index 3bb5465..fecad85 100644
--- a/doc/dict.n
+++ b/doc/dict.n
@@ -54,10 +54,10 @@ The key rule only matches those key/value pairs whose keys match any
 of the given patterns (in the style of \fBstring match\fR.)
 .VE 8.6
 .TP
-\fBdict filter \fIdictionaryValue \fBscript {\fIkeyVar valueVar\fB} \fIscript\fR
+\fBdict filter \fIdictionaryValue \fBscript {\fIkeyVariable valueVariable\fB} \fIscript\fR
 .
 The script rule tests for matching by assigning the key to the
-\fIkeyVar\fR and the value to the \fIvalueVar\fR, and then evaluating
+\fIkeyVariable\fR and the value to the \fIvalueVariable\fR, and then evaluating
 the given script which should return a boolean value (with the
 key/value pair only being included in the result of the \fBdict
 filter\fR when a true value is returned.)  Note that the first
@@ -75,7 +75,7 @@ of the given patterns (in the style of \fBstring match\fR.)
 .VE 8.6
 .RE
 .TP
-\fBdict for {\fIkeyVar valueVar\fB} \fIdictionaryValue body\fR
+\fBdict for {\fIkeyVariable valueVariable\fB} \fIdictionaryValue body\fR
 .
 This command takes three arguments, the first a two-element list of
 variable names (for the key and value respectively of each mapping in
@@ -150,7 +150,7 @@ 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. The
 updated dictionary value is returned.
 .TP
-\fBdict map \fR{\fIkeyVar valueVar\fR} \fIdictionaryValue body\fR
+\fBdict map \fR{\fIkeyVariable valueVariable\fR} \fIdictionaryValue body\fR
 .
 This command applies a transformation to each element of a dictionary,
 returning a new dictionary. It takes three arguments: the first is a
@@ -160,7 +160,7 @@ and the third a script to be evaluated for each mapping with the key and value
 variables set appropriately (in the manner of \fBlmap\fR). In an iteration
 where the evaluated script completes normally (\fBTCL_OK\fR, as opposed to an
 \fBerror\fR, etc.) the result of the script is put into an accumulator
-dictionary using the key that is the current contents of the \fIkeyVar\fR
+dictionary using the key that is the current contents of the \fIkeyVariable\fR
 variable at that point. The result of the \fBdict map\fR command is the
 accumulator dictionary after all keys have been iterated over.
 .RS
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 9e606f7..3c0ddd8 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -2079,7 +2079,7 @@ DictIncrCmd(
     Tcl_Obj *dictPtr, *valuePtr = NULL;
 
     if (objc < 3 || objc > 4) {
-	Tcl_WrongNumArgs(interp, 1, objv, "varName key ?increment?");
+	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?increment?");
 	return TCL_ERROR;
     }
 
@@ -2200,7 +2200,7 @@ DictLappendCmd(
     int i, allocatedDict = 0, allocatedValue = 0;
 
     if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "varName key ?value ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?");
 	return TCL_ERROR;
     }
 
@@ -2287,7 +2287,7 @@ DictAppendCmd(
     int i, allocatedDict = 0;
 
     if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "varName key ?value ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?");
 	return TCL_ERROR;
     }
 
@@ -2361,7 +2361,7 @@ DictForNRCmd(
 
     if (objc != 4) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"{keyVar valueVar} dictionary script");
+		"{keyVarName valueVarName} dictionary script");
 	return TCL_ERROR;
     }
 
@@ -2555,7 +2555,7 @@ DictMapNRCmd(
 
     if (objc != 4) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"{keyVar valueVar} dictionary script");
+		"{keyVarName valueVarName} dictionary script");
 	return TCL_ERROR;
     }
 
@@ -2764,7 +2764,7 @@ DictSetCmd(
     int result, allocatedDict = 0;
 
     if (objc < 4) {
-	Tcl_WrongNumArgs(interp, 1, objv, "varName key ?key ...? value");
+	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?key ...? value");
 	return TCL_ERROR;
     }
 
@@ -2824,7 +2824,7 @@ DictUnsetCmd(
     int result, allocatedDict = 0;
 
     if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "varName key ?key ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?key ...?");
 	return TCL_ERROR;
     }
 
@@ -2992,7 +2992,7 @@ DictFilterCmd(
     case FILTER_SCRIPT:
 	if (objc != 5) {
 	    Tcl_WrongNumArgs(interp, 1, objv,
-		    "dictionary script {keyVar valueVar} filterScript");
+		    "dictionary script {keyVarName valueVarName} filterScript");
 	    return TCL_ERROR;
 	}
 
@@ -3169,7 +3169,7 @@ DictUpdateCmd(
 
     if (objc < 5 || !(objc & 1)) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"varName key varName ?key varName ...? script");
+		"dictVarName key varName ?key varName ...? script");
 	return TCL_ERROR;
     }
 
@@ -3325,7 +3325,7 @@ DictWithCmd(
     Tcl_Obj *dictPtr, *keysPtr, *pathPtr;
 
     if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "dictVar ?key ...? script");
+	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName ?key ...? script");
 	return TCL_ERROR;
     }
 
diff --git a/tests/dict.test b/tests/dict.test
index 642abd8..d5406d0 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -409,13 +409,13 @@ test dict-11.13 {dict incr command} -returnCodes error -body {
     dict incr dictv a a a
 } -cleanup {
     unset dictv
-} -result {wrong # args: should be "dict incr varName key ?increment?"}
+} -result {wrong # args: should be "dict incr dictVarName key ?increment?"}
 test dict-11.14 {dict incr command} -returnCodes error -body {
     set dictv a
     dict incr dictv
 } -cleanup {
     unset dictv
-} -result {wrong # args: should be "dict incr varName key ?increment?"}
+} -result {wrong # args: should be "dict incr dictVarName key ?increment?"}
 test dict-11.15 {dict incr command: write failure} -setup {
     unset -nocomplain dictVar
 } -body {
@@ -486,10 +486,10 @@ test dict-12.6 {dict lappend command} -returnCodes error -body {
 } -result {missing value to go with key}
 test dict-12.7 {dict lappend command} -returnCodes error -body {
     dict lappend
-} -result {wrong # args: should be "dict lappend varName key ?value ...?"}
+} -result {wrong # args: should be "dict lappend dictVarName key ?value ...?"}
 test dict-12.8 {dict lappend command} -returnCodes error -body {
     dict lappend dictv
-} -result {wrong # args: should be "dict lappend varName key ?value ...?"}
+} -result {wrong # args: should be "dict lappend dictVarName key ?value ...?"}
 test dict-12.9 {dict lappend command} -returnCodes error -body {
     set dictv [dict create a "\{"]
     dict lappend dictv a a
@@ -553,10 +553,10 @@ test dict-13.6 {dict append command} -returnCodes error -body {
 } -result {missing value to go with key}
 test dict-13.7 {dict append command} -returnCodes error -body {
     dict append
-} -result {wrong # args: should be "dict append varName key ?value ...?"}
+} -result {wrong # args: should be "dict append dictVarName key ?value ...?"}
 test dict-13.8 {dict append command} -returnCodes error -body {
     dict append dictv
-} -result {wrong # args: should be "dict append varName key ?value ...?"}
+} -result {wrong # args: should be "dict append dictVarName key ?value ...?"}
 test dict-13.9 {dict append command: write failure} -setup {
     unset -nocomplain dictVar
 } -body {
@@ -574,16 +574,16 @@ test dict-13.11 {compiled dict append: invalidate string rep - Bug 3079830} {
 
 test dict-14.1 {dict for command: syntax} -returnCodes error -body {
     dict for
-} -result {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}
+} -result {wrong # args: should be "dict for {keyVarName valueVarName} dictionary script"}
 test dict-14.2 {dict for command: syntax} -returnCodes error -body {
     dict for x
-} -result {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}
+} -result {wrong # args: should be "dict for {keyVarName valueVarName} dictionary script"}
 test dict-14.3 {dict for command: syntax} -returnCodes error -body {
     dict for x x
-} -result {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}
+} -result {wrong # args: should be "dict for {keyVarName valueVarName} dictionary script"}
 test dict-14.4 {dict for command: syntax} -returnCodes error -body {
     dict for x x x x
-} -result {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}
+} -result {wrong # args: should be "dict for {keyVarName valueVarName} dictionary script"}
 test dict-14.5 {dict for command: syntax} -returnCodes error -body {
     dict for x x x
 } -result {must have exactly two variable names}
@@ -813,13 +813,13 @@ test dict-15.9 {dict set command: write failure} -setup {
 } -result {can't set "dictVar": variable is array}
 test dict-15.10 {dict set command: syntax} -returnCodes error -body {
     dict set
-} -result {wrong # args: should be "dict set varName key ?key ...? value"}
+} -result {wrong # args: should be "dict set dictVarName key ?key ...? value"}
 test dict-15.11 {dict set command: syntax} -returnCodes error -body {
     dict set a
-} -result {wrong # args: should be "dict set varName key ?key ...? value"}
+} -result {wrong # args: should be "dict set dictVarName key ?key ...? value"}
 test dict-15.12 {dict set command: syntax} -returnCodes error -body {
     dict set a a
-} -result {wrong # args: should be "dict set varName key ?key ...? value"}
+} -result {wrong # args: should be "dict set dictVarName key ?key ...? value"}
 test dict-15.13 {dict set command} -returnCodes error -body {
     set dictVar a
     dict set dictVar b c
@@ -872,7 +872,7 @@ test dict-16.7 {dict unset command} -setup {
 } -result {0 {} 1}
 test dict-16.8 {dict unset command} -returnCodes error -body {
     dict unset dictVar
-} -result {wrong # args: should be "dict unset varName key ?key ...?"}
+} -result {wrong # args: should be "dict unset dictVarName key ?key ...?"}
 test dict-16.9 {dict unset command: write failure} -setup {
     unset -nocomplain dictVar
 } -body {
@@ -923,7 +923,7 @@ test dict-16.16 {dict unset command} -body {
 } -result {0 {} 1}
 test dict-16.17 {dict unset command} -returnCodes error -body {
     apply {{} {dict unset dictVar}}
-} -result {wrong # args: should be "dict unset varName key ?key ...?"}
+} -result {wrong # args: should be "dict unset dictVarName key ?key ...?"}
 test dict-16.18 {dict unset command: write failure} -body {
     apply {{} {
 	set dictVar(block) {}
@@ -1052,7 +1052,7 @@ test dict-17.17 {dict filter command: script} -body {
 } -result b
 test dict-17.18 {dict filter command: script} -returnCodes error -body {
     dict filter {a b} script {k k}
-} -result {wrong # args: should be "dict filter dictionary script {keyVar valueVar} filterScript"}
+} -result {wrong # args: should be "dict filter dictionary script {keyVarName valueVarName} filterScript"}
 test dict-17.19 {dict filter command: script} -returnCodes error -body {
     dict filter {a b} script k {continue}
 } -result {must have exactly two variable names}
@@ -1308,16 +1308,16 @@ test dict-20.25 {dict merge command: type check is mandatory} -body {
 
 test dict-21.1 {dict update command} -returnCodes 1 -body {
     dict update
-} -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
+} -result {wrong # args: should be "dict update dictVarName key varName ?key varName ...? script"}
 test dict-21.2 {dict update command} -returnCodes 1 -body {
     dict update v
-} -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
+} -result {wrong # args: should be "dict update dictVarName key varName ?key varName ...? script"}
 test dict-21.3 {dict update command} -returnCodes 1 -body {
     dict update v k
-} -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
+} -result {wrong # args: should be "dict update dictVarName key varName ?key varName ...? script"}
 test dict-21.4 {dict update command} -returnCodes 1 -body {
     dict update v k v
-} -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
+} -result {wrong # args: should be "dict update dictVarName key varName ?key varName ...? script"}
 test dict-21.5 {dict update command} -body {
     set a {b c}
     set result {}
@@ -1455,10 +1455,10 @@ test dict-21.17 {dict update command: no recursive structures [Bug 1786481]} {
 
 test dict-22.1 {dict with command} -body {
     dict with
-} -returnCodes 1 -result {wrong # args: should be "dict with dictVar ?key ...? script"}
+} -returnCodes 1 -result {wrong # args: should be "dict with dictVarName ?key ...? script"}
 test dict-22.2 {dict with command} -body {
     dict with v
-} -returnCodes 1 -result {wrong # args: should be "dict with dictVar ?key ...? script"}
+} -returnCodes 1 -result {wrong # args: should be "dict with dictVarName ?key ...? script"}
 test dict-22.3 {dict with command} -body {
     unset -nocomplain v
     dict with v {error "in body"}
@@ -1718,16 +1718,16 @@ rename linenumber {}
 
 test dict-24.1 {dict map command: syntax} -returnCodes error -body {
     dict map
-} -result {wrong # args: should be "dict map {keyVar valueVar} dictionary script"}
+} -result {wrong # args: should be "dict map {keyVarName valueVarName} dictionary script"}
 test dict-24.2 {dict map command: syntax} -returnCodes error -body {
     dict map x
-} -result {wrong # args: should be "dict map {keyVar valueVar} dictionary script"}
+} -result {wrong # args: should be "dict map {keyVarName valueVarName} dictionary script"}
 test dict-24.3 {dict map command: syntax} -returnCodes error -body {
     dict map x x
-} -result {wrong # args: should be "dict map {keyVar valueVar} dictionary script"}
+} -result {wrong # args: should be "dict map {keyVarName valueVarName} dictionary script"}
 test dict-24.4 {dict map command: syntax} -returnCodes error -body {
     dict map x x x x
-} -result {wrong # args: should be "dict map {keyVar valueVar} dictionary script"}
+} -result {wrong # args: should be "dict map {keyVarName valueVarName} dictionary script"}
 test dict-24.5 {dict map command: syntax} -returnCodes error -body {
     dict map x x x
 } -result {must have exactly two variable names}
-- 
cgit v0.12


From 31c57051e72eb8b545de3e43ed6fd77d62db67f9 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 16 Jun 2014 09:24:39 +0000
Subject: [311e61d12a] Generate error code in *all* places where commands are
 looked up.

---
 library/init.tcl | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/library/init.tcl b/library/init.tcl
index f63eedf..bb17319 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -398,7 +398,8 @@ proc unknown args {
 	    return -code error "ambiguous command name \"$name\": [lsort $cmds]"
 	}
     }
-    return -code error "invalid command name \"$name\""
+    return -code error -errorcode [list TCL LOOKUP COMMAND $name] \
+	"invalid command name \"$name\""
 }
 
 # auto_load --
-- 
cgit v0.12


From d27ff0c78862fc1652325b8c27e0882aa772171f Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 17 Jun 2014 14:30:06 +0000
Subject: [f0f876c141] Improve consistency in error messages.

---
 generic/tclClock.c    |  6 +++---
 generic/tclCmdMZ.c    | 16 +++++++++-------
 generic/tclFCmd.c     |  2 +-
 generic/tclIOCmd.c    |  6 +++---
 library/clock.tcl     |  8 ++++----
 tests/clock.test      | 12 ++++++------
 tests/exec.test       |  6 +++---
 tests/fCmd.test       |  4 ++--
 tests/ioCmd.test      |  2 +-
 tests/regexp.test     | 16 ++++++++--------
 tests/regexpComp.test | 16 ++++++++--------
 tests/string.test     |  4 ++--
 tests/subst.test      |  8 ++++----
 tests/switch.test     |  8 ++++----
 14 files changed, 58 insertions(+), 56 deletions(-)

diff --git a/generic/tclClock.c b/generic/tclClock.c
index 15f29e5..7e917f6 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -1703,7 +1703,7 @@ ClockClicksObjCmd(
     case 1:
 	break;
     case 2:
-	if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "switch", 0,
+	if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "option", 0,
 		&index) != TCL_OK) {
 	    return TCL_ERROR;
 	}
@@ -1873,9 +1873,9 @@ ClockParseformatargsObjCmd(
     localeObj = litPtr[LIT_C];
     timezoneObj = litPtr[LIT__NIL];
     for (i = 2; i < objc; i+=2) {
-	if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", 0,
+	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
 		&optionIndex) != TCL_OK) {
-	    Tcl_SetErrorCode(interp, "CLOCK", "badSwitch",
+	    Tcl_SetErrorCode(interp, "CLOCK", "badOption",
 		    Tcl_GetString(objv[i]), NULL);
 	    return TCL_ERROR;
 	}
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 00c9f2f..0f7f20a 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -161,7 +161,7 @@ Tcl_RegexpObjCmd(
 	if (name[0] != '-') {
 	    break;
 	}
-	if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT,
+	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", TCL_EXACT,
 		&index) != TCL_OK) {
 	    goto optionError;
 	}
@@ -217,7 +217,7 @@ Tcl_RegexpObjCmd(
   endOfForLoop:
     if ((objc - i) < (2 - about)) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-	    "?-switch ...? exp string ?matchVar? ?subMatchVar ...?");
+		"?-option ...? exp string ?matchVar? ?subMatchVar ...?");
 	goto optionError;
     }
     objc -= i;
@@ -231,6 +231,8 @@ Tcl_RegexpObjCmd(
     if (doinline && ((objc - 2) != 0)) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"regexp match variables not allowed when using -inline", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "REGEXP",
+		"MIX_VAR_INLINE", NULL);
 	goto optionError;
     }
 
@@ -519,7 +521,7 @@ Tcl_RegsubObjCmd(
 	if (name[0] != '-') {
 	    break;
 	}
-	if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch",
+	if (Tcl_GetIndexFromObj(interp, objv[idx], options, "option",
 		TCL_EXACT, &index) != TCL_OK) {
 	    goto optionError;
 	}
@@ -566,7 +568,7 @@ Tcl_RegsubObjCmd(
   endOfForLoop:
     if (objc-idx < 3 || objc-idx > 4) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"?-switch ...? exp string subSpec ?varName?");
+		"?-option ...? exp string subSpec ?varName?");
     optionError:
 	if (startIndex) {
 	    Tcl_DecrRefCount(startIndex);
@@ -3391,7 +3393,7 @@ TclSubstOptions(
     for (i = 0; i < numOpts; i++) {
 	int optionIndex;
 
-	if (Tcl_GetIndexFromObj(interp, opts[i], substOptions, "switch", 0,
+	if (Tcl_GetIndexFromObj(interp, opts[i], substOptions, "option", 0,
 		&optionIndex) != TCL_OK) {
 	    return TCL_ERROR;
 	}
@@ -3591,7 +3593,7 @@ TclNRSwitchObjCmd(
   finishedOptions:
     if (objc - i < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"?-switch ...? string ?pattern body ...? ?default body?");
+		"?-option ...? string ?pattern body ...? ?default body?");
 	return TCL_ERROR;
     }
     if (indexVarObj != NULL && mode != OPT_REGEXP) {
@@ -3638,7 +3640,7 @@ TclNRSwitchObjCmd(
 
 	if (objc < 1) {
 	    Tcl_WrongNumArgs(interp, 1, savedObjv,
-		    "?-switch ...? string {?pattern body ...? ?default body?}");
+		    "?-option ...? string {?pattern body ...? ?default body?}");
 	    return TCL_ERROR;
 	}
 	objv = listv;
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 6452fff..8bf0a5a 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -1196,7 +1196,7 @@ TclFileLinkCmd(
 	    static const char *const linkTypes[] = {
 		"-symbolic", "-hard", NULL
 	    };
-	    if (Tcl_GetIndexFromObj(interp, objv[1], linkTypes, "switch", 0,
+	    if (Tcl_GetIndexFromObj(interp, objv[1], linkTypes, "option", 0,
 		    &linkAction) != TCL_OK) {
 		return TCL_ERROR;
 	    }
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 084cefb..3368a76 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -919,7 +919,7 @@ Tcl_ExecObjCmd(
 	if (string[0] != '-') {
 	    break;
 	}
-	if (Tcl_GetIndexFromObj(interp, objv[skip], options, "switch",
+	if (Tcl_GetIndexFromObj(interp, objv[skip], options, "option",
 		TCL_EXACT, &index) != TCL_OK) {
 	    return TCL_ERROR;
 	}
@@ -933,7 +933,7 @@ Tcl_ExecObjCmd(
 	}
     }
     if (objc <= skip) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?-switch ...? arg ?arg ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "?-option ...? arg ?arg ...?");
 	return TCL_ERROR;
     }
 
@@ -1696,7 +1696,7 @@ Tcl_FcopyObjCmd(
     toRead = -1;
     cmdPtr = NULL;
     for (i = 3; i < objc; i += 2) {
-	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "switch", 0,
+	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
 		&index) != TCL_OK) {
 	    return TCL_ERROR;
 	}
diff --git a/library/clock.tcl b/library/clock.tcl
index 1e652b4..67d15b1 100644
--- a/library/clock.tcl
+++ b/library/clock.tcl
@@ -1227,8 +1227,8 @@ proc ::tcl::clock::scan { args } {
 	    }
 	    default {
 		return -code error \
-		    -errorcode [list CLOCK badSwitch $flag] \
-		    "bad switch \"$flag\",\
+		    -errorcode [list CLOCK badOption $flag] \
+		    "bad option \"$flag\",\
                      must be -base, -format, -gmt, -locale or -timezone"
 	    }
 	}
@@ -4295,8 +4295,8 @@ proc ::tcl::clock::add { clockval args } {
 		    set timezone $b
 		}
 		default {
-		    throw [list CLOCK badSwitch $a] \
-			"bad switch \"$a\",\
+		    throw [list CLOCK badOption $a] \
+			"bad option \"$a\",\
                          must be -gmt, -locale or -timezone"
 		}
 	    }
diff --git a/tests/clock.test b/tests/clock.test
index 8debba1..2abeab9 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -273,7 +273,7 @@ test clock-1.4 "clock format - bad flag" {*}{
     list [catch {clock format 0 -oops badflag} msg] $msg $::errorCode
     } 
     -match glob
-    -result {1 {bad switch "-oops": must be -format, -gmt, -locale, or -timezone} {CLOCK badSwitch -oops}}
+    -result {1 {bad option "-oops": must be -format, -gmt, -locale, or -timezone} {CLOCK badOption -oops}}
 }
 
 test clock-1.5 "clock format - bad timezone" {
@@ -35450,7 +35450,7 @@ test clock-33.2 {clock clicks tests} {
 } {1}
 test clock-33.3 {clock clicks tests} {
     list [catch {clock clicks foo} msg] $msg
-} {1 {bad switch "foo": must be -milliseconds or -microseconds}}
+} {1 {bad option "foo": must be -milliseconds or -microseconds}}
 test clock-33.4 {clock clicks tests} {
     expr [clock clicks -milliseconds]+1
     concat {}
@@ -35485,10 +35485,10 @@ test clock-33.5a {clock tests, millisecond timing test} {
 } {ok}
 test clock-33.6 {clock clicks, milli with too much abbreviation} {
     list [catch { clock clicks ? } msg] $msg
-} {1 {bad switch "?": must be -milliseconds or -microseconds}}
+} {1 {bad option "?": must be -milliseconds or -microseconds}}
 test clock-33.7 {clock clicks, milli with too much abbreviation} {
     list [catch { clock clicks - } msg] $msg
-} {1 {ambiguous switch "-": must be -milliseconds or -microseconds}}
+} {1 {ambiguous option "-": must be -milliseconds or -microseconds}}
 
 test clock-33.8 {clock clicks test, microsecond timing test} {
     # This test can fail on a system that is so heavily loaded that
@@ -35607,7 +35607,7 @@ test clock-34.8 {clock scan tests} {
 } {Oct 23,1992 15:00 GMT}
 test clock-34.9 {clock scan tests} {
     list [catch {clock scan "Jan 12" -bad arg} msg] $msg
-} {1 {bad switch "-bad", must be -base, -format, -gmt, -locale or -timezone}}
+} {1 {bad option "-bad", must be -base, -format, -gmt, -locale or -timezone}}
 # The following two two tests test the two year date policy
 test clock-34.10 {clock scan tests} {
     set time [clock scan "1/1/71" -gmt true]
@@ -36907,7 +36907,7 @@ test clock-65.1 {clock add, bad option [Bug 2481670]} {*}{
     }
     -match glob
     -returnCodes error
-    -result {bad switch "-foo"*}
+    -result {bad option "-foo"*}
 }
 
 test clock-66.1 {clock scan, no date, never-before-seen timezone} {*}{
diff --git a/tests/exec.test b/tests/exec.test
index 871c0c5..16a8320 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -370,7 +370,7 @@ err}
 
 test exec-10.1 {errors in exec invocation} -constraints {exec} -body {
     exec
-} -returnCodes error -result {wrong # args: should be "exec ?-switch ...? arg ?arg ...?"}
+} -returnCodes error -result {wrong # args: should be "exec ?-option ...? arg ?arg ...?"}
 test exec-10.2 {errors in exec invocation} -constraints {exec} -body {
     exec | cat
 } -returnCodes error -result {illegal use of | or |& in command}
@@ -545,10 +545,10 @@ test exec-14.1 {-keepnewline switch} {exec} {
 } "foo\n"
 test exec-14.2 {-keepnewline switch} -constraints {exec} -body {
     exec -keepnewline
-} -returnCodes error -result {wrong # args: should be "exec ?-switch ...? arg ?arg ...?"}
+} -returnCodes error -result {wrong # args: should be "exec ?-option ...? arg ?arg ...?"}
 test exec-14.3 {unknown switch} -constraints {exec} -body {
     exec -gorp
-} -returnCodes error -result {bad switch "-gorp": must be -ignorestderr, -keepnewline, or --}
+} -returnCodes error -result {bad option "-gorp": must be -ignorestderr, -keepnewline, or --}
 test exec-14.4 {-- switch} -constraints {exec} -body {
     exec -- -gorp
 } -returnCodes error -result {couldn't execute "-gorp": no such file or directory}
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 3d22b09..5836e00 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -2324,10 +2324,10 @@ test fCmd-28.2 {file link} -returnCodes error -body {
 } -result {wrong # args: should be "file link ?-linktype? linkname ?target?"}
 test fCmd-28.3 {file link} -returnCodes error -body {
     file link abc b c
-} -result {bad switch "abc": must be -symbolic or -hard}
+} -result {bad option "abc": must be -symbolic or -hard}
 test fCmd-28.4 {file link} -returnCodes error -body {
     file link -abc b c
-} -result {bad switch "-abc": must be -symbolic or -hard}
+} -result {bad option "-abc": must be -symbolic or -hard}
 cd [workingDirectory]
 makeDirectory abc.dir
 makeDirectory abc2.dir
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index ff93719..8d35ec7 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -639,7 +639,7 @@ test iocmd-15.9 {Tcl_FcopyObjCmd} {fcopy} {
 } "1 {channel \"$rfile\" wasn't opened for writing}"
 test iocmd-15.10 {Tcl_FcopyObjCmd} {fcopy} {
     list [catch {fcopy $rfile $wfile foo bar} msg] $msg
-} {1 {bad switch "foo": must be -size or -command}}
+} {1 {bad option "foo": must be -size or -command}}
 test iocmd-15.11 {Tcl_FcopyObjCmd} {fcopy} {
     list [catch {fcopy $rfile $wfile -size foo} msg] $msg
 } {1 {expected integer but got "foo"}}
diff --git a/tests/regexp.test b/tests/regexp.test
index 1b2bec9..a83c99b 100644
--- a/tests/regexp.test
+++ b/tests/regexp.test
@@ -241,13 +241,13 @@ test regexp-5.5 {exercise cache of compiled expressions} {
 
 test regexp-6.1 {regexp errors} {
     list [catch {regexp a} msg] $msg
-} {1 {wrong # args: should be "regexp ?-switch ...? exp string ?matchVar? ?subMatchVar ...?"}}
+} {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}}
 test regexp-6.2 {regexp errors} {
     list [catch {regexp -nocase a} msg] $msg
-} {1 {wrong # args: should be "regexp ?-switch ...? exp string ?matchVar? ?subMatchVar ...?"}}
+} {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}}
 test regexp-6.3 {regexp errors} {
     list [catch {regexp -gorp a} msg] $msg
-} {1 {bad switch "-gorp": must be -all, -about, -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}}
+} {1 {bad option "-gorp": must be -all, -about, -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}}
 test regexp-6.4 {regexp errors} {
     list [catch {regexp a( b} msg] $msg
 } {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
@@ -441,19 +441,19 @@ test regexp-10.5 {inverse partial newline sensitivity in regsub} {
 
 test regexp-11.1 {regsub errors} {
     list [catch {regsub a b} msg] $msg
-} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}}
+} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
 test regexp-11.2 {regsub errors} {
     list [catch {regsub -nocase a b} msg] $msg
-} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}}
+} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
 test regexp-11.3 {regsub errors} {
     list [catch {regsub -nocase -all a b} msg] $msg
-} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}}
+} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
 test regexp-11.4 {regsub errors} {
     list [catch {regsub a b c d e f} msg] $msg
-} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}}
+} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
 test regexp-11.5 {regsub errors} {
     list [catch {regsub -gorp a b c} msg] $msg
-} {1 {bad switch "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}}
+} {1 {bad option "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}}
 test regexp-11.6 {regsub errors} {
     list [catch {regsub -nocase a( b c d} msg] $msg
 } {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
diff --git a/tests/regexpComp.test b/tests/regexpComp.test
index 94fb90e..7be1195 100644
--- a/tests/regexpComp.test
+++ b/tests/regexpComp.test
@@ -316,17 +316,17 @@ test regexpComp-6.1 {regexp errors} {
     evalInProc {
 	list [catch {regexp a} msg] $msg
     }
-} {1 {wrong # args: should be "regexp ?-switch ...? exp string ?matchVar? ?subMatchVar ...?"}}
+} {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}}
 test regexpComp-6.2 {regexp errors} {
     evalInProc {
 	list [catch {regexp -nocase a} msg] $msg
     }
-} {1 {wrong # args: should be "regexp ?-switch ...? exp string ?matchVar? ?subMatchVar ...?"}}
+} {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}}
 test regexpComp-6.3 {regexp errors} {
     evalInProc {
 	list [catch {regexp -gorp a} msg] $msg
     }
-} {1 {bad switch "-gorp": must be -all, -about, -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}}
+} {1 {bad option "-gorp": must be -all, -about, -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}}
 test regexpComp-6.4 {regexp errors} {
     evalInProc {
 	list [catch {regexp a( b} msg] $msg
@@ -562,27 +562,27 @@ test regexpComp-11.1 {regsub errors} {
     evalInProc {
 	list [catch {regsub a b} msg] $msg
     }
-} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}}
+} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
 test regexpComp-11.2 {regsub errors} {
     evalInProc {
 	list [catch {regsub -nocase a b} msg] $msg
     }
-} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}}
+} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
 test regexpComp-11.3 {regsub errors} {
     evalInProc {
 	list [catch {regsub -nocase -all a b} msg] $msg
     }
-} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}}
+} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
 test regexpComp-11.4 {regsub errors} {
     evalInProc {
 	list [catch {regsub a b c d e f} msg] $msg
     }
-} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}}
+} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
 test regexpComp-11.5 {regsub errors} {
     evalInProc {
 	list [catch {regsub -gorp a b c} msg] $msg
     }
-} {1 {bad switch "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}}
+} {1 {bad option "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}}
 test regexpComp-11.6 {regsub errors} {
     evalInProc {
 	list [catch {regsub -nocase a( b c d} msg] $msg
diff --git a/tests/string.test b/tests/string.test
index cf658a2..a8a83d9 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -1801,8 +1801,8 @@ test string-26.7 {tcl::prefix} -body {
     tcl::prefix match -exact {apa bepa cepa depa} be
 } -returnCodes 1 -result {bad option "be": must be apa, bepa, cepa, or depa}
 test string-26.8 {tcl::prefix} -body {
-    tcl::prefix match -message switch {apa bepa bear depa} be
-} -returnCodes 1 -result {ambiguous switch "be": must be apa, bepa, bear, or depa}
+    tcl::prefix match -message wombat {apa bepa bear depa} be
+} -returnCodes 1 -result {ambiguous wombat "be": must be apa, bepa, bear, or depa}
 test string-26.9 {tcl::prefix} -body {
     tcl::prefix match -error {} {apa bepa bear depa} be
 } -returnCodes 0 -result {}
diff --git a/tests/subst.test b/tests/subst.test
index 7466895..498512d 100644
--- a/tests/subst.test
+++ b/tests/subst.test
@@ -21,7 +21,7 @@ test subst-1.1 {basics} -returnCodes error -body {
 } -result {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"}
 test subst-1.2 {basics} -returnCodes error -body {
     subst a b c
-} -result {bad switch "a": must be -nobackslashes, -nocommands, or -novariables}
+} -result {bad option "a": must be -nobackslashes, -nocommands, or -novariables}
 
 test subst-2.1 {simple strings} {
     subst {}
@@ -119,13 +119,13 @@ test subst-6.1 {clear the result after command substitution} -body {
 
 test subst-7.1 {switches} -returnCodes error -body {
     subst foo bar
-} -result {bad switch "foo": must be -nobackslashes, -nocommands, or -novariables}
+} -result {bad option "foo": must be -nobackslashes, -nocommands, or -novariables}
 test subst-7.2 {switches} -returnCodes error -body {
     subst -no bar
-} -result {ambiguous switch "-no": must be -nobackslashes, -nocommands, or -novariables}
+} -result {ambiguous option "-no": must be -nobackslashes, -nocommands, or -novariables}
 test subst-7.3 {switches} -returnCodes error -body {
     subst -bogus bar
-} -result {bad switch "-bogus": must be -nobackslashes, -nocommands, or -novariables}
+} -result {bad option "-bogus": must be -nobackslashes, -nocommands, or -novariables}
 test subst-7.4 {switches} {
     set x 123
     subst -nobackslashes {abc $x [expr 1+2] \\\x41}
diff --git a/tests/switch.test b/tests/switch.test
index a03948b..4d204bb 100644
--- a/tests/switch.test
+++ b/tests/switch.test
@@ -169,7 +169,7 @@ test switch-4.1 {error in executed command} {
 "switch a a {error "Just a test"} default {subst 1}"}}
 test switch-4.2 {error: not enough args} -returnCodes error -body {
     switch
-} -result {wrong # args: should be "switch ?-switch ...? string ?pattern body ...? ?default body?"}
+} -result {wrong # args: should be "switch ?-option ...? string ?pattern body ...? ?default body?"}
 test switch-4.3 {error: pattern with no body} -body {
     switch a b
 } -returnCodes error -result {extra switch pattern with no body}
@@ -269,16 +269,16 @@ test switch-8.3 {weird body text, variable} {
 
 test switch-9.1 {empty pattern/body list} -returnCodes error -body {
     switch x
-} -result {wrong # args: should be "switch ?-switch ...? string ?pattern body ...? ?default body?"}
+} -result {wrong # args: should be "switch ?-option ...? string ?pattern body ...? ?default body?"}
 test switch-9.2 {unpaired pattern} -returnCodes error -body {
     switch -- x
 } -result {extra switch pattern with no body}
 test switch-9.3 {empty pattern/body list} -body {
     switch x {}
-} -returnCodes error -result {wrong # args: should be "switch ?-switch ...? string {?pattern body ...? ?default body?}"}
+} -returnCodes error -result {wrong # args: should be "switch ?-option ...? string {?pattern body ...? ?default body?}"}
 test switch-9.4 {empty pattern/body list} -body {
     switch -- x {}
-} -returnCodes error -result {wrong # args: should be "switch ?-switch ...? string {?pattern body ...? ?default body?}"}
+} -returnCodes error -result {wrong # args: should be "switch ?-option ...? string {?pattern body ...? ?default body?}"}
 test switch-9.5 {unpaired pattern} -body {
     switch x a {} b
 } -returnCodes error -result {extra switch pattern with no body}
-- 
cgit v0.12


From 002bdcfeb0578c3dc428a72d3bdd33b476740519 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 19 Jun 2014 16:38:33 +0000
Subject: [b47b176adf] Stop segfault when variability in mutex lock schedules
 cause a ForwardingResult to remain on the forwardList after it has been
 processed.

---
 generic/tclIORTrans.c | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index e6e552f..d2707a1 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -2225,6 +2225,9 @@ DeleteReflectedTransformMap(
 	 */
 
 	evPtr = resultPtr->evPtr;
+	if (evPtr == NULL) {
+	    continue;
+	}
 	paramPtr = evPtr->param;
 
 	evPtr->resultPtr = NULL;
@@ -2350,6 +2353,9 @@ DeleteThreadReflectedTransformMap(
 	 */
 
 	evPtr = resultPtr->evPtr;
+	if (evPtr == NULL) {
+	    continue;
+	}
 	paramPtr = evPtr->param;
 
 	evPtr->resultPtr = NULL;
-- 
cgit v0.12


From 871b2c750d594d61b15d9fcd809dd50633ad881c Mon Sep 17 00:00:00 2001
From: aku <akupries@shaw.ca>
Date: Fri, 20 Jun 2014 05:05:21 +0000
Subject: [b47b176adf] Stop possible segfaults when variability in mutex lock
 schedules cause a ForwardingResult to remain on the forwardList after it has
 been processed (IORChan is the origin of the code in IORTrans).

---
 generic/tclIORChan.c | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 3107f9e..e1bd6e1 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -2384,10 +2384,18 @@ DeleteReflectedChannelMap(
 	/*
 	 * The receiver for the event exited, before processing the event. We
 	 * detach the result now, wake the originator up and signal failure.
+         *
+         * Attention: Results may have been detached already, by either the
+         * receiver, or this thread, as part of other parts in the thread
+         * teardown. Such results are ignored. See ticket [b47b176adf] for the
+         * identical race condition in Tcl 8.6 IORTrans.
 	 */
 
 	evPtr = resultPtr->evPtr;
 	paramPtr = evPtr->param;
+	if (!evPtr) {
+	    continue;
+	}
 
 	evPtr->resultPtr = NULL;
 	resultPtr->evPtr = NULL;
@@ -2515,10 +2523,18 @@ DeleteThreadReflectedChannelMap(
 	/*
 	 * The receiver for the event exited, before processing the event. We
 	 * detach the result now, wake the originator up and signal failure.
+         *
+         * Attention: Results may have been detached already, by either the
+         * receiver, or this thread, as part of other parts in the thread
+         * teardown. Such results are ignored. See ticket [b47b176adf] for the
+         * identical race condition in Tcl 8.6 IORTrans.
 	 */
 
 	evPtr = resultPtr->evPtr;
 	paramPtr = evPtr->param;
+	if (!evPtr) {
+	    continue;
+	}
 
 	evPtr->resultPtr = NULL;
 	resultPtr->evPtr = NULL;
-- 
cgit v0.12


From e69901045e82f866693fcb6716831418846e2bac Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 20 Jun 2014 20:21:50 +0000
Subject: ticket [2f9df4c4fa]: tcltest - request to move -cleanup script
 execution until after -output compare

---
 library/tcltest/pkgIndex.tcl |  2 +-
 library/tcltest/tcltest.tcl  | 14 +++++++-------
 unix/Makefile.in             |  4 ++--
 win/Makefile.in              |  4 ++--
 4 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl
index c99ad2a..987725f 100644
--- a/library/tcltest/pkgIndex.tcl
+++ b/library/tcltest/pkgIndex.tcl
@@ -9,4 +9,4 @@
 # full path name of this file's directory.
 
 if {![package vsatisfies [package provide Tcl] 8.5]} {return}
-package ifneeded tcltest 2.3.7 [list source [file join $dir tcltest.tcl]]
+package ifneeded tcltest 2.3.8 [list source [file join $dir tcltest.tcl]]
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 4b94312..7dd969b 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -22,7 +22,7 @@ namespace eval tcltest {
     # When the version number changes, be sure to update the pkgIndex.tcl file,
     # and the install directory in the Makefiles.  When the minor version
     # changes (new feature) be sure to update the man page as well.
-    variable Version 2.3.7
+    variable Version 2.3.8
 
     # Compatibility support for dumb variables defined in tcltest 1
     # Do not use these.  Call [package provide Tcl] and [info patchlevel]
@@ -1991,6 +1991,12 @@ proc tcltest::test {name description args} {
 	}
     }
 
+    # check if the return code matched the expected return code
+    set codeFailure 0
+    if {!$setupFailure && ($returnCode ni $returnCodes)} {
+	set codeFailure 1
+    }
+
     # Always run the cleanup script
     set code [catch {uplevel 1 $cleanup} cleanupMsg]
     if {$code == 1} {
@@ -2032,12 +2038,6 @@ proc tcltest::test {name description args} {
 	}
     }
 
-    # check if the return code matched the expected return code
-    set codeFailure 0
-    if {!$setupFailure && ($returnCode ni $returnCodes)} {
-	set codeFailure 1
-    }
-
     # If expected output/error strings exist, we have to compare
     # them.  If the comparison fails, then so did the test.
     set outputFailure 0
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 746abde..1738570 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -785,8 +785,8 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs
 	    done;
 	@echo "Installing package msgcat 1.5.2 as a Tcl Module";
 	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.5.2.tm;
-	@echo "Installing package tcltest 2.3.7 as a Tcl Module";
-	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.7.tm;
+	@echo "Installing package tcltest 2.3.8 as a Tcl Module";
+	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.8.tm;
 
 	@echo "Installing package platform 1.0.12 as a Tcl Module";
 	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.12.tm;
diff --git a/win/Makefile.in b/win/Makefile.in
index b962fb4..a80d2fa 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -651,8 +651,8 @@ install-libraries: libraries install-tzdata install-msgs
 	    done;
 	@echo "Installing package msgcat 1.5.2 as a Tcl Module";
 	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.2.tm;
-	@echo "Installing package tcltest 2.3.7 as a Tcl Module";
-	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.7.tm;
+	@echo "Installing package tcltest 2.3.8 as a Tcl Module";
+	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.8.tm;
 	@echo "Installing package platform 1.0.12 as a Tcl Module";
 	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.12.tm;
 	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
-- 
cgit v0.12


From b45ad18c6c725693ccb23cad53b0264b3c368259 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 20 Jun 2014 20:50:48 +0000
Subject: previous commit was not quite right, this one should be better

---
 library/tcltest/tcltest.tcl | 28 ++++++++++++++--------------
 1 file changed, 14 insertions(+), 14 deletions(-)

diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 7dd969b..22d79e1 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -1991,20 +1991,6 @@ proc tcltest::test {name description args} {
 	}
     }
 
-    # check if the return code matched the expected return code
-    set codeFailure 0
-    if {!$setupFailure && ($returnCode ni $returnCodes)} {
-	set codeFailure 1
-    }
-
-    # Always run the cleanup script
-    set code [catch {uplevel 1 $cleanup} cleanupMsg]
-    if {$code == 1} {
-	set errorInfo(cleanup) $::errorInfo
-	set errorCode(cleanup) $::errorCode
-    }
-    set cleanupFailure [expr {$code != 0}]
-
     set coreFailure 0
     set coreMsg ""
     # check for a core file first - if one was created by the test,
@@ -2038,6 +2024,12 @@ proc tcltest::test {name description args} {
 	}
     }
 
+    # check if the return code matched the expected return code
+    set codeFailure 0
+    if {!$setupFailure && ($returnCode ni $returnCodes)} {
+	set codeFailure 1
+    }
+
     # If expected output/error strings exist, we have to compare
     # them.  If the comparison fails, then so did the test.
     set outputFailure 0
@@ -2076,6 +2068,14 @@ proc tcltest::test {name description args} {
 	set scriptFailure 1
     }
 
+    # Always run the cleanup script
+    set code [catch {uplevel 1 $cleanup} cleanupMsg]
+    if {$code == 1} {
+	set errorInfo(cleanup) $::errorInfo
+	set errorCode(cleanup) $::errorCode
+    }
+    set cleanupFailure [expr {$code != 0}]
+
     # if we didn't experience any failures, then we passed
     variable numTests
     if {!($setupFailure || $cleanupFailure || $coreFailure
-- 
cgit v0.12


From 2b8bf1a9f78976b319f00258e80ed4c3fe467e50 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 23 Jun 2014 12:48:16 +0000
Subject: Fix execute-6.5 test failure on trunk: the "preserveCore" part of
 tcltest::test assumes that the cleanup is done first, so moving the cleanup
 means the the "preserverCore" part needs to move with it.

---
 library/tcltest/tcltest.tcl | 66 ++++++++++++++++++++++-----------------------
 1 file changed, 33 insertions(+), 33 deletions(-)

diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 22d79e1..8e43859 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -1991,39 +1991,6 @@ proc tcltest::test {name description args} {
 	}
     }
 
-    set coreFailure 0
-    set coreMsg ""
-    # check for a core file first - if one was created by the test,
-    # then the test failed
-    if {[preserveCore]} {
-	if {[file exists [file join [workingDirectory] core]]} {
-	    # There's only a test failure if there is a core file
-	    # and (1) there previously wasn't one or (2) the new
-	    # one is different from the old one.
-	    if {[info exists coreModTime]} {
-		if {$coreModTime != [file mtime \
-			[file join [workingDirectory] core]]} {
-		    set coreFailure 1
-		}
-	    } else {
-		set coreFailure 1
-	    }
-	
-	    if {([preserveCore] > 1) && ($coreFailure)} {
-		append coreMsg "\nMoving file to:\
-		    [file join [temporaryDirectory] core-$name]"
-		catch {file rename -force -- \
-		    [file join [workingDirectory] core] \
-		    [file join [temporaryDirectory] core-$name]
-		} msg
-		if {$msg ne {}} {
-		    append coreMsg "\nError:\
-			Problem renaming core file: $msg"
-		}
-	    }
-	}
-    }
-
     # check if the return code matched the expected return code
     set codeFailure 0
     if {!$setupFailure && ($returnCode ni $returnCodes)} {
@@ -2076,6 +2043,39 @@ proc tcltest::test {name description args} {
     }
     set cleanupFailure [expr {$code != 0}]
 
+    set coreFailure 0
+    set coreMsg ""
+    # check for a core file first - if one was created by the test,
+    # then the test failed
+    if {[preserveCore]} {
+	if {[file exists [file join [workingDirectory] core]]} {
+	    # There's only a test failure if there is a core file
+	    # and (1) there previously wasn't one or (2) the new
+	    # one is different from the old one.
+	    if {[info exists coreModTime]} {
+		if {$coreModTime != [file mtime \
+			[file join [workingDirectory] core]]} {
+		    set coreFailure 1
+		}
+	    } else {
+		set coreFailure 1
+	    }
+	
+	    if {([preserveCore] > 1) && ($coreFailure)} {
+		append coreMsg "\nMoving file to:\
+		    [file join [temporaryDirectory] core-$name]"
+		catch {file rename -force -- \
+		    [file join [workingDirectory] core] \
+		    [file join [temporaryDirectory] core-$name]
+		} msg
+		if {$msg ne {}} {
+		    append coreMsg "\nError:\
+			Problem renaming core file: $msg"
+		}
+	    }
+	}
+    }
+
     # if we didn't experience any failures, then we passed
     variable numTests
     if {!($setupFailure || $cleanupFailure || $coreFailure
-- 
cgit v0.12


From b590e079873c15af1b48b4a05ba3d7db5926b9d7 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 24 Jun 2014 16:34:05 +0000
Subject: Simplify / refactor Tcl_ReadRaw().  No need for CopyBuffer().

---
 generic/tclIO.c | 177 ++++++++++++++++----------------------------------------
 1 file changed, 50 insertions(+), 127 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 308e7a9..c2a705c 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -178,7 +178,6 @@ static void		CleanupChannelHandlers(Tcl_Interp *interp,
 static int		CloseChannel(Tcl_Interp *interp, Channel *chanPtr,
 			    int errorCode);
 static void		CommonGetsCleanup(Channel *chanPtr);
-static int		CopyBuffer(Channel *chanPtr, char *result, int space);
 static int		CopyData(CopyState *csPtr, int mask);
 static void		CopyEventProc(ClientData clientData, int mask);
 static void		CreateScriptRecord(Tcl_Interp *interp,
@@ -4983,63 +4982,77 @@ Tcl_Read(
 int
 Tcl_ReadRaw(
     Tcl_Channel chan,		/* The channel from which to read. */
-    char *bufPtr,		/* Where to store input read. */
+    char *readBuf,		/* Where to store input read. */
     int bytesToRead)		/* Maximum number of bytes to read. */
 {
     Channel *chanPtr = (Channel *) chan;
     ChannelState *statePtr = chanPtr->state;
 				/* State info for channel */
-    int nread, copied, copiedNow = INT_MAX;
-
-    /*
-     * The check below does too much because it will reject a call to this
-     * function with a channel which is part of an 'fcopy'. But we have to
-     * allow this here or else the chaining in the transformation drivers will
-     * fail with 'file busy' error instead of retrieving and transforming the
-     * data to copy.
-     *
-     * We let the check procedure now believe that there is no fcopy in
-     * progress. A better solution than this might be an additional flag
-     * argument to switch off specific checks.
-     */
+    int copied = 0;
 
     if (CheckChannelErrors(statePtr, TCL_READABLE | CHANNEL_RAW_MODE) != 0) {
 	return -1;
     }
 
-    /*
-     * Check for information in the push-back buffers. If there is some, use
-     * it. Go to the driver only if there is none (anymore) and the caller
-     * requests more bytes.
-     */
+    /* First read bytes from the push-back buffers. */
 
-    Tcl_Preserve(chanPtr);
-    for (copied = 0; bytesToRead > 0 && copiedNow > 0;
-	    bufPtr+=copiedNow, bytesToRead-=copiedNow, copied+=copiedNow) {
-	copiedNow = CopyBuffer(chanPtr, bufPtr, bytesToRead);
+    while (chanPtr->inQueueHead && bytesToRead > 0) {
+	ChannelBuffer *bufPtr = chanPtr->inQueueHead;
+	int bytesInBuffer = BytesLeft(bufPtr);
+	int toCopy = (bytesInBuffer < bytesToRead) ? bytesInBuffer
+		: bytesToRead;
+
+	/* Copy the current chunk into the read buffer. */
+
+	memcpy(readBuf, RemovePoint(bufPtr), (size_t) toCopy);
+	bufPtr->nextRemoved += toCopy;
+	copied += toCopy;
+	readBuf += toCopy;
+	bytesToRead -= toCopy;
+
+	/* If the current buffer is empty recycle it. */
+
+	if (IsBufferEmpty(bufPtr)) {
+	    chanPtr->inQueueHead = bufPtr->nextPtr;
+	    if (chanPtr->inQueueHead == NULL) {
+		chanPtr->inQueueTail = NULL;
+	    }
+	    RecycleBuffer(chanPtr->state, bufPtr, 0);
+	}
     }
 
+    /* Go to the driver if more data needed. */
+
     if (bytesToRead > 0) {
-	/*
-	 * Now go to the driver to get as much as is possible to
-	 * fill the remaining request.  Since we're directly filling
-	 * the caller's buffer, retain the blocked flag.
-	 */
 
-	nread = ChanRead(chanPtr, bufPtr, bytesToRead);
-	if (nread < 0) {
+	int nread = ChanRead(chanPtr, readBuf+copied, bytesToRead);
+
+	if (nread > 0) {
+	    /* Successful read (short is OK) - add to bytes copied */
+	    copied += nread;
+	} else if (nread < 0) {
+	    /*
+	     * An error signaled.  If CHANNEL_BLOCKED, then the error
+	     * is not real, but an indication of blocked state.  In
+	     * that case, retain the flag and let caller receive the
+	     * short read of copied bytes from the pushback.
+	     * HOWEVER, if copied==0 bytes from pushback then repeat
+	     * signalling the blocked state as an error to caller so
+	     * there is no false report of an EOF.
+	     * When !CHANNEL_BLOCKED, the error is real and passes on
+	     * to caller.
+	     */
 	    if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) {
 		copied = -1;
 	    }
-	} else {
-	    copied += nread;
-	}
-	if (copied != 0) {
+	} else if (copied > 0) {
+	    /*
+	     * nread == 0.  Driver is at EOF, but if copied>0 bytes
+	     * from pushback, then we should not signal it yet.
+	     */
 	    ResetFlag(statePtr, CHANNEL_EOF);
 	}
     }
-
-    Tcl_Release(chanPtr);
     return copied;
 }
 
@@ -8941,96 +8954,6 @@ DoRead(
 /*
  *----------------------------------------------------------------------
  *
- * CopyBuffer --
- *
- *	Copy at most one buffer of input to the result space.
- *
- * Results:
- *	Number of bytes stored in the result buffer. May return zero if no
- *	input is available.
- *
- * Side effects:
- *	Consumes buffered input. May deallocate one buffer.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CopyBuffer(
-    Channel *chanPtr,		/* Channel from which to read input. */
-    char *result,		/* Where to store the copied input. */
-    int space)			/* How many bytes are available in result to
-				 * store the copied input? */
-{
-    ChannelBuffer *bufPtr;	/* The buffer from which to copy bytes. */
-    int bytesInBuffer;		/* How many bytes are available to be copied
-				 * in the current input buffer? */
-    int copied;			/* How many characters were already copied
-				 * into the destination space? */
-
-    /*
-     * If there is no input at all, return zero. The invariant is that either
-     * there is no buffer in the queue, or if the first buffer is empty, it is
-     * also the last buffer (and thus there is no input in the queue). Note
-     * also that if the buffer is empty, we don't leave it in the queue, but
-     * recycle it.
-     */
-
-    if (chanPtr->inQueueHead == NULL) {
-	return 0;
-    }
-    bufPtr = chanPtr->inQueueHead;
-    bytesInBuffer = BytesLeft(bufPtr);
-
-    copied = 0;
-
-    if (bytesInBuffer == 0) {
-	RecycleBuffer(chanPtr->state, bufPtr, 0);
-	chanPtr->inQueueHead = NULL;
-	chanPtr->inQueueTail = NULL;
-	return 0;
-    }
-
-    /*
-     * Copy the current chunk into the result buffer.
-     */
-
-    if (bytesInBuffer < space) {
-	space = bytesInBuffer;
-    }
-
-    memcpy(result, RemovePoint(bufPtr), (size_t) space);
-    bufPtr->nextRemoved += space;
-    copied = space;
-
-    /*
-     * We don't care about in-stream EOF characters here as the data read here
-     * may still flow through one or more transformations, i.e. is not in its
-     * final state yet.
-     */
-
-    /*
-     * If the current buffer is empty recycle it.
-     */
-
-    if (IsBufferEmpty(bufPtr)) {
-	chanPtr->inQueueHead = bufPtr->nextPtr;
-	if (chanPtr->inQueueHead == NULL) {
-	    chanPtr->inQueueTail = NULL;
-	}
-	RecycleBuffer(chanPtr->state, bufPtr, 0);
-    }
-
-    /*
-     * Return the number of characters copied into the result buffer.
-     */
-
-    return copied;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * CopyEventProc --
  *
  *	This routine is invoked as a channel event handler for the background
-- 
cgit v0.12


From e7158f66d79b491e7b6f871259b591bd1aebe67d Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 26 Jun 2014 15:59:27 +0000
Subject: Fix mismatch of Tcl_Preserve() / Tcl_Release().

---
 generic/tclIO.c | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index c2a705c..85b015c 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -3945,8 +3945,7 @@ Tcl_GetsObj(
     Tcl_EncodingState oldState;
 
     if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
-	copiedTotal = -1;
-	goto done;
+	return -1;
     }
 
     /*
-- 
cgit v0.12