Merge 8.7

5 files changed, 48 insertions, 138 deletions

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 242d182..4d5e328 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -204,8 +204,6 @@ static Tcl_Encoding	GetBinaryEncoding();
 static void		FreeBinaryEncoding(ClientData clientData);
 static Tcl_HashTable *	GetChannelTable(Tcl_Interp *interp);
 static int		GetInput(Channel *chanPtr);
-static int		HaveVersion(const Tcl_ChannelType *typePtr,
-			    Tcl_ChannelTypeVersion minimumVersion);
 static void		PeekAhead(Channel *chanPtr, char **dstEndPtr,
 			    GetsState *gsPtr);
 static int		ReadBytes(ChannelState *statePtr, Tcl_Obj *objPtr,
@@ -492,9 +490,8 @@ ChanSeek(
      * type and non-NULL.
      */
 
-    if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
-	    chanPtr->typePtr->wideSeekProc != NULL) {
-	return chanPtr->typePtr->wideSeekProc(chanPtr->instanceData,
+    if (Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL) {
+	return Tcl_ChannelWideSeekProc(chanPtr->typePtr)(chanPtr->instanceData,
 		offset, mode, errnoPtr);
     }
 
@@ -503,7 +500,7 @@ ChanSeek(
 	return -1;
     }
 
-    return chanPtr->typePtr->seekProc(chanPtr->instanceData,
+    return Tcl_ChannelSeekProc(chanPtr->typePtr)(chanPtr->instanceData,
 	    offset, mode, errnoPtr);
 }
 
@@ -4216,7 +4213,7 @@ WillWrite(
 {
     int inputBuffered;
 
-    if ((chanPtr->typePtr->seekProc != NULL) &&
+    if ((Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL) &&
             ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){
         int ignore;
 
@@ -4238,7 +4235,7 @@ WillRead(
 	Tcl_SetErrno(EINVAL);
 	return -1;
     }
-    if ((chanPtr->typePtr->seekProc != NULL)
+    if ((Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL)
             && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
 	/*
 	 * CAVEAT - The assumption here is that FlushChannel() will push out
@@ -7001,7 +6998,7 @@ Tcl_Seek(
      * defined. This means that the channel does not support seeking.
      */
 
-    if (chanPtr->typePtr->seekProc == NULL) {
+    if (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) {
 	Tcl_SetErrno(EINVAL);
 	return -1;
     }
@@ -7165,7 +7162,7 @@ Tcl_Tell(
      * defined. This means that the channel does not support seeking.
      */
 
-    if (chanPtr->typePtr->seekProc == NULL) {
+    if (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) {
 	Tcl_SetErrno(EINVAL);
 	return -1;
     }
@@ -10488,49 +10485,15 @@ Tcl_ChannelVersion(
     const Tcl_ChannelType *chanTypePtr)
 				/* Pointer to channel type. */
 {
-    if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) {
-	return TCL_CHANNEL_VERSION_2;
-    } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_3) {
-	return TCL_CHANNEL_VERSION_3;
-    } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_4) {
-	return TCL_CHANNEL_VERSION_4;
-    } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_5) {
-	return TCL_CHANNEL_VERSION_5;
-    } else {
+    if ((chanTypePtr->version < TCL_CHANNEL_VERSION_2)
+	    || (chanTypePtr->version > TCL_CHANNEL_VERSION_5)) {
 	/*
 	 * In <v2 channel versions, the version field is occupied by the
 	 * Tcl_DriverBlockModeProc
 	 */
-
 	return TCL_CHANNEL_VERSION_1;
     }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * HaveVersion --
- *
- *	Return whether a channel type is (at least) of a given version.
- *
- * Results:
- *	True if the minimum version is exceeded by the version actually
- *	present.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-HaveVersion(
-    const Tcl_ChannelType *chanTypePtr,
-    Tcl_ChannelTypeVersion minimumVersion)
-{
-    Tcl_ChannelTypeVersion actualVersion = Tcl_ChannelVersion(chanTypePtr);
-
-    return (PTR2INT(actualVersion)) >= (PTR2INT(minimumVersion));
+    return chanTypePtr->version;
 }
 
 /*
@@ -10553,15 +10516,14 @@ Tcl_ChannelBlockModeProc(
     const Tcl_ChannelType *chanTypePtr)
 				/* Pointer to channel type. */
 {
-    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
-	return chanTypePtr->blockModeProc;
+    if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) {
+	/*
+	 * The v1 structure had the blockModeProc in a different place.
+	 */
+	return (Tcl_DriverBlockModeProc *) chanTypePtr->version;
     }
 
-    /*
-     * The v1 structure had the blockModeProc in a different place.
-     */
-
-    return (Tcl_DriverBlockModeProc *) chanTypePtr->version;
+    return chanTypePtr->blockModeProc;
 }
 
 /*
@@ -10801,10 +10763,10 @@ Tcl_ChannelFlushProc(
     const Tcl_ChannelType *chanTypePtr)
 				/* Pointer to channel type. */
 {
-    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
-	return chanTypePtr->flushProc;
+    if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) {
+	return NULL;
     }
-    return NULL;
+    return chanTypePtr->flushProc;
 }
 
 /*
@@ -10828,10 +10790,10 @@ Tcl_ChannelHandlerProc(
     const Tcl_ChannelType *chanTypePtr)
 				/* Pointer to channel type. */
 {
-    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
-	return chanTypePtr->handlerProc;
+    if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) {
+	return NULL;
     }
-    return NULL;
+    return chanTypePtr->handlerProc;
 }
 
 /*
@@ -10855,10 +10817,10 @@ Tcl_ChannelWideSeekProc(
     const Tcl_ChannelType *chanTypePtr)
 				/* Pointer to channel type. */
 {
-    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) {
-	return chanTypePtr->wideSeekProc;
+    if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_3) {
+	return NULL;
     }
-    return NULL;
+    return chanTypePtr->wideSeekProc;
 }
 
 /*
@@ -10883,10 +10845,10 @@ Tcl_ChannelThreadActionProc(
     const Tcl_ChannelType *chanTypePtr)
 				/* Pointer to channel type. */
 {
-    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) {
-	return chanTypePtr->threadActionProc;
+    if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_4) {
+	return NULL;
     }
-    return NULL;
+    return chanTypePtr->threadActionProc;
 }
 
 /*
@@ -11198,10 +11160,10 @@ Tcl_ChannelTruncateProc(
     const Tcl_ChannelType *chanTypePtr)
 				/* Pointer to channel type. */
 {
-    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_5)) {
-	return chanTypePtr->truncateProc;
+    if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_5) {
+	return NULL;
     }
-    return NULL;
+    return chanTypePtr->truncateProc;
 }
 
 /*
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 522ed3d..342c730 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -684,7 +684,7 @@ Tcl_CloseObjCmd(
 	/*
 	 * Special handling is needed if and only if the channel mode supports
 	 * more than the direction to close. Because if the close the last
-	 * direction suppported we can and will go through the regular
+	 * direction supported we can and will go through the regular
 	 * process.
 	 */
 
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index 5fbd511..ec18767 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -27,10 +27,6 @@
 #define EOK	0
 #endif
 
-/* DUPLICATE of HaveVersion() in tclIO.c // TODO - MODULE_SCOPE */
-static int		HaveVersion(const Tcl_ChannelType *typePtr,
-			    Tcl_ChannelTypeVersion minimumVersion);
-
 /*
  * Signatures of all functions used in the C layer of the reflection.
  */
@@ -1386,15 +1382,14 @@ ReflectSeekWide(
      * non-NULL...
      */
 
-    if (HaveVersion(parent->typePtr, TCL_CHANNEL_VERSION_3) &&
-	parent->typePtr->wideSeekProc != NULL) {
-	curPos = parent->typePtr->wideSeekProc(parent->instanceData, offset,
+    if (Tcl_ChannelWideSeekProc(parent->typePtr) != NULL) {
+	curPos = Tcl_ChannelWideSeekProc(parent->typePtr)(parent->instanceData, offset,
 		seekMode, errorCodePtr);
     } else if (offset < LONG_MIN || offset > LONG_MAX) {
 	*errorCodePtr = EOVERFLOW;
 	curPos = -1;
     } else {
-	curPos = parent->typePtr->seekProc(
+	curPos = Tcl_ChannelSeekProc(parent->typePtr)(
 		parent->instanceData, offset, seekMode,
 		errorCodePtr);
     }
@@ -3390,33 +3385,6 @@ TransformLimit(
     return 1;
 }
 
-/* DUPLICATE of HaveVersion() in tclIO.c
- *----------------------------------------------------------------------
- *
- * HaveVersion --
- *
- *	Return whether a channel type is (at least) of a given version.
- *
- * Results:
- *	True if the minimum version is exceeded by the version actually
- *	present.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-HaveVersion(
-    const Tcl_ChannelType *chanTypePtr,
-    Tcl_ChannelTypeVersion minimumVersion)
-{
-    Tcl_ChannelTypeVersion actualVersion = Tcl_ChannelVersion(chanTypePtr);
-
-    return PTR2INT(actualVersion) >= PTR2INT(minimumVersion);
-}
-
 /*
  * Local Variables:
  * mode: c
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 09ed008..fcb508d 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -688,30 +688,19 @@ TcpClose2Proc(
 {
     TcpState *statePtr = instanceData;
     int errorCode = 0;
-    int sd;
 
     /*
      * Shutdown the OS socket handle.
      */
-
-    switch(flags) {
-    case TCL_CLOSE_READ:
-        sd = SHUT_RD;
-        break;
-    case TCL_CLOSE_WRITE:
-        sd = SHUT_WR;
-        break;
-    default:
-        if (interp) {
-            Tcl_SetObjResult(interp, Tcl_NewStringObj(
-                    "socket close2proc called bidirectionally", -1));
-        }
-        return TCL_ERROR;
+    if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) {
+	return TcpCloseProc(instanceData, interp);
     }
-    if (shutdown(statePtr->fds.fd,sd) < 0) {
+    if ((flags & TCL_CLOSE_READ) && (shutdown(statePtr->fds.fd, SHUT_RD) < 0)) {
+	errorCode = errno;
+    }
+    if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->fds.fd, SHUT_WR) < 0) && (errorCode != 0)) {
 	errorCode = errno;
     }
-
     return errorCode;
 }
 
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 8e2723d..1159a64 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1137,25 +1137,13 @@ TcpClose2Proc(
 {
     TcpState *statePtr = instanceData;
     int errorCode = 0;
-    int sd;
 
     /*
      * Shutdown the OS socket handle.
      */
 
-    switch(flags) {
-    case TCL_CLOSE_READ:
-	sd = SD_RECEIVE;
-	break;
-    case TCL_CLOSE_WRITE:
-	sd = SD_SEND;
-	break;
-    default:
-	if (interp) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "socket close2proc called bidirectionally", -1));
-	}
-	return TCL_ERROR;
+    if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) {
+	return TcpCloseProc(instanceData, interp);
     }
 
     /*
@@ -1163,11 +1151,14 @@ TcpClose2Proc(
      * TCL_WRITABLE so this should never be called for a server socket.
      */
 
-    if (shutdown(statePtr->sockets->fd, sd) == SOCKET_ERROR) {
+    if ((flags & TCL_CLOSE_READ) && (shutdown(statePtr->sockets->fd, SD_RECEIVE) == SOCKET_ERROR)) {
+	TclWinConvertError((DWORD) WSAGetLastError());
+	errorCode = Tcl_GetErrno();
+    }
+    if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->sockets->fd, SD_SEND) == SOCKET_ERROR) && (errorCode != 0)) {
 	TclWinConvertError((DWORD) WSAGetLastError());
 	errorCode = Tcl_GetErrno();
     }
-
     return errorCode;
 }