summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tcl.decls25
-rw-r--r--generic/tcl.h6
-rw-r--r--generic/tclDecls.h28
-rw-r--r--generic/tclEncoding.c2
-rw-r--r--generic/tclIO.c169
-rw-r--r--generic/tclIOCmd.c6
-rw-r--r--generic/tclIOGT.c110
-rw-r--r--generic/tclIORChan.c38
-rw-r--r--generic/tclIORTrans.c59
-rw-r--r--generic/tclIOUtil.c28
-rw-r--r--generic/tclInt.h2
-rw-r--r--generic/tclMain.c2
-rw-r--r--generic/tclPipe.c2
-rw-r--r--generic/tclStubInit.c6
-rw-r--r--generic/tclZipfs.c81
-rw-r--r--generic/tclZlib.c13
-rw-r--r--unix/tclUnixChan.c93
-rw-r--r--unix/tclUnixPipe.c2
-rw-r--r--unix/tclUnixSock.c6
-rw-r--r--win/tclWinChan.c97
-rw-r--r--win/tclWinConsole.c13
-rw-r--r--win/tclWinPipe.c2
-rw-r--r--win/tclWinSerial.c16
-rw-r--r--win/tclWinSock.c12
24 files changed, 242 insertions, 576 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 63995be..8dfc2e4 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -312,9 +312,10 @@ declare 79 {
declare 80 {
void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, void *clientData)
}
-declare 81 {
- int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan)
-}
+# Removed in 9.0:
+#declare 81 {
+# int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan)
+#}
declare 82 {
int Tcl_CommandComplete(const char *cmd)
}
@@ -1468,10 +1469,11 @@ declare 400 {
Tcl_DriverBlockModeProc *Tcl_ChannelBlockModeProc(
const Tcl_ChannelType *chanTypePtr)
}
-declare 401 {
- Tcl_DriverCloseProc *Tcl_ChannelCloseProc(
- const Tcl_ChannelType *chanTypePtr)
-}
+# Removed in 9.0
+#declare 401 {
+# Tcl_DriverCloseProc *Tcl_ChannelCloseProc(
+# const Tcl_ChannelType *chanTypePtr)
+#}
declare 402 {
Tcl_DriverClose2Proc *Tcl_ChannelClose2Proc(
const Tcl_ChannelType *chanTypePtr)
@@ -1484,10 +1486,11 @@ declare 404 {
Tcl_DriverOutputProc *Tcl_ChannelOutputProc(
const Tcl_ChannelType *chanTypePtr)
}
-declare 405 {
- Tcl_DriverSeekProc *Tcl_ChannelSeekProc(
- const Tcl_ChannelType *chanTypePtr)
-}
+# Removed in 9.0
+#declare 405 {
+# Tcl_DriverSeekProc *Tcl_ChannelSeekProc(
+# const Tcl_ChannelType *chanTypePtr)
+#}
declare 406 {
Tcl_DriverSetOptionProc *Tcl_ChannelSetOptionProc(
const Tcl_ChannelType *chanTypePtr)
diff --git a/generic/tcl.h b/generic/tcl.h
index 003a28d..8dbf5fe 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -1226,10 +1226,6 @@ typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, void *clientData);
* Channel version tag. This was introduced in 8.3.2/8.4.
*/
-#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)
#define TCL_CHANNEL_VERSION_5 ((Tcl_ChannelTypeVersion) 0x5)
/*
@@ -1298,7 +1294,7 @@ 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. */
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index ba18baf..66ee818 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -255,8 +255,7 @@ EXTERN void Tcl_CallWhenDeleted(Tcl_Interp *interp,
/* 80 */
EXTERN void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc,
void *clientData);
-/* 81 */
-EXTERN int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan);
+/* Slot 81 is reserved */
/* 82 */
EXTERN int Tcl_CommandComplete(const char *cmd);
/* 83 */
@@ -1067,9 +1066,7 @@ EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion(
/* 400 */
EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc(
const Tcl_ChannelType *chanTypePtr);
-/* 401 */
-EXTERN Tcl_DriverCloseProc * Tcl_ChannelCloseProc(
- const Tcl_ChannelType *chanTypePtr);
+/* Slot 401 is reserved */
/* 402 */
EXTERN Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc(
const Tcl_ChannelType *chanTypePtr);
@@ -1079,9 +1076,7 @@ EXTERN Tcl_DriverInputProc * Tcl_ChannelInputProc(
/* 404 */
EXTERN Tcl_DriverOutputProc * Tcl_ChannelOutputProc(
const Tcl_ChannelType *chanTypePtr);
-/* 405 */
-EXTERN Tcl_DriverSeekProc * Tcl_ChannelSeekProc(
- const Tcl_ChannelType *chanTypePtr);
+/* Slot 405 is reserved */
/* 406 */
EXTERN Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc(
const Tcl_ChannelType *chanTypePtr);
@@ -1865,7 +1860,7 @@ typedef struct TclStubs {
int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */
void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, void *clientData); /* 79 */
void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, void *clientData); /* 80 */
- int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */
+ void (*reserved81)(void);
int (*tcl_CommandComplete) (const char *cmd); /* 82 */
char * (*tcl_Concat) (int argc, const char *const *argv); /* 83 */
size_t (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */
@@ -2193,11 +2188,11 @@ 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 */
+ void (*reserved401)(void);
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 */
+ void (*reserved405)(void);
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 */
@@ -2616,8 +2611,7 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_CallWhenDeleted) /* 79 */
#define Tcl_CancelIdleCall \
(tclStubsPtr->tcl_CancelIdleCall) /* 80 */
-#define Tcl_Close \
- (tclStubsPtr->tcl_Close) /* 81 */
+/* Slot 81 is reserved */
#define Tcl_CommandComplete \
(tclStubsPtr->tcl_CommandComplete) /* 82 */
#define Tcl_Concat \
@@ -3221,16 +3215,14 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_ChannelVersion) /* 399 */
#define Tcl_ChannelBlockModeProc \
(tclStubsPtr->tcl_ChannelBlockModeProc) /* 400 */
-#define Tcl_ChannelCloseProc \
- (tclStubsPtr->tcl_ChannelCloseProc) /* 401 */
+/* Slot 401 is reserved */
#define Tcl_ChannelClose2Proc \
(tclStubsPtr->tcl_ChannelClose2Proc) /* 402 */
#define Tcl_ChannelInputProc \
(tclStubsPtr->tcl_ChannelInputProc) /* 403 */
#define Tcl_ChannelOutputProc \
(tclStubsPtr->tcl_ChannelOutputProc) /* 404 */
-#define Tcl_ChannelSeekProc \
- (tclStubsPtr->tcl_ChannelSeekProc) /* 405 */
+/* Slot 405 is reserved */
#define Tcl_ChannelSetOptionProc \
(tclStubsPtr->tcl_ChannelSetOptionProc) /* 406 */
#define Tcl_ChannelGetOptionProc \
@@ -3933,4 +3925,6 @@ extern const TclStubs *tclStubsPtr;
# endif
#endif
+#define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
+
#endif /* _TCLDECLS */
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index ff327e0..418ac0f 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -1638,7 +1638,7 @@ LoadEncodingFile(
"invalid encoding file \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL);
}
- Tcl_Close(NULL, chan);
+ Tcl_CloseEx(NULL, chan, 0);
return encoding;
}
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 9230fd3..fcf8085 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -374,11 +374,7 @@ ChanClose(
Channel *chanPtr,
Tcl_Interp *interp)
{
- if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
- return chanPtr->typePtr->closeProc(chanPtr->instanceData, interp);
- } else {
- return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, 0);
- }
+ return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, 0);
}
static inline int
@@ -490,18 +486,13 @@ ChanSeek(
* type and non-NULL.
*/
- if (Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL) {
- return Tcl_ChannelWideSeekProc(chanPtr->typePtr)(chanPtr->instanceData,
- offset, mode, errnoPtr);
- }
-
- if (offset<LONG_MIN || offset>LONG_MAX) {
- *errnoPtr = EOVERFLOW;
+ if (Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) {
+ *errnoPtr = EINVAL;
return -1;
}
- return Tcl_ChannelSeekProc(chanPtr->typePtr)(chanPtr->instanceData,
- offset, mode, errnoPtr);
+ return Tcl_ChannelWideSeekProc(chanPtr->typePtr)(chanPtr->instanceData,
+ offset, mode, errnoPtr);
}
static inline void
@@ -677,7 +668,7 @@ TclFinalizeIOSubsystem(void)
* interpreter will close the channel when it gets destroyed.
*/
- (void) Tcl_Close(NULL, (Tcl_Channel) chanPtr);
+ (void) Tcl_CloseEx(NULL, (Tcl_Channel) chanPtr, 0);
} else {
/*
* The refcount is greater than zero, so flush the channel.
@@ -1047,7 +1038,7 @@ DeleteChannelTable(
statePtr->epoch++;
if (statePtr->refCount-- <= 1) {
if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
- (void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
+ (void) Tcl_CloseEx(interp, (Tcl_Channel) chanPtr, 0);
}
}
@@ -1270,11 +1261,11 @@ Tcl_UnregisterChannel(
Tcl_Preserve(statePtr);
if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
/*
- * We don't want to re-enter Tcl_Close().
+ * We don't want to re-enter Tcl_CloseEx().
*/
if (!GotFlag(statePtr, CHANNEL_CLOSED)) {
- if (Tcl_Close(interp, chan) != TCL_OK) {
+ if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) {
SetFlag(statePtr, CHANNEL_CLOSED);
Tcl_Release(statePtr);
return TCL_ERROR;
@@ -1626,8 +1617,11 @@ 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);
+ 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);
}
if ((TCL_READABLE & mask) && (NULL == typePtr->inputProc)) {
Tcl_Panic("channel type %s must define inputProc when used for reader channel", typePtr->typeName);
@@ -1638,9 +1632,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
@@ -2186,7 +2177,7 @@ Tcl_UnstackChannel(
*/
if (statePtr->refCount + 1 <= 1) {
- if (Tcl_Close(interp, chan) != TCL_OK) {
+ if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) {
/*
* TIP #219, Tcl Channel Reflection API.
* "TclChanCaughtErrorBypass" is not required here, it was
@@ -3134,7 +3125,7 @@ CloseChannel(
ChannelFree(chanPtr);
- return Tcl_Close(interp, (Tcl_Channel) downChanPtr);
+ return Tcl_CloseEx(interp, (Tcl_Channel) downChanPtr, 0);
}
/*
@@ -3373,7 +3364,7 @@ Tcl_SpliceChannel(
/* ARGSUSED */
int
-Tcl_Close(
+TclClose(
Tcl_Interp *interp, /* Interpreter for errors. */
Tcl_Channel chan) /* The channel being closed. Must not be
* referenced in any interpreter. */
@@ -3382,7 +3373,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;
@@ -3483,12 +3474,7 @@ 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;
- }
+ (void)chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, TCL_CLOSE_READ);
/*
* The call to FlushChannel will flush any queued output and invoke the
@@ -3548,19 +3534,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.
*
*----------------------------------------------------------------------
*/
@@ -3580,18 +3564,26 @@ Tcl_CloseEx(
return TCL_OK;
}
- /* TODO: assert flags validity ? */
-
chanPtr = (Channel *) chan;
statePtr = chanPtr->state;
+ if ((flags & (TCL_READABLE | TCL_WRITABLE)) == 0) {
+ return TclClose(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;
}
@@ -4214,12 +4206,12 @@ WillWrite(
{
int inputBuffered;
- if ((Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL) &&
- ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){
- int ignore;
+ if (((Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL)
+ ) && ((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);
}
}
@@ -4236,8 +4228,8 @@ WillRead(
Tcl_SetErrno(EINVAL);
return -1;
}
- if ((Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL)
- && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
+ if (((Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL)
+ ) && (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
@@ -7000,7 +6992,8 @@ Tcl_Seek(
* defined. This means that the channel does not support seeking.
*/
- if (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) {
+ if ((Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL)
+ ) {
Tcl_SetErrno(EINVAL);
return -1;
}
@@ -7164,7 +7157,8 @@ Tcl_Tell(
* defined. This means that the channel does not support seeking.
*/
- if (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL) {
+ if ((Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL)
+ ) {
Tcl_SetErrno(EINVAL);
return -1;
}
@@ -10488,14 +10482,6 @@ Tcl_ChannelVersion(
const Tcl_ChannelType *chanTypePtr)
/* Pointer to channel type. */
{
- 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;
- }
return chanTypePtr->version;
}
@@ -10519,43 +10505,12 @@ Tcl_ChannelBlockModeProc(
const Tcl_ChannelType *chanTypePtr)
/* Pointer to channel type. */
{
- if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) {
- /*
- * The v1 structure had the blockModeProc in a different place.
- */
- return (Tcl_DriverBlockModeProc *) chanTypePtr->version;
- }
-
return chanTypePtr->blockModeProc;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_ChannelCloseProc --
- *
- * Return the Tcl_DriverCloseProc of the channel type.
- *
- * Results:
- * A pointer to the proc.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_DriverCloseProc *
-Tcl_ChannelCloseProc(
- const Tcl_ChannelType *chanTypePtr)
- /* Pointer to channel type. */
-{
- return chanTypePtr->closeProc;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_ChannelClose2Proc --
*
* Return the Tcl_DriverClose2Proc of the channel type.
@@ -10628,30 +10583,6 @@ Tcl_ChannelOutputProc(
/*
*----------------------------------------------------------------------
*
- * Tcl_ChannelSeekProc --
- *
- * Return the Tcl_DriverSeekProc of the channel type.
- *
- * Results:
- * A pointer to the proc.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_DriverSeekProc *
-Tcl_ChannelSeekProc(
- const Tcl_ChannelType *chanTypePtr)
- /* Pointer to channel type. */
-{
- return chanTypePtr->seekProc;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_ChannelSetOptionProc --
*
* Return the Tcl_DriverSetOptionProc of the channel type.
@@ -10766,9 +10697,6 @@ Tcl_ChannelFlushProc(
const Tcl_ChannelType *chanTypePtr)
/* Pointer to channel type. */
{
- if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) {
- return NULL;
- }
return chanTypePtr->flushProc;
}
@@ -10793,9 +10721,6 @@ Tcl_ChannelHandlerProc(
const Tcl_ChannelType *chanTypePtr)
/* Pointer to channel type. */
{
- if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) {
- return NULL;
- }
return chanTypePtr->handlerProc;
}
@@ -10820,9 +10745,6 @@ Tcl_ChannelWideSeekProc(
const Tcl_ChannelType *chanTypePtr)
/* Pointer to channel type. */
{
- if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_3) {
- return NULL;
- }
return chanTypePtr->wideSeekProc;
}
@@ -10848,9 +10770,6 @@ Tcl_ChannelThreadActionProc(
const Tcl_ChannelType *chanTypePtr)
/* Pointer to channel type. */
{
- if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_4) {
- return NULL;
- }
return chanTypePtr->threadActionProc;
}
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 2e492b8..e10be42 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -967,7 +967,7 @@ Tcl_ExecObjCmd(
*/
TclGetAndDetachPids(interp, chan);
- if (Tcl_Close(interp, chan) != TCL_OK) {
+ if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) {
return TCL_ERROR;
}
return TCL_OK;
@@ -999,7 +999,7 @@ Tcl_ExecObjCmd(
* string.
*/
- result = Tcl_Close(interp, chan);
+ result = Tcl_CloseEx(interp, chan, 0);
Tcl_AppendObjToObj(resultPtr, Tcl_GetObjResult(interp));
/*
@@ -1405,7 +1405,7 @@ AcceptCallbackProc(
* the client socket - just close it.
*/
- Tcl_Close(NULL, chan);
+ Tcl_CloseEx(NULL, chan, 0);
}
}
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index 5f0f55e..e9c4fae 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -22,13 +22,11 @@
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,
const char *buf, int toWrite, int *errorCodePtr);
-static int TransformSeekProc(ClientData instanceData, long offset,
- int mode, int *errorCodePtr);
static int TransformSetOptionProc(ClientData instanceData,
Tcl_Interp *interp, const char *optionName,
const char *value);
@@ -119,15 +117,15 @@ 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. */
+ NULL, /* Close proc. */
TransformInputProc, /* Input proc. */
TransformOutputProc, /* Output proc. */
- TransformSeekProc, /* Seek proc. */
+ NULL, /* Seek proc. */
TransformSetOptionProc, /* Set option proc. */
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. */
@@ -533,10 +531,15 @@ TransformBlockModeProc(
static int
TransformCloseProc(
ClientData instanceData,
- Tcl_Interp *interp)
+ Tcl_Interp *interp,
+ int flags)
{
TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
+ if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
+ return EINVAL;
+ }
+
/*
* Important: In this procedure 'dataPtr->self' already points to the
* underlying channel.
@@ -811,73 +814,6 @@ TransformOutputProc(
/*
*----------------------------------------------------------------------
*
- * TransformSeekProc --
- *
- * This procedure is called by the generic IO level to move the access
- * point in a channel.
- *
- * Side effects:
- * Moves the location at which the channel will be accessed in future
- * operations. Flushes all transformation buffers, then forwards it to
- * the underlying channel.
- *
- * Result:
- * -1 if failed, the new position if successful. An output argument
- * contains the POSIX error code if an error occurred, or zero.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TransformSeekProc(
- ClientData instanceData, /* The channel to manipulate. */
- long offset, /* Size of movement. */
- int mode, /* How to move. */
- int *errorCodePtr) /* Location of error flag. */
-{
- TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
- Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
- const Tcl_ChannelType *parentType = Tcl_GetChannelType(parent);
- Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);
-
- if ((offset == 0) && (mode == SEEK_CUR)) {
- /*
- * This is no seek but a request to tell the caller the current
- * location. Simply pass the request down.
- */
-
- return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset,
- mode, errorCodePtr);
- }
-
- /*
- * It is a real request to change the position. Flush all data waiting for
- * output and discard everything in the input buffers. Then pass the
- * request down, unchanged.
- */
-
- PreserveData(dataPtr);
- if (dataPtr->mode & TCL_WRITABLE) {
- ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
- P_NO_PRESERVE);
- }
-
- if (dataPtr->mode & TCL_READABLE) {
- ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT,
- P_NO_PRESERVE);
- ResultClear(&dataPtr->result);
- dataPtr->readIsFlushed = 0;
- dataPtr->eofPending = 0;
- }
- ReleaseData(dataPtr);
-
- return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode,
- errorCodePtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TransformWideSeekProc --
*
* This procedure is called by the generic IO level to move the access
@@ -905,7 +841,6 @@ TransformWideSeekProc(
TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
const Tcl_ChannelType *parentType = Tcl_GetChannelType(parent);
- Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);
Tcl_DriverWideSeekProc *parentWideSeekProc =
Tcl_ChannelWideSeekProc(parentType);
ClientData parentData = Tcl_GetChannelInstanceData(parent);
@@ -918,9 +853,10 @@ TransformWideSeekProc(
if (parentWideSeekProc != NULL) {
return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
+ } else {
+ *errorCodePtr = EINVAL;
+ return -1;
}
-
- return parentSeekProc(parentData, 0, mode, errorCodePtr);
}
/*
@@ -948,25 +884,11 @@ TransformWideSeekProc(
* If we have a wide seek capability, we should stick with that.
*/
- if (parentWideSeekProc != NULL) {
- return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
- }
-
- /*
- * 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;
+ if (parentWideSeekProc == NULL) {
+ *errorCodePtr = EINVAL;
return -1;
}
-
- return parentSeekProc(parentData, offset,
- mode, errorCodePtr);
+ return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
}
/*
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index a460090..018c59f 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,
@@ -46,8 +46,6 @@ static int ReflectEventDelete(Tcl_Event *ev, ClientData cd);
#endif
static Tcl_WideInt ReflectSeekWide(ClientData clientData,
Tcl_WideInt offset, int mode, int *errorCodePtr);
-static int ReflectSeek(ClientData clientData, long offset,
- int mode, int *errorCodePtr);
static int ReflectGetOption(ClientData clientData,
Tcl_Interp *interp, const char *optionName,
Tcl_DString *dsPtr);
@@ -65,15 +63,15 @@ 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 */
+ NULL, /* Close channel, clean instance data */
ReflectInput, /* Handle read request */
ReflectOutput, /* Handle write request */
- ReflectSeek, /* Move location of access point. NULL'able */
+ NULL,
ReflectSetOption, /* Set options. NULL'able */
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 */
@@ -81,7 +79,7 @@ static const Tcl_ChannelType tclRChannelType = {
#if TCL_THREADS
ReflectThread, /* thread action, tracking owner */
#else
- NULL, /* thread action */
+ (void *)-1, /* thread action */
#endif
NULL /* truncate */
};
@@ -697,7 +695,6 @@ TclChanCreateObjCmd(
clonePtr->blockModeProc = NULL;
}
if (!(methods & FLAG(METH_SEEK))) {
- clonePtr->seekProc = NULL;
clonePtr->wideSeekProc = NULL;
}
@@ -1153,7 +1150,8 @@ TclChanCaughtErrorBypass(
static int
ReflectClose(
ClientData clientData,
- Tcl_Interp *interp)
+ Tcl_Interp *interp,
+ int flags)
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
int result; /* Result code for 'close' */
@@ -1163,6 +1161,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
@@ -1616,24 +1618,6 @@ ReflectSeekWide(
newLoc = -1;
goto stop;
}
-
-static int
-ReflectSeek(
- ClientData clientData,
- long offset,
- int seekMode,
- int *errorCodePtr)
-{
- /*
- * This function can be invoked from a transformation which is based on
- * standard seeking, i.e. non-wide. Because of this we have to implement
- * it, a dummy is not enough. We simply delegate the call to the wide
- * routine.
- */
-
- return ReflectSeekWide(clientData, offset, seekMode,
- errorCodePtr);
-}
/*
*----------------------------------------------------------------------
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index 0a68518..9e18a05 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,
@@ -41,8 +41,6 @@ static void ReflectWatch(ClientData clientData, int mask);
static int ReflectBlock(ClientData clientData, int mode);
static Tcl_WideInt ReflectSeekWide(ClientData clientData,
Tcl_WideInt offset, int mode, int *errorCodePtr);
-static int ReflectSeek(ClientData clientData, long offset,
- int mode, int *errorCodePtr);
static int ReflectGetOption(ClientData clientData,
Tcl_Interp *interp, const char *optionName,
Tcl_DString *dsPtr);
@@ -60,15 +58,15 @@ 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. */
+ NULL, /* Close channel, clean instance data. */
ReflectInput, /* Handle read request. */
ReflectOutput, /* Handle write request. */
- ReflectSeek, /* Move location of access point. */
+ NULL, /* Move location of access point. */
ReflectSetOption, /* Set options. */
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. */
@@ -881,7 +879,8 @@ UnmarshallErrorResult(
static int
ReflectClose(
ClientData clientData,
- Tcl_Interp *interp)
+ Tcl_Interp *interp,
+ int flags)
{
ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
int errorCode, errorCodeSet = 0;
@@ -892,6 +891,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
@@ -1329,18 +1332,6 @@ ReflectSeekWide(
Channel *parent = (Channel *) rtPtr->parent;
Tcl_WideInt curPos; /* Position on the device. */
- Tcl_DriverSeekProc *seekProc =
- Tcl_ChannelSeekProc(Tcl_GetChannelType(rtPtr->parent));
-
- /*
- * Fail if the parent channel is not seekable.
- */
-
- if (seekProc == NULL) {
- Tcl_SetErrno(EINVAL);
- return -1;
- }
-
/*
* Check if we can leave out involving the Tcl level, i.e. transformation
* handler. This is true for tell requests, and transformations which
@@ -1384,16 +1375,12 @@ ReflectSeekWide(
* non-NULL...
*/
- 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;
+ if (Tcl_ChannelWideSeekProc(parent->typePtr) == NULL) {
+ *errorCodePtr = EINVAL;
curPos = -1;
} else {
- curPos = Tcl_ChannelSeekProc(parent->typePtr)(
- parent->instanceData, offset, seekMode,
- errorCodePtr);
+ curPos = Tcl_ChannelWideSeekProc(parent->typePtr)(parent->instanceData, offset,
+ seekMode, errorCodePtr);
}
if (curPos == -1) {
Tcl_SetErrno(*errorCodePtr);
@@ -1403,24 +1390,6 @@ ReflectSeekWide(
Tcl_Release(rtPtr);
return curPos;
}
-
-static int
-ReflectSeek(
- ClientData clientData,
- long offset,
- int seekMode,
- int *errorCodePtr)
-{
- /*
- * This function can be invoked from a transformation which is based on
- * standard seeking, i.e. non-wide. Because of this we have to implement
- * it, a dummy is not enough. We simply delegate the call to the wide
- * routine.
- */
-
- return ReflectSeekWide(clientData, offset, seekMode,
- errorCodePtr);
-}
/*
*----------------------------------------------------------------------
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 5c0ce0b..26ff1d8 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -1733,7 +1733,7 @@ Tcl_FSEvalFileEx(
if (encodingName != NULL) {
if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName)
!= TCL_OK) {
- Tcl_Close(interp,chan);
+ Tcl_CloseEx(interp,chan,0);
return result;
}
}
@@ -1746,7 +1746,7 @@ Tcl_FSEvalFileEx(
*/
if (Tcl_ReadChars(chan, objPtr, 1, 0) == TCL_IO_FAILURE) {
- Tcl_Close(interp, chan);
+ Tcl_CloseEx(interp, chan, 0);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't read file \"%s\": %s",
TclGetString(pathPtr), Tcl_PosixError(interp)));
@@ -1761,14 +1761,14 @@ Tcl_FSEvalFileEx(
if (Tcl_ReadChars(chan, objPtr, -1,
memcmp(string, "\xef\xbb\xbf", 3)) == TCL_IO_FAILURE) {
- Tcl_Close(interp, chan);
+ Tcl_CloseEx(interp, chan, 0);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't read file \"%s\": %s",
TclGetString(pathPtr), Tcl_PosixError(interp)));
goto end;
}
- if (Tcl_Close(interp, chan) != TCL_OK) {
+ if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) {
goto end;
}
@@ -1869,7 +1869,7 @@ TclNREvalFile(
if (encodingName != NULL) {
if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName)
!= TCL_OK) {
- Tcl_Close(interp,chan);
+ Tcl_CloseEx(interp, chan, 0);
return TCL_ERROR;
}
}
@@ -1882,7 +1882,7 @@ TclNREvalFile(
*/
if (Tcl_ReadChars(chan, objPtr, 1, 0) == TCL_IO_FAILURE) {
- Tcl_Close(interp, chan);
+ Tcl_CloseEx(interp, chan, 0);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't read file \"%s\": %s",
TclGetString(pathPtr), Tcl_PosixError(interp)));
@@ -1898,7 +1898,7 @@ TclNREvalFile(
if (Tcl_ReadChars(chan, objPtr, -1,
memcmp(string, "\xef\xbb\xbf", 3)) == TCL_IO_FAILURE) {
- Tcl_Close(interp, chan);
+ Tcl_CloseEx(interp, chan, 0);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't read file \"%s\": %s",
TclGetString(pathPtr), Tcl_PosixError(interp)));
@@ -1906,7 +1906,7 @@ TclNREvalFile(
return TCL_ERROR;
}
- if (Tcl_Close(interp, chan) != TCL_OK) {
+ if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) {
Tcl_DecrRefCount(objPtr);
return TCL_ERROR;
}
@@ -2238,7 +2238,7 @@ Tcl_FSOpenFileChannel(
"could not seek to end of file while opening \"%s\": %s",
TclGetString(pathPtr), Tcl_PosixError(interp)));
}
- Tcl_Close(NULL, retVal);
+ Tcl_CloseEx(NULL, retVal, 0);
return NULL;
}
if (binary) {
@@ -3248,11 +3248,11 @@ Tcl_LoadFile(
}
buffer = TclpLoadMemoryGetBuffer(interp, size);
if (!buffer) {
- Tcl_Close(interp, data);
+ Tcl_CloseEx(interp, data, 0);
goto mustCopyToTempAnyway;
}
ret = Tcl_Read(data, (char *)buffer, size);
- Tcl_Close(interp, data);
+ Tcl_CloseEx(interp, data, 0);
ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr,
&unloadProcPtr, flags);
if (ret == TCL_OK && *handlePtr != NULL) {
@@ -4251,7 +4251,7 @@ TclCrossFilesystemCopy(
* Could not open an input channel. Why didn't the caller check this?
*/
- Tcl_Close(interp, out);
+ Tcl_CloseEx(interp, out, 0);
goto done;
}
@@ -4268,8 +4268,8 @@ TclCrossFilesystemCopy(
* If the copy failed, assume that copy channel left an error message.
*/
- Tcl_Close(interp, in);
- Tcl_Close(interp, out);
+ Tcl_CloseEx(interp, in, 0);
+ Tcl_CloseEx(interp, out, 0);
/*
* Set modification date of copied file.
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 4eb929a..15f6b54 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -4099,7 +4099,7 @@ MODULE_SCOPE void TclProcessCreated(Tcl_Pid pid);
MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
int *codePtr, Tcl_Obj **msgObjPtr,
Tcl_Obj **errorObjPtr);
-
+MODULE_SCOPE int TclClose(Tcl_Interp *, Tcl_Channel chan);
/*
* TIP #508: [array default]
*/
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 16e2159..8b8daf3 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -250,7 +250,7 @@ Tcl_SourceRCFile(
c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
if (c != NULL) {
- Tcl_Close(NULL, c);
+ Tcl_CloseEx(NULL, c, 0);
if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
chan = Tcl_GetStdChannel(TCL_STDERR);
if (chan) {
diff --git a/generic/tclPipe.c b/generic/tclPipe.c
index 6c73f92..61a2080 100644
--- a/generic/tclPipe.c
+++ b/generic/tclPipe.c
@@ -351,7 +351,7 @@ TclCleanupChildren(
Tcl_DecrRefCount(objPtr);
}
}
- Tcl_Close(NULL, errorChan);
+ Tcl_CloseEx(NULL, errorChan, 0);
}
/*
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 48ff391..753b604 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -834,7 +834,7 @@ const TclStubs tclStubs = {
Tcl_BadChannelOption, /* 78 */
Tcl_CallWhenDeleted, /* 79 */
Tcl_CancelIdleCall, /* 80 */
- Tcl_Close, /* 81 */
+ 0, /* 81 */
Tcl_CommandComplete, /* 82 */
Tcl_Concat, /* 83 */
Tcl_ConvertElement, /* 84 */
@@ -1162,11 +1162,11 @@ const TclStubs tclStubs = {
Tcl_ChannelName, /* 398 */
Tcl_ChannelVersion, /* 399 */
Tcl_ChannelBlockModeProc, /* 400 */
- Tcl_ChannelCloseProc, /* 401 */
+ 0, /* 401 */
Tcl_ChannelClose2Proc, /* 402 */
Tcl_ChannelInputProc, /* 403 */
Tcl_ChannelOutputProc, /* 404 */
- Tcl_ChannelSeekProc, /* 405 */
+ 0, /* 405 */
Tcl_ChannelSetOptionProc, /* 406 */
Tcl_ChannelGetOptionProc, /* 407 */
Tcl_ChannelWatchProc, /* 408 */
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index fbbe1ed..afba76b 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -385,13 +385,11 @@ 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,
int toRead, int *errloc);
-static int ZipChannelSeek(void *instanceData, long offset,
- int mode, int *errloc);
static Tcl_WideInt ZipChannelWideSeek(void *instanceData, Tcl_WideInt offset,
int mode, int *errloc);
static void ZipChannelWatchChannel(void *instanceData,
@@ -444,15 +442,15 @@ static const Tcl_Filesystem zipfsFilesystem = {
static Tcl_ChannelType ZipChannelType = {
"zip", /* Type name. */
TCL_CHANNEL_VERSION_5,
- ZipChannelClose, /* Close channel, clean instance data */
+ NULL, /* Close channel, clean instance data */
ZipChannelRead, /* Handle read request */
ZipChannelWrite, /* Handle write request */
- ZipChannelSeek, /* Move location of access point, NULL'able */
+ NULL, /* Move location of access point, NULL'able */
NULL, /* Set options, NULL'able */
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 */
@@ -938,7 +936,7 @@ ZipFSCloseArchive(
zf->ptrToFree = NULL;
}
if (zf->chan) {
- Tcl_Close(interp, zf->chan);
+ Tcl_CloseEx(interp, zf->chan, 0);
zf->chan = NULL;
}
}
@@ -1141,7 +1139,7 @@ ZipFSOpenArchive(
ZIPFS_POSIX_ERROR(interp, "file read error");
goto error;
}
- Tcl_Close(interp, zf->chan);
+ Tcl_CloseEx(interp, zf->chan, 0);
zf->chan = NULL;
} else {
#ifdef _WIN32
@@ -2139,11 +2137,11 @@ ZipAddFile(
#ifdef _WIN32
/* hopefully a directory */
if (strcmp("permission denied", Tcl_PosixError(interp)) == 0) {
- Tcl_Close(interp, in);
+ Tcl_CloseEx(interp, in, 0);
return TCL_OK;
}
#endif /* _WIN32 */
- Tcl_Close(interp, in);
+ Tcl_CloseEx(interp, in, 0);
return TCL_ERROR;
} else {
Tcl_Obj *pathObj = Tcl_NewStringObj(path, -1);
@@ -2162,12 +2160,12 @@ ZipAddFile(
len = Tcl_Read(in, buf, bufsize);
if (len == TCL_IO_FAILURE) {
if (nbyte == 0 && errno == EISDIR) {
- Tcl_Close(interp, in);
+ Tcl_CloseEx(interp, in, 0);
return TCL_OK;
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf("read error on \"%s\": %s",
path, Tcl_PosixError(interp)));
- Tcl_Close(interp, in);
+ Tcl_CloseEx(interp, in, 0);
return TCL_ERROR;
}
if (len == 0) {
@@ -2179,7 +2177,7 @@ ZipAddFile(
if (Tcl_Seek(in, 0, SEEK_SET) == -1) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf("seek error on \"%s\": %s",
path, Tcl_PosixError(interp)));
- Tcl_Close(interp, in);
+ Tcl_CloseEx(interp, in, 0);
return TCL_ERROR;
}
pos[0] = Tcl_Tell(out);
@@ -2190,7 +2188,7 @@ ZipAddFile(
wrerr:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"write error on %s: %s", path, Tcl_PosixError(interp)));
- Tcl_Close(interp, in);
+ Tcl_CloseEx(interp, in, 0);
return TCL_ERROR;
}
if ((len + pos[0]) & 3) {
@@ -2224,7 +2222,7 @@ ZipAddFile(
i);
Tcl_AppendObjToErrorInfo(interp, eiPtr);
- Tcl_Close(interp, in);
+ Tcl_CloseEx(interp, in, 0);
return TCL_ERROR;
}
ret = Tcl_GetObjResult(interp);
@@ -2234,7 +2232,7 @@ ZipAddFile(
i);
Tcl_AppendObjToErrorInfo(interp, eiPtr);
- Tcl_Close(interp, in);
+ Tcl_CloseEx(interp, in, 0);
return TCL_ERROR;
}
ch = (int) (r * 256);
@@ -2253,7 +2251,7 @@ ZipAddFile(
if (len != 12) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"write error on %s: %s", path, Tcl_PosixError(interp)));
- Tcl_Close(interp, in);
+ Tcl_CloseEx(interp, in, 0);
return TCL_ERROR;
}
memcpy(keys0, keys, sizeof(keys0));
@@ -2271,7 +2269,7 @@ ZipAddFile(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"compression init error on \"%s\"", path));
Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DEFLATE_INIT", NULL);
- Tcl_Close(interp, in);
+ Tcl_CloseEx(interp, in, 0);
return TCL_ERROR;
}
do {
@@ -2280,7 +2278,7 @@ ZipAddFile(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"read error on %s: %s", path, Tcl_PosixError(interp)));
deflateEnd(&stream);
- Tcl_Close(interp, in);
+ Tcl_CloseEx(interp, in, 0);
return TCL_ERROR;
}
stream.avail_in = len;
@@ -2295,7 +2293,7 @@ ZipAddFile(
"deflate error on %s", path));
Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DEFLATE", NULL);
deflateEnd(&stream);
- Tcl_Close(interp, in);
+ Tcl_CloseEx(interp, in, 0);
return TCL_ERROR;
}
olen = sizeof(obuf) - stream.avail_out;
@@ -2311,7 +2309,7 @@ ZipAddFile(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"write error: %s", Tcl_PosixError(interp)));
deflateEnd(&stream);
- Tcl_Close(interp, in);
+ Tcl_CloseEx(interp, in, 0);
return TCL_ERROR;
}
nbytecompr += olen;
@@ -2329,7 +2327,7 @@ ZipAddFile(
}
if (Tcl_Seek(out, pos[2], SEEK_SET) != pos[2]) {
seekErr:
- Tcl_Close(interp, in);
+ Tcl_CloseEx(interp, in, 0);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"seek error: %s", Tcl_PosixError(interp)));
return TCL_ERROR;
@@ -2341,7 +2339,7 @@ ZipAddFile(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"read error on \"%s\": %s",
path, Tcl_PosixError(interp)));
- Tcl_Close(interp, in);
+ Tcl_CloseEx(interp, in, 0);
return TCL_ERROR;
} else if (len == 0) {
break;
@@ -2357,7 +2355,7 @@ ZipAddFile(
if (Tcl_Write(out, buf, len) != len) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"write error: %s", Tcl_PosixError(interp)));
- Tcl_Close(interp, in);
+ Tcl_CloseEx(interp, in, 0);
return TCL_ERROR;
}
nbytecompr += len;
@@ -2367,7 +2365,7 @@ ZipAddFile(
pos[1] = Tcl_Tell(out);
Tcl_TruncateChannel(out, pos[1]);
}
- Tcl_Close(interp, in);
+ Tcl_CloseEx(interp, in, 0);
hPtr = Tcl_CreateHashEntry(fileHash, zpath, &isNew);
if (!isNew) {
@@ -2585,7 +2583,7 @@ ZipFSMkZipOrImgObjCmd(
Tcl_DecrRefCount(list);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"write error: %s", Tcl_PosixError(interp)));
- Tcl_Close(interp, out);
+ Tcl_CloseEx(interp, out, 0);
if (zf == &zf0) {
ZipFSCloseArchive(interp, zf);
} else {
@@ -2618,7 +2616,7 @@ ZipFSMkZipOrImgObjCmd(
if (!in) {
memset(passBuf, 0, sizeof(passBuf));
Tcl_DecrRefCount(list);
- Tcl_Close(interp, out);
+ Tcl_CloseEx(interp, out, 0);
return TCL_ERROR;
}
i = Tcl_Seek(in, 0, SEEK_END);
@@ -2628,8 +2626,8 @@ ZipFSMkZipOrImgObjCmd(
Tcl_DecrRefCount(list);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s: %s", errMsg, Tcl_PosixError(interp)));
- Tcl_Close(interp, out);
- Tcl_Close(interp, in);
+ Tcl_CloseEx(interp, out, 0);
+ Tcl_CloseEx(interp, in, 0);
return TCL_ERROR;
}
Tcl_Seek(in, 0, SEEK_SET);
@@ -2651,7 +2649,7 @@ ZipFSMkZipOrImgObjCmd(
goto cperr;
}
}
- Tcl_Close(interp, in);
+ Tcl_CloseEx(interp, in, 0);
}
len = strlen(passBuf);
if (len > 0) {
@@ -2660,7 +2658,7 @@ ZipFSMkZipOrImgObjCmd(
Tcl_DecrRefCount(list);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"write error: %s", Tcl_PosixError(interp)));
- Tcl_Close(interp, out);
+ Tcl_CloseEx(interp, out, 0);
return TCL_ERROR;
}
}
@@ -2776,9 +2774,9 @@ ZipFSMkZipOrImgObjCmd(
done:
if (ret == TCL_OK) {
- ret = Tcl_Close(interp, out);
+ ret = Tcl_CloseEx(interp, out, 0);
} else {
- Tcl_Close(interp, out);
+ Tcl_CloseEx(interp, out, 0);
}
Tcl_DecrRefCount(list);
for (hPtr = Tcl_FirstHashEntry(&fileHash, &search); hPtr;
@@ -3332,11 +3330,16 @@ ZipFSTclLibraryObjCmd(
static int
ZipChannelClose(
void *instanceData,
- Tcl_Interp *dummy) /* Current interpreter. */
+ Tcl_Interp *dummy, /* Current interpreter. */
+ int flags)
{
ZipChannel *info = (ZipChannel *)instanceData;
(void)dummy;
+ if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
+ return EINVAL;
+ }
+
if (info->iscompr && info->ubuf) {
Tcl_Free(info->ubuf);
info->ubuf = NULL;
@@ -3562,16 +3565,6 @@ ZipChannelWideSeek(
info->numRead = (size_t) offset;
return info->numRead;
}
-
-static int
-ZipChannelSeek(
- void *instanceData,
- long offset,
- int mode,
- int *errloc)
-{
- return ZipChannelWideSeek(instanceData, offset, mode, errloc);
-}
/*
*-------------------------------------------------------------------------
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index d520739..4a91e26 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,
+ NULL,
ZlibTransformInput,
ZlibTransformOutput,
NULL, /* seekProc */
@@ -213,7 +213,7 @@ static const Tcl_ChannelType zlibChannelType = {
ZlibTransformGetOption,
ZlibTransformWatch,
ZlibTransformGetHandle,
- NULL, /* close2Proc */
+ ZlibTransformClose, /* close2Proc */
ZlibTransformBlockMode,
NULL, /* flushProc */
ZlibTransformEventHandler,
@@ -2905,12 +2905,17 @@ ZlibStreamHeaderCmd(
static int
ZlibTransformClose(
void *instanceData,
- Tcl_Interp *interp)
+ Tcl_Interp *interp,
+ int flags)
{
ZlibChannelData *cd = (ZlibChannelData *)instanceData;
int e, result = TCL_OK;
size_t written;
+ 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 2314ba3..7478627 100644
--- a/unix/tclUnixChan.c
+++ b/unix/tclUnixChan.c
@@ -121,15 +121,13 @@ typedef struct {
static int FileBlockModeProc(void *instanceData, int mode);
static int FileCloseProc(void *instanceData,
- Tcl_Interp *interp);
+ Tcl_Interp *interp, int flags);
static int FileGetHandleProc(void *instanceData,
int direction, void **handlePtr);
static int FileInputProc(void *instanceData, char *buf,
int toRead, int *errorCode);
static int FileOutputProc(void *instanceData,
const char *buf, int toWrite, int *errorCode);
-static int FileSeekProc(void *instanceData, long offset,
- int mode, int *errorCode);
static int FileTruncateProc(void *instanceData,
Tcl_WideInt length);
static Tcl_WideInt FileWideSeekProc(void *instanceData,
@@ -137,7 +135,7 @@ static Tcl_WideInt FileWideSeekProc(void *instanceData,
static void FileWatchProc(void *instanceData, int mask);
#ifdef SUPPORTS_TTY
static int TtyCloseProc(void *instanceData,
- Tcl_Interp *interp);
+ Tcl_Interp *interp, int flags);
static void TtyGetAttributes(int fd, TtyAttrs *ttyPtr);
static int TtyGetOptionProc(void *instanceData,
Tcl_Interp *interp, const char *optionName,
@@ -161,15 +159,15 @@ static int TtySetOptionProc(void *instanceData,
static const Tcl_ChannelType fileChannelType = {
"file", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
- FileCloseProc, /* Close proc. */
+ NULL, /* Close proc. */
FileInputProc, /* Input proc. */
FileOutputProc, /* Output proc. */
- FileSeekProc, /* Seek proc. */
+ NULL,
NULL, /* Set option proc. */
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. */
@@ -187,7 +185,7 @@ static const Tcl_ChannelType fileChannelType = {
static const Tcl_ChannelType ttyChannelType = {
"tty", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
- TtyCloseProc, /* Close proc. */
+ NULL, /* Close proc. */
FileInputProc, /* Input proc. */
FileOutputProc, /* Output proc. */
NULL, /* Seek proc. */
@@ -195,7 +193,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. */
@@ -353,12 +351,17 @@ FileOutputProc(
static int
FileCloseProc(
void *instanceData, /* File state. */
- Tcl_Interp *dummy) /* For error reporting - unused. */
+ Tcl_Interp *dummy, /* For error reporting - unused. */
+ int flags)
{
FileState *fsPtr = (FileState *)instanceData;
int errorCode = 0;
(void)dummy;
+ if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
+ return EINVAL;
+ }
+
Tcl_DeleteFileHandler(fsPtr->fd);
/*
@@ -379,10 +382,14 @@ FileCloseProc(
static int
TtyCloseProc(
void *instanceData,
- Tcl_Interp *interp)
+ Tcl_Interp *interp,
+ int flags)
{
TtyState *ttyPtr = (TtyState*)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.
*/
@@ -411,73 +418,13 @@ TtyCloseProc(
* Delegate to close for files.
*/
- return FileCloseProc(instanceData, interp);
+ return FileCloseProc(instanceData, interp, flags);
}
#endif /* SUPPORTS_TTY */
/*
*----------------------------------------------------------------------
*
- * FileSeekProc --
- *
- * This function is called by the generic IO level to move the access
- * point in a file based channel.
- *
- * Results:
- * -1 if failed, the new position if successful. An output argument
- * contains the POSIX error code if an error occurred, or zero.
- *
- * Side effects:
- * Moves the location at which the channel will be accessed in future
- * operations.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FileSeekProc(
- void *instanceData, /* File state. */
- long offset, /* Offset to seek to. */
- int mode, /* Relative to where should we seek? Can be
- * one of SEEK_START, SEEK_SET or SEEK_END. */
- int *errorCodePtr) /* To store error code. */
-{
- FileState *fsPtr = (FileState *)instanceData;
- Tcl_WideInt oldLoc, newLoc;
-
- /*
- * Save our current place in case we need to roll-back the seek.
- */
-
- oldLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR);
- if (oldLoc == -1) {
- /*
- * Bad things are happening. Error out...
- */
-
- *errorCodePtr = errno;
- return -1;
- }
-
- newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode);
-
- /*
- * Check for expressability in our return type, and roll-back otherwise.
- */
-
- if (newLoc > INT_MAX) {
- *errorCodePtr = EOVERFLOW;
- TclOSseek(fsPtr->fd, (Tcl_SeekOffset) oldLoc, SEEK_SET);
- return -1;
- } else {
- *errorCodePtr = (newLoc == -1) ? errno : 0;
- }
- return (int) newLoc;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* FileWideSeekProc --
*
* This function is called by the generic IO level to move the access
@@ -1738,7 +1685,7 @@ TclpOpenFileChannel(
if (Tcl_SetChannelOption(interp, fsPtr->fileState.channel,
"-translation", translation) != TCL_OK) {
- Tcl_Close(NULL, fsPtr->fileState.channel);
+ Tcl_CloseEx(NULL, fsPtr->fileState.channel, 0);
return NULL;
}
}
diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c
index 55fd03d..a0445a2 100644
--- a/unix/tclUnixPipe.c
+++ b/unix/tclUnixPipe.c
@@ -69,7 +69,7 @@ static int SetupStdFile(TclFile file, int type);
static const Tcl_ChannelType pipeChannelType = {
"pipe", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
- TCL_CLOSE2PROC, /* Close proc. */
+ NULL, /* Close proc. */
PipeInputProc, /* Input proc. */
PipeOutputProc, /* Output proc. */
NULL, /* Seek proc. */
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 0fa4edf..f72a888 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -157,7 +157,7 @@ static void WrapNotify(void *clientData, int mask);
static const Tcl_ChannelType tcpChannelType = {
"tcp", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
- TcpCloseProc, /* Close proc. */
+ NULL, /* Close proc. */
TcpInputProc, /* Input proc. */
TcpOutputProc, /* Output proc. */
NULL, /* Seek proc. */
@@ -1419,7 +1419,7 @@ Tcl_OpenTcpClient(
statePtr, TCL_READABLE | TCL_WRITABLE);
if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation",
"auto crlf") == TCL_ERROR) {
- Tcl_Close(NULL, statePtr->channel);
+ Tcl_CloseEx(NULL, statePtr->channel, 0);
return NULL;
}
return statePtr->channel;
@@ -1486,7 +1486,7 @@ TclpMakeTcpClientChannelMode(
statePtr, mode);
if (Tcl_SetChannelOption(NULL, statePtr->channel, "-translation",
"auto crlf") == TCL_ERROR) {
- Tcl_Close(NULL, statePtr->channel);
+ Tcl_CloseEx(NULL, statePtr->channel, 0);
return NULL;
}
return statePtr->channel;
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index 23a3545..aa002f3 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);
@@ -85,8 +85,6 @@ static int FileInputProc(ClientData instanceData, char *buf,
int toRead, int *errorCode);
static int FileOutputProc(ClientData instanceData,
const char *buf, int toWrite, int *errorCode);
-static int FileSeekProc(ClientData instanceData, long offset,
- int mode, int *errorCode);
static Tcl_WideInt FileWideSeekProc(ClientData instanceData,
Tcl_WideInt offset, int mode, int *errorCode);
static void FileSetupProc(ClientData clientData, int flags);
@@ -105,15 +103,15 @@ static int NativeIsComPort(const WCHAR *nativeName);
static const Tcl_ChannelType fileChannelType = {
"file", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
- FileCloseProc, /* Close proc. */
+ NULL, /* Close proc. */
FileInputProc, /* Input proc. */
FileOutputProc, /* Output proc. */
- FileSeekProc, /* Seek proc. */
+ NULL,
NULL, /* Set option proc. */
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. */
@@ -390,7 +388,8 @@ FileBlockProc(
static int
FileCloseProc(
ClientData instanceData, /* Pointer to FileInfo structure. */
- Tcl_Interp *dummy) /* Not used. */
+ Tcl_Interp *dummy, /* Not used. */
+ int flags)
{
FileInfo *fileInfoPtr = (FileInfo *)instanceData;
FileInfo *infoPtr;
@@ -398,6 +397,10 @@ FileCloseProc(
int errorCode = 0;
(void)dummy;
+ if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
+ return EINVAL;
+ }
+
/*
* Remove the file from the watch list.
*/
@@ -446,84 +449,6 @@ FileCloseProc(
/*
*----------------------------------------------------------------------
*
- * FileSeekProc --
- *
- * Seeks on a file-based channel. Returns the new position.
- *
- * Results:
- * -1 if failed, the new position if successful. If failed, it also sets
- * *errorCodePtr to the error code.
- *
- * Side effects:
- * Moves the location at which the channel will be accessed in future
- * operations.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FileSeekProc(
- ClientData instanceData, /* File state. */
- long offset, /* Offset to seek to. */
- int mode, /* Relative to where should we seek? */
- int *errorCodePtr) /* To store error code. */
-{
- FileInfo *infoPtr = (FileInfo *)instanceData;
- LONG newPos, newPosHigh, oldPos, oldPosHigh;
- DWORD moveMethod;
-
- *errorCodePtr = 0;
- if (mode == SEEK_SET) {
- moveMethod = FILE_BEGIN;
- } else if (mode == SEEK_CUR) {
- moveMethod = FILE_CURRENT;
- } else {
- moveMethod = FILE_END;
- }
-
- /*
- * Save our current place in case we need to roll-back the seek.
- */
-
- oldPosHigh = 0;
- oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
- if (oldPos == (LONG) INVALID_SET_FILE_POINTER) {
- DWORD winError = GetLastError();
-
- if (winError != NO_ERROR) {
- TclWinConvertError(winError);
- *errorCodePtr = errno;
- return -1;
- }
- }
-
- newPosHigh = (offset < 0 ? -1 : 0);
- newPos = SetFilePointer(infoPtr->handle, offset, &newPosHigh, moveMethod);
- if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
- DWORD winError = GetLastError();
-
- if (winError != NO_ERROR) {
- TclWinConvertError(winError);
- *errorCodePtr = errno;
- return -1;
- }
- }
-
- /*
- * Check for expressability in our return type, and roll-back otherwise.
- */
-
- if (newPosHigh != 0) {
- *errorCodePtr = EOVERFLOW;
- SetFilePointer(infoPtr->handle, oldPos, &oldPosHigh, FILE_BEGIN);
- return -1;
- }
- return (int) newPos;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* FileWideSeekProc --
*
* Seeks on a file-based channel. Returns the new position.
@@ -1320,7 +1245,7 @@ TclpGetDefaultStdChannel(
if (Tcl_SetChannelOption(NULL,channel,"-translation","auto")!=TCL_OK ||
Tcl_SetChannelOption(NULL,channel,"-eofchar","\032 {}")!=TCL_OK ||
Tcl_SetChannelOption(NULL,channel,"-buffering",bufMode)!=TCL_OK) {
- Tcl_Close(NULL, channel);
+ Tcl_CloseEx(NULL, channel, 0);
return (Tcl_Channel) NULL;
}
return channel;
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index b92be89..58082d7 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. */
+ NULL, /* 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. */
@@ -537,7 +537,8 @@ ConsoleBlockModeProc(
static int
ConsoleCloseProc(
ClientData instanceData, /* Pointer to ConsoleInfo structure. */
- Tcl_Interp *dummy) /* For error reporting. */
+ Tcl_Interp *dummy, /* For error reporting. */
+ int flags)
{
ConsoleInfo *consolePtr = (ConsoleInfo *)instanceData;
int errorCode = 0;
@@ -545,6 +546,10 @@ ConsoleCloseProc(
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
* done before we can close the file, since the thread may be blocking
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 4d2b20a..d21425b 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -203,7 +203,7 @@ static void PipeThreadActionProc(ClientData instanceData,
static const Tcl_ChannelType pipeChannelType = {
"pipe", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
- TCL_CLOSE2PROC, /* Close proc. */
+ NULL, /* Close proc. */
PipeInputProc, /* Input proc. */
PipeOutputProc, /* Output proc. */
NULL, /* Seek proc. */
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index bcc7983..e529f77 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. */
+ NULL, /* 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. */
@@ -606,15 +606,19 @@ SerialBlockProc(
static int
SerialCloseProc(
ClientData instanceData, /* Pointer to SerialInfo structure. */
- Tcl_Interp *dummy) /* For error reporting. */
+ Tcl_Interp *dummy, /* 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);
(void)dummy;
- 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 c6d5501..a1eaa18 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -280,7 +280,7 @@ static Tcl_DriverGetHandleProc TcpGetHandleProc;
static const Tcl_ChannelType tcpChannelType = {
"tcp", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
- TcpCloseProc, /* Close proc. */
+ NULL, /* Close proc. */
TcpInputProc, /* Input proc. */
TcpOutputProc, /* Output proc. */
NULL, /* Seek proc. */
@@ -2108,11 +2108,11 @@ Tcl_OpenTcpClient(
statePtr, (TCL_READABLE | TCL_WRITABLE));
if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel,
"-translation", "auto crlf")) {
- Tcl_Close(NULL, statePtr->channel);
+ Tcl_CloseEx(NULL, statePtr->channel, 0);
return NULL;
} else if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel,
"-eofchar", "")) {
- Tcl_Close(NULL, statePtr->channel);
+ Tcl_CloseEx(NULL, statePtr->channel, 0);
return NULL;
}
return statePtr->channel;
@@ -2360,7 +2360,7 @@ Tcl_OpenTcpServerEx(
SendSelectMessage(tsdPtr, SELECT, statePtr);
if (Tcl_SetChannelOption(interp, statePtr->channel, "-eofchar", "")
== TCL_ERROR) {
- Tcl_Close(NULL, statePtr->channel);
+ Tcl_CloseEx(NULL, statePtr->channel, 0);
return NULL;
}
return statePtr->channel;
@@ -2433,12 +2433,12 @@ TcpAccept(
newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
"auto crlf") == TCL_ERROR) {
- Tcl_Close(NULL, newInfoPtr->channel);
+ Tcl_CloseEx(NULL, newInfoPtr->channel, 0);
return;
}
if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "")
== TCL_ERROR) {
- Tcl_Close(NULL, newInfoPtr->channel);
+ Tcl_CloseEx(NULL, newInfoPtr->channel, 0);
return;
}
generated by cgit v0.12 at 2024-11-16 07:42:46 (GMT)