From f85de8a933413038cc1f868fb450de8daa02e676 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 29 Jan 2020 15:52:02 +0000
Subject: Deprecate channel types 1-4

---
 generic/tcl.decls     |   2 +-
 generic/tcl.h         |  10 +++++
 generic/tclDecls.h    |  10 ++++-
 generic/tclIO.c       | 119 ++++++++++++++++++++++++++++----------------------
 generic/tclIOGT.c     |  55 ++++++++++++++---------
 generic/tclIORChan.c  |   2 +
 generic/tclIORTrans.c |  39 ++++++++++++-----
 generic/tclStubInit.c |   1 +
 8 files changed, 151 insertions(+), 87 deletions(-)

diff --git a/generic/tcl.decls b/generic/tcl.decls
index c9488bc..8a88a04 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -1431,7 +1431,7 @@ declare 404 {
     Tcl_DriverOutputProc *Tcl_ChannelOutputProc(
 	    const Tcl_ChannelType *chanTypePtr)
 }
-declare 405 {
+declare 405 {deprecated {Use Tcl_ChannelWideSeekProc}} {
     Tcl_DriverSeekProc *Tcl_ChannelSeekProc(
 	    const Tcl_ChannelType *chanTypePtr)
 }
diff --git a/generic/tcl.h b/generic/tcl.h
index 85e52f4..2639d84 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -1400,10 +1400,12 @@ typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData);
  * Channel version tag. This was introduced in 8.3.2/8.4.
  */
 
+#ifndef TCL_NO_DEPRECATED
 #define TCL_CHANNEL_VERSION_1	((Tcl_ChannelTypeVersion) 0x1)
 #define TCL_CHANNEL_VERSION_2	((Tcl_ChannelTypeVersion) 0x2)
 #define TCL_CHANNEL_VERSION_3	((Tcl_ChannelTypeVersion) 0x3)
 #define TCL_CHANNEL_VERSION_4	((Tcl_ChannelTypeVersion) 0x4)
+#endif
 #define TCL_CHANNEL_VERSION_5	((Tcl_ChannelTypeVersion) 0x5)
 
 /*
@@ -1426,8 +1428,12 @@ typedef int	(Tcl_DriverInputProc) (ClientData instanceData, char *buf,
 			int toRead, int *errorCodePtr);
 typedef int	(Tcl_DriverOutputProc) (ClientData instanceData,
 			const char *buf, int toWrite, int *errorCodePtr);
+#ifndef TCL_NO_DEPRECATED
 typedef int	(Tcl_DriverSeekProc) (ClientData instanceData, long offset,
 			int mode, int *errorCodePtr);
+#else
+#define Tcl_DriverSeekProc Tcl_DriverWideSeekProc
+#endif
 typedef int	(Tcl_DriverSetOptionProc) (ClientData instanceData,
 			Tcl_Interp *interp, const char *optionName,
 			const char *value);
@@ -1478,9 +1484,13 @@ typedef struct Tcl_ChannelType {
 				/* Function to call for input on channel. */
     Tcl_DriverOutputProc *outputProc;
 				/* Function to call for output on channel. */
+#ifdef TCL_NO_DEPRECATED
+    void *notUsed;
+#else
     Tcl_DriverSeekProc *seekProc;
 				/* Function to call to seek on the channel.
 				 * May be NULL. */
