merge core-8-5-branch

5 files changed, 123 insertions, 140 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..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) {
@@ -3197,19 +3200,72 @@ 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);
+	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);
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 e7b086a..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);
 }
@@ -719,44 +684,52 @@ 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.
 	 */
 
-	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
-		(WPARAM) UNSELECT, (LPARAM) infoPtr);
-
-	FD_ZERO(&readFds);
-	FD_SET(infoPtr->socket, &readFds);
-	timeout.tv_usec = 0;
-	timeout.tv_sec = 0;
+	if (infoPtr->lastError) {
 
-	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 (events & (FD_WRITE | FD_CONNECT)) {
-	mask |= TCL_WRITABLE;
-	if (events & FD_CONNECT && infoPtr->lastError != NO_ERROR) {
+	    fd_set readFds;
+	    struct timeval timeout;
+
 	    /*
-	     * Connect errors should also fire the readable handler.
+	     * 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.
 	     */
 
-	    mask |= TCL_READABLE;
+	    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+		    (WPARAM) UNSELECT, (LPARAM) infoPtr);
+
+	    FD_ZERO(&readFds);
+	    FD_SET(infoPtr->socket, &readFds);
+	    timeout.tv_usec = 0;
+	    timeout.tv_sec = 0;
+
+	    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);
+	    }
 	}
     }
 
+    /*
+     * writable event
+     */
+
+    if (events & FD_WRITE) {
+	mask |= TCL_WRITABLE;
+    }
+
     if (mask) {
 	Tcl_NotifyChannel(infoPtr->channel, mask);
     }
@@ -2409,19 +2382,18 @@ SocketProc(
 		 */
 
 		if (error != ERROR_SUCCESS) {
+		    /* Async Connect error */
 		    TclWinConvertWSAError((DWORD) error);
 		    infoPtr->lastError = Tcl_GetErrno();
+		    /* Fire also readable event on connect failure */
+		    infoPtr->readyEvents |= FD_READ;
 		}
-	    }
 
-	    if (infoPtr->flags & SOCKET_ASYNC_CONNECT) {
-		infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
-		if (error != ERROR_SUCCESS) {
-		    TclWinConvertWSAError((DWORD) error);
-		    infoPtr->lastError = Tcl_GetErrno();
-		}
+		/* fire writable event on connect */
 		infoPtr->readyEvents |= FD_WRITE;
+
 	    }
+
 	    infoPtr->readyEvents |= event;
 
 	    /*
@@ -2557,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);
 }