+#endif
     Tcl_DriverSetOptionProc *setOptionProc;
 				/* Set an option on a channel. */
     Tcl_DriverGetOptionProc *getOptionProc;
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index c487521..f832f78 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1218,7 +1218,8 @@ EXTERN Tcl_DriverInputProc * Tcl_ChannelInputProc(
 EXTERN Tcl_DriverOutputProc * Tcl_ChannelOutputProc(
 				const Tcl_ChannelType *chanTypePtr);
 /* 405 */
-EXTERN Tcl_DriverSeekProc * Tcl_ChannelSeekProc(
+TCL_DEPRECATED("Use Tcl_ChannelWideSeekProc")
+Tcl_DriverSeekProc *	Tcl_ChannelSeekProc(
 				const Tcl_ChannelType *chanTypePtr);
 /* 406 */
 EXTERN Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc(
@@ -2359,7 +2360,7 @@ typedef struct TclStubs {
     Tcl_DriverClose2Proc * (*tcl_ChannelClose2Proc) (const Tcl_ChannelType *chanTypePtr); /* 402 */
     Tcl_DriverInputProc * (*tcl_ChannelInputProc) (const Tcl_ChannelType *chanTypePtr); /* 403 */
     Tcl_DriverOutputProc * (*tcl_ChannelOutputProc) (const Tcl_ChannelType *chanTypePtr); /* 404 */
-    Tcl_DriverSeekProc * (*tcl_ChannelSeekProc) (const Tcl_ChannelType *chanTypePtr); /* 405 */
+    TCL_DEPRECATED_API("Use Tcl_ChannelWideSeekProc") Tcl_DriverSeekProc * (*tcl_ChannelSeekProc) (const Tcl_ChannelType *chanTypePtr); /* 405 */
     Tcl_DriverSetOptionProc * (*tcl_ChannelSetOptionProc) (const Tcl_ChannelType *chanTypePtr); /* 406 */
     Tcl_DriverGetOptionProc * (*tcl_ChannelGetOptionProc) (const Tcl_ChannelType *chanTypePtr); /* 407 */
     Tcl_DriverWatchProc * (*tcl_ChannelWatchProc) (const Tcl_ChannelType *chanTypePtr); /* 408 */
@@ -4171,4 +4172,9 @@ extern const TclStubs *tclStubsPtr;
 #define Tcl_GlobalEvalObj(interp, objPtr) \
     Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)
 
+#ifdef TCL_NO_DEPRECATED
+#undef Tcl_ChannelSeekProc
+#define Tcl_ChannelSeekProc Tcl_ChannelWideSeekProc
+#endif
+
 #endif /* _TCLDECLS */
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 643b8f1..ad78287 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -492,18 +492,19 @@ ChanSeek(
      * type and non-NULL.
      */
 
-    if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
-	    chanPtr->typePtr->wideSeekProc != NULL) {
-	return chanPtr->typePtr->wideSeekProc(chanPtr->instanceData,
+#ifndef TCL_NO_DEPRECATED
+    if (!HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) ||
+	    chanPtr->typePtr->wideSeekProc == NULL) {
+	if (offset<LONG_MIN || offset>LONG_MAX) {
+	    *errnoPtr = EOVERFLOW;
+	    return -1;
+	}
+	return chanPtr->typePtr->seekProc(chanPtr->instanceData,
 		offset, mode, errnoPtr);
     }
+#endif
 
-    if (offset<LONG_MIN || offset>LONG_MAX) {
-	*errnoPtr = EOVERFLOW;
-	return -1;
-    }
-
-    return chanPtr->typePtr->seekProc(chanPtr->instanceData,
+    return chanPtr->typePtr->wideSeekProc(chanPtr->instanceData,
 	    offset, mode, errnoPtr);
 }
 
@@ -1640,9 +1641,6 @@ Tcl_CreateChannel(
     if (NULL == typePtr->watchProc) {
 	Tcl_Panic("channel type %s must define watchProc", typePtr->typeName);
     }
-    if ((NULL!=typePtr->wideSeekProc) && (NULL == typePtr->seekProc)) {
-	Tcl_Panic("channel type %s must define seekProc if defining wideSeekProc", typePtr->typeName);
-    }
 
     /*
      * JH: We could subsequently memset these to 0 to avoid the numerous
@@ -4215,12 +4213,15 @@ WillWrite(
 {
     int inputBuffered;
 
-    if ((chanPtr->typePtr->seekProc != NULL) &&
-            ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){
-        int ignore;
+    if (((chanPtr->typePtr->wideSeekProc != NULL)
+#ifndef TCL_NO_DEPRECATED
+	    || (chanPtr->typePtr->seekProc != NULL)
+#endif
+	    ) && ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){
+	int ignore;
 
-        DiscardInputQueued(chanPtr->state, 0);
-        ChanSeek(chanPtr, -inputBuffered, SEEK_CUR, &ignore);
+	DiscardInputQueued(chanPtr->state, 0);
+	ChanSeek(chanPtr, -inputBuffered, SEEK_CUR, &ignore);
     }
 }
 
@@ -4237,8 +4238,11 @@ WillRead(
 	Tcl_SetErrno(EINVAL);
 	return -1;
     }
-    if ((chanPtr->typePtr->seekProc != NULL)
-            && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
+    if (((chanPtr->typePtr->wideSeekProc != NULL)
+#ifndef TCL_NO_DEPRECATED
+	    || (chanPtr->typePtr->seekProc != NULL)
+#endif
+	    ) && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
 	/*
 	 * CAVEAT - The assumption here is that FlushChannel() will push out
 	 * the bytes of any writes that are in progress.  Since this is a
@@ -6997,7 +7001,11 @@ Tcl_Seek(
      * defined. This means that the channel does not support seeking.
      */
 
-    if (chanPtr->typePtr->seekProc == NULL) {
+    if ((chanPtr->typePtr->wideSeekProc == NULL)
+#ifndef TCL_NO_DEPRECATED
+	    && (chanPtr->typePtr->seekProc == NULL)
+#endif
+    ) {
 	Tcl_SetErrno(EINVAL);
 	return -1;
     }
@@ -7161,7 +7169,11 @@ Tcl_Tell(
      * defined. This means that the channel does not support seeking.
      */
 
-    if (chanPtr->typePtr->seekProc == NULL) {
+    if ((chanPtr->typePtr->wideSeekProc == NULL)
+#ifndef TCL_NO_DEPRECATED
+	    && (chanPtr->typePtr->seekProc == NULL)
+#endif
+	) {
 	Tcl_SetErrno(EINVAL);
 	return -1;
     }
@@ -10499,22 +10511,17 @@ 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 {
+#ifndef TCL_NO_DEPRECATED
+    if ((chanTypePtr->version > (Tcl_ChannelTypeVersion) 0x7)
+	    || (chanTypePtr->version < (Tcl_ChannelTypeVersion) 0x1)) {
 	/*
 	 * In <v2 channel versions, the version field is occupied by the
 	 * Tcl_DriverBlockModeProc
 	 */
-
 	return TCL_CHANNEL_VERSION_1;
     }
+#endif
+    return chanTypePtr->version;
 }
 
 /*
@@ -10564,15 +10571,15 @@ Tcl_ChannelBlockModeProc(
     const Tcl_ChannelType *chanTypePtr)
 				/* Pointer to channel type. */
 {
-    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
-	return chanTypePtr->blockModeProc;
+#ifndef TCL_NO_DEPRECATED
+    if (!HaveVersion(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;
+#endif
+    return chanTypePtr->blockModeProc;
 }
 
 /*
@@ -10671,6 +10678,7 @@ Tcl_ChannelOutputProc(
     return chanTypePtr->outputProc;
 }
 
+#ifndef TCL_NO_DEPRECATED
 /*
  *----------------------------------------------------------------------
  *
@@ -10694,6 +10702,7 @@ Tcl_ChannelSeekProc(
 {
     return chanTypePtr->seekProc;
 }
+#endif
 
 /*
  *----------------------------------------------------------------------
@@ -10812,10 +10821,12 @@ Tcl_ChannelFlushProc(
     const Tcl_ChannelType *chanTypePtr)
 				/* Pointer to channel type. */
 {
-    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
-	return chanTypePtr->flushProc;
+#ifndef TCL_NO_DEPRECATED
+    if (!HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
+	return NULL;
     }
-    return NULL;
+#endif
+    return chanTypePtr->flushProc;
 }
 
 /*
@@ -10839,10 +10850,12 @@ Tcl_ChannelHandlerProc(
     const Tcl_ChannelType *chanTypePtr)
 				/* Pointer to channel type. */
 {
-    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
-	return chanTypePtr->handlerProc;
+#ifndef TCL_NO_DEPRECATED
+    if (!HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
+	return NULL;
     }
-    return NULL;
+#endif
+    return chanTypePtr->handlerProc;
 }
 
 /*
@@ -10866,10 +10879,12 @@ Tcl_ChannelWideSeekProc(
     const Tcl_ChannelType *chanTypePtr)
 				/* Pointer to channel type. */
 {
-    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) {
-	return chanTypePtr->wideSeekProc;
+#ifndef TCL_NO_DEPRECATED
+    if (!HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) {
+	return NULL;
     }
-    return NULL;
+#endif
+    return chanTypePtr->wideSeekProc;
 }
 
 /*
@@ -10894,10 +10909,12 @@ Tcl_ChannelThreadActionProc(
     const Tcl_ChannelType *chanTypePtr)
 				/* Pointer to channel type. */
 {
-    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) {
-	return chanTypePtr->threadActionProc;
+#ifndef TCL_NO_DEPRECATED
+    if (!HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) {
+	return NULL;
     }
-    return NULL;
+#endif
+    return chanTypePtr->threadActionProc;
 }
 
 /*
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index 9949a0e..ee180fa 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -27,8 +27,10 @@ static int		TransformInputProc(ClientData instanceData, char *buf,
 			    int toRead, int *errorCodePtr);
 static int		TransformOutputProc(ClientData instanceData,
 			    const char *buf, int toWrite, int *errorCodePtr);
+#ifndef TCL_NO_DEPRECATED
 static int		TransformSeekProc(ClientData instanceData, long offset,
 			    int mode, int *errorCodePtr);
+#endif
 static int		TransformSetOptionProc(ClientData instanceData,
 			    Tcl_Interp *interp, const char *optionName,
 			    const char *value);
@@ -122,7 +124,11 @@ static const Tcl_ChannelType transformChannelType = {
     TransformCloseProc,		/* Close proc. */
     TransformInputProc,		/* Input proc. */
     TransformOutputProc,	/* Output proc. */
+#ifndef TCL_NO_DEPRECATED
     TransformSeekProc,		/* Seek proc. */
+#else
+    NULL,
+#endif
     TransformSetOptionProc,	/* Set option proc. */
     TransformGetOptionProc,	/* Get option proc. */
     TransformWatchProc,		/* Initialize notifier. */
@@ -808,6 +814,7 @@ TransformOutputProc(
     return toWrite;
 }
 
+#ifndef TCL_NO_DEPRECATED
 /*
  *----------------------------------------------------------------------
  *
@@ -838,7 +845,7 @@ TransformSeekProc(
     TransformChannelData *dataPtr = instanceData;
     Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
     const Tcl_ChannelType *parentType = Tcl_GetChannelType(parent);
-    Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);
+    Tcl_DriverSeekProc *parentSeekProc = parentType->seekProc;
 
     if ((offset == 0) && (mode == SEEK_CUR)) {
 	/*
@@ -874,6 +881,7 @@ TransformSeekProc(
     return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode,
 	    errorCodePtr);
 }
+#endif
 
 /*
  *----------------------------------------------------------------------
@@ -905,7 +913,9 @@ TransformWideSeekProc(
     TransformChannelData *dataPtr = instanceData;
     Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
     const Tcl_ChannelType *parentType	= Tcl_GetChannelType(parent);
-    Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);
+#ifndef TCL_NO_DEPRECATED
+    Tcl_DriverSeekProc *parentSeekProc = parentType->seekProc;
+#endif
     Tcl_DriverWideSeekProc *parentWideSeekProc =
 	    Tcl_ChannelWideSeekProc(parentType);
     ClientData parentData = Tcl_GetChannelInstanceData(parent);
@@ -916,11 +926,13 @@ TransformWideSeekProc(
 	 * location. Simply pass the request down.
 	 */
 
-	if (parentWideSeekProc != NULL) {
-	    return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
+#ifndef TCL_NO_DEPRECATED
+	if (parentWideSeekProc == NULL) {
+	    return parentSeekProc(parentData, 0, mode, errorCodePtr);
 	}
+#endif
 
-	return parentSeekProc(parentData, 0, mode, errorCodePtr);
+	return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
     }
 
     /*
@@ -948,25 +960,26 @@ TransformWideSeekProc(
      * If we have a wide seek capability, we should stick with that.
      */
 
-    if (parentWideSeekProc != NULL) {
-	return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
-    }
+#ifndef TCL_NO_DEPRECATED
+    if (parentWideSeekProc == NULL) {
+	/*
+	 * We're transferring to narrow seeks at this point; this is a bit complex
+	 * because we have to check whether the seek is possible first (i.e.
+	 * whether we are losing information in truncating the bits of the
+	 * offset). Luckily, there's a defined error for what happens when trying
+	 * to go out of the representable range.
+	 */
 
-    /*
-     * We're transferring to narrow seeks at this point; this is a bit complex
-     * because we have to check whether the seek is possible first (i.e.
-     * whether we are losing information in truncating the bits of the
-     * offset). Luckily, there's a defined error for what happens when trying
-     * to go out of the representable range.
-     */
+	if (offset<LONG_MIN || offset>LONG_MAX) {
+	    *errorCodePtr = EOVERFLOW;
+	    return -1;
+	}
 
-    if (offset<LONG_MIN || offset>LONG_MAX) {
-	*errorCodePtr = EOVERFLOW;
-	return -1;
+	return parentSeekProc(parentData, offset,
+		mode, errorCodePtr);
     }
-
-    return parentSeekProc(parentData, offset,
-	    mode, errorCodePtr);
+#endif
+    return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
 }
 
 /*
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 1d90def..99dff63 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -696,7 +696,9 @@ TclChanCreateObjCmd(
 	    clonePtr->blockModeProc = NULL;
 	}
 	if (!(methods & FLAG(METH_SEEK))) {
+#ifndef TCL_NO_DEPRECATED
 	    clonePtr->seekProc = NULL;
+#endif
 	    clonePtr->wideSeekProc = NULL;
 	}
 
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index 8385d88..8f6b079 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -28,8 +28,10 @@
 #endif
 
 /* DUPLICATE of HaveVersion() in tclIO.c // TODO - MODULE_SCOPE */
+#ifndef TCL_NO_DEPRECATED
 static int		HaveVersion(const Tcl_ChannelType *typePtr,
 			    Tcl_ChannelTypeVersion minimumVersion);
+#endif
 
 /*
  * Signatures of all functions used in the C layer of the reflection.
@@ -1331,14 +1333,18 @@ ReflectSeekWide(
     Channel *parent = (Channel *) rtPtr->parent;
     Tcl_WideInt curPos;		/* Position on the device. */
 
-    Tcl_DriverSeekProc *seekProc =
-	    Tcl_ChannelSeekProc(Tcl_GetChannelType(rtPtr->parent));
+    const Tcl_ChannelType *channelType =
+	    Tcl_GetChannelType(rtPtr->parent);
 
     /*
      * Fail if the parent channel is not seekable.
      */
 
-    if (seekProc == NULL) {
+    if ((channelType->wideSeekProc == NULL)
+#ifndef TCL_NO_DEPRECATED
+	    && (channelType->seekProc == NULL)
+#endif
+    ) {
 	Tcl_SetErrno(EINVAL);
 	return -1;
     }
@@ -1386,18 +1392,25 @@ ReflectSeekWide(
      * non-NULL...
      */
 
-    if (HaveVersion(parent->typePtr, TCL_CHANNEL_VERSION_3) &&
-	parent->typePtr->wideSeekProc != NULL) {
+#ifndef TCL_NO_DEPRECATED
+    if (!HaveVersion(parent->typePtr, TCL_CHANNEL_VERSION_3) ||
+	parent->typePtr->wideSeekProc == NULL) {
+	if (offset < LONG_MIN || offset > LONG_MAX) {
+	    *errorCodePtr = EOVERFLOW;
+	    curPos = -1;
+	} else {
+	    curPos = parent->typePtr->seekProc(
+		    parent->instanceData, offset, seekMode,
+	    errorCodePtr);
+	}
+    } else {
 	curPos = parent->typePtr->wideSeekProc(parent->instanceData, offset,
 		seekMode, errorCodePtr);
-    } else if (offset < LONG_MIN || offset > LONG_MAX) {
-	*errorCodePtr = EOVERFLOW;
-	curPos = -1;
-    } else {
-	curPos = parent->typePtr->seekProc(
-		parent->instanceData, offset, seekMode,
-		errorCodePtr);
     }
+#else
+    curPos = parent->typePtr->wideSeekProc(parent->instanceData, offset,
+	    seekMode, errorCodePtr);
+#endif
     if (curPos == -1) {
 	Tcl_SetErrno(*errorCodePtr);
     }
@@ -3407,6 +3420,7 @@ TransformLimit(
  *----------------------------------------------------------------------
  */
 
+#ifndef TCL_NO_DEPRECATED
 static int
 HaveVersion(
     const Tcl_ChannelType *chanTypePtr,
@@ -3416,6 +3430,7 @@ HaveVersion(
 
     return PTR2INT(actualVersion) >= PTR2INT(minimumVersion);
 }
+#endif
 
 /*
  * Local Variables:
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 6a588a5..927f1d0 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -256,6 +256,7 @@ mp_err	TclBN_mp_mul_d(const mp_int *a, unsigned int b, mp_int *c) {
 #   define Tcl_DbNewLongObj 0
 #   define Tcl_BackgroundError 0
 #   define Tcl_FreeResult 0
+#   define Tcl_ChannelSeekProc 0
 #else
 
 mp_err TclBN_mp_div_3(const mp_int *a, mp_int *c, unsigned int *d) {
-- 
cgit v0.12


From bfad7e731e065f729b1b29430eadc5599fed2221 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 31 Jan 2020 14:58:07 +0000
Subject: Make Tcl_ChannelCloseProc() deprecated too. Implement close2Proc and
 wideSeekProc for all internal channel types.

---
 generic/tcl.decls     |  2 +-
 generic/tcl.h         | 10 +-------
 generic/tclDecls.h    |  5 ++--
 generic/tclIO.c       | 68 ++++++++++++++++++++++++++++++---------------------
 generic/tclIOGT.c     | 13 +++++++---
 generic/tclIORChan.c  | 13 +++++++---
 generic/tclIORTrans.c | 13 +++++++---
 generic/tclStubInit.c |  1 +
 generic/tclZipfs.c    | 13 +++++++---
 generic/tclZlib.c     | 13 +++++++---
 unix/tclUnixChan.c    | 27 +++++++++++++-------
 unix/tclUnixSock.c    |  4 +++
 win/tclWinChan.c      | 14 ++++++++---
 win/tclWinConsole.c   | 14 ++++++++---
 win/tclWinSerial.c    | 16 +++++++-----
 win/tclWinSock.c      |  4 +++
 16 files changed, 147 insertions(+), 83 deletions(-)

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 8a88a04..1e124a4 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -1415,7 +1415,7 @@ declare 400 {
     Tcl_DriverBlockModeProc *Tcl_ChannelBlockModeProc(
 	    const Tcl_ChannelType *chanTypePtr)
 }
-declare 401 {
+declare 401 {deprecated {Use Tcl_ChannelClose2Proc}} {
     Tcl_DriverCloseProc *Tcl_ChannelCloseProc(
 	    const Tcl_ChannelType *chanTypePtr)
 }
diff --git a/generic/tcl.h b/generic/tcl.h
index d8a28a5..18a56dc 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -1428,12 +1428,8 @@ typedef int	(Tcl_DriverInputProc) (ClientData instanceData, char *buf,
 			int toRead, int *errorCodePtr);
 typedef int	(Tcl_DriverOutputProc) (ClientData instanceData,
 			const char *buf, int toWrite, int *errorCodePtr);
-#ifndef TCL_NO_DEPRECATED
 typedef int	(Tcl_DriverSeekProc) (ClientData instanceData, long offset,
 			int mode, int *errorCodePtr);
-#else
-#define Tcl_DriverSeekProc Tcl_DriverWideSeekProc
-#endif
 typedef int	(Tcl_DriverSetOptionProc) (ClientData instanceData,
 			Tcl_Interp *interp, const char *optionName,
 			const char *value);
@@ -1478,19 +1474,15 @@ typedef struct Tcl_ChannelType {
 				/* Version of the channel type. */
     Tcl_DriverCloseProc *closeProc;
 				/* Function to call to close the channel, or
-				 * TCL_CLOSE2PROC if the close2Proc should be
+				 * NULL or TCL_CLOSE2PROC if the close2Proc should be
 				 * used instead. */
     Tcl_DriverInputProc *inputProc;
 				/* Function to call for input on channel. */
     Tcl_DriverOutputProc *outputProc;
 				/* Function to call for output on channel. */
-#ifdef TCL_NO_DEPRECATED
-    struct something_undefined *notUsed;
-#else
     Tcl_DriverSeekProc *seekProc;
 				/* Function to call to seek on the channel.
 				 * May be NULL. */
-#endif
     Tcl_DriverSetOptionProc *setOptionProc;
 				/* Set an option on a channel. */
     Tcl_DriverGetOptionProc *getOptionProc;
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 6e9b391..6cb7547 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1206,7 +1206,8 @@ EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion(
 EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc(
 				const Tcl_ChannelType *chanTypePtr);
 /* 401 */
-EXTERN Tcl_DriverCloseProc * Tcl_ChannelCloseProc(
+TCL_DEPRECATED("Use Tcl_ChannelClose2Proc")
+Tcl_DriverCloseProc *	Tcl_ChannelCloseProc(
 				const Tcl_ChannelType *chanTypePtr);
 /* 402 */
 EXTERN Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc(
@@ -2356,7 +2357,7 @@ typedef struct TclStubs {
     const char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */
     Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */
     Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */
-    Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (const Tcl_ChannelType *chanTypePtr); /* 401 */
+    TCL_DEPRECATED_API("Use Tcl_ChannelClose2Proc") Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (const Tcl_ChannelType *chanTypePtr); /* 401 */
     Tcl_DriverClose2Proc * (*tcl_ChannelClose2Proc) (const Tcl_ChannelType *chanTypePtr); /* 402 */
     Tcl_DriverInputProc * (*tcl_ChannelInputProc) (const Tcl_ChannelType *chanTypePtr); /* 403 */
     Tcl_DriverOutputProc * (*tcl_ChannelOutputProc) (const Tcl_ChannelType *chanTypePtr); /* 404 */
diff --git a/generic/tclIO.c b/generic/tclIO.c
index fccc989..370508d 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -374,11 +374,12 @@ ChanClose(
     Channel *chanPtr,
     Tcl_Interp *interp)
 {
-    if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
+#ifndef TCL_NO_DEPRECATED
+    if ((chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) && (chanPtr->typePtr->closeProc != NULL)) {
 	return chanPtr->typePtr->closeProc(chanPtr->instanceData, interp);
-    } else {
-	return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, 0);
     }
+#endif
+    return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, 0);
 }
 
 static inline int
@@ -1630,9 +1631,18 @@ Tcl_CreateChannel(
 
     assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc *));
     assert(typePtr->typeName != NULL);
-    if (NULL == typePtr->closeProc) {
-	Tcl_Panic("channel type %s must define closeProc", typePtr->typeName);
+#ifndef TCL_NO_DEPRECATED
+    if (((NULL == typePtr->closeProc) || (TCL_CLOSE2PROC == typePtr->closeProc)) && (typePtr->close2Proc == NULL)) {
+	Tcl_Panic("channel type %s must define closeProc or close2Proc", typePtr->typeName);
+    }
+#else
+    if (Tcl_ChannelVersion(typePtr) < TCL_CHANNEL_VERSION_5) {
+	Tcl_Panic("channel type %s must be version TCL_CHANNEL_VERSION_5", typePtr->typeName);
+    }
+    if (typePtr->close2Proc == NULL) {
+	Tcl_Panic("channel type %s must define close2Proc", typePtr->typeName);
     }
+#endif
     if ((TCL_READABLE & mask) && (NULL == typePtr->inputProc)) {
 	Tcl_Panic("channel type %s must define inputProc when used for reader channel", typePtr->typeName);
     }
@@ -1643,17 +1653,9 @@ Tcl_CreateChannel(
 	Tcl_Panic("channel type %s must define watchProc", typePtr->typeName);
     }
 #ifndef TCL_NO_DEPRECATED
-    if ((NULL!=typePtr->wideSeekProc) && (NULL == typePtr->seekProc)) {
+    if ((NULL != typePtr->wideSeekProc) && (NULL == typePtr->seekProc)) {
 	Tcl_Panic("channel type %s must define seekProc if defining wideSeekProc", typePtr->typeName);
     }
-#elif 1 /* TODO: Too strict for backwards compatibility, just make sure for the Tcl core for now. */
-    if (NULL != typePtr->notUsed) {
-	Tcl_Panic("channel type %s cannot have seekProc", typePtr->typeName);
-    }
-#else
-    if ((NULL!=typePtr->notUsed) && (NULL == typePtr->wideSeekProc)) {
-	Tcl_Panic("channel type %s must define wideSeekProc if defining seekProc", typePtr->typeName);
-    }
 #endif
 
     /*
@@ -3396,7 +3398,7 @@ Tcl_Close(
 				 * channel. */
     Channel *chanPtr;		/* The real IO channel. */
     ChannelState *statePtr;	/* State of real IO channel. */
-    int result;			/* Of calling FlushChannel. */
+    int result = 0;			/* Of calling FlushChannel. */
     int flushcode;
     int stickyError;
 
@@ -3497,12 +3499,14 @@ Tcl_Close(
      * it anymore and this will help avoid deadlocks on some channel types.
      */
 
-    if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {
-	result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp,
-		TCL_CLOSE_READ);
-    } else {
-	result = 0;
+#ifndef TCL_NO_DEPRECATED
+    if ((chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) || (chanPtr->typePtr->closeProc == NULL)) {
+	/* If this half-close fails, just continue the full close */
+	(void)chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, TCL_CLOSE_READ);
     }
+#else
+    (void)chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, TCL_CLOSE_READ);
+#endif
 
     /*
      * The call to FlushChannel will flush any queued output and invoke the
@@ -3562,19 +3566,17 @@ Tcl_Close(
  *
  * Tcl_CloseEx --
  *
- *	Closes one side of a channel, read or write.
+ *	Closes one side of a channel, read or write, close all.
  *
  * Results:
  *	A standard Tcl result.
  *
  * Side effects:
- *	Closes one direction of the channel.
+ *	Closes one direction of the channel, or do a full close.
  *
  * NOTE:
  *	Tcl_CloseEx closes the specified direction of the channel as far as
- *	the user is concerned. The channel keeps existing however. You cannot
- *	calls this function to close the last possible direction of the
- *	channel. Use Tcl_Close for that.
+ *	the user is concerned. If flags = 0, this is equivalent to Tcl_Close.
  *
  *----------------------------------------------------------------------
  */
@@ -3594,18 +3596,26 @@ Tcl_CloseEx(
 	return TCL_OK;
     }
 
-    /* TODO: assert flags validity ? */
-
     chanPtr = (Channel *) chan;
     statePtr = chanPtr->state;
 
+    if ((flags & (TCL_READABLE | TCL_WRITABLE)) == 0) {
+	return Tcl_Close(interp, chan);
+    }
+    if ((flags & (TCL_READABLE | TCL_WRITABLE)) == (TCL_READABLE | TCL_WRITABLE)) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"double-close of channels not supported by %ss",
+		chanPtr->typePtr->typeName));
+	return TCL_ERROR;
+    }
+
     /*
      * Does the channel support half-close anyway? Error if not.
      */
 
     if (!chanPtr->typePtr->close2Proc) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                "half-close of channels not supported by %ss",
+		"half-close of channels not supported by %ss",
 		chanPtr->typePtr->typeName));
 	return TCL_ERROR;
     }
@@ -10585,6 +10595,7 @@ Tcl_ChannelBlockModeProc(
  *----------------------------------------------------------------------
  */
 
+#ifndef TCL_NO_DEPRECATED
 Tcl_DriverCloseProc *
 Tcl_ChannelCloseProc(
     const Tcl_ChannelType *chanTypePtr)
@@ -10592,6 +10603,7 @@ Tcl_ChannelCloseProc(
 {
     return chanTypePtr->closeProc;
 }
+#endif
 
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index 4195256..c983434 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -22,7 +22,7 @@
 static int		TransformBlockModeProc(ClientData instanceData,
 			    int mode);
 static int		TransformCloseProc(ClientData instanceData,
-			    Tcl_Interp *interp);
+			    Tcl_Interp *interp, int flags);
 static int		TransformInputProc(ClientData instanceData, char *buf,
 			    int toRead, int *errorCodePtr);
 static int		TransformOutputProc(ClientData instanceData,
@@ -121,7 +121,7 @@ static inline void	ResultAdd(ResultBuffer *r, unsigned char *buf,
 static const Tcl_ChannelType transformChannelType = {
     "transform",		/* Type name. */
     TCL_CHANNEL_VERSION_5,	/* v5 channel */
-    TransformCloseProc,		/* Close proc. */
+    TCL_CLOSE2PROC,		/* Close proc. */
     TransformInputProc,		/* Input proc. */
     TransformOutputProc,	/* Output proc. */
 #ifndef TCL_NO_DEPRECATED
@@ -133,7 +133,7 @@ static const Tcl_ChannelType transformChannelType = {
     TransformGetOptionProc,	/* Get option proc. */
     TransformWatchProc,		/* Initialize notifier. */
     TransformGetFileHandleProc,	/* Get OS handles out of channel. */
-    NULL,			/* close2proc */
+    TransformCloseProc,		/* close2proc */
     TransformBlockModeProc,	/* Set blocking/nonblocking mode.*/
     NULL,			/* Flush proc. */
     TransformNotifyProc,	/* Handling of events bubbling up. */
@@ -539,10 +539,15 @@ TransformBlockModeProc(
 static int
 TransformCloseProc(
     ClientData instanceData,
-    Tcl_Interp *interp)
+    Tcl_Interp *interp,
+	int flags)
 {
     TransformChannelData *dataPtr = instanceData;
 
+    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
+	return EINVAL;
+    }
+
     /*
      * Important: In this procedure 'dataPtr->self' already points to the
      * underlying channel.
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 3baf8f3..ebe2f7e 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -32,7 +32,7 @@
  */
 
 static int		ReflectClose(ClientData clientData,
-			    Tcl_Interp *interp);
+			    Tcl_Interp *interp, int flags);
 static int		ReflectInput(ClientData clientData, char *buf,
 			    int toRead, int *errorCodePtr);
 static int		ReflectOutput(ClientData clientData, const char *buf,
@@ -67,7 +67,7 @@ static void     TimerRunWrite(ClientData clientData);
 static const Tcl_ChannelType tclRChannelType = {
     "tclrchannel",	   /* Type name.				  */
     TCL_CHANNEL_VERSION_5, /* v5 channel */
-    ReflectClose,	   /* Close channel, clean instance data	  */
+    TCL_CLOSE2PROC,	   /* Close channel, clean instance data	  */
     ReflectInput,	   /* Handle read request			  */
     ReflectOutput,	   /* Handle write request			  */
 #ifndef TCL_NO_DEPRECATED
@@ -79,7 +79,7 @@ static const Tcl_ChannelType tclRChannelType = {
     ReflectGetOption,	   /* Get options.			NULL'able */
     ReflectWatch,	   /* Initialize notifier			  */
     NULL,		   /* Get OS handle from the channel.	NULL'able */
-    NULL,		   /* No close2 support.		NULL'able */
+	ReflectClose,	   /* No close2 support.		NULL'able */
     ReflectBlock,	   /* Set blocking/nonblocking.		NULL'able */
     NULL,		   /* Flush channel. Not used by core.	NULL'able */
     NULL,		   /* Handle events.			NULL'able */
@@ -1158,7 +1158,8 @@ TclChanCaughtErrorBypass(
 static int
 ReflectClose(
     ClientData clientData,
-    Tcl_Interp *interp)
+    Tcl_Interp *interp,
+	int flags)
 {
     ReflectedChannel *rcPtr = clientData;
     int result;			/* Result code for 'close' */
@@ -1168,6 +1169,10 @@ ReflectClose(
     Tcl_HashEntry *hPtr;	/* Entry in the above map */
     const Tcl_ChannelType *tctPtr;
 
+    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
+	return EINVAL;
+    }
+
     if (TclInThreadExit()) {
 	/*
 	 * This call comes from TclFinalizeIOSystem. There are no
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index 70dd640..316378f 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -32,7 +32,7 @@
  */
 
 static int		ReflectClose(ClientData clientData,
-			    Tcl_Interp *interp);
+			    Tcl_Interp *interp, int flags);
 static int		ReflectInput(ClientData clientData, char *buf,
 			    int toRead, int *errorCodePtr);
 static int		ReflectOutput(ClientData clientData, const char *buf,
@@ -62,7 +62,7 @@ static int		ReflectNotify(ClientData clientData, int mask);
 static const Tcl_ChannelType tclRTransformType = {
     "tclrtransform",		/* Type name. */
     TCL_CHANNEL_VERSION_5,	/* v5 channel. */
-    ReflectClose,		/* Close channel, clean instance data. */
+    TCL_CLOSE2PROC,		/* Close channel, clean instance data. */
     ReflectInput,		/* Handle read request. */
     ReflectOutput,		/* Handle write request. */
 #ifndef TCL_NO_DEPRECATED
@@ -74,7 +74,7 @@ static const Tcl_ChannelType tclRTransformType = {
     ReflectGetOption,		/* Get options. */
     ReflectWatch,		/* Initialize notifier. */
     ReflectHandle,		/* Get OS handle from the channel. */
-    NULL,			/* No close2 support. NULL'able. */
+	ReflectClose,		/* No close2 support. NULL'able. */
     ReflectBlock,		/* Set blocking/nonblocking. */
     NULL,			/* Flush channel. Not used by core.
 				 * NULL'able. */
@@ -885,7 +885,8 @@ UnmarshallErrorResult(
 static int
 ReflectClose(
     ClientData clientData,
-    Tcl_Interp *interp)
+    Tcl_Interp *interp,
+    int flags)
 {
     ReflectedTransform *rtPtr = clientData;
     int errorCode, errorCodeSet = 0;
@@ -896,6 +897,10 @@ ReflectClose(
 				 * in this interp. */
     Tcl_HashEntry *hPtr;	/* Entry in the above map */
 
+    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
+	return EINVAL;
+    }
+
     if (TclInThreadExit()) {
 	/*
 	 * This call comes from TclFinalizeIOSystem. There are no
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 927f1d0..971d42d 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -257,6 +257,7 @@ mp_err	TclBN_mp_mul_d(const mp_int *a, unsigned int b, mp_int *c) {
 #   define Tcl_BackgroundError 0
 #   define Tcl_FreeResult 0
 #   define Tcl_ChannelSeekProc 0
+#   define Tcl_ChannelCloseProc 0
 #else
 
 mp_err TclBN_mp_div_3(const mp_int *a, mp_int *c, unsigned int *d) {
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index b45d86e..ee87af0 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -385,7 +385,7 @@ static int		ZipFSLoadFile(Tcl_Interp *interp, Tcl_Obj *path,
 static void		ZipfsExitHandler(ClientData clientData);
 static void		ZipfsSetup(void);
 static int		ZipChannelClose(void *instanceData,
-			    Tcl_Interp *interp);
+			    Tcl_Interp *interp, int flags);
 static int		ZipChannelGetFile(void *instanceData,
 			    int direction, void **handlePtr);
 static int		ZipChannelRead(void *instanceData, char *buf,
@@ -446,7 +446,7 @@ static const Tcl_Filesystem zipfsFilesystem = {
 static Tcl_ChannelType ZipChannelType = {
     "zip",		    /* Type name. */
     TCL_CHANNEL_VERSION_5,
-    ZipChannelClose,	    /* Close channel, clean instance data */
+    TCL_CLOSE2PROC,	    /* Close channel, clean instance data */
     ZipChannelRead,	    /* Handle read request */
     ZipChannelWrite,	    /* Handle write request */
 #ifndef TCL_NO_DEPRECATED
@@ -458,7 +458,7 @@ static Tcl_ChannelType ZipChannelType = {
     NULL,		    /* Get options, NULL'able */
     ZipChannelWatchChannel, /* Initialize notifier */
     ZipChannelGetFile,	    /* Get OS handle from the channel */
-    NULL,		    /* 2nd version of close channel, NULL'able */
+	ZipChannelClose,	    /* 2nd version of close channel, NULL'able */
     NULL,		    /* Set blocking mode for raw channel, NULL'able */
     NULL,		    /* Function to flush channel, NULL'able */
     NULL,		    /* Function to handle event, NULL'able */
@@ -3318,10 +3318,15 @@ ZipFSTclLibraryObjCmd(
 static int
 ZipChannelClose(
     void *instanceData,
-    Tcl_Interp *dummy)		/* Current interpreter. */
+    Tcl_Interp *dummy,		/* Current interpreter. */
+    int flags)
 {
     ZipChannel *info = instanceData;
 
+    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
+	return EINVAL;
+    }
+
     if (info->iscompr && info->ubuf) {
 	ckfree(info->ubuf);
 	info->ubuf = NULL;
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 49f1c39..44451e2 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -160,7 +160,7 @@ typedef struct {
 
 static Tcl_CmdDeleteProc	ZlibStreamCmdDelete;
 static Tcl_DriverBlockModeProc	ZlibTransformBlockMode;
-static Tcl_DriverCloseProc	ZlibTransformClose;
+static Tcl_DriverClose2Proc	ZlibTransformClose;
 static Tcl_DriverGetHandleProc	ZlibTransformGetHandle;
 static Tcl_DriverGetOptionProc	ZlibTransformGetOption;
 static Tcl_DriverHandlerProc	ZlibTransformEventHandler;
@@ -205,7 +205,7 @@ static void		ZlibTransformTimerRun(void *clientData);
 static const Tcl_ChannelType zlibChannelType = {
     "zlib",
     TCL_CHANNEL_VERSION_5,
-    ZlibTransformClose,
+    TCL_CLOSE2PROC,
     ZlibTransformInput,
     ZlibTransformOutput,
     NULL,			/* seekProc */
@@ -213,7 +213,7 @@ static const Tcl_ChannelType zlibChannelType = {
     ZlibTransformGetOption,
     ZlibTransformWatch,
     ZlibTransformGetHandle,
-    NULL,			/* close2Proc */
+	ZlibTransformClose,			/* close2Proc */
     ZlibTransformBlockMode,
     NULL,			/* flushProc */
     ZlibTransformEventHandler,
@@ -2895,11 +2895,16 @@ ZlibStreamHeaderCmd(
 static int
 ZlibTransformClose(
     void *instanceData,
-    Tcl_Interp *interp)
+    Tcl_Interp *interp,
+	int flags)
 {
     ZlibChannelData *cd = instanceData;
     int e, written, result = TCL_OK;
 
+    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
+	return EINVAL;
+    }
+
     /*
      * Delete the support timer.
      */
diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c
index 56a0276..e1b7223 100644
--- a/unix/tclUnixChan.c
+++ b/unix/tclUnixChan.c
@@ -121,7 +121,7 @@ typedef struct {
 
 static int		FileBlockModeProc(ClientData instanceData, int mode);
 static int		FileCloseProc(ClientData instanceData,
-			    Tcl_Interp *interp);
+			    Tcl_Interp *interp, int flags);
 static int		FileGetHandleProc(ClientData instanceData,
 			    int direction, ClientData *handlePtr);
 static int		FileInputProc(ClientData instanceData, char *buf,
@@ -139,7 +139,7 @@ static Tcl_WideInt	FileWideSeekProc(ClientData instanceData,
 static void		FileWatchProc(ClientData instanceData, int mask);
 #ifdef SUPPORTS_TTY
 static int		TtyCloseProc(ClientData instanceData,
-			    Tcl_Interp *interp);
+			    Tcl_Interp *interp, int flags);
 static void		TtyGetAttributes(int fd, TtyAttrs *ttyPtr);
 static int		TtyGetOptionProc(ClientData instanceData,
 			    Tcl_Interp *interp, const char *optionName,
@@ -163,7 +163,7 @@ static int		TtySetOptionProc(ClientData instanceData,
 static const Tcl_ChannelType fileChannelType = {
     "file",			/* Type name. */
     TCL_CHANNEL_VERSION_5,	/* v5 channel */
-    FileCloseProc,		/* Close proc. */
+    TCL_CLOSE2PROC,		/* Close proc. */
     FileInputProc,		/* Input proc. */
     FileOutputProc,		/* Output proc. */
 #ifndef TCL_NO_DEPRECATED
@@ -175,7 +175,7 @@ static const Tcl_ChannelType fileChannelType = {
     NULL,			/* Get option proc. */
     FileWatchProc,		/* Initialize notifier. */
     FileGetHandleProc,		/* Get OS handles out of channel. */
-    NULL,			/* close2proc. */
+    FileCloseProc,		/* close2proc. */
     FileBlockModeProc,		/* Set blocking or non-blocking mode.*/
     NULL,			/* flush proc. */
     NULL,			/* handler proc. */
@@ -193,7 +193,7 @@ static const Tcl_ChannelType fileChannelType = {
 static const Tcl_ChannelType ttyChannelType = {
     "tty",			/* Type name. */
     TCL_CHANNEL_VERSION_5,	/* v5 channel */
-    TtyCloseProc,		/* Close proc. */
+    TCL_CLOSE2PROC,		/* Close proc. */
     FileInputProc,		/* Input proc. */
     FileOutputProc,		/* Output proc. */
     NULL,			/* Seek proc. */
@@ -201,7 +201,7 @@ static const Tcl_ChannelType ttyChannelType = {
     TtyGetOptionProc,		/* Get option proc. */
     FileWatchProc,		/* Initialize notifier. */
     FileGetHandleProc,		/* Get OS handles out of channel. */
-    NULL,			/* close2proc. */
+    TtyCloseProc,			/* close2proc. */
     FileBlockModeProc,		/* Set blocking or non-blocking mode.*/
     NULL,			/* flush proc. */
     NULL,			/* handler proc. */
@@ -359,11 +359,16 @@ FileOutputProc(
 static int
 FileCloseProc(
     ClientData instanceData,	/* File state. */
-    Tcl_Interp *interp)		/* For error reporting - unused. */
+    Tcl_Interp *dummy,		/* For error reporting - unused. */
+    int flags)
 {
     FileState *fsPtr = instanceData;
     int errorCode = 0;
 
+    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
+	return EINVAL;
+    }
+
     Tcl_DeleteFileHandler(fsPtr->fd);
 
     /*
@@ -384,10 +389,14 @@ FileCloseProc(
 static int
 TtyCloseProc(
     ClientData instanceData,
-    Tcl_Interp *interp)
+    Tcl_Interp *interp,
+	int flags)
 {
     TtyState *ttyPtr = instanceData;
 
+    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
+	return EINVAL;
+    }
     /*
      * If we've been asked by the user to drain or flush, do so now.
      */
@@ -416,7 +425,7 @@ TtyCloseProc(
      * Delegate to close for files.
      */
 
-    return FileCloseProc(instanceData, interp);
+    return FileCloseProc(instanceData, interp, flags);
 }
 #endif /* SUPPORTS_TTY */
 
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 57735da..e9c552e 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -157,7 +157,11 @@ static void		WrapNotify(ClientData clientData, int mask);
 static const Tcl_ChannelType tcpChannelType = {
     "tcp",			/* Type name. */
     TCL_CHANNEL_VERSION_5,	/* v5 channel */
+#ifndef TCL_NO_DEPRECATED
     TcpCloseProc,		/* Close proc. */
+#else
+    TCL_CLOSE2PROC,		/* Close proc. */
+#endif
     TcpInputProc,		/* Input proc. */
     TcpOutputProc,		/* Output proc. */
     NULL,			/* Seek proc. */
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index 829cc74..b7f5c04 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -76,7 +76,7 @@ static int		FileBlockProc(ClientData instanceData, int mode);
 static void		FileChannelExitHandler(ClientData clientData);
 static void		FileCheckProc(ClientData clientData, int flags);
 static int		FileCloseProc(ClientData instanceData,
-			    Tcl_Interp *interp);
+			    Tcl_Interp *interp, int flags);
 static int		FileEventProc(Tcl_Event *evPtr, int flags);
 static int		FileGetHandleProc(ClientData instanceData,
 			    int direction, ClientData *handlePtr);
@@ -107,7 +107,7 @@ static int		NativeIsComPort(const WCHAR *nativeName);
 static const Tcl_ChannelType fileChannelType = {
     "file",			/* Type name. */
     TCL_CHANNEL_VERSION_5,	/* v5 channel */
-    FileCloseProc,		/* Close proc. */
+    TCL_CLOSE2PROC,		/* Close proc. */
     FileInputProc,		/* Input proc. */
     FileOutputProc,		/* Output proc. */
 #ifndef TCL_NO_DEPRECATED
@@ -119,7 +119,7 @@ static const Tcl_ChannelType fileChannelType = {
     NULL,			/* Get option proc. */
     FileWatchProc,		/* Set up the notifier to watch the channel. */
     FileGetHandleProc,		/* Get an OS handle from channel. */
-    NULL,			/* close2proc. */
+    FileCloseProc,		/* close2proc. */
     FileBlockProc,		/* Set blocking or non-blocking mode.*/
     NULL,			/* flush proc. */
     NULL,			/* handler proc. */
@@ -392,12 +392,18 @@ FileBlockProc(
 static int
 FileCloseProc(
     ClientData instanceData,	/* Pointer to FileInfo structure. */
-    Tcl_Interp *interp)		/* Not used. */
+    Tcl_Interp *dummy,		/* Not used. */
+    int flags)
 {
     FileInfo *fileInfoPtr = instanceData;
     FileInfo *infoPtr;
     ThreadSpecificData *tsdPtr;
     int errorCode = 0;
+    (void)dummy;
+
+    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
+	return EINVAL;
+    }
 
     /*
      * Remove the file from the watch list.
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index 7de425b..632f0e7 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.c
@@ -142,7 +142,7 @@ static int		ConsoleBlockModeProc(ClientData instanceData,
 			    int mode);
 static void		ConsoleCheckProc(ClientData clientData, int flags);
 static int		ConsoleCloseProc(ClientData instanceData,
-			    Tcl_Interp *interp);
+			    Tcl_Interp *interp, int flags);
 static int		ConsoleEventProc(Tcl_Event *evPtr, int flags);
 static void		ConsoleExitHandler(ClientData clientData);
 static int		ConsoleGetHandleProc(ClientData instanceData,
@@ -180,7 +180,7 @@ static BOOL		WriteConsoleBytes(HANDLE hConsole,
 static const Tcl_ChannelType consoleChannelType = {
     "console",			/* Type name. */
     TCL_CHANNEL_VERSION_5,	/* v5 channel */
-    ConsoleCloseProc,		/* Close proc. */
+    TCL_CLOSE2PROC,		/* Close proc. */
     ConsoleInputProc,		/* Input proc. */
     ConsoleOutputProc,		/* Output proc. */
     NULL,			/* Seek proc. */
@@ -188,7 +188,7 @@ static const Tcl_ChannelType consoleChannelType = {
     ConsoleGetOptionProc,	/* Get option proc. */
     ConsoleWatchProc,		/* Set up notifier to watch the channel. */
     ConsoleGetHandleProc,	/* Get an OS handle from channel. */
-    NULL,			/* close2proc. */
+    ConsoleCloseProc,		/* close2proc. */
     ConsoleBlockModeProc,	/* Set blocking or non-blocking mode. */
     NULL,			/* Flush proc. */
     NULL,			/* Handler proc. */
@@ -531,12 +531,18 @@ ConsoleBlockModeProc(
 static int
 ConsoleCloseProc(
     ClientData instanceData,	/* Pointer to ConsoleInfo structure. */
-    Tcl_Interp *interp)		/* For error reporting. */
+    Tcl_Interp *dummy,		/* For error reporting. */
+    int flags)
 {
     ConsoleInfo *consolePtr = instanceData;
     int errorCode = 0;
     ConsoleInfo *infoPtr, **nextPtrPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    (void)dummy;
+
+    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
+	return EINVAL;
+    }
 
     /*
      * Clean up the background thread if necessary. Note that this must be
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index e945055..ec5d17b 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -168,7 +168,7 @@ static COMMTIMEOUTS no_timeout = {
 static int		SerialBlockProc(ClientData instanceData, int mode);
 static void		SerialCheckProc(ClientData clientData, int flags);
 static int		SerialCloseProc(ClientData instanceData,
-			    Tcl_Interp *interp);
+			    Tcl_Interp *interp, int flags);
 static int		SerialEventProc(Tcl_Event *evPtr, int flags);
 static void		SerialExitHandler(ClientData clientData);
 static int		SerialGetHandleProc(ClientData instanceData,
@@ -204,7 +204,7 @@ static int		SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf,
 static const Tcl_ChannelType serialChannelType = {
     "serial",			/* Type name. */
     TCL_CHANNEL_VERSION_5,	/* v5 channel */
-    SerialCloseProc,		/* Close proc. */
+    TCL_CLOSE2PROC,		/* Close proc. */
     SerialInputProc,		/* Input proc. */
     SerialOutputProc,		/* Output proc. */
     NULL,			/* Seek proc. */
@@ -212,7 +212,7 @@ static const Tcl_ChannelType serialChannelType = {
     SerialGetOptionProc,	/* Get option proc. */
     SerialWatchProc,		/* Set up notifier to watch the channel. */
     SerialGetHandleProc,	/* Get an OS handle from channel. */
-    NULL,			/* close2proc. */
+    SerialCloseProc,		/* close2proc. */
     SerialBlockProc,		/* Set blocking or non-blocking mode.*/
     NULL,			/* flush proc. */
     NULL,			/* handler proc. */
@@ -597,14 +597,18 @@ SerialBlockProc(
 static int
 SerialCloseProc(
     ClientData instanceData,    /* Pointer to SerialInfo structure. */
-    Tcl_Interp *interp)		/* For error reporting. */
+    Tcl_Interp *interp,		/* For error reporting. */
+    int flags)
 {
     SerialInfo *serialPtr = (SerialInfo *) instanceData;
-    int errorCode, result = 0;
+    int errorCode = 0, result = 0;
     SerialInfo *infoPtr, **nextPtrPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
-    errorCode = 0;
+    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
+	return EINVAL;
+    }
+
 
     if (serialPtr->validMask & TCL_READABLE) {
 	PurgeComm(serialPtr->handle, PURGE_RXABORT | PURGE_RXCLEAR);
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 8b42b9b..8213fde 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -280,7 +280,11 @@ static Tcl_DriverGetHandleProc	TcpGetHandleProc;
 static const Tcl_ChannelType tcpChannelType = {
     "tcp",			/* Type name. */
     TCL_CHANNEL_VERSION_5,	/* v5 channel */
+#ifndef TCL_NO_DEPRECATED
     TcpCloseProc,		/* Close proc. */
+#else
+    TCL_CLOSE2PROC,		/* Close proc. */
+#endif
     TcpInputProc,		/* Input proc. */
     TcpOutputProc,		/* Output proc. */
     NULL,			/* Seek proc. */
-- 
cgit v0.12


From f2ae531f0fc28d15c43ec95cf8b7299bc7a49e88 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sun, 2 Feb 2020 22:17:50 +0000
Subject: Oopsee

---
 generic/tclDecls.h | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index fad7811..4619dfe 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -4174,7 +4174,7 @@ extern const TclStubs *tclStubsPtr;
 #define Tcl_GlobalEvalObj(interp, objPtr) \
     Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)
 
-#if !defined(TCL_NO_DEPRECATED) && defined(USE_TCL_STUBS)
+#if defined(TCL_NO_DEPRECATED) && defined(USE_TCL_STUBS)
 #undef Tcl_Close
 #define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
 #endif
-- 
cgit v0.12