summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authoroehhar <harald.oehlmann@elmicron.de>2014-05-29 14:53:45 (GMT)
committeroehhar <harald.oehlmann@elmicron.de>2014-05-29 14:53:45 (GMT)
commit99881838a7e2f2f15331858f6654beb534bfccc8 (patch)
tree9be3430887ad5943e0fe6308e10daaf21569c76a
parentb5277efde02115a99b120d3a90fb1471c6aee409 (diff)
parentd344208a62df4671dac9a66fa4589979bc68d7bb (diff)
downloadtcl-99881838a7e2f2f15331858f6654beb534bfccc8.zip
tcl-99881838a7e2f2f15331858f6654beb534bfccc8.tar.gz
tcl-99881838a7e2f2f15331858f6654beb534bfccc8.tar.bz2
merge core-8-5-branch
-rw-r--r--doc/clock.n5
-rw-r--r--doc/tclvars.n4
-rw-r--r--generic/tclBinary.c92
-rw-r--r--generic/tclClock.c39
-rw-r--r--generic/tclCmdMZ.c12
-rw-r--r--generic/tclExecute.c10
-rw-r--r--generic/tclIO.c2095
-rw-r--r--generic/tclIO.h32
-rw-r--r--generic/tclIOCmd.c32
-rw-r--r--generic/tclIOGT.c172
-rw-r--r--generic/tclIORChan.c297
-rw-r--r--generic/tclIOUtil.c86
-rw-r--r--generic/tclInt.h23
-rw-r--r--generic/tclIntPlatDecls.h8
-rw-r--r--generic/tclStringObj.c61
-rw-r--r--generic/tclStubInit.c18
-rw-r--r--generic/tclThread.c8
-rw-r--r--generic/tclThreadAlloc.c27
-rw-r--r--generic/tclUtil.c2
-rw-r--r--tests/chanio.test6
-rw-r--r--tests/clock.test9
-rw-r--r--tests/cmdAH.test3
-rw-r--r--tests/io.test276
-rw-r--r--tests/ioCmd.test107
-rw-r--r--tests/iogt.test78
-rw-r--r--tests/socket.test51
-rw-r--r--unix/Makefile.in10
-rwxr-xr-xunix/configure7
-rw-r--r--unix/configure.in1
-rw-r--r--unix/tcl.m44
-rw-r--r--unix/tcl.pc.in14
-rw-r--r--unix/tclUnixFile.c6
-rw-r--r--unix/tclUnixThrd.c1
-rw-r--r--win/tclWinFCmd.c5
-rw-r--r--win/tclWinFile.c74
-rw-r--r--win/tclWinInit.c24
-rw-r--r--win/tclWinPort.h9
-rw-r--r--win/tclWinSock.c151
38 files changed, 2195 insertions, 1664 deletions
diff --git a/doc/clock.n b/doc/clock.n
index 7c4c3df..a0cc63e 100644
--- a/doc/clock.n
+++ b/doc/clock.n
@@ -626,8 +626,9 @@ On output, produces a locale-dependent time of day representation on a
12-hour clock. On input, accepts whatever \fB%r\fR produces.
.TP
\fB%R\fR
-On output, produces a locale-dependent time of day representation on a
-24-hour clock. On input, accepts whatever \fB%R\fR produces.
+On output, the time in 24-hour notation (%H:%M). For a version
+including the seconds, see \fB%T\fR below. On input, accepts whatever
+\fB%R\fR produces.
.TP
\fB%s\fR
On output, simply formats the \fItimeVal\fR argument as a decimal
diff --git a/doc/tclvars.n b/doc/tclvars.n
index b3e1bee..84823e0 100644
--- a/doc/tclvars.n
+++ b/doc/tclvars.n
@@ -284,8 +284,8 @@ was compiled with threads enabled.
\fBuser\fR
This identifies the
current user based on the login information available on the platform.
-This comes from the USER or LOGNAME environment variable on Unix,
-and the value from GetUserName on Windows.
+This value comes from the getuid() and getpwuid() system calls on Unix,
+and the value from the GetUserName() system call on Windows.
.TP
\fBwordSize\fR
This gives the size of the native-machine word in bytes (strictly, it
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index dbb296b..68289f2 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -549,6 +549,98 @@ UpdateStringOfByteArray(
/*
*----------------------------------------------------------------------
*
+ * TclAppendBytesToByteArray --
+ *
+ * This function appends an array of bytes to a byte array object. Note
+ * that the object *must* be unshared, and the array of bytes *must not*
+ * refer to the object being appended to.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Allocates enough memory for an array of bytes of the requested total
+ * size, or possibly larger. [Bug 2992970]
+ *
+ *----------------------------------------------------------------------
+ */
+
+#define TCL_MIN_GROWTH 1024
+void
+TclAppendBytesToByteArray(
+ Tcl_Obj *objPtr,
+ const unsigned char *bytes,
+ int len)
+{
+ ByteArray *byteArrayPtr;
+ int needed;
+
+ if (Tcl_IsShared(objPtr)) {
+ Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
+ }
+ if (len < 0) {
+ Tcl_Panic("%s must be called with definite number of bytes to append",
+ "TclAppendBytesToByteArray");
+ }
+ if (len == 0) {
+ /* Append zero bytes is a no-op. */
+ return;
+ }
+ if (objPtr->typePtr != &tclByteArrayType) {
+ SetByteArrayFromAny(NULL, objPtr);
+ }
+ byteArrayPtr = GET_BYTEARRAY(objPtr);
+
+ if (len > INT_MAX - byteArrayPtr->used) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
+
+ needed = byteArrayPtr->used + len;
+ /*
+ * If we need to, resize the allocated space in the byte array.
+ */
+
+ if (needed > byteArrayPtr->allocated) {
+ ByteArray *ptr = NULL;
+ int attempt;
+
+ if (needed <= INT_MAX/2) {
+ /* Try to allocate double the total space that is needed. */
+ attempt = 2 * needed;
+ ptr = (ByteArray *) attemptckrealloc((void *) byteArrayPtr,
+ BYTEARRAY_SIZE(attempt));
+ }
+ if (ptr == NULL) {
+ /* Try to allocate double the increment that is needed (plus). */
+ unsigned int limit = INT_MAX - needed;
+ unsigned int extra = len + TCL_MIN_GROWTH;
+ int growth = (int) ((extra > limit) ? limit : extra);
+
+ attempt = needed + growth;
+ ptr = (ByteArray *) attemptckrealloc((void *) byteArrayPtr,
+ BYTEARRAY_SIZE(attempt));
+ }
+ if (ptr == NULL) {
+ /* Last chance: Try to allocate exactly what is needed. */
+ attempt = needed;
+ ptr = (ByteArray *) ckrealloc((void *)byteArrayPtr,
+ BYTEARRAY_SIZE(attempt));
+ }
+ byteArrayPtr = ptr;
+ byteArrayPtr->allocated = attempt;
+ SET_BYTEARRAY(objPtr, byteArrayPtr);
+ }
+
+ if (bytes) {
+ memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
+ }
+ byteArrayPtr->used += len;
+ TclInvalidateStringRep(objPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_BinaryObjCmd --
*
* This procedure implements the "binary" Tcl command.
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 5b95ae6..3ec94fb 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -548,19 +548,22 @@ ClockGetjuliandayfromerayearmonthdayObjCmd (
}
dict = objv[1];
if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
|| Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
&era) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR],
- &fieldPtr) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
|| TclGetIntFromObj(interp, fieldPtr, &(fields.year)) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH],
- &fieldPtr) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
|| TclGetIntFromObj(interp, fieldPtr, &(fields.month)) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH],
- &fieldPtr) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
|| TclGetIntFromObj(interp, fieldPtr,
&(fields.dayOfMonth)) != TCL_OK
|| TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
+ if (fieldPtr == NULL)
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
return TCL_ERROR;
}
fields.era = era;
@@ -639,21 +642,21 @@ ClockGetjuliandayfromerayearweekdayObjCmd (
}
dict = objv[1];
if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
|| Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
&era) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr,
- &(fields.iso8601Year)) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr,
- &(fields.iso8601Week)) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr,
- &(fields.dayOfWeek)) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
+ || TclGetIntFromObj(interp, fieldPtr, &(fields.iso8601Year)) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
+ || TclGetIntFromObj(interp, fieldPtr, &(fields.iso8601Week)) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
+ || TclGetIntFromObj(interp, fieldPtr, &(fields.dayOfWeek)) != TCL_OK
|| TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
+ if (fieldPtr == NULL)
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
return TCL_ERROR;
}
fields.era = era;
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 6fd468c..70943e9 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1345,7 +1345,7 @@ StringIndexCmd(
* Unicode string rep to get the index'th char.
*/
- if (objv[1]->typePtr == &tclByteArrayType) {
+ if (TclIsPureByteArray(objv[1])) {
const unsigned char *string =
Tcl_GetByteArrayFromObj(objv[1], &length);
@@ -2086,7 +2086,7 @@ StringRangeCmd(
* Unicode string rep to get the range.
*/
- if (objv[1]->typePtr == &tclByteArrayType) {
+ if (TclIsPureByteArray(objv[1])) {
string = Tcl_GetByteArrayFromObj(objv[1], &length);
length--;
} else {
@@ -2537,8 +2537,8 @@ StringEqualCmd(
return TCL_OK;
}
- if (!nocase && objv[0]->typePtr == &tclByteArrayType &&
- objv[1]->typePtr == &tclByteArrayType) {
+ if (!nocase && TclIsPureByteArray(objv[0]) &&
+ TclIsPureByteArray(objv[1])) {
/*
* Use binary versions of comparisons since that won't cause undue
* type conversions and it is much faster. Only do this if we're
@@ -2684,8 +2684,8 @@ StringCmpCmd(
return TCL_OK;
}
- if (!nocase && objv[0]->typePtr == &tclByteArrayType &&
- objv[1]->typePtr == &tclByteArrayType) {
+ if (!nocase && TclIsPureByteArray(objv[0]) &&
+ TclIsPureByteArray(objv[1])) {
/*
* Use binary versions of comparisons since that won't cause undue
* type conversions and it is much faster. Only do this if we're
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 2e396e8..c4f9836 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4235,8 +4235,8 @@ TclExecuteByteCode(
*/
iResult = s1len = s2len = 0;
- } else if ((valuePtr->typePtr == &tclByteArrayType)
- && (value2Ptr->typePtr == &tclByteArrayType)) {
+ } else if (TclIsPureByteArray(valuePtr)
+ && TclIsPureByteArray(value2Ptr)) {
s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
iResult = memcmp(s1, s2,
@@ -4354,7 +4354,7 @@ TclExecuteByteCode(
* use the Unicode string rep to get the index'th char.
*/
- if (valuePtr->typePtr == &tclByteArrayType) {
+ if (TclIsPureByteArray(valuePtr)) {
bytes = (char *)Tcl_GetByteArrayFromObj(valuePtr, &length);
} else {
/*
@@ -4370,7 +4370,7 @@ TclExecuteByteCode(
}
if ((index >= 0) && (index < length)) {
- if (valuePtr->typePtr == &tclByteArrayType) {
+ if (TclIsPureByteArray(valuePtr)) {
objResultPtr = Tcl_NewByteArrayObj((unsigned char *)
(&bytes[index]), 1);
} else if (valuePtr->bytes && length == valuePtr->length) {
@@ -4422,7 +4422,7 @@ TclExecuteByteCode(
ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
match = TclUniCharMatch(ustring1, length1, ustring2, length2,
nocase);
- } else if ((valuePtr->typePtr == &tclByteArrayType) && !nocase) {
+ } else if (TclIsPureByteArray(valuePtr) && !nocase) {
unsigned char *string1, *string2;
int length1, length2;
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 3636861..0716074 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -6,6 +6,7 @@
*
* Copyright (c) 1998-2000 Ajuba Solutions
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Contributions from Don Porter, NIST, 2014. (not subject to US copyright)
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -162,7 +163,11 @@ typedef struct CloseCallback {
*/
static ChannelBuffer * AllocChannelBuffer(int length);
+static void PreserveChannelBuffer(ChannelBuffer *bufPtr);
+static void ReleaseChannelBuffer(ChannelBuffer *bufPtr);
+static int IsShared(ChannelBuffer *bufPtr);
static void ChannelTimerProc(ClientData clientData);
+static int ChanRead(Channel *chanPtr, char *dst, int dstSize);
static int CheckChannelErrors(ChannelState *statePtr,
int direction);
static int CheckForDeadChannel(Tcl_Interp *interp,
@@ -173,8 +178,6 @@ static void CleanupChannelHandlers(Tcl_Interp *interp,
static int CloseChannel(Tcl_Interp *interp, Channel *chanPtr,
int errorCode);
static void CommonGetsCleanup(Channel *chanPtr);
-static int CopyAndTranslateBuffer(ChannelState *statePtr,
- char *result, int space);
static int CopyBuffer(Channel *chanPtr, char *result, int space);
static int CopyData(CopyState *csPtr, int mask);
static void CopyEventProc(ClientData clientData, int mask);
@@ -188,7 +191,7 @@ static int DetachChannel(Tcl_Interp *interp, Tcl_Channel chan);
static void DiscardInputQueued(ChannelState *statePtr,
int discardSavedBuffers);
static void DiscardOutputQueued(ChannelState *chanPtr);
-static int DoRead(Channel *chanPtr, char *srcPtr, int slen);
+static int DoRead(Channel *chanPtr, char *dst, int bytesToRead);
static int DoReadChars(Channel *chan, Tcl_Obj *objPtr, int toRead,
int appendFlag);
static int FilterInputBytes(Channel *chanPtr,
@@ -205,16 +208,16 @@ static int HaveVersion(const Tcl_ChannelType *typePtr,
static void PeekAhead(Channel *chanPtr, char **dstEndPtr,
GetsState *gsPtr);
static int ReadBytes(ChannelState *statePtr, Tcl_Obj *objPtr,
- int charsLeft, int *offsetPtr);
+ int charsLeft);
static int ReadChars(ChannelState *statePtr, Tcl_Obj *objPtr,
- int charsLeft, int *offsetPtr, int *factorPtr);
+ int charsLeft, int *factorPtr);
static void RecycleBuffer(ChannelState *statePtr,
ChannelBuffer *bufPtr, int mustDiscard);
static int StackSetBlockMode(Channel *chanPtr, int mode);
static int SetBlockMode(Tcl_Interp *interp, Channel *chanPtr,
int mode);
static void StopCopy(CopyState *csPtr);
-static int TranslateInputEOL(ChannelState *statePtr, char *dst,
+static void TranslateInputEOL(ChannelState *statePtr, char *dst,
const char *src, int *dstLenPtr, int *srcLenPtr);
static void UpdateInterest(Channel *chanPtr);
static int Write(Channel *chanPtr, const char *src,
@@ -281,7 +284,7 @@ static int WillRead(Channel *chanPtr);
#define IsBufferEmpty(bufPtr) ((bufPtr)->nextAdded == (bufPtr)->nextRemoved)
-#define IsBufferFull(bufPtr) ((bufPtr)->nextAdded >= (bufPtr)->bufLength)
+#define IsBufferFull(bufPtr) ((bufPtr) && (bufPtr)->nextAdded >= (bufPtr)->bufLength)
#define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded > (bufPtr)->bufLength)
@@ -295,6 +298,7 @@ static int WillRead(Channel *chanPtr);
#define SetFlag(statePtr, flag) ((statePtr)->flags |= (flag))
#define ResetFlag(statePtr, flag) ((statePtr)->flags &= ~(flag))
+#define GotFlag(statePtr, flag) ((statePtr)->flags & (flag))
/*
* Macro for testing whether a string (in optionName, length len) matches a
@@ -342,21 +346,78 @@ static Tcl_ObjType chanObjType = {
#define MAX_CHANNEL_BUFFER_SIZE (1024*1024)
/*
- * ChanRead, dropped here by a time traveler, see 8.6
+ *---------------------------------------------------------------------------
+ *
+ * ChanRead --
+ *
+ * Read up to dstSize bytes using the inputProc of chanPtr, store
+ * them at dst, and return the number of bytes stored.
+ *
+ * Results:
+ * The return value of the driver inputProc,
+ * - number of bytes stored at dst, ot
+ * - -1 on error, with a Posix error code available to the
+ * caller by calling Tcl_GetErrno().
+ *
+ * Side effects:
+ * The CHANNEL_BLOCKED and CHANNEL_EOF flags of the channel state are
+ * set as appropriate.
+ * On EOF, the inputEncodingFlags are set to perform ending operations
+ * on decoding.
+ * TODO - Is this really the right place for that?
+ *
+ *---------------------------------------------------------------------------
*/
-static inline int
+static int
ChanRead(
Channel *chanPtr,
char *dst,
- int dstSize,
- int *errnoPtr)
+ int dstSize)
{
+ int bytesRead, result;
+
+ /*
+ * If the caller asked for zero bytes, we'd force the inputProc
+ * to return zero bytes, and then misinterpret that as EOF.
+ */
+ assert(dstSize > 0);
+
+ /*
+ * Each read op must set the blocked and eof states anew, not let
+ * the effect of prior reads leak through.
+ */
+ ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
if (WillRead(chanPtr) < 0) {
return -1;
}
- return chanPtr->typePtr->inputProc(chanPtr->instanceData, dst, dstSize,
- errnoPtr);
+ bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData,
+ dst, dstSize, &result);
+
+ /* Stop any flag leakage through stacked channel levels */
+ ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
+ if (bytesRead > 0) {
+ /*
+ * If we get a short read, signal up that we may be BLOCKED.
+ * We should avoid calling the driver because on some
+ * platforms we will block in the low level reading code even
+ * though the channel is set into nonblocking mode.
+ */
+
+ if (bytesRead < dstSize) {
+ SetFlag(chanPtr->state, CHANNEL_BLOCKED);
+ }
+ } else if (bytesRead == 0) {
+ SetFlag(chanPtr->state, CHANNEL_EOF);
+ chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END;
+ } else if (bytesRead < 0) {
+ if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
+ SetFlag(chanPtr->state, CHANNEL_BLOCKED);
+ result = EAGAIN;
+ }
+ Tcl_SetErrno(result);
+ }
+ return bytesRead;
}
static inline Tcl_WideInt
@@ -459,7 +520,7 @@ TclFinalizeIOSubsystem(void)
statePtr != NULL;
statePtr = statePtr->nextCSPtr) {
chanPtr = statePtr->topChanPtr;
- if (!(statePtr->flags & (CHANNEL_INCLOSE|CHANNEL_CLOSED|CHANNEL_DEAD))) {
+ if (!GotFlag(statePtr, CHANNEL_INCLOSE|CHANNEL_CLOSED|CHANNEL_DEAD)) {
active = 1;
break;
}
@@ -556,6 +617,7 @@ Tcl_SetStdChannel(
int type) /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
switch (type) {
case TCL_STDIN:
tsdPtr->stdinInitialized = 1;
@@ -672,11 +734,9 @@ Tcl_CreateCloseHandler(
ClientData clientData) /* Arbitrary data to pass to the close
* callback. */
{
- ChannelState *statePtr;
+ ChannelState *statePtr = ((Channel *) chan)->state;
CloseCallback *cbPtr;
- statePtr = ((Channel *) chan)->state;
-
cbPtr = (CloseCallback *) ckalloc(sizeof(CloseCallback));
cbPtr->proc = proc;
cbPtr->clientData = clientData;
@@ -712,10 +772,9 @@ Tcl_DeleteCloseHandler(
ClientData clientData) /* The callback data for the callback to
* remove. */
{
- ChannelState *statePtr;
+ ChannelState *statePtr = ((Channel *) chan)->state;
CloseCallback *cbPtr, *cbPrevPtr;
- statePtr = ((Channel *) chan)->state;
for (cbPtr = statePtr->closeCbPtr, cbPrevPtr = NULL;
cbPtr != NULL; cbPtr = cbPtr->nextPtr) {
if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
@@ -869,7 +928,7 @@ DeleteChannelTable(
SetFlag(statePtr, CHANNEL_TAINTED);
statePtr->refCount--;
if (statePtr->refCount <= 0) {
- if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+ if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
}
}
@@ -1060,7 +1119,7 @@ Tcl_UnregisterChannel(
statePtr = ((Channel *) chan)->state->bottomChanPtr->state;
- if (statePtr->flags & CHANNEL_INCLOSE) {
+ if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
if (interp != NULL) {
Tcl_AppendResult(interp, "Illegal recursive call to close "
"through close-handler of channel", NULL);
@@ -1089,22 +1148,13 @@ Tcl_UnregisterChannel(
*/
if (statePtr->refCount <= 0) {
- /*
- * Ensure that if there is another buffer, it gets flushed whether or
- * not we are doing a background flush.
- */
-
- if ((statePtr->curOutPtr != NULL) &&
- IsBufferReady(statePtr->curOutPtr)) {
- SetFlag(statePtr, BUFFER_READY);
- }
Tcl_Preserve((ClientData)statePtr);
- if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+ if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
/*
* We don't want to re-enter Tcl_Close().
*/
- if (!(statePtr->flags & CHANNEL_CLOSED)) {
+ if (!GotFlag(statePtr, CHANNEL_CLOSED)) {
if (Tcl_Close(interp, chan) != TCL_OK) {
SetFlag(statePtr, CHANNEL_CLOSED);
Tcl_Release((ClientData)statePtr);
@@ -1313,7 +1363,7 @@ Tcl_GetChannel(
chanPtr = Tcl_GetHashValue(hPtr);
chanPtr = chanPtr->state->bottomChanPtr;
if (modePtr != NULL) {
- *modePtr = (chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE));
+ *modePtr = GotFlag(chanPtr->state, TCL_READABLE|TCL_WRITABLE);
}
return (Tcl_Channel) chanPtr;
@@ -1361,7 +1411,7 @@ TclGetChannelFromObj(
*channelPtr = (Tcl_Channel) (statePtr->bottomChanPtr);
if (modePtr != NULL) {
- *modePtr = (statePtr->flags & (TCL_READABLE|TCL_WRITABLE));
+ *modePtr = GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE);
}
return TCL_OK;
@@ -1624,7 +1674,7 @@ Tcl_StackChannel(
* --+---+---+---+----+
*/
- if ((mask & (statePtr->flags & (TCL_READABLE | TCL_WRITABLE))) == 0) {
+ if ((mask & (GotFlag(statePtr, TCL_READABLE | TCL_WRITABLE))) == 0) {
if (interp) {
Tcl_AppendResult(interp,
"reading and writing both disallowed for channel \"",
@@ -1641,15 +1691,16 @@ Tcl_StackChannel(
*/
if ((mask & TCL_WRITABLE) != 0) {
- CopyState *csPtrR;
- CopyState *csPtrW;
+ CopyState *csPtrR = statePtr->csPtrR;
+ CopyState *csPtrW = statePtr->csPtrW;
- csPtrR = statePtr->csPtrR;
statePtr->csPtrR = NULL;
-
- csPtrW = statePtr->csPtrW;
statePtr->csPtrW = NULL;
+ /*
+ * TODO: Examine what can go wrong if Tcl_Flush() call disturbs
+ * the stacking state of this channel during its operations.
+ */
if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
statePtr->csPtrR = csPtrR;
statePtr->csPtrW = csPtrW;
@@ -1680,17 +1731,17 @@ Tcl_StackChannel(
*/
if (((mask & TCL_READABLE) != 0) && (statePtr->inQueueHead != NULL)) {
+
/*
- * Remark: It is possible that the channel buffers contain data from
- * some earlier push-backs.
+ * When statePtr->inQueueHead is not NULL, we know
+ * prevChanPtr->inQueueHead must be NULL.
*/
- statePtr->inQueueTail->nextPtr = prevChanPtr->inQueueHead;
- prevChanPtr->inQueueHead = statePtr->inQueueHead;
+ assert(prevChanPtr->inQueueHead == NULL);
+ assert(prevChanPtr->inQueueTail == NULL);
- if (prevChanPtr->inQueueTail == NULL) {
- prevChanPtr->inQueueTail = statePtr->inQueueTail;
- }
+ prevChanPtr->inQueueHead = statePtr->inQueueHead;
+ prevChanPtr->inQueueTail = statePtr->inQueueTail;
statePtr->inQueueHead = NULL;
statePtr->inQueueTail = NULL;
@@ -1782,6 +1833,13 @@ Tcl_UnstackChannel(
* structure.
*/
+ /*
+ * TODO: Figure out how to handle the situation where the chan
+ * operations called below by this unstacking operation cause
+ * another unstacking recursively. In that case the downChanPtr
+ * value we're holding on to will not be the right thing.
+ */
+
Channel *downChanPtr = chanPtr->downChanPtr;
/*
@@ -1792,14 +1850,11 @@ Tcl_UnstackChannel(
* CheckForChannelErrors inside.
*/
- if (statePtr->flags & TCL_WRITABLE) {
- CopyState *csPtrR;
- CopyState *csPtrW;
+ if (GotFlag(statePtr, TCL_WRITABLE)) {
+ CopyState *csPtrR = statePtr->csPtrR;
+ CopyState *csPtrW = statePtr->csPtrW;
- csPtrR = statePtr->csPtrR;
statePtr->csPtrR = NULL;
-
- csPtrW = statePtr->csPtrW;
statePtr->csPtrW = NULL;
if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) {
@@ -1836,16 +1891,14 @@ Tcl_UnstackChannel(
* 'DiscardInputQueued' on that.
*/
- if ((((statePtr->flags & TCL_READABLE) != 0)) &&
+ if (GotFlag(statePtr, TCL_READABLE) &&
((statePtr->inQueueHead != NULL) ||
(chanPtr->inQueueHead != NULL))) {
-
if ((statePtr->inQueueHead != NULL) &&
(chanPtr->inQueueHead != NULL)) {
statePtr->inQueueTail->nextPtr = chanPtr->inQueueHead;
statePtr->inQueueTail = chanPtr->inQueueTail;
statePtr->inQueueHead = statePtr->inQueueTail;
-
} else if (chanPtr->inQueueHead != NULL) {
statePtr->inQueueHead = chanPtr->inQueueHead;
statePtr->inQueueTail = chanPtr->inQueueTail;
@@ -1902,7 +1955,7 @@ Tcl_UnstackChannel(
*/
Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
- UpdateInterest(downChanPtr);
+ UpdateInterest(statePtr->topChanPtr);
if (result != 0) {
Tcl_SetErrno(result);
@@ -2105,7 +2158,7 @@ Tcl_GetChannelMode(
ChannelState *statePtr = ((Channel *) chan)->state;
/* State of actual channel. */
- return (statePtr->flags & (TCL_READABLE | TCL_WRITABLE));
+ return GotFlag(statePtr, TCL_READABLE | TCL_WRITABLE);
}
/*
@@ -2216,8 +2269,33 @@ AllocChannelBuffer(
bufPtr->nextRemoved = BUFFER_PADDING;
bufPtr->bufLength = length + BUFFER_PADDING;
bufPtr->nextPtr = NULL;
+ bufPtr->refCount = 1;
return bufPtr;
}
+
+static void
+PreserveChannelBuffer(
+ ChannelBuffer *bufPtr)
+{
+ bufPtr->refCount++;
+}
+
+static void
+ReleaseChannelBuffer(
+ ChannelBuffer *bufPtr)
+{
+ if (--bufPtr->refCount) {
+ return;
+ }
+ ckfree((char *) bufPtr);
+}
+
+static int
+IsShared(
+ ChannelBuffer *bufPtr)
+{
+ return bufPtr->refCount > 1;
+}
/*
*----------------------------------------------------------------------
@@ -2248,20 +2326,23 @@ RecycleBuffer(
/*
* Do we have to free the buffer to the OS?
*/
+ if (IsShared(bufPtr)) {
+ mustDiscard = 1;
+ }
if (mustDiscard) {
- ckfree((char *) bufPtr);
+ ReleaseChannelBuffer(bufPtr);
return;
}
/*
- * Only save buffers which are at least as big as the requested buffersize
- * for the channel. This is to honor dynamic changes of the buffersize
+ * Only save buffers which have the requested buffersize for the
+ * channel. This is to honor dynamic changes of the buffersize
* made by the user.
*/
- if ((bufPtr->bufLength - BUFFER_PADDING) < statePtr->bufSize) {
- ckfree((char *) bufPtr);
+ if ((bufPtr->bufLength - BUFFER_PADDING) != statePtr->bufSize) {
+ ReleaseChannelBuffer(bufPtr);
return;
}
@@ -2269,7 +2350,7 @@ RecycleBuffer(
* Only save buffers for the input queue if the channel is readable.
*/
- if (statePtr->flags & TCL_READABLE) {
+ if (GotFlag(statePtr, TCL_READABLE)) {
if (statePtr->inQueueHead == NULL) {
statePtr->inQueueHead = bufPtr;
statePtr->inQueueTail = bufPtr;
@@ -2285,7 +2366,7 @@ RecycleBuffer(
* Only save buffers for the output queue if the channel is writable.
*/
- if (statePtr->flags & TCL_WRITABLE) {
+ if (GotFlag(statePtr, TCL_WRITABLE)) {
if (statePtr->curOutPtr == NULL) {
statePtr->curOutPtr = bufPtr;
goto keepBuffer;
@@ -2296,7 +2377,7 @@ RecycleBuffer(
* If we reached this code we return the buffer to the OS.
*/
- ckfree((char *) bufPtr);
+ ReleaseChannelBuffer(bufPtr);
return;
keepBuffer:
@@ -2358,7 +2439,7 @@ CheckForDeadChannel(
Tcl_Interp *interp, /* For error reporting (can be NULL) */
ChannelState *statePtr) /* The channel state to check. */
{
- if (statePtr->flags & CHANNEL_DEAD) {
+ if (GotFlag(statePtr, CHANNEL_DEAD)) {
Tcl_SetErrno(EINVAL);
if (interp) {
Tcl_AppendResult(interp,
@@ -2400,8 +2481,6 @@ FlushChannel(
ChannelState *statePtr = chanPtr->state;
/* State of the channel stack. */
ChannelBuffer *bufPtr; /* Iterates over buffered output queue. */
- int toWrite; /* Amount of output data in current buffer
- * available to be written. */
int written; /* Amount of output data actually written in
* current round. */
int errorCode = 0; /* Stores POSIX error codes from channel
@@ -2421,62 +2500,57 @@ FlushChannel(
}
/*
- * Loop over the queued buffers and attempt to flush as much as possible
- * of the queued output to the channel.
+ * Should we shift the current output buffer over to the output queue?
+ * First check that there are bytes in it. If so then...
+ * If the output queue is empty, then yes, trusting the caller called
+ * us only when written bytes ought to be flushed.
+ * If the current output buffer is full, then yes, so we can meet
+ * the post-condition that on a successful return to caller we've
+ * left space in the current output buffer for more writing (the flush
+ * call was to make new room).
+ * Otherwise, no. Keep the current output buffer where it is so more
+ * can be written to it, possibly filling it, to promote more efficient
+ * buffer usage.
*/
- while (1) {
- /*
- * If the queue is empty and there is a ready current buffer, OR if
- * the current buffer is full, then move the current buffer to the
- * queue.
- */
-
- if (((statePtr->curOutPtr != NULL) &&
- IsBufferFull(statePtr->curOutPtr))
- || ((statePtr->flags & BUFFER_READY) &&
- (statePtr->outQueueHead == NULL))) {
- ResetFlag(statePtr, BUFFER_READY);
- statePtr->curOutPtr->nextPtr = NULL;
- if (statePtr->outQueueHead == NULL) {
- statePtr->outQueueHead = statePtr->curOutPtr;
- } else {
- statePtr->outQueueTail->nextPtr = statePtr->curOutPtr;
- }
- statePtr->outQueueTail = statePtr->curOutPtr;
- statePtr->curOutPtr = NULL;
+ bufPtr = statePtr->curOutPtr;
+ if (bufPtr && BytesLeft(bufPtr) && /* Keep empties off queue */
+ (statePtr->outQueueHead == NULL || IsBufferFull(bufPtr))) {
+ if (statePtr->outQueueHead == NULL) {
+ statePtr->outQueueHead = bufPtr;
+ } else {
+ statePtr->outQueueTail->nextPtr = bufPtr;
}
- bufPtr = statePtr->outQueueHead;
+ statePtr->outQueueTail = bufPtr;
+ statePtr->curOutPtr = NULL;
+ }
- /*
- * If we are not being called from an async flush and an async flush
- * is active, we just return without producing any output.
- */
+ assert(!IsBufferFull(statePtr->curOutPtr));
- if ((!calledFromAsyncFlush) &&
- (statePtr->flags & BG_FLUSH_SCHEDULED)) {
- return 0;
- }
+ /*
+ * If we are not being called from an async flush and an async flush
+ * is active, we just return without producing any output.
+ */
- /*
- * If the output queue is still empty, break out of the while loop.
- */
+ if (!calledFromAsyncFlush && GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
+ return 0;
+ }
- if (bufPtr == NULL) {
- break; /* Out of the "while (1)". */
- }
+ /*
+ * Loop over the queued buffers and attempt to flush as much as possible
+ * of the queued output to the channel.
+ */
+
+ while (statePtr->outQueueHead) {
+ bufPtr = statePtr->outQueueHead;
/*
* Produce the output on the channel.
*/
- toWrite = BytesLeft(bufPtr);
- if (toWrite == 0) {
- written = 0;
- } else {
- written = (chanPtr->typePtr->outputProc)(chanPtr->instanceData,
- RemovePoint(bufPtr), toWrite, &errorCode);
- }
+ PreserveChannelBuffer(bufPtr);
+ written = (chanPtr->typePtr->outputProc)(chanPtr->instanceData,
+ RemovePoint(bufPtr), BytesLeft(bufPtr), &errorCode);
/*
* If the write failed completely attempt to start the asynchronous
@@ -2491,6 +2565,7 @@ FlushChannel(
if (errorCode == EINTR) {
errorCode = 0;
+ ReleaseChannelBuffer(bufPtr);
continue;
}
@@ -2507,11 +2582,12 @@ FlushChannel(
* it's a tty channel (dup'ed underneath)
*/
- if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+ if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
SetFlag(statePtr, BG_FLUSH_SCHEDULED);
UpdateInterest(chanPtr);
}
errorCode = 0;
+ ReleaseChannelBuffer(bufPtr);
break;
}
@@ -2579,8 +2655,11 @@ FlushChannel(
*/
DiscardOutputQueued(statePtr);
- continue;
+ ReleaseChannelBuffer(bufPtr);
+ break;
} else {
+ /* TODO: Consider detecting and reacting to short writes
+ * on blocking channels. Ought not happen. See iocmd-24.2. */
wroteSome = 1;
}
@@ -2597,7 +2676,8 @@ FlushChannel(
}
RecycleBuffer(statePtr, bufPtr, 0);
}
- } /* Closes "while (1)". */
+ ReleaseChannelBuffer(bufPtr);
+ } /* Closes "while". */
/*
* If we wrote some data while flushing in the background, we are done.
@@ -2606,13 +2686,19 @@ FlushChannel(
* data has been flushed at the system level.
*/
- if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+ if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
if (wroteSome) {
return errorCode;
} else if (statePtr->outQueueHead == NULL) {
ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
(chanPtr->typePtr->watchProc)(chanPtr->instanceData,
statePtr->interestMask);
+ } else {
+ /* TODO: If code reaches this point, it means a writable
+ * event is being handled on the channel, but the channel
+ * could not in fact be written to. This ought not happen,
+ * but Unix pipes appear to act this way (see io-53.4).
+ * Also can imagine broken reflected channels. */
}
}
@@ -2622,7 +2708,7 @@ FlushChannel(
* current output buffer.
*/
- if ((statePtr->flags & CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
+ if (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
(statePtr->outQueueHead == NULL) &&
((statePtr->curOutPtr == NULL) ||
IsBufferEmpty(statePtr->curOutPtr))) {
@@ -2681,7 +2767,7 @@ CloseChannel(
*/
if (statePtr->curOutPtr != NULL) {
- ckfree((char *) statePtr->curOutPtr);
+ ReleaseChannelBuffer(statePtr->curOutPtr);
statePtr->curOutPtr = NULL;
}
@@ -2698,7 +2784,7 @@ CloseChannel(
* device.
*/
- if ((statePtr->outEofChar != 0) && (statePtr->flags & TCL_WRITABLE)) {
+ if ((statePtr->outEofChar != 0) && GotFlag(statePtr, TCL_WRITABLE)) {
int dummy;
char c = (char) statePtr->outEofChar;
@@ -3103,7 +3189,7 @@ Tcl_Close(
Tcl_Panic("called Tcl_Close on channel with refCount > 0");
}
- if (statePtr->flags & CHANNEL_INCLOSE) {
+ if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
if (interp) {
Tcl_AppendResult(interp, "Illegal recursive call to close "
"through close-handler of channel", NULL);
@@ -3119,7 +3205,8 @@ Tcl_Close(
stickyError = 0;
- if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
+ if ((statePtr->encoding != NULL)
+ && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)
&& (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
statePtr->outputEncodingFlags |= TCL_ENCODING_END;
if (WriteChars(chanPtr, "", 0) < 0) {
@@ -3157,14 +3244,6 @@ Tcl_Close(
ResetFlag(statePtr, CHANNEL_INCLOSE);
/*
- * Ensure that the last output buffer will be flushed.
- */
-
- if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
- SetFlag(statePtr, BUFFER_READY);
- }
-
- /*
* If this channel supports it, close the read side, since we don't need
* it anymore and this will help avoid deadlocks on some channel types.
*/
@@ -3209,7 +3288,17 @@ Tcl_Close(
Tcl_SetObjResult(interp,
Tcl_NewStringObj(Tcl_PosixError(interp), -1));
}
- flushcode = -1;
+ return TCL_ERROR;
+ }
+ /*
+ * Bug 97069ea11a: set error message if a flush code is set and no error
+ * message set up to now.
+ */
+ if (flushcode != 0 && interp != NULL
+ && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp)) ) {
+ Tcl_SetErrno(flushcode);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(Tcl_PosixError(interp), -1));
}
if ((flushcode != 0) || (result != 0)) {
return TCL_ERROR;
@@ -3556,12 +3645,25 @@ static void WillWrite(Channel *chanPtr)
static int WillRead(Channel *chanPtr)
{
+ if (chanPtr->typePtr == NULL) {
+ /* Prevent read attempts on a closed channel */
+ DiscardInputQueued(chanPtr->state, 0);
+ Tcl_SetErrno(EINVAL);
+ return -1;
+ }
if ((chanPtr->typePtr->seekProc != NULL)
&& (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
- if ((chanPtr->state->curOutPtr != NULL)
- && IsBufferReady(chanPtr->state->curOutPtr)) {
- SetFlag(chanPtr->state, BUFFER_READY);
- }
+
+ /*
+ * CAVEAT - The assumption here is that FlushChannel() will
+ * push out the bytes of any writes that are in progress.
+ * Since this is a seekable channel, we assume it is not one
+ * that can block and force bg flushing. Channels we know that
+ * can do that -- sockets, pipes -- are not seekable. If the
+ * assumption is wrong, more drastic measures may be required here
+ * like temporarily setting the channel into blocking mode.
+ */
+
if (FlushChannel(NULL, chanPtr, 0) != 0) {
return -1;
}
@@ -3612,7 +3714,7 @@ Write(
endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);
- if ((statePtr->flags & CHANNEL_LINEBUFFERED)
+ if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)
|| (statePtr->outputTranslation != TCL_TRANSLATE_LF)) {
nextNewLine = memchr(src, '\n', srcLen);
}
@@ -3642,6 +3744,7 @@ Write(
bufPtr->nextAdded += saved;
saved = 0;
}
+ PreserveChannelBuffer(bufPtr);
dst = InsertPoint(bufPtr);
dstLen = SpaceLeft(bufPtr);
@@ -3655,6 +3758,7 @@ Write(
if ((result != TCL_OK) && (srcRead + dstWrote == 0)) {
/* We're reading from invalid/incomplete UTF-8 */
+ ReleaseChannelBuffer(bufPtr);
if (total == 0) {
Tcl_SetErrno(EINVAL);
return -1;
@@ -3697,9 +3801,7 @@ Write(
&statePtr->outputEncodingState, dst,
dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL);
- if (srcRead != nlLen) {
- Tcl_Panic("Can This Happen?");
- }
+ assert (srcRead == nlLen);
bufPtr->nextAdded += dstWrote;
src++;
@@ -3731,6 +3833,7 @@ Write(
if (IsBufferFull(bufPtr)) {
if (FlushChannel(NULL, chanPtr, 0) != 0) {
+ ReleaseChannelBuffer(bufPtr);
return -1;
}
flushed += statePtr->bufSize;
@@ -3738,10 +3841,10 @@ Write(
needNlFlush = 0;
}
}
+ ReleaseChannelBuffer(bufPtr);
}
- if ((flushed < total) && (statePtr->flags & CHANNEL_UNBUFFERED ||
- (needNlFlush && statePtr->flags & CHANNEL_LINEBUFFERED))) {
- SetFlag(statePtr, BUFFER_READY);
+ if ((flushed < total) && (GotFlag(statePtr, CHANNEL_UNBUFFERED) ||
+ (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED)))) {
if (FlushChannel(NULL, chanPtr, 0) != 0) {
return -1;
}
@@ -3852,6 +3955,7 @@ Tcl_GetsObj(
*/
chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
bufPtr = statePtr->inQueueHead;
encoding = statePtr->encoding;
@@ -3984,7 +4088,7 @@ Tcl_GetsObj(
case TCL_TRANSLATE_AUTO:
eol = dst;
skip = 1;
- if (statePtr->flags & INPUT_SAW_CR) {
+ if (GotFlag(statePtr, INPUT_SAW_CR)) {
ResetFlag(statePtr, INPUT_SAW_CR);
if ((eol < dstEnd) && (*eol == '\n')) {
/*
@@ -4052,7 +4156,7 @@ Tcl_GetsObj(
SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
}
- if (statePtr->flags & CHANNEL_EOF) {
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
skip = 0;
eol = dstEnd;
if (eol == objPtr->bytes + oldLength) {
@@ -4064,6 +4168,7 @@ Tcl_GetsObj(
Tcl_SetObjLength(objPtr, oldLength);
CommonGetsCleanup(chanPtr);
copiedTotal = -1;
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
goto done;
}
goto gotEOL;
@@ -4080,6 +4185,17 @@ Tcl_GetsObj(
*/
gotEOL:
+ /*
+ * Regenerate the top channel, in case it was changed due to
+ * self-modifying reflected transforms.
+ */
+
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_Release(chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
+ }
+
bufPtr = gs.bufPtr;
if (bufPtr == NULL) {
Tcl_Panic("Tcl_GetsObj: gotEOL reached with bufPtr==NULL");
@@ -4108,13 +4224,22 @@ Tcl_GetsObj(
*/
restore:
+ /*
+ * Regenerate the top channel, in case it was changed due to
+ * self-modifying reflected transforms.
+ */
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_Release(chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
+ }
bufPtr = statePtr->inQueueHead;
- if (bufPtr == NULL) {
- Tcl_Panic("Tcl_GetsObj: restore reached with bufPtr==NULL");
+ if (bufPtr != NULL) {
+ bufPtr->nextRemoved = oldRemoved;
+ bufPtr = bufPtr->nextPtr;
}
- bufPtr->nextRemoved = oldRemoved;
- for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
+ for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
bufPtr->nextRemoved = BUFFER_PADDING;
}
CommonGetsCleanup(chanPtr);
@@ -4143,7 +4268,17 @@ Tcl_GetsObj(
*/
done:
+ /*
+ * Regenerate the top channel, in case it was changed due to
+ * self-modifying reflected transforms.
+ */
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_Release(chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
+ }
UpdateInterest(chanPtr);
+ Tcl_Release(chanPtr);
return copiedTotal;
}
@@ -4189,6 +4324,7 @@ TclGetsObjBinary(
*/
chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
bufPtr = statePtr->inQueueHead;
@@ -4232,16 +4368,17 @@ TclGetsObjBinary(
* device. Side effect is to allocate another channel buffer.
*/
- if (statePtr->flags & CHANNEL_BLOCKED) {
- if (statePtr->flags & CHANNEL_NONBLOCKING) {
- goto restore;
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED);
+ if (GotFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_NONBLOCKING)
+ == (CHANNEL_BLOCKED|CHANNEL_NONBLOCKING)) {
+ goto restore;
}
if (GetInput(chanPtr) != 0) {
goto restore;
}
bufPtr = statePtr->inQueueTail;
+ if (bufPtr == NULL) {
+ goto restore;
+ }
}
dst = (unsigned char *) RemovePoint(bufPtr);
@@ -4284,7 +4421,7 @@ TclGetsObjBinary(
SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
}
- if (statePtr->flags & CHANNEL_EOF) {
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
skip = 0;
eol = dstEnd;
if ((dst == dstEnd) && (byteLen == oldLength)) {
@@ -4296,6 +4433,7 @@ TclGetsObjBinary(
byteArray = Tcl_SetByteArrayLength(objPtr, oldLength);
CommonGetsCleanup(chanPtr);
copiedTotal = -1;
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
goto done;
}
goto gotEOL;
@@ -4354,12 +4492,12 @@ TclGetsObjBinary(
restore:
bufPtr = statePtr->inQueueHead;
- if (bufPtr == NULL) {
- Tcl_Panic("TclGetsObjBinary: restore reached with bufPtr==NULL");
+ if (bufPtr) {
+ bufPtr->nextRemoved = oldRemoved;
+ bufPtr = bufPtr->nextPtr;
}
- bufPtr->nextRemoved = oldRemoved;
- for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
+ for ( ; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
bufPtr->nextRemoved = BUFFER_PADDING;
}
CommonGetsCleanup(chanPtr);
@@ -4388,6 +4526,7 @@ TclGetsObjBinary(
done:
UpdateInterest(chanPtr);
+ Tcl_Release(chanPtr);
return copiedTotal;
}
@@ -4464,7 +4603,7 @@ FilterInputBytes(
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
ChannelBuffer *bufPtr;
- char *raw, *rawStart, *dst;
+ char *raw, *dst;
int offset, toRead, dstNeeded, spaceLeft, result, rawLen;
Tcl_Obj *objPtr;
#define ENCODING_LINESIZE 20 /* Lower bound on how many bytes to convert at
@@ -4498,14 +4637,6 @@ FilterInputBytes(
*/
read:
- if (statePtr->flags & CHANNEL_BLOCKED) {
- if (statePtr->flags & CHANNEL_NONBLOCKING) {
- gsPtr->charsWrote = 0;
- gsPtr->rawRead = 0;
- return -1;
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED);
- }
if (GetInput(chanPtr) != 0) {
gsPtr->charsWrote = 0;
gsPtr->rawRead = 0;
@@ -4513,6 +4644,11 @@ FilterInputBytes(
}
bufPtr = statePtr->inQueueTail;
gsPtr->bufPtr = bufPtr;
+ if (bufPtr == NULL) {
+ gsPtr->charsWrote = 0;
+ gsPtr->rawRead = 0;
+ return -1;
+ }
}
/*
@@ -4521,8 +4657,7 @@ FilterInputBytes(
* string rep if we need more space.
*/
- rawStart = RemovePoint(bufPtr);
- raw = rawStart;
+ raw = RemovePoint(bufPtr);
rawLen = BytesLeft(bufPtr);
dst = *gsPtr->dstPtr;
@@ -4579,7 +4714,7 @@ FilterInputBytes(
* returning those UTF-8 characters because a EOL might be
* present in them.
*/
- } else if (statePtr->flags & CHANNEL_EOF) {
+ } else if (GotFlag(statePtr, CHANNEL_EOF)) {
/*
* There was a partial character followed by EOF on the
* device. Fall through, returning that nothing was found.
@@ -4589,9 +4724,15 @@ FilterInputBytes(
} else {
/*
* There are no more cached raw bytes left. See if we can get
- * some more.
+ * some more, but avoid blocking on a non-blocking channel.
*/
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)
+ == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) {
+ gsPtr->charsWrote = 0;
+ gsPtr->rawRead = 0;
+ return -1;
+ }
goto read;
}
} else {
@@ -4601,7 +4742,7 @@ FilterInputBytes(
statePtr->inQueueTail = nextPtr;
}
extra = rawLen - gsPtr->rawRead;
- memcpy(nextPtr->buf + BUFFER_PADDING - extra,
+ memcpy(nextPtr->buf + (BUFFER_PADDING - extra),
raw + gsPtr->rawRead, (size_t) extra);
nextPtr->nextRemoved -= extra;
bufPtr->nextAdded -= extra;
@@ -4668,7 +4809,7 @@ PeekAhead(
goto cleanup;
}
- if ((statePtr->flags & CHANNEL_NONBLOCKING) == 0) {
+ if (!GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
if (blockModeProc == NULL) {
/*
@@ -4836,7 +4977,7 @@ Tcl_ReadRaw(
Channel *chanPtr = (Channel *) chan;
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
- int nread, result, copied, copiedNow;
+ int nread, copied, copiedNow = INT_MAX;
/*
* The check below does too much because it will reject a call to this
@@ -4860,108 +5001,33 @@ Tcl_ReadRaw(
* requests more bytes.
*/
- for (copied = 0; copied < bytesToRead; copied += copiedNow) {
- copiedNow = CopyBuffer(chanPtr, bufPtr + copied,
- bytesToRead - copied);
- if (copiedNow == 0) {
- if (statePtr->flags & CHANNEL_EOF) {
- goto done;
- }
- if (statePtr->flags & CHANNEL_BLOCKED) {
- if (statePtr->flags & CHANNEL_NONBLOCKING) {
- goto done;
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED);
- }
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- /*
- * [Bug 943274]. Better emulation of non-blocking channels for
- * channels without BlockModeProc, by keeping track of true
- * fileevents generated by the OS == Data waiting and reading if
- * and only if we are sure to have data.
- */
-
- if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
- (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
- !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
- /*
- * We bypass the driver; it would block as no data is
- * available.
- */
-
- nread = -1;
- result = EWOULDBLOCK;
- } else {
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
- /*
- * Now go to the driver to get as much as is possible to fill
- * the remaining request. Do all the error handling by
- * ourselves. The code was stolen from 'GetInput' and slightly
- * adapted (different return value here).
- *
- * The case of 'bytesToRead == 0' at this point cannot happen.
- */
-
- nread = ChanRead(chanPtr, bufPtr + copied,
- bytesToRead - copied, &result);
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- }
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
- if (nread > 0) {
- /*
- * If we get a short read, signal up that we may be BLOCKED.
- * We should avoid calling the driver because on some
- * platforms we will block in the low level reading code even
- * though the channel is set into nonblocking mode.
- */
-
- if (nread < (bytesToRead - copied)) {
- SetFlag(statePtr, CHANNEL_BLOCKED);
- }
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- if (nread <= (bytesToRead - copied)) {
- /*
- * [Bug 943274] We have read the available data, clear
- * flag.
- */
-
- ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
- }
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
- } else if (nread == 0) {
- SetFlag(statePtr, CHANNEL_EOF);
- statePtr->inputEncodingFlags |= TCL_ENCODING_END;
-
- } else if (nread < 0) {
- if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
- if (copied > 0) {
- /*
- * Information that was copied earlier has precedence
- * over EAGAIN/WOULDBLOCK handling.
- */
-
- return copied;
- }
+ Tcl_Preserve(chanPtr);
+ for (copied = 0; bytesToRead > 0 && copiedNow > 0;
+ bufPtr+=copiedNow, bytesToRead-=copiedNow, copied+=copiedNow) {
+ copiedNow = CopyBuffer(chanPtr, bufPtr, bytesToRead);
+ }
- SetFlag(statePtr, CHANNEL_BLOCKED);
- result = EAGAIN;
- }
+ if (bytesToRead > 0) {
+ /*
+ * Now go to the driver to get as much as is possible to
+ * fill the remaining request. Since we're directly filling
+ * the caller's buffer, retain the blocked flag.
+ */
- Tcl_SetErrno(result);
- return -1;
+ nread = ChanRead(chanPtr, bufPtr, bytesToRead);
+ if (nread < 0) {
+ if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) {
+ copied = -1;
}
-
- return copied + nread;
+ } else {
+ copied += nread;
+ }
+ if (copied != 0) {
+ ResetFlag(statePtr, CHANNEL_EOF);
}
}
- done:
+ Tcl_Release(chanPtr);
return copied;
}
@@ -5058,8 +5124,9 @@ DoReadChars(
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
ChannelBuffer *bufPtr;
- int offset, factor, copied, copiedNow, result;
+ int factor, copied, copiedNow, result;
Tcl_Encoding encoding;
+ int binaryMode;
#define UTF_EXPANSION_FACTOR 1024
/*
@@ -5069,9 +5136,14 @@ DoReadChars(
chanPtr = statePtr->topChanPtr;
encoding = statePtr->encoding;
factor = UTF_EXPANSION_FACTOR;
+ Tcl_Preserve(chanPtr);
+
+ binaryMode = (encoding == NULL)
+ && (statePtr->inputTranslation == TCL_TRANSLATE_LF)
+ && (statePtr->inEofChar == '\0');
if (appendFlag == 0) {
- if (encoding == NULL) {
+ if (binaryMode) {
Tcl_SetByteArrayLength(objPtr, 0);
} else {
Tcl_SetObjLength(objPtr, 0);
@@ -5080,27 +5152,23 @@ DoReadChars(
* We're going to access objPtr->bytes directly, so we must ensure
* that this is actually a string object (otherwise it might have
* been pure Unicode).
+ *
+ * Probably not needed anymore.
*/
TclGetString(objPtr);
}
- offset = 0;
- } else {
- if (encoding == NULL) {
- Tcl_GetByteArrayFromObj(objPtr, &offset);
- } else {
- TclGetStringFromObj(objPtr, &offset);
- }
}
+ /* Must clear the BLOCKED flag here since we check before reading */
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
for (copied = 0; (unsigned) toRead > 0; ) {
copiedNow = -1;
if (statePtr->inQueueHead != NULL) {
- if (encoding == NULL) {
- copiedNow = ReadBytes(statePtr, objPtr, toRead, &offset);
+ if (binaryMode) {
+ copiedNow = ReadBytes(statePtr, objPtr, toRead);
} else {
- copiedNow = ReadChars(statePtr, objPtr, toRead, &offset,
- &factor);
+ copiedNow = ReadChars(statePtr, objPtr, toRead, &factor);
}
/*
@@ -5121,22 +5189,24 @@ DoReadChars(
}
if (copiedNow < 0) {
- if (statePtr->flags & CHANNEL_EOF) {
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
break;
}
- if (statePtr->flags & CHANNEL_BLOCKED) {
- if (statePtr->flags & CHANNEL_NONBLOCKING) {
- break;
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED);
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)
+ == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) {
+ break;
}
result = GetInput(chanPtr);
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_Release(chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
+ }
if (result != 0) {
- if (result == EAGAIN) {
- break;
+ if (!GotFlag(statePtr, CHANNEL_BLOCKED)) {
+ copied = -1;
}
- copied = -1;
- goto done;
+ break;
}
} else {
copied += copiedNow;
@@ -5144,20 +5214,31 @@ DoReadChars(
}
}
- ResetFlag(statePtr, CHANNEL_BLOCKED);
- if (encoding == NULL) {
- Tcl_SetByteArrayLength(objPtr, offset);
- } else {
- Tcl_SetObjLength(objPtr, offset);
+ /*
+ * Failure to fill a channel buffer may have left channel reporting
+ * a "blocked" state, but so long as we fulfilled the request here,
+ * the caller does not consider us blocked.
+ */
+ if (toRead == 0) {
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
+ }
+
+ /*
+ * Regenerate the top channel, in case it was changed due to
+ * self-modifying reflected transforms.
+ */
+ if (chanPtr != statePtr->topChanPtr) {
+ Tcl_Release(chanPtr);
+ chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
}
/*
* Update the notifier state so we don't block while there is still data
* in the buffers.
*/
-
- done:
UpdateInterest(chanPtr);
+ Tcl_Release(chanPtr);
return copied;
}
@@ -5175,13 +5256,11 @@ DoReadChars(
* allocated to hold data read from the channel as needed.
*
* Results:
- * The return value is the number of bytes appended to the object and
- * *offsetPtr is filled with the total number of bytes in the object
- * (greater than the return value if there were already bytes in the
- * object).
+ * The return value is the number of bytes appended to the object, or
+ * -1 to indicate that zero bytes were read due to an EOF.
*
* Side effects:
- * None.
+ * The storage of bytes in objPtr can cause (re-)allocation of memory.
*
*---------------------------------------------------------------------------
*/
@@ -5194,72 +5273,22 @@ ReadBytes(
* been allocated to hold data, not how many
* bytes of data have been stored in the
* object. */
- int bytesToRead, /* Maximum number of bytes to store, or < 0 to
+ int bytesToRead) /* Maximum number of bytes to store, or < 0 to
* get all available bytes. Bytes are obtained
* from the first buffer in the queue - even
* if this number is larger than the number of
* bytes available in the first buffer, only
* the bytes from the first buffer are
* returned. */
- int *offsetPtr) /* On input, contains how many bytes of objPtr
- * have been used to hold data. On output,
- * filled with how many bytes are now being
- * used. */
{
- int toRead, srcLen, offset, length, srcRead, dstWrote;
- ChannelBuffer *bufPtr;
- char *src, *dst;
-
- offset = *offsetPtr;
+ ChannelBuffer *bufPtr = statePtr->inQueueHead;
+ int srcLen = BytesLeft(bufPtr);
+ int toRead = bytesToRead>srcLen || bytesToRead<0 ? srcLen : bytesToRead;
- bufPtr = statePtr->inQueueHead;
- src = RemovePoint(bufPtr);
- srcLen = BytesLeft(bufPtr);
-
- toRead = bytesToRead;
- if ((unsigned) toRead > (unsigned) srcLen) {
- toRead = srcLen;
- }
-
- dst = (char *) Tcl_GetByteArrayFromObj(objPtr, &length);
- if (toRead > length - offset - 1) {
- /*
- * Double the existing size of the object or make enough room to hold
- * all the characters we may get from the source buffer, whichever is
- * larger.
- */
-
- length = offset * 2;
- if (offset < toRead) {
- length = offset + toRead + 1;
- }
- dst = (char *) Tcl_SetByteArrayLength(objPtr, length);
- }
- dst += offset;
-
- if (statePtr->flags & INPUT_NEED_NL) {
- ResetFlag(statePtr, INPUT_NEED_NL);
- if ((srcLen == 0) || (*src != '\n')) {
- *dst = '\r';
- *offsetPtr += 1;
- return 1;
- }
- *dst++ = '\n';
- src++;
- srcLen--;
- toRead--;
- }
-
- srcRead = srcLen;
- dstWrote = toRead;
- if (TranslateInputEOL(statePtr, dst, src, &dstWrote, &srcRead) != 0) {
- if (dstWrote == 0) {
- return -1;
- }
- }
- bufPtr->nextRemoved += srcRead;
- *offsetPtr += dstWrote;
- return dstWrote;
+ TclAppendBytesToByteArray(objPtr, (unsigned char *) RemovePoint(bufPtr),
+ toRead);
+ bufPtr->nextRemoved += toRead;
+ return toRead;
}
/*
@@ -5303,263 +5332,344 @@ ReadChars(
* is larger than the number of characters
* available in the first buffer, only the
* characters from the first buffer are
- * returned. */
- int *offsetPtr, /* On input, contains how many bytes of objPtr
- * have been used to hold data. On output,
- * filled with how many bytes are now being
- * used. */
+ * returned. The execption is when there is
+ * not any complete character in the first
+ * buffer. In that case, a recursive call
+ * effectively obtains chars from the
+ * second buffer. */
int *factorPtr) /* On input, contains a guess of how many
* bytes need to be allocated to hold the
* result of converting N source bytes to
* UTF-8. On output, contains another guess
* based on the data seen so far. */
{
- int toRead, factor, offset, spaceLeft, srcLen, dstNeeded;
- int srcRead, dstWrote, numChars, dstRead;
- ChannelBuffer *bufPtr;
- char *src, *dst;
- Tcl_EncodingState oldState;
- int encEndFlagSuppressed = 0;
-
- factor = *factorPtr;
- offset = *offsetPtr;
+ Tcl_Encoding encoding = statePtr->encoding? statePtr->encoding
+ : GetBinaryEncoding();
+ Tcl_EncodingState savedState = statePtr->inputEncodingState;
+ ChannelBuffer *bufPtr = statePtr->inQueueHead;
+ int savedIEFlags = statePtr->inputEncodingFlags;
+ int savedFlags = statePtr->flags;
+ char *dst, *src = RemovePoint(bufPtr);
+ int dstLimit, numBytes, srcLen = BytesLeft(bufPtr);
- bufPtr = statePtr->inQueueHead;
- src = RemovePoint(bufPtr);
- srcLen = BytesLeft(bufPtr);
+ /*
+ * One src byte can yield at most one character. So when the
+ * number of src bytes we plan to read is less than the limit on
+ * character count to be read, clearly we will remain within that
+ * limit, and we can use the value of "srcLen" as a tighter limit
+ * for sizing receiving buffers.
+ */
- toRead = charsToRead;
- if ((unsigned)toRead > (unsigned)srcLen) {
- toRead = srcLen;
- }
+ int toRead = ((unsigned) charsToRead > srcLen) ? srcLen : charsToRead;
/*
* 'factor' is how much we guess that the bytes in the source buffer will
* expand when converted to UTF-8 chars. This guess comes from analyzing
* how many characters were produced by the previous pass.
*/
+
+ int factor = *factorPtr;
+ int dstNeeded = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
- dstNeeded = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
- spaceLeft = objPtr->length - offset;
-
- if (dstNeeded > spaceLeft) {
- /*
- * Double the existing size of the object or make enough room to hold
- * all the characters we want from the source buffer, whichever is
- * larger.
- */
-
- int length = offset + ((offset < dstNeeded) ? dstNeeded : offset);
-
- if (Tcl_AttemptSetObjLength(objPtr, length) == 0) {
- length = offset + dstNeeded;
- if (Tcl_AttemptSetObjLength(objPtr, length) == 0) {
- dstNeeded = TCL_UTF_MAX - 1 + toRead;
- length = offset + dstNeeded;
- Tcl_SetObjLength(objPtr, length);
- }
- }
- spaceLeft = length - offset;
- }
+ (void) TclGetStringFromObj(objPtr, &numBytes);
+ Tcl_AppendToObj(objPtr, NULL, dstNeeded);
if (toRead == srcLen) {
- /*
- * Want to convert the whole buffer in one pass. If we have enough
- * space, convert it using all available space in object rather than
- * using the factor.
- */
-
- dstNeeded = spaceLeft;
+ unsigned int size;
+ dst = TclGetStringStorage(objPtr, &size) + numBytes;
+ dstNeeded = size - numBytes;
+ } else {
+ dst = TclGetString(objPtr) + numBytes;
}
- dst = objPtr->bytes + offset;
/*
- * [Bug 1462248]: The cause of the crash reported in this bug is this:
- *
- * - ReadChars, called with a single buffer, with a incomplete
- * multi-byte character at the end (only the first byte of it).
- * - Encoding translation fails, asks for more data
- * - Data is read, and eof is reached, TCL_ENCODING_END (TEE) is set.
- * - ReadChar is called again, converts the first buffer, but due to TEE
- * it does not check for incomplete multi-byte data, and the character
- * just after the end of the first buffer is a valid completion of the
- * multi-byte header in the actual buffer. The conversion reads more
- * characters from the buffer then present. This causes nextRemoved to
- * overshoot nextAdded and the next reads compute a negative srcLen,
- * cause further translations to fail, causing copying of data into the
- * next buffer using bad arguments, causing the mecpy for to eventually
- * fail.
- *
- * In the end it is a memory access bug spiraling out of control if the
- * conditions are _just so_. And ultimate cause is that TEE is given to a
- * conversion where it should not. TEE signals that this is the last
- * buffer. Except in our case it is not.
- *
- * My solution is to suppress TEE if the first buffer is not the last. We
- * will eventually need it given that EOF has been reached, but not right
- * now. This is what the new flag "endEncSuppressFlag" is for.
+ * This routine is burdened with satisfying several constraints.
+ * It cannot append more than 'charsToRead` chars onto objPtr.
+ * This is measured after encoding and translation transformations
+ * are completed. There is no precise number of src bytes that can
+ * be associated with the limit. Yet, when we are done, we must know
+ * precisely the number of src bytes that were consumed to produce
+ * the appended chars, so that all subsequent bytes are left in
+ * the buffers for future read operations.
*
- * The bug in 'Tcl_Utf2UtfProc' where it read from memory behind the
- * actual buffer has been fixed as well, and fixes the problem with the
- * crash too, but this would still allow the generic layer to
- * accidentially break a multi-byte sequence if the conditions are just
- * right, because again the ExternalToUtf would be successful where it
- * should not.
+ * The consequence is that we have no choice but to implement a
+ * "trial and error" approach, where in general we may need to
+ * perform transformations and copies multiple times to achieve
+ * a consistent set of results. This takes the shape of a loop.
*/
- if ((statePtr->inputEncodingFlags & TCL_ENCODING_END) &&
- (bufPtr->nextPtr != NULL)) {
+ dstLimit = dstNeeded + 1;
+ while (1) {
+ int dstDecoded, dstRead, dstWrote, srcRead, numChars;
+
/*
- * TEE is set for a buffer which is not the last. Squash it for now,
- * and restore it later, before yielding control to our caller.
+ * Perform the encoding transformation. Read no more than
+ * srcLen bytes, write no more than dstLimit bytes.
*/
- statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
- encEndFlagSuppressed = 1;
- }
+ int code = Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
+ statePtr->inputEncodingFlags & (bufPtr->nextPtr
+ ? ~0 : ~TCL_ENCODING_END), &statePtr->inputEncodingState,
+ dst, dstLimit, &srcRead, &dstDecoded, &numChars);
- oldState = statePtr->inputEncodingState;
- if (statePtr->flags & INPUT_NEED_NL) {
/*
- * We want a '\n' because the last character we saw was '\r'.
+ * Perform the translation transformation in place. Read no more
+ * than the dstDecoded bytes the encoding transformation actually
+ * produced. Capture the number of bytes written in dstWrote.
+ * Capture the number of bytes actually consumed in dstRead.
*/
- ResetFlag(statePtr, INPUT_NEED_NL);
- Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
- statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
- dst, TCL_UTF_MAX + 1, &srcRead, &dstWrote, &numChars);
- if ((dstWrote > 0) && (*dst == '\n')) {
+ dstWrote = dstLimit;
+ dstRead = dstDecoded;
+ TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
+
+ if (dstRead < dstDecoded) {
+
/*
- * The next char was a '\n'. Consume it and produce a '\n'.
+ * The encoding transformation produced bytes that the
+ * translation transformation did not consume. Why did
+ * this happen?
*/
- bufPtr->nextRemoved += srcRead;
- } else {
+ if (statePtr->inEofChar && dst[dstRead] == statePtr->inEofChar) {
+ /*
+ * 1) There's an eof char set on the channel, and
+ * we saw it and stopped translating at that point.
+ *
+ * NOTE the bizarre spec of TranslateInputEOL in this case.
+ * Clearly the eof char had to be read in order to account
+ * for the stopping, but the value of dstRead does not
+ * include it.
+ *
+ * Also rather bizarre, our caller can only notice an
+ * EOF condition if we return the value -1 as the number
+ * of chars read. This forces us to perform a 2-call
+ * dance where the first call can read all the chars
+ * up to the eof char, and the second call is solely
+ * for consuming the encoded eof char then pointed at
+ * by src so that we can return that magic -1 value.
+ * This seems really wasteful, especially since
+ * the first decoding pass of each call is likely to
+ * decode many bytes beyond that eof char that's all we
+ * care about.
+ */
+
+ if (dstRead == 0) {
+ /*
+ * Curious choice in the eof char handling. We leave
+ * the eof char in the buffer. So, no need to compute
+ * a proper srcRead value. At this point, there
+ * are no chars before the eof char in the buffer.
+ */
+ Tcl_SetObjLength(objPtr, numBytes);
+ return -1;
+ }
+
+ {
+ /*
+ * There are chars leading the buffer before the eof
+ * char. Adjust the dstLimit so we go back and read
+ * only those and do not encounter the eof char this
+ * time.
+ */
+
+ dstLimit = dstRead + TCL_UTF_MAX;
+ statePtr->flags = savedFlags;
+ statePtr->inputEncodingFlags = savedIEFlags;
+ statePtr->inputEncodingState = savedState;
+ continue;
+ }
+ }
+
/*
- * The next char was not a '\n'. Produce a '\r'.
+ * 2) The other way to read fewer bytes than are decoded
+ * is when the final byte is \r and we're in a CRLF
+ * translation mode so we cannot decide whether to
+ * record \r or \n yet.
*/
- *dst = '\r';
- }
- statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
- *offsetPtr += 1;
+ assert(dst[dstRead] == '\r');
+ assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF);
- if (encEndFlagSuppressed) {
- statePtr->inputEncodingFlags |= TCL_ENCODING_END;
- }
- return 1;
- }
+ if (dstWrote > 0) {
+ /*
+ * There are chars we can read before we hit the bare cr.
+ * Go back with a smaller dstLimit so we get them in the
+ * next pass, compute a matching srcRead, and don't end
+ * up back here in this call.
+ */
- Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
- statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
- dstNeeded + 1, &srcRead, &dstWrote, &numChars);
+ dstLimit = dstRead + TCL_UTF_MAX;
+ statePtr->flags = savedFlags;
+ statePtr->inputEncodingFlags = savedIEFlags;
+ statePtr->inputEncodingState = savedState;
+ continue;
+ }
- if (encEndFlagSuppressed) {
- statePtr->inputEncodingFlags |= TCL_ENCODING_END;
- }
+ assert(dstWrote == 0);
+ assert(dstRead == 0);
- if (srcRead == 0) {
- /*
- * Not enough bytes in src buffer to make a complete char. Copy the
- * bytes to the next buffer to make a new contiguous string, then tell
- * the caller to fill the buffer with more bytes.
- */
+ /*
+ * We decoded only the bare cr, and we cannot read a
+ * translated char from that alone. We have to know what's
+ * next. So why do we only have the one decoded char?
+ */
- ChannelBuffer *nextPtr;
+ if (code != TCL_OK) {
+ char buffer[TCL_UTF_MAX + 2];
+ int read, decoded, count;
+
+ /*
+ * Didn't get everything the buffer could offer
+ */
+
+ statePtr->flags = savedFlags;
+ statePtr->inputEncodingFlags = savedIEFlags;
+ statePtr->inputEncodingState = savedState;
+
+ Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
+ statePtr->inputEncodingFlags & (bufPtr->nextPtr
+ ? ~0 : ~TCL_ENCODING_END), &statePtr->inputEncodingState,
+ buffer, TCL_UTF_MAX + 2, &read, &decoded, &count);
+
+ if (count == 2) {
+ if (buffer[1] == '\n') {
+ /* \r\n translate to \n */
+ dst[0] = '\n';
+ bufPtr->nextRemoved += read;
+ } else {
+ dst[0] = '\r';
+ bufPtr->nextRemoved += srcRead;
+ }
+
+ dst[1] = '\0';
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
+
+ Tcl_SetObjLength(objPtr, numBytes + 1);
+ return 1;
+ }
+
+ } else if (GotFlag(statePtr, CHANNEL_EOF)) {
- nextPtr = bufPtr->nextPtr;
- if (nextPtr == NULL) {
- if (srcLen > 0) {
/*
- * There isn't enough data in the buffers to complete the next
- * character, so we need to wait for more data before the next
- * file event can be delivered. [Bug 478856]
- *
- * The exception to this is if the input buffer was completely
- * empty before we tried to convert its contents. Nothing in,
- * nothing out, and no incomplete character data. The
- * conversion before the current one was complete.
+ * The bare \r is the only char and we will never read
+ * a subsequent char to make the determination.
*/
- SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
+ dst[0] = '\r';
+ bufPtr->nextRemoved = bufPtr->nextAdded;
+ Tcl_SetObjLength(objPtr, numBytes + 1);
+ return 1;
}
- return -1;
+
+ /*
+ * Revise the dstRead value so that the numChars calc
+ * below correctly computes zero characters read.
+ */
+
+ dstRead = numChars;
+
+ /* FALL THROUGH - get more data (dstWrote == 0) */
}
- /*
- * Space is made at the beginning of the buffer to copy the previous
- * unused bytes there. Check first if the buffer we are using actually
- * has enough space at its beginning for the data we are copying.
- * Because if not we will write over the buffer management
- * information, especially the 'nextPtr'.
- *
- * Note that the BUFFER_PADDING (See AllocChannelBuffer) is used to
- * prevent exactly this situation. I.e. it should never happen.
- * Therefore it is ok to panic should it happen despite the
- * precautions.
+ /*
+ * The translation transformation can only reduce the number
+ * of chars when it converts \r\n into \n. The reduction in
+ * the number of chars is the difference in bytes read and written.
*/
- if (nextPtr->nextRemoved - srcLen < 0) {
- Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough");
- }
+ numChars -= (dstRead - dstWrote);
- nextPtr->nextRemoved -= srcLen;
- memcpy(RemovePoint(nextPtr), src, (size_t) srcLen);
- RecycleBuffer(statePtr, bufPtr, 0);
- statePtr->inQueueHead = nextPtr;
- return ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr);
- }
+ if (charsToRead > 0 && numChars > charsToRead) {
- dstRead = dstWrote;
- if (TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead) != 0) {
- /*
- * Hit EOF char. How many bytes of src correspond to where the EOF was
- * located in dst? Run the conversion again with an output buffer just
- * big enough to hold the data so we can get the correct value for
- * srcRead.
- */
+ /*
+ * We read more chars than allowed. Reset limits to
+ * prevent that and try again.
+ */
- if (dstWrote == 0) {
- return -1;
+ dstLimit = Tcl_UtfAtIndex(dst, charsToRead + 1) - dst;
+ statePtr->flags = savedFlags;
+ statePtr->inputEncodingFlags = savedIEFlags;
+ statePtr->inputEncodingState = savedState;
+ continue;
}
- statePtr->inputEncodingState = oldState;
- Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
- statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
- dst, dstRead + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
- TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
- }
- /*
- * The number of characters that we got may be less than the number that
- * we started with because "\r\n" sequences may have been turned into just
- * '\n' in dst.
- */
+ if (dstWrote == 0) {
+ ChannelBuffer *nextPtr;
- numChars -= (dstRead - dstWrote);
+ /* We were not able to read any chars. */
- if ((unsigned) numChars > (unsigned) toRead) {
- /*
- * Got too many chars.
- */
+ assert (numChars == 0);
+
+ /*
+ * There is one situation where this is the correct final
+ * result. If the src buffer contains only a single \n
+ * byte, and we are in TCL_TRANSLATE_AUTO mode, and
+ * when the translation pass was made the INPUT_SAW_CR
+ * flag was set on the channel. In that case, the
+ * correct behavior is to consume that \n and produce the
+ * empty string.
+ */
- const char *eof;
+ if (dst[0] == '\n') {
+ assert(statePtr->inputTranslation == TCL_TRANSLATE_AUTO);
+ assert(dstRead == 1);
- eof = Tcl_UtfAtIndex(dst, toRead);
- statePtr->inputEncodingState = oldState;
- Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
- statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
- dst, eof - dst + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
- dstRead = dstWrote;
- TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
- numChars -= (dstRead - dstWrote);
- }
- statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
+ goto consume;
+ }
+
+ /* Otherwise, reading zero characters indicates there's
+ * something incomplete at the end of the src buffer.
+ * Maybe there were not enough src bytes to decode into
+ * a char. Maybe a lone \r could not be translated (crlf
+ * mode). Need to combine any unused src bytes we have
+ * in the first buffer with subsequent bytes to try again.
+ */
+
+ nextPtr = bufPtr->nextPtr;
+
+ if (nextPtr == NULL) {
+ if (srcLen > 0) {
+ SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
+ }
+ Tcl_SetObjLength(objPtr, numBytes);
+ return -1;
+ }
+
+ /*
+ * Space is made at the beginning of the buffer to copy the
+ * previous unused bytes there. Check first if the buffer we
+ * are using actually has enough space at its beginning for
+ * the data we are copying. Because if not we will write over
+ * the buffer management information, especially the 'nextPtr'.
+ *
+ * Note that the BUFFER_PADDING (See AllocChannelBuffer) is
+ * used to prevent exactly this situation. I.e. it should never
+ * happen. Therefore it is ok to panic should it happen despite
+ * the precautions.
+ */
+
+ if (nextPtr->nextRemoved - srcLen < 0) {
+ Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough");
+ }
+
+ nextPtr->nextRemoved -= srcLen;
+ memcpy(RemovePoint(nextPtr), src, (size_t) srcLen);
+ RecycleBuffer(statePtr, bufPtr, 0);
+ statePtr->inQueueHead = nextPtr;
+ Tcl_SetObjLength(objPtr, numBytes);
+ return ReadChars(statePtr, objPtr, charsToRead, factorPtr);
+ }
- bufPtr->nextRemoved += srcRead;
- if (dstWrote > srcRead + 1) {
- *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;
+ statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
+
+ consume:
+ bufPtr->nextRemoved += srcRead;
+ if (dstWrote > srcRead + 1) {
+ *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;
+ }
+ Tcl_SetObjLength(objPtr, numBytes + dstWrote);
+ return numChars;
}
- *offsetPtr += dstWrote;
- return numChars;
}
/*
@@ -5580,7 +5690,7 @@ ReadChars(
*---------------------------------------------------------------------------
*/
-static int
+static void
TranslateInputEOL(
ChannelState *statePtr, /* Channel being read, for EOL translation and
* EOF character. */
@@ -5589,133 +5699,138 @@ TranslateInputEOL(
* characters. */
const char *srcStart, /* Source characters. */
int *dstLenPtr, /* On entry, the maximum length of output
- * buffer in bytes; must be <= *srcLenPtr. On
- * exit, the number of bytes actually used in
- * output buffer. */
+ * buffer in bytes. On exit, the number of
+ * bytes actually used in output buffer. */
int *srcLenPtr) /* On entry, the length of source buffer. On
* exit, the number of bytes read from the
* source buffer. */
{
- int dstLen, srcLen, inEofChar;
- const char *eof;
+ const char *eof = NULL;
+ int dstLen = *dstLenPtr;
+ int srcLen = *srcLenPtr;
+ int inEofChar = statePtr->inEofChar;
- dstLen = *dstLenPtr;
+ /*
+ * Depending on the translation mode in use, there's no need
+ * to scan more srcLen bytes at srcStart than can possibly transform
+ * to dstLen bytes. This keeps the scan for eof char below from
+ * being pointlessly long.
+ */
+
+ switch (statePtr->inputTranslation) {
+ case TCL_TRANSLATE_LF:
+ case TCL_TRANSLATE_CR:
+ if (srcLen > dstLen) {
+ /* In these modes, each src byte become a dst byte. */
+ srcLen = dstLen;
+ }
+ break;
+ default:
+ /* In other modes, at most 2 src bytes become a dst byte. */
+ if (srcLen > 2 * dstLen) {
+ srcLen = 2 * dstLen;
+ }
+ break;
+ }
- eof = NULL;
- inEofChar = statePtr->inEofChar;
if (inEofChar != '\0') {
/*
- * Find EOF in translated buffer then compress out the EOL. The source
- * buffer may be much longer than the destination buffer - we only
- * want to return EOF if the EOF has been copied to the destination
- * buffer.
+ * Make sure we do not read past any logical end of channel input
+ * created by the presence of the input eof char.
*/
- const char *src, *srcMax;
-
- srcMax = srcStart + *srcLenPtr;
- for (src = srcStart; src < srcMax; src++) {
- if (*src == inEofChar) {
- eof = src;
- srcLen = src - srcStart;
- if (srcLen < dstLen) {
- dstLen = srcLen;
- }
- *srcLenPtr = srcLen;
- break;
- }
+ if ((eof = memchr(srcStart, inEofChar, srcLen))) {
+ srcLen = eof - srcStart;
}
}
+
switch (statePtr->inputTranslation) {
case TCL_TRANSLATE_LF:
+ case TCL_TRANSLATE_CR:
if (dstStart != srcStart) {
- memcpy(dstStart, srcStart, (size_t) dstLen);
+ memcpy(dstStart, srcStart, (size_t) srcLen);
}
- srcLen = dstLen;
- break;
- case TCL_TRANSLATE_CR: {
- char *dst, *dstEnd;
+ if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
+ char *dst = dstStart;
+ char *dstEnd = dstStart + srcLen;
- if (dstStart != srcStart) {
- memcpy(dstStart, srcStart, (size_t) dstLen);
- }
- dstEnd = dstStart + dstLen;
- for (dst = dstStart; dst < dstEnd; dst++) {
- if (*dst == '\r') {
- *dst = '\n';
+ while ((dst = memchr(dst, '\r', dstEnd - dst))) {
+ *dst++ = '\n';
}
}
- srcLen = dstLen;
+ dstLen = srcLen;
break;
- }
case TCL_TRANSLATE_CRLF: {
- char *dst;
- const char *src, *srcEnd, *srcMax;
-
- dst = dstStart;
- src = srcStart;
- srcEnd = srcStart + dstLen;
- srcMax = srcStart + *srcLenPtr;
-
- for ( ; src < srcEnd; ) {
- if (*src == '\r') {
- src++;
- if (src >= srcMax) {
- SetFlag(statePtr, INPUT_NEED_NL);
- } else if (*src == '\n') {
- *dst++ = *src++;
- } else {
+ const char *crFound, *src = srcStart;
+ char *dst = dstStart;
+ int lesser = (dstLen < srcLen) ? dstLen : srcLen;
+
+ while ((crFound = memchr(src, '\r', lesser))) {
+ int numBytes = crFound - src;
+ memmove(dst, src, numBytes);
+
+ dst += numBytes; dstLen -= numBytes;
+ src += numBytes; srcLen -= numBytes;
+ if (srcLen == 1) {
+ /* valid src bytes end in \r */
+ if (eof) {
*dst++ = '\r';
+ src++; srcLen--;
+ } else {
+ lesser = 0;
+ break;
}
+ } else if (src[1] == '\n') {
+ *dst++ = '\n';
+ src += 2; srcLen -= 2;
} else {
- *dst++ = *src++;
+ *dst++ = '\r';
+ src++; srcLen--;
}
+ dstLen--;
+ lesser = (dstLen < srcLen) ? dstLen : srcLen;
}
- srcLen = src - srcStart;
- dstLen = dst - dstStart;
+ memmove(dst, src, lesser);
+ srcLen = src + lesser - srcStart;
+ dstLen = dst + lesser - dstStart;
break;
}
case TCL_TRANSLATE_AUTO: {
- char *dst;
- const char *src, *srcEnd, *srcMax;
-
- dst = dstStart;
- src = srcStart;
- srcEnd = srcStart + dstLen;
- srcMax = srcStart + *srcLenPtr;
+ const char *crFound, *src = srcStart;
+ char *dst = dstStart;
+ int lesser;
- if ((statePtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
- if (*src == '\n') {
- src++;
- }
+ if (GotFlag(statePtr, INPUT_SAW_CR) && srcLen) {
+ if (*src == '\n') { src++; srcLen--; }
ResetFlag(statePtr, INPUT_SAW_CR);
}
- for ( ; src < srcEnd; ) {
- if (*src == '\r') {
- src++;
- if (src >= srcMax) {
- SetFlag(statePtr, INPUT_SAW_CR);
- } else if (*src == '\n') {
- if (srcEnd < srcMax) {
- srcEnd++;
- }
- src++;
- }
- *dst++ = '\n';
- } else {
- *dst++ = *src++;
+ lesser = (dstLen < srcLen) ? dstLen : srcLen;
+ while ((crFound = memchr(src, '\r', lesser))) {
+ int numBytes = crFound - src;
+ memmove(dst, src, numBytes);
+
+ dst[numBytes] = '\n';
+ dst += numBytes + 1; dstLen -= numBytes + 1;
+ src += numBytes + 1; srcLen -= numBytes + 1;
+ if (srcLen == 0) {
+ SetFlag(statePtr, INPUT_SAW_CR);
+ } else if (*src == '\n') {
+ src++; srcLen--;
}
+ lesser = (dstLen < srcLen) ? dstLen : srcLen;
}
- srcLen = src - srcStart;
- dstLen = dst - dstStart;
+ memmove(dst, src, lesser);
+ srcLen = src + lesser - srcStart;
+ dstLen = dst + lesser - dstStart;
break;
}
default:
- return 0;
+ Tcl_Panic("unknown input translation %d", statePtr->inputTranslation);
}
*dstLenPtr = dstLen;
+ *srcLenPtr = srcLen;
- if ((eof != NULL) && (srcStart + srcLen >= eof)) {
+ if (srcStart + srcLen == eof) {
/*
* EOF character was seen in EOL translated range. Leave current file
* position pointing at the EOF character, but don't store the EOF
@@ -5724,12 +5839,8 @@ TranslateInputEOL(
SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
statePtr->inputEncodingFlags |= TCL_ENCODING_END;
- ResetFlag(statePtr, INPUT_SAW_CR | INPUT_NEED_NL);
- return 1;
+ ResetFlag(statePtr, INPUT_SAW_CR);
}
-
- *srcLenPtr = srcLen;
- return 0;
}
/*
@@ -5783,16 +5894,11 @@ Tcl_Ungets(
statePtr->flags = flags;
/*
- * If we have encountered a sticky EOF, just punt without storing (sticky
- * EOF is set if we have seen the input eofChar, to prevent reading beyond
- * the eofChar). Otherwise, clear the EOF flags, and clear the BLOCKED
- * bit. We want to discover these conditions anew in each operation.
+ * Clear the EOF flags, and clear the BLOCKED bit.
*/
- if (statePtr->flags & CHANNEL_STICKY_EOF) {
- goto done;
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_EOF);
+ ResetFlag(statePtr,
+ CHANNEL_BLOCKED | CHANNEL_STICKY_EOF | CHANNEL_EOF | INPUT_SAW_CR);
bufPtr = AllocChannelBuffer(len);
memcpy(InsertPoint(bufPtr), str, (size_t) len);
@@ -5857,14 +5963,6 @@ Tcl_Flush(
return -1;
}
- /*
- * Force current output buffer to be output also.
- */
-
- if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
- SetFlag(statePtr, BUFFER_READY);
- }
-
result = FlushChannel(NULL, chanPtr, 0);
if (result != 0) {
return TCL_ERROR;
@@ -5915,7 +6013,7 @@ DiscardInputQueued(
*/
if (discardSavedBuffers && statePtr->saveInBufPtr != NULL) {
- ckfree((char *) statePtr->saveInBufPtr);
+ ReleaseChannelBuffer(statePtr->saveInBufPtr);
statePtr->saveInBufPtr = NULL;
}
}
@@ -5927,6 +6025,9 @@ DiscardInputQueued(
*
* Reads input data from a device into a channel buffer.
*
+ * IMPORTANT! This routine is only called on a chanPtr argument
+ * that is the top channel of a stack!
+ *
* Results:
* The return value is the Posix error code if an error occurred while
* reading from the file, or 0 otherwise.
@@ -5959,21 +6060,28 @@ GetInput(
return EINVAL;
}
+ /*
+ * For a channel at EOF do not bother allocating buffers; there's
+ * nothing more to read. Avoid calling the driver inputproc in
+ * case some of them do not react well to additional calls after
+ * they've reported an eof state..
+ * TODO: Candidate for a can't happen panic.
+ */
+
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
+ return 0;
+ }
+
/*
* First check for more buffers in the pushback area of the topmost
* channel in the stack and use them. They can be the result of a
* transformation which went away without reading all the information
* placed in the area when it was stacked.
- *
- * Two possibilities for the state: No buffers in it, or a single empty
- * buffer. In the latter case we can recycle it now.
*/
if (chanPtr->inQueueHead != NULL) {
- if (statePtr->inQueueHead != NULL) {
- RecycleBuffer(statePtr, statePtr->inQueueHead, 0);
- statePtr->inQueueHead = NULL;
- }
+
+ assert(statePtr->inQueueHead == NULL);
statePtr->inQueueHead = chanPtr->inQueueHead;
statePtr->inQueueTail = chanPtr->inQueueTail;
@@ -5994,21 +6102,20 @@ GetInput(
*/
bufPtr = statePtr->inQueueTail;
- if ((bufPtr != NULL) && !IsBufferFull(bufPtr)) {
- toRead = SpaceLeft(bufPtr);
- } else {
+
+ if ((bufPtr == NULL) || IsBufferFull(bufPtr)) {
bufPtr = statePtr->saveInBufPtr;
statePtr->saveInBufPtr = NULL;
/*
* Check the actual buffersize against the requested buffersize.
- * Buffers which are smaller than requested are squashed. This is done
+ * Saved buffers of the wrong size are squashed. This is done
* to honor dynamic changes of the buffersize made by the user.
*/
if ((bufPtr != NULL)
- && (bufPtr->bufLength - BUFFER_PADDING < statePtr->bufSize)) {
- ckfree((char *) bufPtr);
+ && (bufPtr->bufLength - BUFFER_PADDING != statePtr->bufSize)) {
+ ReleaseChannelBuffer(bufPtr);
bufPtr = NULL;
}
@@ -6017,21 +6124,8 @@ GetInput(
}
bufPtr->nextPtr = NULL;
- /*
- * SF #427196: Use the actual size of the buffer to determine the
- * number of bytes to read from the channel and not the size for new
- * buffers. They can be different if the buffersize was changed
- * between reads.
- *
- * Note: This affects performance negatively if the buffersize was
- * extended but this small buffer is reused for all subsequent reads.
- * The system never uses buffers with the requested bigger size in
- * that case. An adjunct patch could try and delete all unused buffers
- * it encounters and which are smaller than the formally requested
- * buffersize.
- */
-
toRead = SpaceLeft(bufPtr);
+ assert(toRead == statePtr->bufSize);
if (statePtr->inQueueTail == NULL) {
statePtr->inQueueHead = bufPtr;
@@ -6039,80 +6133,22 @@ GetInput(
statePtr->inQueueTail->nextPtr = bufPtr;
}
statePtr->inQueueTail = bufPtr;
+ } else {
+ toRead = SpaceLeft(bufPtr);
}
- /*
- * If EOF is set, we should avoid calling the driver because on some
- * platforms it is impossible to read from a device after EOF.
- */
-
- if (statePtr->flags & CHANNEL_EOF) {
- return 0;
- }
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- /*
- * [SF Tcl Bug 943274]. Better emulation of non-blocking channels for
- * channels without BlockModeProc, by keeping track of true fileevents
- * generated by the OS == Data waiting and reading if and only if we are
- * sure to have data.
- */
+ PreserveChannelBuffer(bufPtr);
+ nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead);
- if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
- (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
- !(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
- /*
- * Bypass the driver, it would block, as no data is available
- */
-
- nread = -1;
- result = EWOULDBLOCK;
+ if (nread < 0) {
+ result = Tcl_GetErrno();
} else {
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
- nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead, &result);
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- }
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
- if (nread > 0) {
+ result = 0;
bufPtr->nextAdded += nread;
-
- /*
- * If we get a short read, signal up that we may be BLOCKED. We should
- * avoid calling the driver because on some platforms we will block in
- * the low level reading code even though the channel is set into
- * nonblocking mode.
- */
-
- if (nread < toRead) {
- SetFlag(statePtr, CHANNEL_BLOCKED);
- }
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- if (nread <= toRead) {
- /*
- * [SF Tcl Bug 943274] We have read the available data, clear
- * flag.
- */
-
- ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
- }
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
- } else if (nread == 0) {
- SetFlag(statePtr, CHANNEL_EOF);
- statePtr->inputEncodingFlags |= TCL_ENCODING_END;
- } else if (nread < 0) {
- if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
- SetFlag(statePtr, CHANNEL_BLOCKED);
- result = EAGAIN;
- }
- Tcl_SetErrno(result);
- return result;
}
- return 0;
+
+ ReleaseChannelBuffer(bufPtr);
+ return result;
}
/*
@@ -6227,28 +6263,19 @@ Tcl_Seek(
*/
wasAsync = 0;
- if (statePtr->flags & CHANNEL_NONBLOCKING) {
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
wasAsync = 1;
result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
if (result != 0) {
return Tcl_LongAsWide(-1);
}
ResetFlag(statePtr, CHANNEL_NONBLOCKING);
- if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+ if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
}
}
/*
- * If there is data buffered in statePtr->curOutPtr then mark the channel
- * as ready to flush before invoking FlushChannel.
- */
-
- if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
- SetFlag(statePtr, BUFFER_READY);
- }
-
- /*
* If the flush fails we cannot recover the original position. In that
* case the seek is not attempted because we do not know where the access
* position is - instead we return the error. FlushChannel has already
@@ -6570,8 +6597,7 @@ CheckChannelErrors(
* order to drain data from stacked channels.
*/
- if ((statePtr->flags & CHANNEL_CLOSED) &&
- ((flags & CHANNEL_RAW_MODE) == 0)) {
+ if (GotFlag(statePtr, CHANNEL_CLOSED) && !(flags & CHANNEL_RAW_MODE)) {
Tcl_SetErrno(EACCES);
return -1;
}
@@ -6580,7 +6606,7 @@ CheckChannelErrors(
* Fail if the channel is not opened for desired operation.
*/
- if ((statePtr->flags & direction) == 0) {
+ if (GotFlag(statePtr, direction) == 0) {
Tcl_SetErrno(EACCES);
return -1;
}
@@ -6593,23 +6619,13 @@ CheckChannelErrors(
* retrieving and transforming the data to copy.
*/
- if (BUSY_STATE(statePtr,flags) && ((flags & CHANNEL_RAW_MODE) == 0)) {
+ if (BUSY_STATE(statePtr, flags) && ((flags & CHANNEL_RAW_MODE) == 0)) {
Tcl_SetErrno(EBUSY);
return -1;
}
if (direction == TCL_READABLE) {
- /*
- * If we have not encountered a sticky EOF, clear the EOF bit (sticky
- * EOF is set if we have seen the input eofChar, to prevent reading
- * beyond the eofChar). Also, always clear the BLOCKED bit. We want to
- * discover these conditions anew in each operation.
- */
-
- if ((statePtr->flags & CHANNEL_STICKY_EOF) == 0) {
- ResetFlag(statePtr, CHANNEL_EOF);
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
+ ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
}
return 0;
@@ -6638,8 +6654,8 @@ Tcl_Eof(
ChannelState *statePtr = ((Channel *) chan)->state;
/* State of real channel structure. */
- return ((statePtr->flags & CHANNEL_STICKY_EOF) ||
- ((statePtr->flags & CHANNEL_EOF) &&
+ return (GotFlag(statePtr, CHANNEL_STICKY_EOF) ||
+ (GotFlag(statePtr, CHANNEL_EOF) &&
(Tcl_InputBuffered(chan) == 0))) ? 1 : 0;
}
@@ -6666,7 +6682,7 @@ Tcl_InputBlocked(
ChannelState *statePtr = ((Channel *) chan)->state;
/* State of real channel structure. */
- return (statePtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
+ return GotFlag(statePtr, CHANNEL_BLOCKED) ? 1 : 0;
}
/*
@@ -6825,7 +6841,27 @@ Tcl_SetChannelBufferSize(
}
statePtr = ((Channel *) chan)->state;
+
+ if (statePtr->bufSize == sz) {
+ return;
+ }
statePtr->bufSize = sz;
+
+ /*
+ * If bufsize changes, need to get rid of old utility buffer.
+ */
+
+ if (statePtr->saveInBufPtr != NULL) {
+ RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1);
+ statePtr->saveInBufPtr = NULL;
+ }
+ if ((statePtr->inQueueHead != NULL)
+ && (statePtr->inQueueHead->nextPtr == NULL)
+ && IsBufferEmpty(statePtr->inQueueHead)) {
+ RecycleBuffer(statePtr, statePtr->inQueueHead, 1);
+ statePtr->inQueueHead = NULL;
+ statePtr->inQueueTail = NULL;
+ }
}
/*
@@ -7259,6 +7295,7 @@ Tcl_SetChannelOption(
return TCL_ERROR;
}
Tcl_SetChannelBufferSize(chan, newBufferSize);
+ return TCL_OK;
} else if (HaveOpt(2, "-encoding")) {
Tcl_Encoding encoding;
@@ -7276,7 +7313,8 @@ Tcl_SetChannelOption(
* iso2022, the terminated escape sequence must write to the buffer.
*/
- if ((statePtr->encoding != NULL) && (statePtr->curOutPtr != NULL)
+ if ((statePtr->encoding != NULL)
+ && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)
&& (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
statePtr->outputEncodingFlags |= TCL_ENCODING_END;
WriteChars(chanPtr, "", 0);
@@ -7289,6 +7327,7 @@ Tcl_SetChannelOption(
statePtr->outputEncodingFlags = TCL_ENCODING_START;
ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
UpdateInterest(chanPtr);
+ return TCL_OK;
} else if (HaveOpt(2, "-eofchar")) {
if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
return TCL_ERROR;
@@ -7308,10 +7347,10 @@ Tcl_SetChannelOption(
ckfree((char *) argv);
return TCL_ERROR;
}
- if (statePtr->flags & TCL_READABLE) {
+ if (GotFlag(statePtr, TCL_READABLE)) {
statePtr->inEofChar = inValue;
}
- if (statePtr->flags & TCL_WRITABLE) {
+ if (GotFlag(statePtr, TCL_WRITABLE)) {
statePtr->outEofChar = outValue;
}
} else {
@@ -7345,11 +7384,11 @@ Tcl_SetChannelOption(
}
if (argc == 1) {
- readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
- writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[0] : NULL;
+ readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL;
+ writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[0] : NULL;
} else if (argc == 2) {
- readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
- writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[1] : NULL;
+ readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL;
+ writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL;
} else {
if (interp) {
Tcl_AppendResult(interp,
@@ -7450,22 +7489,6 @@ Tcl_SetChannelOption(
return Tcl_BadChannelOption(interp, optionName, NULL);
}
- /*
- * If bufsize changes, need to get rid of old utility buffer.
- */
-
- if (statePtr->saveInBufPtr != NULL) {
- RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1);
- statePtr->saveInBufPtr = NULL;
- }
- if ((statePtr->inQueueHead != NULL)
- && (statePtr->inQueueHead->nextPtr == NULL)
- && IsBufferEmpty(statePtr->inQueueHead)) {
- RecycleBuffer(statePtr, statePtr->inQueueHead, 1);
- statePtr->inQueueHead = NULL;
- statePtr->inQueueTail = NULL;
- }
-
return TCL_OK;
}
@@ -7557,21 +7580,6 @@ Tcl_NotifyChannel(
Channel *upChanPtr;
const Tcl_ChannelType *upTypePtr;
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- /*
- * [SF Tcl Bug 943274] For a non-blocking channel without blockmodeproc we
- * keep track of actual input coming from the OS so that we can do a
- * credible imitation of non-blocking behaviour.
- */
-
- if ((mask & TCL_READABLE) &&
- (statePtr->flags & CHANNEL_NONBLOCKING) &&
- (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
- !(statePtr->flags & CHANNEL_TIMER_FEV)) {
- SetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
- }
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
/*
* In contrast to the other API functions this procedure walks towards the
* top of a stack and not down from it.
@@ -7630,7 +7638,7 @@ Tcl_NotifyChannel(
* don't call any write handlers before the flush is complete.
*/
- if ((statePtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
+ if (GotFlag(statePtr, BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
FlushChannel(NULL, chanPtr, 1);
mask &= ~TCL_WRITABLE;
}
@@ -7700,12 +7708,17 @@ UpdateInterest(
/* State info for channel */
int mask = statePtr->interestMask;
+ if (chanPtr->typePtr == NULL) {
+ /* Do not update interest on a closed channel */
+ return;
+ }
+
/*
* If there are flushed buffers waiting to be written, then we need to
* watch for the channel to become writable.
*/
- if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+ if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
mask |= TCL_WRITABLE;
}
@@ -7717,7 +7730,7 @@ UpdateInterest(
*/
if (mask & TCL_READABLE) {
- if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
+ if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
&& (statePtr->inQueueHead != NULL)
&& IsBufferReady(statePtr->inQueueHead)) {
mask &= ~TCL_READABLE;
@@ -7796,7 +7809,7 @@ ChannelTimerProc(
ChannelState *statePtr = chanPtr->state;
/* State info for channel */
- if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
+ if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
&& (statePtr->interestMask & TCL_READABLE)
&& (statePtr->inQueueHead != NULL)
&& IsBufferReady(statePtr->inQueueHead)) {
@@ -7806,29 +7819,8 @@ ChannelTimerProc(
*/
statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,chanPtr);
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- /*
- * Set the TIMER flag to notify the higher levels that the driver
- * might have no data for us. We do this only if we are in
- * non-blocking mode and the driver has no BlockModeProc because only
- * then we really don't know if the driver will block or not. A
- * similar test is done in "PeekAhead".
- */
-
- if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
- (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) {
- SetFlag(statePtr, CHANNEL_TIMER_FEV);
- }
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
Tcl_Preserve(statePtr);
- Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
-
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- ResetFlag(statePtr, CHANNEL_TIMER_FEV);
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-
+ Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);
Tcl_Release(statePtr);
} else {
statePtr->timer = NULL;
@@ -8241,7 +8233,7 @@ Tcl_FileEventObjCmd(
}
chanPtr = (Channel *) chan;
statePtr = chanPtr->state;
- if ((statePtr->flags & mask) == 0) {
+ if (GotFlag(statePtr, mask) == 0) {
Tcl_AppendResult(interp, "channel is not ",
(mask == TCL_READABLE) ? "readable" : "writable", NULL);
return TCL_ERROR;
@@ -8751,13 +8743,24 @@ CopyData(
*
* DoRead --
*
- * Reads a given number of bytes from a channel.
+ * Stores up to "bytesToRead" bytes in memory pointed to by "dst".
+ * These bytes come from reading the channel "chanPtr" and
+ * performing the configured translations.
*
* No encoding conversions are applied to the bytes being read.
*
* Results:
- * The number of characters read, or -1 on error. Use Tcl_GetErrno() to
- * retrieve the error code for the error that occurred.
+ * The number of bytes actually stored (<= bytesToRead),
+ * or -1 if there is an error in reading the channel. Use
+ * Tcl_GetErrno() to retrieve the error code for the error
+ * that occurred.
+ *
+ * The number of bytes stored can be less than the number
+ * requested when
+ * - EOF is reached on the channel; or
+ * - the channel is non-blocking, and we've read all we can
+ * without blocking.
+ * - a channel reading error occurs (and we return -1)
*
* Side effects:
* May cause input to be buffered.
@@ -8768,288 +8771,151 @@ CopyData(
static int
DoRead(
Channel *chanPtr, /* The channel from which to read. */
- char *bufPtr, /* Where to store input read. */
- int toRead) /* Maximum number of bytes to read. */
+ char *dst, /* Where to store input read. */
+ int bytesToRead) /* Maximum number of bytes to read. */
{
ChannelState *statePtr = chanPtr->state;
- /* State info for channel */
- int copied; /* How many characters were copied into the
- * result string? */
- int copiedNow; /* How many characters were copied from the
- * current input buffer? */
- int result; /* Of calling GetInput. */
+ char *p = dst;
- /*
- * If we have not encountered a sticky EOF, clear the EOF bit. Either way
- * clear the BLOCKED bit. We want to discover these anew during each
- * operation.
- */
+ Tcl_Preserve(chanPtr);
+ while (bytesToRead) {
+ /*
+ * Each pass through the loop is intended to process up to
+ * one channel buffer.
+ */
- if (!(statePtr->flags & CHANNEL_STICKY_EOF)) {
- ResetFlag(statePtr, CHANNEL_EOF);
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
+ int bytesRead, bytesWritten;
+ ChannelBuffer *bufPtr = statePtr->inQueueHead;
- for (copied = 0; copied < toRead; copied += copiedNow) {
- copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied,
- toRead - copied);
- if (copiedNow == 0) {
- if (statePtr->flags & CHANNEL_EOF) {
- goto done;
- }
- if (statePtr->flags & CHANNEL_BLOCKED) {
- if (statePtr->flags & CHANNEL_NONBLOCKING) {
- goto done;
- }
- ResetFlag(statePtr, CHANNEL_BLOCKED);
- }
- result = GetInput(chanPtr);
- if (result != 0) {
- if (result != EAGAIN) {
- copied = -1;
- }
- goto done;
- }
- }
- }
+ /*
+ * When there's no buffered data to read, and we're at EOF,
+ * escape to the caller.
+ */
- ResetFlag(statePtr, CHANNEL_BLOCKED);
+ if (GotFlag(statePtr, CHANNEL_EOF)
+ && (bufPtr == NULL || IsBufferEmpty(bufPtr))) {
+ break;
+ }
- /*
- * Update the notifier state so we don't block while there is still data
- * in the buffers.
- */
+ /* If there is no full buffer, attempt to create and/or fill one. */
- done:
- UpdateInterest(chanPtr);
- return copied;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CopyAndTranslateBuffer --
- *
- * Copy at most one buffer of input to the result space, doing eol
- * translations according to mode in effect currently.
- *
- * Results:
- * Number of bytes stored in the result buffer (as opposed to the number
- * of bytes read from the channel). May return zero if no input is
- * available to be translated.
- *
- * Side effects:
- * Consumes buffered input. May deallocate one buffer.
- *
- *----------------------------------------------------------------------
- */
+ while (!IsBufferFull(bufPtr)) {
+ int code;
-static int
-CopyAndTranslateBuffer(
- ChannelState *statePtr, /* Channel state from which to read input. */
- char *result, /* Where to store the copied input. */
- int space) /* How many bytes are available in result to
- * store the copied input? */
-{
- ChannelBuffer *bufPtr; /* The buffer from which to copy bytes. */
- int bytesInBuffer; /* How many bytes are available to be copied
- * in the current input buffer? */
- int copied; /* How many characters were already copied
- * into the destination space? */
- int i; /* Iterates over the copied input looking for
- * the input eofChar. */
+ moreData:
+ code = GetInput(chanPtr);
+ bufPtr = statePtr->inQueueHead;
- /*
- * If there is no input at all, return zero. The invariant is that either
- * there is no buffer in the queue, or if the first buffer is empty, it is
- * also the last buffer (and thus there is no input in the queue). Note
- * also that if the buffer is empty, we leave it in the queue.
- */
+ assert (bufPtr != NULL);
- if (statePtr->inQueueHead == NULL) {
- return 0;
- }
- bufPtr = statePtr->inQueueHead;
- bytesInBuffer = BytesLeft(bufPtr);
+ if (GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)) {
+ /* Further reads cannot do any more */
+ break;
+ }
+
+ if (code) {
+ /* Read error */
+ UpdateInterest(chanPtr);
+ Tcl_Release(chanPtr);
+ return -1;
+ }
- copied = 0;
- switch (statePtr->inputTranslation) {
- case TCL_TRANSLATE_LF:
- if (bytesInBuffer == 0) {
- return 0;
+ assert (IsBufferFull(bufPtr));
}
- /*
- * Copy the current chunk into the result buffer.
- */
+ assert (bufPtr != NULL);
- if (bytesInBuffer < space) {
- space = bytesInBuffer;
- }
- memcpy(result, RemovePoint(bufPtr), (size_t) space);
- bufPtr->nextRemoved += space;
- copied = space;
- break;
- case TCL_TRANSLATE_CR: {
- char *end;
+ bytesRead = BytesLeft(bufPtr);
+ bytesWritten = bytesToRead;
- if (bytesInBuffer == 0) {
- return 0;
- }
+ TranslateInputEOL(statePtr, p, RemovePoint(bufPtr),
+ &bytesWritten, &bytesRead);
+ bufPtr->nextRemoved += bytesRead;
+ p += bytesWritten;
+ bytesToRead -= bytesWritten;
- /*
- * Copy the current chunk into the result buffer, then replace all \r
- * with \n.
- */
-
- if (bytesInBuffer < space) {
- space = bytesInBuffer;
- }
- memcpy(result, RemovePoint(bufPtr), (size_t) space);
- bufPtr->nextRemoved += space;
- copied = space;
+ if (!IsBufferEmpty(bufPtr)) {
+ /*
+ * Buffer is not empty. How can that be?
+ *
+ * 0) We stopped early because we got all the bytes
+ * we were seeking. That's fine.
+ */
- for (end = result + copied; result < end; result++) {
- if (*result == '\r') {
- *result = '\n';
+ if (bytesToRead == 0) {
+ UpdateInterest(chanPtr);
+ break;
}
- }
- break;
- }
- case TCL_TRANSLATE_CRLF: {
- char *src, *end, *dst;
- int curByte;
- /*
- * If there is a held-back "\r" at EOF, produce it now.
- */
+ /*
+ * 1) We're @EOF because we saw eof char.
+ */
- if (bytesInBuffer == 0) {
- if ((statePtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
- (INPUT_SAW_CR | CHANNEL_EOF)) {
- result[0] = '\r';
- ResetFlag(statePtr, INPUT_SAW_CR);
- return 1;
+ if (statePtr->inEofChar
+ && RemovePoint(bufPtr)[0] == statePtr->inEofChar) {
+ UpdateInterest(chanPtr);
+ break;
}
- return 0;
- }
- /*
- * Copy the current chunk and replace "\r\n" with "\n" (but not
- * standalone "\r"!).
- */
-
- if (bytesInBuffer < space) {
- space = bytesInBuffer;
- }
- memcpy(result, RemovePoint(bufPtr), (size_t) space);
- bufPtr->nextRemoved += space;
- copied = space;
-
- end = result + copied;
- dst = result;
- for (src = result; src < end; src++) {
- curByte = *src;
- if (curByte == '\n') {
- ResetFlag(statePtr, INPUT_SAW_CR);
- } else if (statePtr->flags & INPUT_SAW_CR) {
- ResetFlag(statePtr, INPUT_SAW_CR);
- *dst = '\r';
- dst++;
- }
- if (curByte == '\r') {
- SetFlag(statePtr, INPUT_SAW_CR);
- } else {
- *dst = (char) curByte;
- dst++;
- }
- }
- copied = dst - result;
- break;
- }
- case TCL_TRANSLATE_AUTO: {
- char *src, *end, *dst;
- int curByte;
+ /*
+ * 2) The buffer holds a \r while in CRLF translation,
+ * followed by the end of the buffer.
+ */
- if (bytesInBuffer == 0) {
- return 0;
- }
+ assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF);
+ assert(RemovePoint(bufPtr)[0] == '\r');
+ assert(BytesLeft(bufPtr) == 1);
- /*
- * Loop over the current buffer, converting "\r" and "\r\n" to "\n".
- */
+ if (bufPtr->nextPtr == NULL) {
+ /* There's no more buffered data.... */
- if (bytesInBuffer < space) {
- space = bytesInBuffer;
- }
- memcpy(result, RemovePoint(bufPtr), (size_t) space);
- bufPtr->nextRemoved += space;
- copied = space;
+ if (GotFlag(statePtr, CHANNEL_EOF)) {
+ /* ...and there never will be. */
- end = result + copied;
- dst = result;
- for (src = result; src < end; src++) {
- curByte = *src;
- if (curByte == '\r') {
- SetFlag(statePtr, INPUT_SAW_CR);
- *dst = '\n';
- dst++;
- } else {
- if ((curByte != '\n') || !(statePtr->flags & INPUT_SAW_CR)) {
- *dst = (char) curByte;
- dst++;
+ *p++ = '\r';
+ bytesToRead--;
+ bufPtr->nextRemoved++;
+ } else if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
+ /* ...and we cannot get more now. */
+ SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
+ UpdateInterest(chanPtr);
+ break;
+ } else {
+ /* ... so we need to get some. */
+ goto moreData;
}
- ResetFlag(statePtr, INPUT_SAW_CR);
}
- }
- copied = dst - result;
- break;
- }
- default:
- Tcl_Panic("unknown eol translation mode");
- }
- /*
- * If an in-stream EOF character is set for this channel, check that the
- * input we copied so far does not contain the EOF char. If it does, copy
- * only up to and excluding that character.
- */
+ if (bufPtr->nextPtr) {
+ /* There's a next buffer. Shift orphan \r to it. */
- if (statePtr->inEofChar != 0) {
- for (i = 0; i < copied; i++) {
- if (result[i] == (char) statePtr->inEofChar) {
- /*
- * Set sticky EOF so that no further input is presented to the
- * caller.
- */
+ ChannelBuffer *nextPtr = bufPtr->nextPtr;
- SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
- statePtr->inputEncodingFlags |= TCL_ENCODING_END;
- copied = i;
- break;
+ nextPtr->nextRemoved -= 1;
+ RemovePoint(nextPtr)[0] = '\r';
+ bufPtr->nextRemoved++;
}
}
- }
- /*
- * If the current buffer is empty recycle it.
- */
+ if (IsBufferEmpty(bufPtr)) {
+ statePtr->inQueueHead = bufPtr->nextPtr;
+ if (statePtr->inQueueHead == NULL) {
+ statePtr->inQueueTail = NULL;
+ }
+ RecycleBuffer(statePtr, bufPtr, 0);
+ }
- if (IsBufferEmpty(bufPtr)) {
- statePtr->inQueueHead = bufPtr->nextPtr;
- if (statePtr->inQueueHead == NULL) {
- statePtr->inQueueTail = NULL;
+ if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)
+ == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) {
+ break;
}
- RecycleBuffer(statePtr, bufPtr, 0);
+ }
+ if (bytesToRead == 0) {
+ ResetFlag(statePtr, CHANNEL_BLOCKED);
}
- /*
- * Return the number of characters copied into the result buffer. This may
- * be different from the number of bytes consumed, because of EOL
- * translations.
- */
-
- return copied;
+ Tcl_Release(chanPtr);
+ return (int)(p - dst);
}
/*
@@ -9259,12 +9125,15 @@ StackSetBlockMode(
{
int result = 0;
Tcl_DriverBlockModeProc *blockModeProc;
+ ChannelState *statePtr = chanPtr->state;
/*
* Start at the top of the channel stack
+ * TODO: Examine what can go wrong when blockModeProc calls
+ * disturb the stacking state of the channel.
*/
- chanPtr = chanPtr->state->topChanPtr;
+ chanPtr = statePtr->topChanPtr;
while (chanPtr != NULL) {
blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
if (blockModeProc != NULL) {
@@ -10409,11 +10278,13 @@ SetChannelFromAny(
}
if (objPtr->typePtr == &chanObjType) {
/*
+ * TODO: TAINT Flag and dup'd channel values?
* The channel is valid until any call to DetachChannel occurs.
* Ensure consistency checks are done.
*/
- statePtr = GET_CHANNELSTATE(objPtr);
- if (statePtr->flags & (CHANNEL_TAINTED|CHANNEL_CLOSED)) {
+
+ statePtr = GET_CHANNELSTATE(objPtr);
+ if (GotFlag(statePtr, CHANNEL_TAINTED|CHANNEL_CLOSED)) {
ResetFlag(statePtr, CHANNEL_TAINTED);
Tcl_Release((ClientData) statePtr);
objPtr->typePtr = NULL;
@@ -10483,20 +10354,14 @@ DumpFlags(
ChanFlag('n', CHANNEL_NONBLOCKING);
ChanFlag('l', CHANNEL_LINEBUFFERED);
ChanFlag('u', CHANNEL_UNBUFFERED);
- ChanFlag('R', BUFFER_READY);
ChanFlag('F', BG_FLUSH_SCHEDULED);
ChanFlag('c', CHANNEL_CLOSED);
ChanFlag('E', CHANNEL_EOF);
ChanFlag('S', CHANNEL_STICKY_EOF);
ChanFlag('B', CHANNEL_BLOCKED);
ChanFlag('/', INPUT_SAW_CR);
- ChanFlag('*', INPUT_NEED_NL);
ChanFlag('D', CHANNEL_DEAD);
ChanFlag('R', CHANNEL_RAW_MODE);
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
- ChanFlag('T', CHANNEL_TIMER_FEV);
- ChanFlag('H', CHANNEL_HAS_MORE_DATA);
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
ChanFlag('x', CHANNEL_INCLOSE);
buf[i] ='\0';
@@ -10511,5 +10376,7 @@ DumpFlags(
* mode: c
* c-basic-offset: 4
* fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
* End:
*/
diff --git a/generic/tclIO.h b/generic/tclIO.h
index ebf2ef7..59182ec 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -36,6 +36,7 @@
*/
typedef struct ChannelBuffer {
+ int refCount; /* Current uses count */
int nextAdded; /* The next position into which a character
* will be put in the buffer. */
int nextRemoved; /* Position of next byte to be removed from
@@ -226,11 +227,6 @@ typedef struct ChannelState {
* flushed after every newline. */
#define CHANNEL_UNBUFFERED (1<<5) /* Output to the channel must always
* be flushed immediately. */
-#define BUFFER_READY (1<<6) /* Current output buffer (the
- * curOutPtr field in the channel
- * structure) should be output as soon
- * as possible even though it may not
- * be full. */
#define BG_FLUSH_SCHEDULED (1<<7) /* A background flush of the queued
* output buffers has been
* scheduled. */
@@ -252,9 +248,6 @@ typedef struct ChannelState {
#define INPUT_SAW_CR (1<<12) /* Channel is in CRLF eol input
* translation mode and the last byte
* seen was a "\r". */
-#define INPUT_NEED_NL (1<<15) /* Saw a '\r' at end of last buffer,
- * and there should be a '\n' at
- * beginning of next buffer. */
#define CHANNEL_DEAD (1<<13) /* The channel has been closed by the
* exit handler (on exit) but not
* deallocated. When any IO operation
@@ -274,29 +267,6 @@ typedef struct ChannelState {
* changes. */
#define CHANNEL_RAW_MODE (1<<16) /* When set, notes that the Raw API is
* being used. */
-#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-#define CHANNEL_TIMER_FEV (1<<17) /* When set the event we are notified
- * by is a fileevent generated by a
- * timer. We don't know if the driver
- * has more data and should not try to
- * read from it. If the system needs
- * more than is in the buffers out
- * read routines will simulate a short
- * read (0 characters read) */
-#define CHANNEL_HAS_MORE_DATA (1<<18) /* Set by NotifyChannel for a channel
- * if and only if the channel is
- * configured non-blocking, the driver
- * for said channel has no
- * blockmodeproc, and data has arrived
- * for reading at the OS level). A
- * GetInput will pass reading from the
- * driver if the channel is
- * non-blocking, without blockmode
- * proc and the flag has not been set.
- * A read will be performed if the
- * flag is set. This will reset the
- * flag as well. */
-#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
#define CHANNEL_INCLOSE (1<<19) /* Channel is currently being closed.
* Its structures are still live and
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 2958bc8..afd6272 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -177,6 +177,7 @@ Tcl_PutsObjCmd(
return TCL_ERROR;
}
+ Tcl_Preserve(chan);
result = Tcl_WriteObj(chan, string);
if (result < 0) {
goto error;
@@ -187,6 +188,7 @@ Tcl_PutsObjCmd(
goto error;
}
}
+ Tcl_Release(chan);
return TCL_OK;
/*
@@ -202,6 +204,7 @@ Tcl_PutsObjCmd(
TclGetString(chanObjPtr), "\": ",
Tcl_PosixError(interp), NULL);
}
+ Tcl_Release(chan);
return TCL_ERROR;
}
@@ -248,6 +251,7 @@ Tcl_FlushObjCmd(
return TCL_ERROR;
}
+ Tcl_Preserve(chan);
if (Tcl_Flush(chan) != TCL_OK) {
/*
* TIP #219.
@@ -261,8 +265,10 @@ Tcl_FlushObjCmd(
TclGetString(chanObjPtr), "\": ",
Tcl_PosixError(interp), NULL);
}
+ Tcl_Release(chan);
return TCL_ERROR;
}
+ Tcl_Release(chan);
return TCL_OK;
}
@@ -295,6 +301,7 @@ Tcl_GetsObjCmd(
int lineLen; /* Length of line just read. */
int mode; /* Mode in which channel is opened. */
Tcl_Obj *linePtr, *chanObjPtr;
+ int code = TCL_OK;
if ((objc != 2) && (objc != 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
@@ -310,6 +317,7 @@ Tcl_GetsObjCmd(
return TCL_ERROR;
}
+ Tcl_Preserve(chan);
linePtr = Tcl_NewObj();
lineLen = Tcl_GetsObj(chan, linePtr);
if (lineLen < 0) {
@@ -329,21 +337,24 @@ Tcl_GetsObjCmd(
TclGetString(chanObjPtr), "\": ",
Tcl_PosixError(interp), NULL);
}
- return TCL_ERROR;
+ code = TCL_ERROR;
+ goto done;
}
lineLen = -1;
}
if (objc == 3) {
if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
TCL_LEAVE_ERR_MSG) == NULL) {
- return TCL_ERROR;
+ code = TCL_ERROR;
+ goto done;
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
- return TCL_OK;
} else {
Tcl_SetObjResult(interp, linePtr);
}
- return TCL_OK;
+ done:
+ Tcl_Release(chan);
+ return code;
}
/*
@@ -447,6 +458,7 @@ Tcl_ReadObjCmd(
resultPtr = Tcl_NewObj();
Tcl_IncrRefCount(resultPtr);
+ Tcl_Preserve(chan);
charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
if (charactersRead < 0) {
/*
@@ -462,6 +474,7 @@ Tcl_ReadObjCmd(
TclGetString(chanObjPtr), "\": ",
Tcl_PosixError(interp), NULL);
}
+ Tcl_Release(chan);
Tcl_DecrRefCount(resultPtr);
return TCL_ERROR;
}
@@ -480,6 +493,7 @@ Tcl_ReadObjCmd(
}
}
Tcl_SetObjResult(interp, resultPtr);
+ Tcl_Release(chan);
Tcl_DecrRefCount(resultPtr);
return TCL_OK;
}
@@ -539,6 +553,7 @@ Tcl_SeekObjCmd(
mode = modeArray[optionIndex];
}
+ Tcl_Preserve(chan);
result = Tcl_Seek(chan, offset, mode);
if (result == Tcl_LongAsWide(-1)) {
/*
@@ -552,8 +567,10 @@ Tcl_SeekObjCmd(
TclGetString(objv[1]), "\": ",
Tcl_PosixError(interp), NULL);
}
+ Tcl_Release(chan);
return TCL_ERROR;
}
+ Tcl_Release(chan);
return TCL_OK;
}
@@ -584,6 +601,7 @@ Tcl_TellObjCmd(
{
Tcl_Channel chan; /* The channel to tell on. */
Tcl_WideInt newLoc;
+ int code;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
@@ -599,6 +617,7 @@ Tcl_TellObjCmd(
return TCL_ERROR;
}
+ Tcl_Preserve(chan);
newLoc = Tcl_Tell(chan);
/*
@@ -607,7 +626,10 @@ Tcl_TellObjCmd(
* them into the regular interpreter result.
*/
- if (TclChanCaughtErrorBypass(interp, chan)) {
+
+ code = TclChanCaughtErrorBypass(interp, chan);
+ Tcl_Release(chan);
+ if (code) {
return TCL_ERROR;
}
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index eed21fb..fe0a880 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -210,7 +210,27 @@ struct TransformChannelData {
* a transformation of incoming data. Also
* serves as buffer of all data not yet
* consumed by the reader. */
+ int refCount;
};
+
+static void
+PreserveData(
+ TransformChannelData *dataPtr)
+{
+ dataPtr->refCount++;
+}
+
+static void
+ReleaseData(
+ TransformChannelData *dataPtr)
+{
+ if (--dataPtr->refCount) {
+ return;
+ }
+ ResultClear(&dataPtr->result);
+ Tcl_DecrRefCount(dataPtr->command);
+ ckfree((char *) dataPtr);
+}
/*
*----------------------------------------------------------------------
@@ -240,6 +260,7 @@ TclChannelTransform(
Channel *chanPtr; /* The actual channel. */
ChannelState *statePtr; /* State info for channel. */
int mode; /* Read/write mode of the channel. */
+ int objc;
TransformChannelData *dataPtr;
Tcl_DString ds;
@@ -247,6 +268,12 @@ TclChannelTransform(
return TCL_ERROR;
}
+ if (TCL_OK != Tcl_ListObjLength(interp, cmdObjPtr, &objc)) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("-command value is not a list", -1));
+ return TCL_ERROR;
+ }
+
chanPtr = (Channel *) chan;
statePtr = chanPtr->state;
chanPtr = statePtr->topChanPtr;
@@ -261,6 +288,7 @@ TclChannelTransform(
dataPtr = (TransformChannelData *) ckalloc(sizeof(TransformChannelData));
+ dataPtr->refCount = 1;
Tcl_DStringInit(&ds);
Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
dataPtr->readIsFlushed = 0;
@@ -270,7 +298,6 @@ TclChannelTransform(
}
Tcl_DStringFree(&ds);
- dataPtr->self = chan;
dataPtr->watchMask = 0;
dataPtr->mode = mode;
dataPtr->timer = NULL;
@@ -286,19 +313,20 @@ TclChannelTransform(
if (dataPtr->self == NULL) {
Tcl_AppendResult(interp, "\nfailed to stack channel \"",
Tcl_GetChannelName(chan), "\"", NULL);
- Tcl_DecrRefCount(dataPtr->command);
- ResultClear(&dataPtr->result);
- ckfree((char *) dataPtr);
+ ReleaseData(dataPtr);
return TCL_ERROR;
}
+ Tcl_Preserve(dataPtr->self);
/*
* At last initialize the transformation at the script level.
*/
+ PreserveData(dataPtr);
if ((dataPtr->mode & TCL_WRITABLE) && ExecuteCallback(dataPtr, NULL,
A_CREATE_WRITE, NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE) != TCL_OK){
Tcl_UnstackChannel(interp, chan);
+ ReleaseData(dataPtr);
return TCL_ERROR;
}
@@ -307,9 +335,11 @@ TclChannelTransform(
ExecuteCallback(dataPtr, NULL, A_DELETE_WRITE, NULL, 0, TRANSMIT_DONT,
P_NO_PRESERVE);
Tcl_UnstackChannel(interp, chan);
+ ReleaseData(dataPtr);
return TCL_ERROR;
}
+ ReleaseData(dataPtr);
return TCL_OK;
}
@@ -350,7 +380,10 @@ ExecuteCallback(
unsigned char *resBuf;
Tcl_InterpState state = NULL;
int res = TCL_OK;
- Tcl_Obj *command = Tcl_DuplicateObj(dataPtr->command);
+ Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command);
+ Tcl_Interp *eval = dataPtr->interp;
+
+ Tcl_Preserve(eval);
/*
* Step 1, create the complete command to execute. Do this by appending
@@ -361,26 +394,18 @@ ExecuteCallback(
*/
if (preserve == P_PRESERVE) {
- state = Tcl_SaveInterpState(dataPtr->interp, res);
+ state = Tcl_SaveInterpState(eval, res);
}
Tcl_IncrRefCount(command);
- res = Tcl_ListObjAppendElement(dataPtr->interp, command,
- Tcl_NewStringObj((char *) op, -1));
- if (res != TCL_OK) {
- goto cleanup;
- }
+ Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, -1));
/*
* Use a byte-array to prevent the misinterpretation of binary data coming
* through as UTF while at the tcl level.
*/
- res = Tcl_ListObjAppendElement(dataPtr->interp, command,
- Tcl_NewByteArrayObj(buf, bufLen));
- if (res != TCL_OK) {
- goto cleanup;
- }
+ Tcl_ListObjAppendElement(NULL, command, Tcl_NewByteArrayObj(buf, bufLen));
/*
* Step 2, execute the command at the global level of the interpreter used
@@ -390,13 +415,14 @@ ExecuteCallback(
* current interpreter. Don't copy if in preservation mode.
*/
- res = Tcl_EvalObjEx(dataPtr->interp, command, TCL_EVAL_GLOBAL);
+ res = Tcl_EvalObjEx(eval, command, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(command);
command = NULL;
- if ((res != TCL_OK) && (interp != NULL) && (dataPtr->interp != interp)
+ if ((res != TCL_OK) && (interp != NULL) && (eval != interp)
&& (preserve == P_NO_PRESERVE)) {
- Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp));
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(eval));
+ Tcl_Release(eval);
return res;
}
@@ -411,20 +437,26 @@ ExecuteCallback(
break;
case TRANSMIT_DOWN:
- resObj = Tcl_GetObjResult(dataPtr->interp);
+ if (dataPtr->self == NULL) {
+ break;
+ }
+ resObj = Tcl_GetObjResult(eval);
resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf,
resLen);
break;
case TRANSMIT_SELF:
- resObj = Tcl_GetObjResult(dataPtr->interp);
+ if (dataPtr->self == NULL) {
+ break;
+ }
+ resObj = Tcl_GetObjResult(eval);
resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen);
break;
case TRANSMIT_IBUF:
- resObj = Tcl_GetObjResult(dataPtr->interp);
+ resObj = Tcl_GetObjResult(eval);
resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
ResultAdd(&dataPtr->result, resBuf, resLen);
break;
@@ -434,24 +466,16 @@ ExecuteCallback(
* Interpret result as integer number.
*/
- resObj = Tcl_GetObjResult(dataPtr->interp);
- TclGetIntFromObj(dataPtr->interp, resObj, &dataPtr->maxRead);
+ resObj = Tcl_GetObjResult(eval);
+ TclGetIntFromObj(eval, resObj, &dataPtr->maxRead);
break;
}
- Tcl_ResetResult(dataPtr->interp);
+ Tcl_ResetResult(eval);
if (preserve == P_PRESERVE) {
- (void) Tcl_RestoreInterpState(dataPtr->interp, state);
- }
- return res;
-
- cleanup:
- if (preserve == P_PRESERVE) {
- (void) Tcl_RestoreInterpState(dataPtr->interp, state);
- }
- if (command != NULL) {
- Tcl_DecrRefCount(command);
+ (void) Tcl_RestoreInterpState(eval, state);
}
+ Tcl_Release(eval);
return res;
}
@@ -535,6 +559,7 @@ TransformCloseProc(
* system rely on (f.e. signaling the close to interested parties).
*/
+ PreserveData(dataPtr);
if (dataPtr->mode & TCL_WRITABLE) {
ExecuteCallback(dataPtr, interp, A_FLUSH_WRITE, NULL, 0,
TRANSMIT_DOWN, P_PRESERVE);
@@ -554,14 +579,15 @@ TransformCloseProc(
ExecuteCallback(dataPtr, interp, A_DELETE_READ, NULL, 0,
TRANSMIT_DONT, P_PRESERVE);
}
+ ReleaseData(dataPtr);
/*
* General cleanup.
*/
- ResultClear(&dataPtr->result);
- Tcl_DecrRefCount(dataPtr->command);
- ckfree((char *) dataPtr);
+ Tcl_Release(dataPtr->self);
+ dataPtr->self = NULL;
+ ReleaseData(dataPtr);
return TCL_OK;
}
@@ -596,7 +622,7 @@ TransformInputProc(
* Should assert(dataPtr->mode & TCL_READABLE);
*/
- if (toRead == 0) {
+ if (toRead == 0 || dataPtr->self == NULL) {
/*
* Catch a no-op.
*/
@@ -606,6 +632,7 @@ TransformInputProc(
gotBytes = 0;
downChan = Tcl_GetStackedChannel(dataPtr->self);
+ PreserveData(dataPtr);
while (toRead > 0) {
/*
* Loop until the request is satisfied (or no data is available from
@@ -623,7 +650,7 @@ TransformInputProc(
* break out of the loop and return to the caller.
*/
- return gotBytes;
+ break;
}
/*
@@ -647,7 +674,7 @@ TransformInputProc(
}
} /* else: 'maxRead < 0' == Accept the current value of toRead. */
if (toRead <= 0) {
- return gotBytes;
+ break;
}
/*
@@ -656,43 +683,41 @@ TransformInputProc(
read = Tcl_ReadRaw(downChan, buf, toRead);
if (read < 0) {
- /*
- * Report errors to caller. EAGAIN is a special situation. If we
- * had some data before we report that instead of the request to
- * re-try.
- */
- if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
- return gotBytes;
+ if (Tcl_InputBlocked(downChan) && (gotBytes > 0)) {
+ /*
+ * Zero bytes available from downChan because blocked.
+ * But nonzero bytes already copied, so total is a
+ * valid blocked short read. Return to caller.
+ */
+
+ break;
}
+ /*
+ * Either downChan is not blocked (there's a real error).
+ * or it is and there are no bytes copied yet. In either
+ * case we want to pass the "error" along to the caller,
+ * either to report an error, or to signal to the caller
+ * that zero bytes are available because blocked.
+ */
+
*errorCodePtr = Tcl_GetErrno();
- return -1;
+ gotBytes = -1;
+ break;
} else if (read == 0) {
+
/*
- * Check wether we hit on EOF in the underlying channel or not. If
- * not differentiate between blocking and non-blocking modes. In
- * non-blocking mode we ran temporarily out of data. Signal this
- * to the caller via EWOULDBLOCK and error return (-1). In the
- * other cases we simply return what we got and let the caller
- * wait for more. On the other hand, if we got an EOF we have to
- * convert and flush all waiting partial data.
+ * Zero returned from Tcl_ReadRaw() always indicates EOF
+ * on the down channel.
*/
- if (!Tcl_Eof(downChan)) {
- if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) {
- *errorCodePtr = EWOULDBLOCK;
- return -1;
- }
- return gotBytes;
- }
-
if (dataPtr->readIsFlushed) {
/*
* Already flushed, nothing to do anymore.
*/
- return gotBytes;
+ break;
}
dataPtr->readIsFlushed = 1;
@@ -704,7 +729,7 @@ TransformInputProc(
* We had nothing to flush.
*/
- return gotBytes;
+ break;
}
continue; /* at: while (toRead > 0) */
@@ -718,9 +743,11 @@ TransformInputProc(
if (ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read,
TRANSMIT_IBUF, P_PRESERVE) != TCL_OK) {
*errorCodePtr = EINVAL;
- return -1;
+ gotBytes = -1;
+ break;
}
} /* while toRead > 0 */
+ ReleaseData(dataPtr);
return gotBytes;
}
@@ -762,11 +789,13 @@ TransformOutputProc(
return 0;
}
+ PreserveData(dataPtr);
if (ExecuteCallback(dataPtr, NULL, A_WRITE, UCHARP(buf), toWrite,
TRANSMIT_DOWN, P_NO_PRESERVE) != TCL_OK) {
*errorCodePtr = EINVAL;
- return -1;
+ toWrite = -1;
}
+ ReleaseData(dataPtr);
return toWrite;
}
@@ -819,6 +848,7 @@ TransformSeekProc(
* request down, unchanged.
*/
+ PreserveData(dataPtr);
if (dataPtr->mode & TCL_WRITABLE) {
ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
P_NO_PRESERVE);
@@ -830,6 +860,7 @@ TransformSeekProc(
ResultClear(&dataPtr->result);
dataPtr->readIsFlushed = 0;
}
+ ReleaseData(dataPtr);
return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode,
errorCodePtr);
@@ -890,6 +921,7 @@ TransformWideSeekProc(
* request down, unchanged.
*/
+ PreserveData(dataPtr);
if (dataPtr->mode & TCL_WRITABLE) {
ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
P_NO_PRESERVE);
@@ -901,6 +933,7 @@ TransformWideSeekProc(
ResultClear(&dataPtr->result);
dataPtr->readIsFlushed = 0;
}
+ ReleaseData(dataPtr);
/*
* If we have a wide seek capability, we should stick with that.
@@ -1055,6 +1088,9 @@ TransformWatchProc(
* unchanged.
*/
+ if (dataPtr->self == NULL) {
+ return;
+ }
downChan = Tcl_GetStackedChannel(dataPtr->self);
Tcl_GetChannelType(downChan)->watchProc(
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index ca3ab4b..3107f9e 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -91,31 +91,9 @@ typedef struct {
#ifdef TCL_THREADS
Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */
#endif
-
- /* See [==] as well.
- * Storage for the command prefix and the additional words required for
- * the invocation of methods in the command handler.
- *
- * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2]
- * cmd ... pfx | method chan | detail1 detail2
- * ~~~~ CT ~~~ ~~ CT ~~
- *
- * CT = Belongs to the 'Command handler Thread'.
- */
-
- int argc; /* Number of preallocated words - 2 */
- Tcl_Obj **argv; /* Preallocated array for calling the handler.
- * args[0] is placeholder for cmd word.
- * Followed by the arguments in the prefix,
- * plus 4 placeholders for method, channel,
- * and at most two varying (method specific)
- * words. */
- int methods; /* Bitmask of supported methods */
-
- /*
- * NOTE (9): Should we have predefined shared literals for the method
- * names?
- */
+ Tcl_Obj *cmd; /* Callback command prefix */
+ Tcl_Obj *methods; /* Methods to append to command prefix */
+ Tcl_Obj *name; /* Name of the channel as created */
int mode; /* Mask of R/W mode */
int interest; /* Mask of events the channel is interested
@@ -439,7 +417,7 @@ static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp,
static Tcl_Obj * NextHandle(void);
static void FreeReflectedChannel(ReflectedChannel *rcPtr);
static int InvokeTclMethod(ReflectedChannel *rcPtr,
- const char *method, Tcl_Obj *argOneObj,
+ MethodName method, Tcl_Obj *argOneObj,
Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);
static ReflectedChannelMap * GetReflectedChannelMap(Tcl_Interp *interp);
@@ -454,16 +432,14 @@ static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj* resObj);
* list-quoting to keep the words of the message together. See also [x].
*/
-static const char *msg_read_unsup = "{read not supported by Tcl driver}";
static const char *msg_read_toomuch = "{read delivered more than requested}";
-static const char *msg_write_unsup = "{write not supported by Tcl driver}";
static const char *msg_write_toomuch = "{write wrote more than requested}";
static const char *msg_write_nothing = "{write wrote nothing}";
static const char *msg_seek_beforestart = "{Tried to seek before origin}";
#ifdef TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
-static const char *msg_send_dstlost = "{Owner lost}";
#endif /* TCL_THREADS */
+static const char *msg_send_dstlost = "{Owner lost}";
static const char *msg_dstlost = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";
/*
@@ -568,10 +544,6 @@ TclChanCreateObjCmd(
rcId = NextHandle();
rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId);
- chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
- mode);
- rcPtr->chan = chan;
- chanPtr = (Channel *) chan;
/*
* Invoke 'initialize' and validate that the handler is present and ok.
@@ -585,7 +557,7 @@ TclChanCreateObjCmd(
modeObj = DecodeEventMask(mode);
/* assert modeObj.refCount == 1 */
- result = InvokeTclMethod(rcPtr, "initialize", modeObj, NULL, &resObj);
+ result = InvokeTclMethod(rcPtr, METH_INIT, modeObj, NULL, &resObj);
Tcl_DecrRefCount(modeObj);
if (result != TCL_OK) {
UnmarshallErrorResult(interp, resObj);
@@ -674,7 +646,11 @@ TclChanCreateObjCmd(
* Everything is fine now.
*/
- rcPtr->methods = methods;
+ chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
+ mode);
+ rcPtr->chan = chan;
+ Tcl_Preserve(chan);
+ chanPtr = (Channel *) chan;
if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) {
/*
@@ -737,12 +713,10 @@ TclChanCreateObjCmd(
return TCL_OK;
error:
- /*
- * Signal to ReflectClose to not call 'finalize'.
- */
-
- rcPtr->methods = 0;
- Tcl_Close(interp, chan);
+ Tcl_DecrRefCount(rcPtr->name);
+ Tcl_DecrRefCount(rcPtr->methods);
+ Tcl_DecrRefCount(rcPtr->cmd);
+ ckfree((char*) rcPtr);
return TCL_ERROR;
#undef MODE
@@ -1045,6 +1019,7 @@ ReflectClose(
Tcl_Obj *resObj; /* Result data for 'close' */
ReflectedChannelMap* rcmPtr; /* Map of reflected channels with handlers in this interp */
Tcl_HashEntry* hPtr; /* Entry in the above map */
+ Tcl_ChannelType *tctPtr;
if (TclInThreadExit()) {
/*
@@ -1081,18 +1056,11 @@ ReflectClose(
}
#endif
- Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
- return EOK;
- }
-
- /*
- * -- No -- ASSERT rcPtr->methods & FLAG(METH_FINAL)
- *
- * A cleaned method mask here implies that the channel creation was
- * aborted, and "finalize" must not be called.
- */
-
- if (rcPtr->methods == 0) {
+ tctPtr = ((Channel *)rcPtr->chan)->typePtr;
+ if (tctPtr && tctPtr != &tclRChannelType) {
+ ckfree((char *)tctPtr);
+ ((Channel *)rcPtr->chan)->typePtr = NULL;
+ }
Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
return EOK;
}
@@ -1118,7 +1086,7 @@ ReflectClose(
}
} else {
#endif
- result = InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj);
+ result = InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj);
if ((result != TCL_OK) && (interp != NULL)) {
Tcl_SetChannelErrorInterp(interp, resObj);
}
@@ -1156,6 +1124,11 @@ ReflectClose(
}
#endif
+ tctPtr = ((Channel *)rcPtr->chan)->typePtr;
+ if (tctPtr && tctPtr != &tclRChannelType) {
+ ckfree((char *)tctPtr);
+ ((Channel *)rcPtr->chan)->typePtr = NULL;
+ }
Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
#ifdef TCL_THREADS
}
@@ -1193,18 +1166,6 @@ ReflectInput(
Tcl_Obj *resObj; /* Result data for 'read' */
/*
- * The following check can be done before thread redirection, because we
- * are reading from an item which is readonly, i.e. will never change
- * during the lifetime of the channel.
- */
-
- if (!(rcPtr->methods & FLAG(METH_READ))) {
- SetChannelErrorStr(rcPtr->chan, msg_read_unsup);
- *errorCodePtr = EINVAL;
- return -1;
- }
-
- /*
* Are we in the correct thread?
*/
@@ -1242,7 +1203,7 @@ ReflectInput(
toReadObj = Tcl_NewIntObj(toRead);
Tcl_IncrRefCount(toReadObj);
- if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK) {
+ if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) {
int code = ErrnoReturn (rcPtr, resObj);
if (code < 0) {
@@ -1308,18 +1269,6 @@ ReflectOutput(
int written;
/*
- * The following check can be done before thread redirection, because we
- * are reading from an item which is readonly, i.e. will never change
- * during the lifetime of the channel.
- */
-
- if (!(rcPtr->methods & FLAG(METH_WRITE))) {
- SetChannelErrorStr(rcPtr->chan, msg_write_unsup);
- *errorCodePtr = EINVAL;
- return -1;
- }
-
- /*
* Are we in the correct thread?
*/
@@ -1353,11 +1302,12 @@ ReflectOutput(
/* ASSERT: rcPtr->mode & TCL_WRITABLE */
Tcl_Preserve(rcPtr);
+ Tcl_Preserve(rcPtr->interp);
bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
Tcl_IncrRefCount(bufObj);
- if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+ if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
int code = ErrnoReturn(rcPtr, resObj);
if (code < 0) {
@@ -1369,6 +1319,14 @@ ReflectOutput(
goto invalid;
}
+ if (Tcl_InterpDeleted(rcPtr->interp)) {
+ /*
+ * The interp was destroyed during InvokeTclMethod().
+ */
+
+ SetChannelErrorStr(rcPtr->chan, msg_send_dstlost);
+ goto invalid;
+ }
if (Tcl_GetIntFromObj(rcPtr->interp, resObj, &written) != TCL_OK) {
Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
goto invalid;
@@ -1398,6 +1356,7 @@ ReflectOutput(
stop:
Tcl_DecrRefCount(bufObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ Tcl_Release(rcPtr->interp);
Tcl_Release(rcPtr);
return written;
invalid:
@@ -1470,7 +1429,7 @@ ReflectSeekWide(
Tcl_IncrRefCount(offObj);
Tcl_IncrRefCount(baseObj);
- if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK) {
+ if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) {
Tcl_SetChannelError(rcPtr->chan, resObj);
goto invalid;
}
@@ -1541,8 +1500,6 @@ ReflectWatch(
ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
Tcl_Obj *maskObj;
- /* ASSERT rcPtr->methods & FLAG(METH_WATCH) */
-
/*
* We restrict the interest to what the channel can support. IOW there
* will never be write events for a channel which is not writable.
@@ -1585,7 +1542,7 @@ ReflectWatch(
maskObj = DecodeEventMask(mask);
/* assert maskObj.refCount == 1 */
- (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL);
+ (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
Tcl_DecrRefCount(maskObj);
Tcl_Release(rcPtr);
@@ -1644,7 +1601,7 @@ ReflectBlock(
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL, &resObj) != TCL_OK) {
+ if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, &resObj) != TCL_OK) {
Tcl_SetChannelError(rcPtr->chan, resObj);
errorNum = EINVAL;
} else {
@@ -1718,7 +1675,7 @@ ReflectSetOption(
Tcl_IncrRefCount(optionObj);
Tcl_IncrRefCount(valueObj);
- result = InvokeTclMethod(rcPtr, "configure",optionObj,valueObj, &resObj);
+ result = InvokeTclMethod(rcPtr, METH_CONFIGURE,optionObj,valueObj, &resObj);
if (result != TCL_OK) {
UnmarshallErrorResult(interp, resObj);
}
@@ -1763,7 +1720,7 @@ ReflectGetOption(
Tcl_Obj *resObj; /* Result data for 'configure' */
int listc, result = TCL_OK;
Tcl_Obj **listv;
- const char *method;
+ MethodName method;
/*
* Are we in the correct thread?
@@ -1802,14 +1759,14 @@ ReflectGetOption(
* Retrieve all options.
*/
- method = "cgetall";
+ method = METH_CGETALL;
optionObj = NULL;
} else {
/*
* Retrieve the value of one option.
*/
- method = "cget";
+ method = METH_CGET;
optionObj = Tcl_NewStringObj(optionName, -1);
Tcl_IncrRefCount(optionObj);
}
@@ -2021,16 +1978,13 @@ NewReflectedChannel(
Tcl_Obj *handleObj)
{
ReflectedChannel *rcPtr;
- int i, listc;
- Tcl_Obj **listv;
+ MethodName mn = METH_BLOCKING;
rcPtr = (ReflectedChannel *) ckalloc(sizeof(ReflectedChannel));
/* rcPtr->chan: Assigned by caller. Dummy data here. */
- /* rcPtr->methods: Assigned by caller. Dummy data here. */
rcPtr->chan = NULL;
- rcPtr->methods = 0;
rcPtr->interp = interp;
#ifdef TCL_THREADS
rcPtr->thread = Tcl_GetCurrentThread();
@@ -2038,54 +1992,17 @@ NewReflectedChannel(
rcPtr->mode = mode;
rcPtr->interest = 0; /* Initially no interest registered */
- /*
- * Method placeholder.
- */
-
/* ASSERT: cmdpfxObj is a Tcl List */
-
- Tcl_ListObjGetElements(interp, cmdpfxObj, &listc, &listv);
-
- /*
- * See [==] as well.
- * Storage for the command prefix and the additional words required for
- * the invocation of methods in the command handler.
- *
- * listv [0] [listc-1] | [listc] [listc+1] |
- * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2]
- * cmd ... pfx | method chan | detail1 detail2
- */
-
- rcPtr->argc = listc + 2;
- rcPtr->argv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * (listc+4));
-
- /*
- * Duplicate object references.
- */
-
- for (i=0; i<listc ; i++) {
- Tcl_Obj *word = rcPtr->argv[i] = listv[i];
-
- Tcl_IncrRefCount(word);
- }
-
- i++; /* Skip placeholder for method */
-
- /*
- * [Bug 1667990]: See [x] in FreeReflectedChannel for release
- */
-
- rcPtr->argv[i] = handleObj;
- Tcl_IncrRefCount(handleObj);
-
- /*
- * The next two objects are kept empty, varying arguments.
- */
-
- /*
- * Initialization complete.
- */
-
+ rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
+ Tcl_IncrRefCount(rcPtr->cmd);
+ rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
+ while (mn <= METH_WRITE) {
+ Tcl_ListObjAppendElement(NULL, rcPtr->methods,
+ Tcl_NewStringObj(methodNames[mn++], -1));
+ }
+ Tcl_IncrRefCount(rcPtr->methods);
+ rcPtr->name = handleObj;
+ Tcl_IncrRefCount(rcPtr->name);
return rcPtr;
}
@@ -2136,28 +2053,11 @@ FreeReflectedChannel(
ReflectedChannel *rcPtr)
{
Channel *chanPtr = (Channel *) rcPtr->chan;
- int i, n;
-
- if (chanPtr->typePtr != &tclRChannelType) {
- /*
- * Delete a cloned ChannelType structure.
- */
-
- ckfree((char*) chanPtr->typePtr);
- }
-
- n = rcPtr->argc - 2;
- for (i=0; i<n; i++) {
- Tcl_DecrRefCount(rcPtr->argv[i]);
- }
-
- /*
- * [Bug 1667990]: See [x] in NewReflectedChannel for lock. n+1 = argc-1.
- */
-
- Tcl_DecrRefCount(rcPtr->argv[n+1]);
- ckfree((char*) rcPtr->argv);
+ Tcl_Release(chanPtr);
+ Tcl_DecrRefCount(rcPtr->name);
+ Tcl_DecrRefCount(rcPtr->methods);
+ Tcl_DecrRefCount(rcPtr->cmd);
ckfree((char*) rcPtr);
}
@@ -2188,16 +2088,16 @@ FreeReflectedChannel(
static int
InvokeTclMethod(
ReflectedChannel *rcPtr,
- const char *method,
+ MethodName method,
Tcl_Obj *argOneObj, /* NULL'able */
Tcl_Obj *argTwoObj, /* NULL'able */
Tcl_Obj **resultObjPtr) /* NULL'able */
{
- int cmdc; /* #words in constructed command */
Tcl_Obj *methObj = NULL; /* Method name in object form */
Tcl_InterpState sr; /* State of handler interp */
int result; /* Result code of method invokation */
Tcl_Obj *resObj = NULL; /* Result of method invokation. */
+ Tcl_Obj *cmd;
if (!rcPtr->interp) {
/*
@@ -2220,32 +2120,25 @@ InvokeTclMethod(
}
/*
- * NOTE (5): Decide impl. issue: Cache objects with method names? Needs
- * TSD data as reflections can be created in many different threads.
- * NO: Caching of command resolutions means storage per channel.
- */
-
- /*
- * Insert method into the pre-allocated area, after the command prefix,
+ * Insert method into the callback command, after the command prefix,
* before the channel id.
*/
- methObj = Tcl_NewStringObj(method, -1);
- Tcl_IncrRefCount(methObj);
- rcPtr->argv[rcPtr->argc - 2] = methObj;
+ cmd = TclListObjCopy(NULL, rcPtr->cmd);
+
+ Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
+ Tcl_ListObjAppendElement(NULL, cmd, methObj);
+ Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);
/*
* Append the additional argument containing method specific details
* behind the channel id. If specified.
*/
- cmdc = rcPtr->argc;
if (argOneObj) {
- rcPtr->argv[cmdc] = argOneObj;
- cmdc++;
+ Tcl_ListObjAppendElement(NULL, cmd, argOneObj);
if (argTwoObj) {
- rcPtr->argv[cmdc] = argTwoObj;
- cmdc++;
+ Tcl_ListObjAppendElement(NULL, cmd, argTwoObj);
}
}
@@ -2254,9 +2147,10 @@ InvokeTclMethod(
* existing state intact.
*/
+ Tcl_IncrRefCount(cmd);
sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
Tcl_Preserve(rcPtr->interp);
- result = Tcl_EvalObjv(rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL);
+ result = Tcl_GlobalEvalObj(rcPtr->interp, cmd);
/*
* We do not try to extract the result information if the caller has no
@@ -2282,7 +2176,6 @@ InvokeTclMethod(
*/
if (result != TCL_ERROR) {
- Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rcPtr->argv);
int cmdLen;
const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
@@ -2296,25 +2189,17 @@ InvokeTclMethod(
result = TCL_ERROR;
}
Tcl_AppendObjToErrorInfo(rcPtr->interp, Tcl_ObjPrintf(
- "\n (chan handler subcommand \"%s\")", method));
+ "\n (chan handler subcommand \"%s\")",
+ methodNames[method]));
resObj = MarshallError(rcPtr->interp);
}
Tcl_IncrRefCount(resObj);
}
+ Tcl_DecrRefCount(cmd);
Tcl_RestoreInterpState(rcPtr->interp, sr);
Tcl_Release(rcPtr->interp);
/*
- * Cleanup of the dynamic parts of the command.
- *
- * The detail objects survived the Tcl_EvalObjv without change because of
- * the contract. Therefore there is no need to decrement the refcounts. Only
- * the internal method object has to be disposed of.
- */
-
- Tcl_DecrRefCount(methObj);
-
- /*
* The resObj has a ref count of 1 at this location. This means that the
* caller of InvokeTclMethod has to dispose of it (but only if it was
* returned to it).
@@ -2827,17 +2712,19 @@ ForwardProc(
* call upon for the driver.
*/
- case ForwardedClose:
+ case ForwardedClose: {
/*
* No parameters/results.
*/
- if (InvokeTclMethod(rcPtr, "finalize", NULL, NULL, &resObj)!=TCL_OK) {
+ Tcl_ChannelType *tctPtr;
+
+ if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
}
/*
- * Freeing is done here, in the origin thread, because the argv[]
+ * Freeing is done here, in the origin thread, callback command
* objects belong to this thread. Deallocating them in a different
* thread is not allowed
*
@@ -2856,15 +2743,21 @@ ForwardProc(
Tcl_GetChannelName (rcPtr->chan));
Tcl_DeleteHashEntry (hPtr);
+ tctPtr = ((Channel *)rcPtr->chan)->typePtr;
+ if (tctPtr && tctPtr != &tclRChannelType) {
+ ckfree((char *)tctPtr);
+ ((Channel *)rcPtr->chan)->typePtr = NULL;
+ }
Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
break;
+ }
case ForwardedInput: {
Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead);
Tcl_IncrRefCount(toReadObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "read", toReadObj, NULL, &resObj)!=TCL_OK){
+ if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){
int code = ErrnoReturn (rcPtr, resObj);
if (code < 0) {
@@ -2904,7 +2797,7 @@ ForwardProc(
Tcl_IncrRefCount(bufObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
+ if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
int code = ErrnoReturn(rcPtr, resObj);
if (code < 0) {
@@ -2945,7 +2838,7 @@ ForwardProc(
Tcl_IncrRefCount(baseObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "seek", offObj, baseObj, &resObj)!=TCL_OK){
+ if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK){
ForwardSetObjError(paramPtr, resObj);
paramPtr->seek.offset = -1;
} else {
@@ -2979,7 +2872,7 @@ ForwardProc(
/* assert maskObj.refCount == 1 */
Tcl_Preserve(rcPtr);
- (void) InvokeTclMethod(rcPtr, "watch", maskObj, NULL, NULL);
+ (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
Tcl_DecrRefCount(maskObj);
Tcl_Release(rcPtr);
break;
@@ -2990,7 +2883,7 @@ ForwardProc(
Tcl_IncrRefCount(blockObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "blocking", blockObj, NULL,
+ if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL,
&resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
}
@@ -3006,7 +2899,7 @@ ForwardProc(
Tcl_IncrRefCount(optionObj);
Tcl_IncrRefCount(valueObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "configure", optionObj, valueObj,
+ if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj,
&resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
}
@@ -3025,7 +2918,7 @@ ForwardProc(
Tcl_IncrRefCount(optionObj);
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "cget", optionObj, NULL, &resObj)!=TCL_OK){
+ if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){
ForwardSetObjError(paramPtr, resObj);
} else {
Tcl_DStringAppend(paramPtr->getOpt.value,
@@ -3042,7 +2935,7 @@ ForwardProc(
*/
Tcl_Preserve(rcPtr);
- if (InvokeTclMethod(rcPtr, "cgetall", NULL, NULL, &resObj) != TCL_OK){
+ if (InvokeTclMethod(rcPtr, METH_CGETALL, NULL, NULL, &resObj) != TCL_OK){
ForwardSetObjError(paramPtr, resObj);
} else {
/*
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 295e313..82ffd88 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -24,6 +24,12 @@
#endif
#include "tclFileSystem.h"
+#ifdef TCL_TEMPLOAD_NO_UNLINK
+#ifndef NO_FSTATFS
+#include <sys/statfs.h>
+#endif
+#endif
+
/*
* struct FilesystemRecord --
*
@@ -3149,6 +3155,82 @@ Tcl_FSLoadFile(
typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
+/*
+ * Workaround for issue with modern HPUX which do allow the unlink (no ETXTBSY
+ * error) yet somehow trash some internal data structures which prevents the
+ * second and further shared libraries from getting properly loaded. Only the
+ * first is ok. We try to get around the issue by not unlinking,
+ * i.e. emulating the behaviour of the older HPUX which denied removal.
+ *
+ * Doing the unlink is also an issue within docker containers, whose AUFS
+ * bungles this as well, see
+ * https://github.com/dotcloud/docker/issues/1911
+ *
+ * For these situations the change below makes the execution of the unlink
+ * semi-controllable at runtime.
+ *
+ * An AUFS filesystem (if it can be detected) will force avoidance of
+ * unlink. The env variable TCL_TEMPLOAD_NO_UNLINK allows detection of a
+ * users general request (unlink and not.
+ *
+ * By default the unlink is done (if not in AUFS). However if the variable is
+ * present and set to true (any integer > 0) then the unlink is skipped.
+ */
+
+int
+TclSkipUnlink (Tcl_Obj* shlibFile)
+{
+ /* Order of testing:
+ * 1. On hpux we generally want to skip unlink in general
+ *
+ * Outside of hpux then:
+ * 2. For a general user request (TCL_TEMPLOAD_NO_UNLINK present, non-empty, => int)
+ * 3. For general AUFS environment (statfs, if available).
+ *
+ * Ad 2: This variable can disable/override the AUFS detection, i.e. for
+ * testing if a newer AUFS does not have the bug any more.
+ *
+ * Ad 3: This is conditionally compiled in. Condition currently must be set manually.
+ * This part needs proper tests in the configure(.in).
+ */
+
+#ifdef hpux
+ return 1;
+#else
+ char* skipstr;
+
+ skipstr = getenv ("TCL_TEMPLOAD_NO_UNLINK");
+ if (skipstr && (skipstr[0] != '\0')) {
+ return atoi(skipstr);
+ }
+
+#ifdef TCL_TEMPLOAD_NO_UNLINK
+#ifndef NO_FSTATFS
+ {
+ struct statfs fs;
+ /* Have fstatfs. May not have the AUFS super magic ... Indeed our build
+ * box is too old to have it directly in the headers. Define taken from
+ * http://mooon.googlecode.com/svn/trunk/linux_include/linux/aufs_type.h
+ * http://aufs.sourceforge.net/
+ * Better reference will be gladly taken.
+ */
+#ifndef AUFS_SUPER_MAGIC
+#define AUFS_SUPER_MAGIC ('a' << 24 | 'u' << 16 | 'f' << 8 | 's')
+#endif /* AUFS_SUPER_MAGIC */
+ if ((statfs(Tcl_GetString (shlibFile), &fs) == 0) &&
+ (fs.f_type == AUFS_SUPER_MAGIC)) {
+ return 1;
+ }
+ }
+#endif /* ... NO_FSTATFS */
+#endif /* ... TCL_TEMPLOAD_NO_UNLINK */
+
+ /* Fallback: !hpux, no EV override, no AUFS (detection, nor detected):
+ * Don't skip */
+ return 0;
+#endif /* hpux */
+}
+
int
TclLoadFile(
Tcl_Interp *interp, /* Used for error reporting. */
@@ -3353,7 +3435,9 @@ TclLoadFile(
* avoids any worries about leaving the copy laying around on exit.
*/
- if (Tcl_FSDeleteFile(copyToPtr) == TCL_OK) {
+ if (
+ !TclSkipUnlink (copyToPtr) &&
+ (Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) {
Tcl_DecrRefCount(copyToPtr);
/*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1348340..b30650d 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2480,6 +2480,8 @@ MODULE_SCOPE char tclEmptyString;
*----------------------------------------------------------------
*/
+MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr,
+ const unsigned char *bytes, int len);
MODULE_SCOPE void TclAdvanceContinuations(int* line, int** next, int loc);
MODULE_SCOPE void TclAdvanceLines(int *line, const char *start,
const char *end);
@@ -2550,6 +2552,7 @@ MODULE_SCOPE void TclFinalizeObjects(void);
MODULE_SCOPE void TclFinalizePreserve(void);
MODULE_SCOPE void TclFinalizeSynchronization(void);
MODULE_SCOPE void TclFinalizeThreadAlloc(void);
+MODULE_SCOPE void TclFinalizeThreadAllocThread(void);
MODULE_SCOPE void TclFinalizeThreadData(void);
MODULE_SCOPE void TclFinalizeThreadObjects(void);
MODULE_SCOPE double TclFloor(mp_int *a);
@@ -2570,6 +2573,8 @@ MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp,
int *binaryPtr);
MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
MODULE_SCOPE const char *TclGetSrcInfoForCmd(Interp *iPtr, int *lenPtr);
+MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr,
+ unsigned int *sizePtr);
MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern,
Tcl_Obj *unquotedPrefix, int globFlags,
Tcl_GlobTypeData *types);
@@ -3667,6 +3672,24 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, CONST char *file,
/*
*----------------------------------------------------------------
+ * Macro that encapsulates the logic that determines when it is safe to
+ * interpret a string as a byte array directly. In summary, the object must be
+ * a byte array and must not have a string representation (as the operations
+ * that it is used in are defined on strings, not byte arrays). Theoretically
+ * it is possible to also be efficient in the case where the object's bytes
+ * field is filled by generation from the byte array (c.f. list canonicality)
+ * but we don't do that at the moment since this is purely about efficiency.
+ * The ANSI C "prototype" for this macro is:
+ *
+ * MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr);
+ *----------------------------------------------------------------
+ */
+
+#define TclIsPureByteArray(objPtr) \
+ (((objPtr)->typePtr==&tclByteArrayType) && ((objPtr)->bytes==NULL))
+
+/*
+ *----------------------------------------------------------------
* Macro used by the Tcl core to compare Unicode strings. On big-endian
* systems we can use the more efficient memcmp, but this would not be
* lexically correct on little-endian systems. The ANSI C "prototype" for
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index 80dd2ad..fc20d09 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -847,9 +847,15 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
#undef TclpLocaltime_unix
#undef TclpGmtime_unix
-#if defined(__WIN32__) || defined(__CYGWIN__)
+#if defined(__WIN32__)
# undef TclWinNToHS
+# undef TclWinGetServByName
+# undef TclWinGetSockOpt
+# undef TclWinSetSockOpt
# define TclWinNToHS ntohs
+# define TclWinGetServByName getservbyname
+# define TclWinGetSockOpt getsockopt
+# define TclWinSetSockOpt setsockopt
#else
# undef TclpGetPid
# define TclpGetPid(pid) ((unsigned long) (pid))
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index a929d04..8c6a376 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -1139,7 +1139,8 @@ Tcl_AppendLimitedToObj(
if (ellipsis == NULL) {
ellipsis = "...";
}
- toCopy = Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes;
+ toCopy = (bytes == NULL) ? limit
+ : Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes;
}
/*
@@ -1386,7 +1387,8 @@ AppendUnicodeToUnicodeRep(
* due to the reallocs below.
*/
int offset = -1;
- if (unicode >= stringPtr->unicode && unicode <= stringPtr->unicode
+ if (unicode && unicode >= stringPtr->unicode
+ && unicode <= stringPtr->unicode
+ stringPtr->uallocated / sizeof(Tcl_UniChar)) {
offset = unicode - stringPtr->unicode;
}
@@ -1405,8 +1407,10 @@ AppendUnicodeToUnicodeRep(
* trailing null.
*/
- memcpy(stringPtr->unicode + stringPtr->numChars, unicode,
- appendNumChars * sizeof(Tcl_UniChar));
+ if (unicode) {
+ memcpy(stringPtr->unicode + stringPtr->numChars, unicode,
+ appendNumChars * sizeof(Tcl_UniChar));
+ }
stringPtr->unicode[numChars] = 0;
stringPtr->numChars = numChars;
stringPtr->allocated = 0;
@@ -1478,8 +1482,8 @@ AppendUtfToUnicodeRep(
int numBytes) /* Number of bytes of "bytes" to convert. */
{
Tcl_DString dsPtr;
- int numChars;
- Tcl_UniChar *unicode;
+ int numChars = numBytes;
+ Tcl_UniChar *unicode = NULL;
if (numBytes < 0) {
numBytes = (bytes ? strlen(bytes) : 0);
@@ -1489,8 +1493,11 @@ AppendUtfToUnicodeRep(
}
Tcl_DStringInit(&dsPtr);
- numChars = Tcl_NumUtfChars(bytes, numBytes);
- unicode = (Tcl_UniChar *)Tcl_UtfToUniCharDString(bytes, numBytes, &dsPtr);
+ if (bytes) {
+ numChars = Tcl_NumUtfChars(bytes, numBytes);
+ unicode = (Tcl_UniChar *) Tcl_UtfToUniCharDString(bytes, numBytes,
+ &dsPtr);
+ }
AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
Tcl_DStringFree(&dsPtr);
}
@@ -1547,7 +1554,7 @@ AppendUtfToUtfRep(
* due to the reallocs below.
*/
int offset = -1;
- if (bytes >= objPtr->bytes
+ if (bytes && bytes >= objPtr->bytes
&& bytes <= objPtr->bytes + objPtr->length) {
offset = bytes - objPtr->bytes;
}
@@ -1585,7 +1592,9 @@ AppendUtfToUtfRep(
stringPtr->numChars = -1;
stringPtr->hasUnicode = 0;
- memcpy(objPtr->bytes + oldLength, bytes, (size_t) numBytes);
+ if (bytes) {
+ memcpy(objPtr->bytes + oldLength, bytes, (size_t) numBytes);
+ }
objPtr->bytes[newLength] = 0;
objPtr->length = newLength;
}
@@ -2702,6 +2711,38 @@ Tcl_ObjPrintf(
/*
*---------------------------------------------------------------------------
*
+ * TclGetStringStorage --
+ *
+ * Returns the string storage space of a Tcl_Obj.
+ *
+ * Results:
+ * The pointer value objPtr->bytes is returned and the number of bytes
+ * allocated there is written to *sizePtr (if known).
+ *
+ * Side effects:
+ * May set objPtr->bytes.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+char *
+TclGetStringStorage(
+ Tcl_Obj *objPtr,
+ unsigned int *sizePtr)
+{
+ String *stringPtr;
+
+ if (objPtr->typePtr != &tclStringType || objPtr->bytes == NULL) {
+ return TclGetStringFromObj(objPtr, (int *)sizePtr);
+ }
+
+ stringPtr = GET_STRING(objPtr);
+ *sizePtr = stringPtr->allocated;
+ return objPtr->bytes;
+}
+/*
+ *---------------------------------------------------------------------------
+ *
* TclStringObjReverse --
*
* Implements the [string reverse] operation.
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 99f3e4b..6499bc2 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -33,6 +33,9 @@
#undef Tcl_CreateHashEntry
#undef TclpGetPid
#undef TclSockMinimumBuffers
+#undef TclWinGetServByName
+#undef TclWinGetSockOpt
+#undef TclWinSetSockOpt
#define TclUnusedStubEntry NULL
/*
@@ -104,7 +107,8 @@ TclpIsAtty(int fd)
return isatty(fd);
}
-int
+#define TclWinGetPlatformId winGetPlatformId
+static int
TclWinGetPlatformId()
{
/* Don't bother to determine the real platform on cygwin,
@@ -120,27 +124,31 @@ void *TclWinGetTclInstance()
return hInstance;
}
-int
+#define TclWinSetSockOpt winSetSockOpt
+static int
TclWinSetSockOpt(SOCKET s, int level, int optname,
const char *optval, int optlen)
{
return setsockopt((int) s, level, optname, optval, optlen);
}
-int
+#define TclWinGetSockOpt winGetSockOpt
+static int
TclWinGetSockOpt(SOCKET s, int level, int optname,
char *optval, int *optlen)
{
return getsockopt((int) s, level, optname, optval, optlen);
}
-struct servent *
+#define TclWinGetServByName winGetServByName
+static struct servent *
TclWinGetServByName(const char *name, const char *proto)
{
return getservbyname(name, proto);
}
-char *
+#define TclWinNoBackslash winNoBackslash
+static char *
TclWinNoBackslash(char *path)
{
char *p;
diff --git a/generic/tclThread.c b/generic/tclThread.c
index 8384107..d6b5bcb 100644
--- a/generic/tclThread.c
+++ b/generic/tclThread.c
@@ -338,8 +338,9 @@ Tcl_ConditionFinalize(
*
* TclFinalizeThreadData --
*
- * This function cleans up the thread-local storage. This is called once
- * for each thread.
+ * This function cleans up the thread-local storage. Secondary, it cleans
+ * thread alloc cache.
+ * This is called once for each thread before thread exits.
*
* Results:
* None.
@@ -354,6 +355,9 @@ void
TclFinalizeThreadData(void)
{
TclpFinalizeThreadDataThread();
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+ TclFinalizeThreadAllocThread();
+#endif
}
/*
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index 2e74fa7..106e908 100644
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -1012,6 +1012,33 @@ TclFinalizeThreadAlloc(void)
TclpFreeAllocCache(NULL);
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeThreadAllocThread --
+ *
+ * This procedure is used to destroy single thread private resources used
+ * in this file.
+ * Called in TclpFinalizeThreadData when a thread exits (Tcl_FinalizeThread).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeThreadAllocThread(void)
+{
+ Cache *cachePtr = TclpGetAllocCache();
+ if (cachePtr != NULL) {
+ TclpFreeAllocCache(cachePtr);
+ }
+}
+
#else /* !(TCL_THREADS && USE_THREAD_ALLOC) */
/*
*----------------------------------------------------------------------
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 5f4cdae..8c6adfe 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -2334,7 +2334,7 @@ TclStringMatchObj(
udata = Tcl_GetUnicodeFromObj(strObj, &length);
uptn = Tcl_GetUnicodeFromObj(ptnObj, &plen);
match = TclUniCharMatch(udata, length, uptn, plen, flags);
- } else if ((strObj->typePtr == &tclByteArrayType) && !flags) {
+ } else if (TclIsPureByteArray(strObj) && !flags) {
unsigned char *data, *ptn;
data = Tcl_GetByteArrayFromObj(strObj, &length);
diff --git a/tests/chanio.test b/tests/chanio.test
index b195f7b..2f2540e 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -41,7 +41,7 @@ namespace eval ::tcl::test::io {
# You need a *very* special environment to do some tests. In
# particular, many file systems do not support large-files...
- testConstraint largefileSupport 0
+ testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}]
# some tests can only be run is umask is 2
# if "umask" cannot be run, the tests will be skipped.
@@ -4427,10 +4427,10 @@ test chan-io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport} {
chan puts -nonewline $f abcdef
lappend l [chan tell $f]
chan close $f
- lappend l [file size $f]
+ lappend l [file size $path(test3)]
# truncate...
chan close [open $path(test3) w]
- lappend l [file size $f]
+ lappend l [file size $path(test3)]
set l
} {0 6 6 4294967296 4294967302 4294967302 0}
diff --git a/tests/clock.test b/tests/clock.test
index fea1fc9..7d62a60 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -36927,6 +36927,15 @@ test clock-67.1 {clock format, %% with a letter following [Bug 2819334]} {
clock format [clock seconds] -format %%r
} %r
+test clock-67.2 {Bug d19a30db57} -body {
+ # error, not segfault
+ tcl::clock::GetJulianDayFromEraYearMonthDay {} 2361222
+} -returnCodes error -match glob -result *
+test clock-67.3 {Bug d19a30db57} -body {
+ # error, not segfault
+ tcl::clock::GetJulianDayFromEraYearWeekDay {} 2361222
+} -returnCodes error -match glob -result *
+
# cleanup
namespace delete ::testClock
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index dc61ac6..4ca90c6 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -104,6 +104,9 @@ test cmdAH-2.6.1 {Tcl_CdObjCmd} {
list [catch {cd ""} msg] $msg
} {1 {couldn't change working directory to "": no such file or directory}}
+test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -returnCodes error -body {
+ cd .\0
+} -result "couldn't change working directory to \".\0\": no such file or directory"
test cmdAH-2.7 {Tcl_ConcatObjCmd} {
concat
} {}
diff --git a/tests/io.test b/tests/io.test
index 4791280..f1248b9 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -41,7 +41,7 @@ testConstraint testthread [llength [info commands testthread]]
# You need a *very* special environment to do some tests. In
# particular, many file systems do not support large-files...
-testConstraint largefileSupport 0
+testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}]
# some tests can only be run is umask is 2
# if "umask" cannot be run, the tests will be skipped.
@@ -1559,6 +1559,45 @@ test io-13.8 {TranslateInputEOL: auto mode: \r\n} {
close $f
set x
} "abcd\ndef"
+test io-13.8.1 {TranslateInputEOL: auto mode: \r\n} {
+ set f [open $path(test1) w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "abcd\r\ndef"
+ close $f
+ set f [open $path(test1)]
+ fconfigure $f -translation auto
+ set x {}
+ lappend x [read $f 5]
+ lappend x [read $f]
+ close $f
+ set x
+} [list "abcd\n" "def"]
+test io-13.8.2 {TranslateInputEOL: auto mode: \r\n} {
+ set f [open $path(test1) w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "abcd\r\ndef"
+ close $f
+ set f [open $path(test1)]
+ fconfigure $f -translation auto -buffersize 6
+ set x {}
+ lappend x [read $f 5]
+ lappend x [read $f]
+ close $f
+ set x
+} [list "abcd\n" "def"]
+test io-13.8.3 {TranslateInputEOL: auto mode: \r\n} {
+ set f [open $path(test1) w]
+ fconfigure $f -translation lf
+ puts -nonewline $f "abcd\r\n\r\ndef"
+ close $f
+ set f [open $path(test1)]
+ fconfigure $f -translation auto -buffersize 7
+ set x {}
+ lappend x [read $f 5]
+ lappend x [read $f]
+ close $f
+ set x
+} [list "abcd\n" "\ndef"]
test io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} {
set f [open $path(test1) w]
fconfigure $f -translation lf
@@ -2747,7 +2786,7 @@ test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMa
variable x running
set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
proc writelots {s l} {
- for {set i 0} {$i < 2000} {incr i} {
+ for {set i 0} {$i < 9000} {incr i} {
puts $s $l
}
}
@@ -2778,7 +2817,7 @@ test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMa
close $ss
vwait [namespace which -variable x]
set c
-} 2000
+} 9000
test io-29.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket tempNotMac fileevent} {
# On Mac, this test screws up sockets such that subsequent tests using port 2828
# either cause errors or panic().
@@ -3960,6 +3999,46 @@ test io-32.11 {Tcl_Read from a pipe} {stdio openpipe} {
} {{hello
} {hello
}}
+test io-32.11.1 {Tcl_Read from a pipe} {stdio openpipe} {
+ file delete $path(pipe)
+ set f1 [open $path(pipe) w]
+ puts $f1 {chan configure stdout -translation crlf}
+ puts $f1 {puts [gets stdin]}
+ puts $f1 {puts [gets stdin]}
+ close $f1
+ set f1 [open "|[list [interpreter] $path(pipe)]" r+]
+ puts $f1 hello
+ flush $f1
+ set x ""
+ lappend x [read $f1 6]
+ puts $f1 hello
+ flush $f1
+ lappend x [read $f1]
+ close $f1
+ set x
+} {{hello
+} {hello
+}}
+test io-32.11.1 {Tcl_Read from a pipe} {stdio openpipe} {
+ file delete $path(pipe)
+ set f1 [open $path(pipe) w]
+ puts $f1 {chan configure stdout -translation crlf}
+ puts $f1 {puts [gets stdin]}
+ puts $f1 {puts [gets stdin]}
+ close $f1
+ set f1 [open "|[list [interpreter] $path(pipe)]" r+]
+ puts $f1 hello
+ flush $f1
+ set x ""
+ lappend x [read $f1 6]
+ puts $f1 hello
+ flush $f1
+ lappend x [read $f1]
+ close $f1
+ set x
+} {{hello
+} {hello
+}}
test io-32.12 {Tcl_Read, -nonewline} {
file delete $path(test1)
set f1 [open $path(test1) w]
@@ -4433,10 +4512,10 @@ test io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport} {
puts -nonewline $f abcdef
lappend l [tell $f]
close $f
- lappend l [file size $f]
+ lappend l [file size $path(test3)]
# truncate...
close [open $path(test3) w]
- lappend l [file size $f]
+ lappend l [file size $path(test3)]
set l
} {0 6 6 4294967296 4294967302 4294967302 0}
@@ -4729,7 +4808,7 @@ test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} -body {
close $f
list $s $l $e [scan [string index $in end] %c]
} -result {9 8 1 13}
-test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} -constraints knownBug -body {
+test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} -body {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -translation cr -eofchar \x1a
@@ -4772,6 +4851,21 @@ test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} -body {
close $f
list $c $l $e [scan [string index $in end] %c]
} -result {17 8 1 13}
+test io-35.20 {Tcl_Eof, eof char in middle, cr write, crlf read} {
+ file delete $path(test1)
+ set f [open $path(test1) w]
+ fconfigure $f -translation cr -eofchar {}
+ set i [format \n%cqrsuvw 26]
+ puts $f $i
+ close $f
+ set c [file size $path(test1)]
+ set f [open $path(test1) r]
+ fconfigure $f -translation crlf -eofchar \x1a
+ set l [string length [set in [read $f]]]
+ set e [eof $f]
+ close $f
+ list $c $l $e [scan [string index $in end] %c]
+} {9 1 1 13}
# Test Tcl_InputBlocked
@@ -6611,11 +6705,23 @@ test io-52.4 {TclCopyChannel} {fcopy} {
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation cr -blocking 0
fcopy $f1 $f2 -size 40
- set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
+ set result [list [fblocked $f1] [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
+ close $f1
+ close $f2
+ lappend result [file size $path(test1)]
+} {0 0 0 40}
+test io-52.4.1 {TclCopyChannel} {fcopy} {
+ file delete $path(test1)
+ set f1 [open $thisScript]
+ set f2 [open $path(test1) w]
+ fconfigure $f1 -translation lf -blocking 0 -buffersize 10000000
+ fconfigure $f2 -translation cr -blocking 0
+ fcopy $f1 $f2 -size 40
+ set result [list [fblocked $f1] [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
close $f1
close $f2
lappend result [file size $path(test1)]
-} {0 0 40}
+} {0 0 0 40}
test io-52.5 {TclCopyChannel, all} {fcopy} {
file delete $path(test1)
set f1 [open $thisScript]
@@ -6801,6 +6907,150 @@ test io-52.11 {TclCopyChannel & encodings} {fcopy} {
file size $path(kyrillic.txt)
} 3
+test io-52.12 {coverage of -translation auto} {
+ file delete $path(test1) $path(test2)
+ set out [open $path(test1) wb]
+ chan configure $out -translation lf
+ puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+ close $out
+ set in [open $path(test1)]
+ chan configure $in -buffersize 8
+ set out [open $path(test2) w]
+ chan configure $out -translation lf
+ fcopy $in $out
+ close $in
+ close $out
+ file size $path(test2)
+} 29
+test io-52.13 {coverage of -translation cr} {
+ file delete $path(test1) $path(test2)
+ set out [open $path(test1) wb]
+ chan configure $out -translation lf
+ puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+ close $out
+ set in [open $path(test1)]
+ chan configure $in -buffersize 8 -translation cr
+ set out [open $path(test2) w]
+ chan configure $out -translation lf
+ fcopy $in $out
+ close $in
+ close $out
+ file size $path(test2)
+} 30
+test io-52.14 {coverage of -translation crlf} {
+ file delete $path(test1) $path(test2)
+ set out [open $path(test1) wb]
+ chan configure $out -translation lf
+ puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+ close $out
+ set in [open $path(test1)]
+ chan configure $in -buffersize 8 -translation crlf
+ set out [open $path(test2) w]
+ chan configure $out -translation lf
+ fcopy $in $out
+ close $in
+ close $out
+ file size $path(test2)
+} 29
+test io-52.14.1 {coverage of -translation crlf} {
+ file delete $path(test1) $path(test2)
+ set out [open $path(test1) wb]
+ chan configure $out -translation lf
+ puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+ close $out
+ set in [open $path(test1)]
+ chan configure $in -buffersize 8 -translation crlf
+ set out [open $path(test2) w]
+ fcopy $in $out -size 2
+ close $in
+ close $out
+ file size $path(test2)
+} 2
+test io-52.14.2 {coverage of -translation crlf} {
+ file delete $path(test1) $path(test2)
+ set out [open $path(test1) wb]
+ chan configure $out -translation lf
+ puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+ close $out
+ set in [open $path(test1)]
+ chan configure $in -translation crlf
+ set out [open $path(test2) w]
+ fcopy $in $out -size 9
+ close $in
+ close $out
+ file size $path(test2)
+} 9
+test io-52.15 {coverage of -translation crlf} {
+ file delete $path(test1) $path(test2)
+ set out [open $path(test1) wb]
+ chan configure $out -translation lf
+ puts -nonewline $out abcdefg\r
+ close $out
+ set in [open $path(test1)]
+ chan configure $in -buffersize 8 -translation crlf
+ set out [open $path(test2) w]
+ fcopy $in $out
+ close $in
+ close $out
+ file size $path(test2)
+} 8
+test io-52.16 {coverage of eofChar handling} {
+ file delete $path(test1) $path(test2)
+ set out [open $path(test1) wb]
+ chan configure $out -translation lf
+ puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+ close $out
+ set in [open $path(test1)]
+ chan configure $in -buffersize 8 -translation lf -eofchar a
+ set out [open $path(test2) w]
+ fcopy $in $out
+ close $in
+ close $out
+ file size $path(test2)
+} 0
+test io-52.17 {coverage of eofChar handling} {
+ file delete $path(test1) $path(test2)
+ set out [open $path(test1) wb]
+ chan configure $out -translation lf
+ puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+ close $out
+ set in [open $path(test1)]
+ chan configure $in -buffersize 8 -translation lf -eofchar d
+ set out [open $path(test2) w]
+ fcopy $in $out
+ close $in
+ close $out
+ file size $path(test2)
+} 3
+test io-52.18 {coverage of eofChar handling} {
+ file delete $path(test1) $path(test2)
+ set out [open $path(test1) wb]
+ chan configure $out -translation lf
+ puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+ close $out
+ set in [open $path(test1)]
+ chan configure $in -buffersize 8 -translation crlf -eofchar h
+ set out [open $path(test2) w]
+ fcopy $in $out
+ close $in
+ close $out
+ file size $path(test2)
+} 8
+test io-52.19 {coverage of eofChar handling} {
+ file delete $path(test1) $path(test2)
+ set out [open $path(test1) wb]
+ chan configure $out -translation lf
+ puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
+ close $out
+ set in [open $path(test1)]
+ chan configure $in -buffersize 10 -translation crlf -eofchar h
+ set out [open $path(test2) w]
+ fcopy $in $out
+ close $in
+ close $out
+ file size $path(test2)
+} 8
+
test io-53.1 {CopyData} {fcopy} {
file delete $path(test1)
set f1 [open $thisScript]
@@ -6870,17 +7120,17 @@ test io-53.4 {CopyData: background write overflow} {stdio unix openpipe fileeven
for {set x 0} {$x < 12} {incr x} {
append big $big
}
- file delete $path(test1)
+# file delete $path(test1)
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {
puts ready
fcopy stdin stdout -command { set x }
vwait x
- set f [open $path(test1) w]
- fconfigure $f -translation lf
- puts $f "done"
- close $f
+# set f [open $path(test1) w]
+# fconfigure $f -translation lf
+# puts $f "done"
+# close $f
}
close $f1
set f1 [open "|[list [interpreter] $path(pipe)]" r+]
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 768a748..5a76d48 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -755,6 +755,90 @@ test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match g
rename foo {}
set res
} -result {{} {initialize rc* {read write}} 1 {*all required methods*} {}}
+test iocmd-21.20 {Bug 88aef05cda} -setup {
+ proc foo {method chan args} {
+ switch -- $method blocking {
+ chan configure $chan -blocking [lindex $args 0]
+ return
+ } initialize {
+ return {initialize finalize watch blocking read write
+ configure cget cgetall}
+ } finalize {
+ return
+ }
+ }
+ set ch [chan create {read write} foo]
+} -body {
+ list [catch {chan configure $ch -blocking 0} m] $m
+} -cleanup {
+ close $ch
+ rename foo {}
+} -match glob -result {1 {*nested eval*}}
+test iocmd-21.21 {[close] in [read] segfaults} -setup {
+ proc foo {method chan args} {
+ switch -- $method initialize {
+ return {initialize finalize watch read}
+ } finalize {} watch {} read {
+ close $chan
+ return a
+ }
+ }
+ set ch [chan create read foo]
+} -body {
+ read $ch 0
+} -cleanup {
+ close $ch
+ rename foo {}
+} -result {}
+test iocmd-21.22 {[close] in [read] segfaults} -setup {
+ proc foo {method chan args} {
+ switch -- $method initialize {
+ return {initialize finalize watch read}
+ } finalize {} watch {} read {
+ catch {close $chan}
+ return a
+ }
+ }
+ set ch [chan create read foo]
+} -body {
+ read $ch 1
+} -returnCodes error -cleanup {
+ catch {close $ch}
+ rename foo {}
+} -match glob -result {*invalid argument*}
+test iocmd-21.23 {[close] in [gets] segfaults} -setup {
+ proc foo {method chan args} {
+ switch -- $method initialize {
+ return {initialize finalize watch read}
+ } finalize {} watch {} read {
+ catch {close $chan}
+ return \n
+ }
+ }
+ set ch [chan create read foo]
+} -body {
+ gets $ch
+} -cleanup {
+ catch {close $ch}
+ rename foo {}
+} -result {}
+test iocmd-21.24 {[close] in binary [gets] segfaults} -setup {
+ proc foo {method chan args} {
+ switch -- $method initialize {
+ return {initialize finalize watch read}
+ } finalize {} watch {} read {
+ catch {close $chan}
+ return \n
+ }
+ }
+ set ch [chan create read foo]
+} -body {
+ chan configure $ch -translation binary
+ gets $ch
+} -cleanup {
+ catch {close $ch}
+ rename foo {}
+} -result {}
# --- --- --- --------- --------- ---------
# Helper commands to record the arguments to handler methods.
@@ -1013,6 +1097,20 @@ test iocmd-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glo
rename foo {}
unset res
} -result {{read rc* 4096} {} 0}
+test iocmd-23.11 {chan read, close pulls the rug out} -match glob -body {
+ set res {}
+ proc foo {args} {
+ oninit; onfinal; track
+ set args [lassign $args sub id]
+ if {$sub ne "read"} {return}
+ close $id
+ return {}
+ }
+ set c [chan create {r} foo]
+ note [read $c]
+ rename foo {}
+ set res
+} -result {{read rc* 4096} {}}
# --- === *** ###########################
# method write
@@ -1940,13 +2038,13 @@ test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -m
proc foo {args} {
oninit; onfinal; track;
# destroy interpreter during channel access
- # Actually not possible for an interp to destroy itself.
- interp delete {}
- return}
+ suicide
+ }
set chan [chan create {r w} foo]
fconfigure $chan -buffering none
set chan
}]
+ interp alias $ida suicide {} interp delete $ida
# Move channel to 2nd thread.
interp eval $ida [list testchannel cut $chan]
@@ -1965,8 +2063,7 @@ test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -m
set res
}]
set res
-} -constraints {testchannel impossible} \
- -result {Owner lost}
+} -constraints {testchannel} -result {Owner lost}
test iocmd-32.2 {delete interp of reflected chan} {
# Bug 3034840
diff --git a/tests/iogt.test b/tests/iogt.test
index 3882ecc..5fe3dc2 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -159,8 +159,8 @@ proc fevent {fdelay idelay blocks script data} {
#puts stdout ">>>>>" ; flush stdout
- uplevel #0 set sock $sk
- set res [uplevel #0 $script]
+ uplevel 1 set sock $sk
+ set res [uplevel 1 $script]
catch {close $sk}
return $res
@@ -242,6 +242,36 @@ proc id_fulltrail {var op data} {
return $res
}
+proc id_torture {chan op data} {
+ switch -- $op {
+ create/write -
+ create/read -
+ delete/write -
+ delete/read -
+ clear_read {;#ignore}
+ flush/write -
+ flush/read {}
+ write {
+ global level
+ if {$level} {
+ return
+ }
+ incr level
+ testchannel unstack $chan
+ testchannel transform $chan \
+ -command [namespace code [list id_torture $chan]]
+ return $data
+ }
+ read {
+ testchannel unstack $chan
+ testchannel transform $chan \
+ -command [namespace code [list id_torture $chan]]
+ return $data
+ }
+ query/maxRead {return -1}
+ }
+}
+
proc counter {var op data} {
variable $var
upvar 0 $var n
@@ -364,6 +394,10 @@ proc audit_flow {var -attach channel} {
testchannel transform $channel -command [namespace code [list id_fulltrail $var]]
}
+proc torture {-attach channel} {
+ testchannel transform $channel -command [namespace code [list id_torture $channel]]
+}
+
proc stopafter {var n -attach channel} {
variable $var
upvar 0 $var vn
@@ -518,6 +552,7 @@ query/maxRead
read
query/maxRead
flush/read
+query/maxRead
delete/read
--------
create/write
@@ -570,6 +605,7 @@ read {
}
query/maxRead {} -1
flush/read {} {}
+query/maxRead {} -1
delete/read {} *ignored*
--------
create/write {} *ignored*
@@ -624,6 +660,7 @@ read {%^&*()_+-=
}
query/maxRead {} -1
flush/read {} {}
+query/maxRead {} -1
write %^&*()_+-= %^&*()_+-=
write {
} {
@@ -632,9 +669,27 @@ delete/read {} *ignored*
flush/write {} {}
delete/write {} *ignored*}
+test iogt-2.4 {basic I/O, mixed trail} {testchannel} {
+ set fh [open $path(dummy) r]
+ torture -attach $fh
+ chan configure $fh -buffersize 2
+ set x [read $fh]
+ testchannel unstack $fh
+ close $fh
+ set x
+} {}
+test iogt-2.5 {basic I/O, mixed trail} {testchannel} {
+ set ::level 0
+ set fh [open $path(dummyout) w]
+ torture -attach $fh
+ puts -nonewline $fh abcdef
+ flush $fh
+ testchannel unstack $fh
+ close $fh
+} {}
test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
- {testchannel unknownFailure} {
+ {testchannel knownBug} {
# This test to check the validity of aquired Tcl_Channel references is
# not possible because even a backgrounded fcopy will immediately start
# to copy data, without waiting for the event loop. This is done only in
@@ -651,6 +706,7 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
set fin [open $path(dummy) r]
fevent 1000 500 {20 20 20 10 1 1} {
+ variable copy
close $fin
set fout [open dummyout w]
@@ -688,7 +744,7 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
} {1 {create/write create/read write flush/write flush/read delete/write delete/read}}
-test iogt-4.0 {fileevent readable, after transform} {testchannel unknownFailure} {
+test iogt-4.0 {fileevent readable, after transform} {testchannel knownBug} {
set fin [open $path(dummy) r]
set data [read $fin]
close $fin
@@ -718,10 +774,11 @@ test iogt-4.0 {fileevent readable, after transform} {testchannel unknownFailure}
}
fevent 1000 500 {20 20 20 10 1} {
+ variable stop
audit_flow trail -attach $sock
rblocks_t rbuf trail 23 -attach $sock
- fileevent $sock readable [list Get $sock]
+ fileevent $sock readable [namespace code [list Get $sock]]
flush $sock ; # now, or fcopy will error us out
# But the 1 second delay should be enough to
@@ -819,7 +876,7 @@ delete/write {} *ignored*
delete/read {} *ignored*} ; # catch unescaped quote "
-test iogt-5.0 {EOF simulation} {testchannel unknownFailure} {
+test iogt-5.0 {EOF simulation} {testchannel knownBug} {
set fin [open $path(dummy) r]
set fout [open $path(dummyout) w]
@@ -916,6 +973,15 @@ test iogt-6.0 {Push back} testchannel {
} {xxx}
test iogt-6.1 {Push back and up} {testchannel knownBug} {
+
+ # This test demonstrates the bug/misfeature in the stacked
+ # channel implementation that data can be discarded if it is
+ # read into the buffers of one channel in the stack, and then
+ # that channel is popped before anything above it reads.
+ #
+ # This bug can be worked around by always setting -buffersize
+ # to 1, but who wants to do that?
+
set f [open $path(dummy) r]
# contents of dummy = "abcdefghi..."
diff --git a/tests/socket.test b/tests/socket.test
index 218cce4..1b7c5fa 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -67,6 +67,10 @@ namespace import -force ::tcltest::*
testConstraint testthread [llength [info commands testthread]]
testConstraint exec [llength [info commands exec]]
+# Produce a random port number in the Dynamic/Private range
+# from 49152 through 65535.
+proc randport {} { expr {int(rand()*16383+49152)} }
+
# If remoteServerIP or remoteServerPort are not set, check in the
# environment variables for externally set values.
#
@@ -910,22 +914,6 @@ test socket-8.1 {testing -async flag on sockets} {socket} {
set z
} bye
-test socket-8.2 {testing writable event when quick failure} {socket win} {
- # Test for bug 336441ed59 where a quick background fail was ignored
-
- # Test only for windows as socket -async 255.255.255.255 fails directly
- # on unix
-
- # The following connect should fail very quickly
- set a1 [after 2000 {set x timeout}]
- set s [socket -async 255.255.255.255 43434]
- fileevent $s writable {set x writable}
- vwait x
- catch {close $s}
- after cancel $a1
- set x
-} writable
-
test socket-9.1 {testing spurious events} {socket} {
set len 0
set spurious 0
@@ -1699,6 +1687,37 @@ if {[string match sock* $commandSocket] == 1} {
}
catch {close $commandSocket}
catch {close $remoteProcChan}
+test socket-14.13 {testing writable event when quick failure} -constraints {socket win supported_inet} -body {
+ # Test for bug 336441ed59 where a quick background fail was ignored
+
+ # Test only for windows as socket -async 255.255.255.255 fails
+ # directly on unix
+
+ # The following connect should fail very quickly
+ set a1 [after 2000 {set x timeout}]
+ set s [socket -async 255.255.255.255 43434]
+ fileevent $s writable {set x writable}
+ vwait x
+ set x
+} -cleanup {
+ catch {close $s}
+ after cancel $a1
+} -result writable
+
+test socket-14.14 {testing fileevent readable on failed async socket connect} -constraints [list socket] -body {
+ # Test for bug 581937ab1e
+
+ set a1 [after 5000 {set x timeout}]
+ # This connect should fail
+ set s [socket -async localhost [randport]]
+ fileevent $s readable {set x readable}
+ vwait x
+ set x
+} -cleanup {
+ catch {close $s}
+ after cancel $a1
+} -result readable
+
::tcltest::cleanupTests
flush stdout
return
diff --git a/unix/Makefile.in b/unix/Makefile.in
index c7caf5b..746abde 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -736,6 +736,9 @@ install-binaries: binaries
@INSTALL_STUB_LIB@ ; \
fi
@EXTRA_INSTALL_BINARIES@
+ @echo "Installing pkg-config file to $(LIB_INSTALL_DIR)/pkgconfig/"
+ @mkdir -p $(LIB_INSTALL_DIR)/pkgconfig
+ @$(INSTALL_DATA) tcl.pc $(LIB_INSTALL_DIR)/pkgconfig/tcl.pc
install-libraries: libraries $(INSTALL_TZDATA) install-msgs
@for i in "$(INCLUDE_INSTALL_DIR)" "$(SCRIPT_INSTALL_DIR)"; \
@@ -905,7 +908,8 @@ clean:
distclean: clean
rm -rf Makefile config.status config.cache config.log tclConfig.sh \
- $(PACKAGE).* prototype tclConfig.h *.plist Tcl.framework
+ $(PACKAGE).* prototype tclConfig.h *.plist Tcl.framework \
+ tcl.pc
cd dltest ; $(MAKE) distclean
depend:
@@ -1657,7 +1661,7 @@ $(UNIX_DIR)/tclConfig.h.in: $(MAC_OSX_DIR)/configure
cd $(MAC_OSX_DIR); autoheader; touch $@
EOLFIX=$(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl
-dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(MAC_OSX_DIR)/configure genstubs
+dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(MAC_OSX_DIR)/configure genstubs
rm -rf $(DISTDIR)
mkdir -p $(DISTDIR)/unix
cp -p $(UNIX_DIR)/*.[ch] $(DISTDIR)/unix
@@ -1668,7 +1672,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(MAC_OSX_DIR)/configure
$(UNIX_DIR)/tclConfig.sh.in $(UNIX_DIR)/install-sh \
$(UNIX_DIR)/README $(UNIX_DIR)/ldAix $(UNIX_DIR)/tcl.spec \
$(UNIX_DIR)/installManPage $(UNIX_DIR)/tclConfig.h.in \
- $(DISTDIR)/unix
+ $(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix
chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in
chmod 775 $(DISTDIR)/unix/ldAix
@mkdir $(DISTDIR)/generic
diff --git a/unix/configure b/unix/configure
index 1b2ea41..d268647 100755
--- a/unix/configure
+++ b/unix/configure
@@ -7010,9 +7010,9 @@ echo "$as_me: error: CYGWIN compile is only supported with --enable-threads" >&2
fi
do64bit_ok=yes
if test "x${SHARED_BUILD}" = "x1"; then
- echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args"
+ echo "running cd ${TCL_SRC_DIR}/win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args"
# The eval makes quoting arguments work.
- if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix
+ if cd ${TCL_SRC_DIR}/win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix
then :
else
{ echo "configure: error: configure failed for ../win" 1>&2; exit 1; }
@@ -18915,7 +18915,7 @@ TCL_SHARED_BUILD=${SHARED_BUILD}
- ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in"
+ ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in"
cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
@@ -19469,6 +19469,7 @@ do
"Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile:../unix/Makefile.in" ;;
"dltest/Makefile" ) CONFIG_FILES="$CONFIG_FILES dltest/Makefile:../unix/dltest/Makefile.in" ;;
"tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh:../unix/tclConfig.sh.in" ;;
+ "tcl.pc" ) CONFIG_FILES="$CONFIG_FILES tcl.pc:../unix/tcl.pc.in" ;;
"Tcl.framework" ) CONFIG_COMMANDS="$CONFIG_COMMANDS Tcl.framework" ;;
*) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
diff --git a/unix/configure.in b/unix/configure.in
index b5a09dd..318bcf8 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -940,5 +940,6 @@ AC_CONFIG_FILES([
Makefile:../unix/Makefile.in
dltest/Makefile:../unix/dltest/Makefile.in
tclConfig.sh:../unix/tclConfig.sh.in
+ tcl.pc:../unix/tcl.pc.in
])
AC_OUTPUT
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index 10408a8..b6c86b6 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -1266,9 +1266,9 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
fi
do64bit_ok=yes
if test "x${SHARED_BUILD}" = "x1"; then
- echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args"
+ echo "running cd ${TCL_SRC_DIR}/win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args"
# The eval makes quoting arguments work.
- if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix
+ if cd ${TCL_SRC_DIR}/win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix
then :
else
{ echo "configure: error: configure failed for ../win" 1>&2; exit 1; }
diff --git a/unix/tcl.pc.in b/unix/tcl.pc.in
new file mode 100644
index 0000000..b750300
--- /dev/null
+++ b/unix/tcl.pc.in
@@ -0,0 +1,14 @@
+# tcl pkg-config source file
+
+prefix=@prefix@
+exec_prefix=@exec_prefix@
+libdir=@libdir@
+includedir=@includedir@
+
+Name: Tool Command Language
+Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses.
+URL: http://www.tcl.tk/
+Version: @TCL_VERSION@@TCL_PATCH_LEVEL@
+Libs: -L${libdir} @TCL_LIB_FLAG@
+Libs.private: @TCL_LIBS@
+Cflags: -I${includedir}
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 29f1aba..c5f75a7 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -1111,6 +1111,12 @@ TclNativeCreateNativeRep(
str = Tcl_GetStringFromObj(validPathPtr, &len);
Tcl_UtfToExternalDString(NULL, str, len, &ds);
len = Tcl_DStringLength(&ds) + sizeof(char);
+ if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) {
+ /* See bug [3118489]: NUL in filenames */
+ Tcl_DecrRefCount(validPathPtr);
+ Tcl_DStringFree(&ds);
+ return NULL;
+ }
Tcl_DecrRefCount(validPathPtr);
nativePathPtr = ckalloc((unsigned) len);
memcpy((void*)nativePathPtr, (void*)Tcl_DStringValue(&ds), (size_t) len);
diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c
index ad36242..d30791d 100644
--- a/unix/tclUnixThrd.c
+++ b/unix/tclUnixThrd.c
@@ -814,6 +814,7 @@ TclpFreeAllocCache(
*/
TclFreeAllocCache(ptr);
+ pthread_setspecific(key, NULL);
} else if (initialized) {
/*
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 8999831..441337e 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -1156,7 +1156,12 @@ DoRemoveJustDirectory(
end:
if (errorPtr != NULL) {
+ char *p;
Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
+ p = Tcl_DStringValue(errorPtr);
+ for (; *p; ++p) {
+ if (*p == '\\') *p = '/';
+ }
}
return TCL_ERROR;
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 676c443..9bf63b1 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -1856,6 +1856,9 @@ TclpObjChdir(
nativePath = (const TCHAR *) Tcl_FSGetNativePath(pathPtr);
+ if (!nativePath) {
+ return -1;
+ }
result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath);
if (result == 0) {
@@ -3197,19 +3200,72 @@ TclNativeCreateNativeRep(
}
str = Tcl_GetStringFromObj(validPathPtr, &len);
- if (str[0] == '/' && str[1] == '/' && str[2] == '?' && str[3] == '/') {
- char *p;
-
- for (p = str; p && *p; ++p) {
- if (*p == '/') {
- *p = '\\';
- }
- }
- }
Tcl_WinUtfToTChar(str, len, &ds);
if (tclWinProcs->useWide) {
+ WCHAR *wp = (WCHAR *) Tcl_DStringValue(&ds);
+ len = Tcl_DStringLength(&ds)>>1;
+ /*
+ ** If path starts with "//?/" or "\\?\" (extended path), translate
+ ** any slashes to backslashes but accept the '?' as being valid.
+ */
+ if ((str[0]=='\\' || str[0]=='/') && (str[1]=='\\' || str[1]=='/')
+ && str[2]=='?' && (str[3]=='\\' || str[3]=='/')) {
+ wp[0] = wp[1] = wp[3] = '\\';
+ str += 4;
+ wp += 4;
+ len -= 4;
+ }
+ /*
+ ** If there is a drive prefix, the ':' must be considered valid.
+ **/
+ if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z'))
+ && str[1]==':') {
+ wp += 2;
+ len -= 2;
+ }
+ while (len-->0) {
+ if ((*wp < ' ') || wcschr(L"\"*:<>?|", *wp)) {
+ Tcl_DecrRefCount(validPathPtr);
+ Tcl_DStringFree(&ds);
+ return NULL;
+ } else if (*wp=='/') {
+ *wp = '\\';
+ }
+ ++wp;
+ }
len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
} else {
+ char *p = Tcl_DStringValue(&ds);
+ len = Tcl_DStringLength(&ds);
+ /*
+ ** If path starts with "//?/" or "\\?\" (extended path), translate
+ ** any slashes to backslashes but accept the '?' as being valid.
+ */
+ if ((str[0]=='\\' || str[0]=='/') && (str[1]=='\\' || str[1]=='/')
+ && str[2]=='?' && (str[3]=='\\' || str[3]=='/')) {
+ p[0] = p[1] = p[3] = '\\';
+ str += 4;
+ p += 4;
+ len -= 4;
+ }
+ /*
+ ** If there is a drive prefix, the ':' must be considered valid.
+ **/
+ if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z'))
+ && str[1]==':') {
+ p += 2;
+ len -= 2;
+ }
+ while (len-->0) {
+ if ((*p < ' ') || strchr("\"*:<>?|", *p)) {
+ Tcl_DecrRefCount(validPathPtr);
+ Tcl_DStringFree(&ds);
+ return NULL;
+ } else if (*p=='/') {
+ *p = '\\';
+ }
+ ++p;
+ }
len = Tcl_DStringLength(&ds) + sizeof(char);
}
Tcl_DecrRefCount(validPathPtr);
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 2f3c7e8..4e860b2 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -113,8 +113,8 @@ static int ToUtf(CONST WCHAR *wSrc, char *dst);
*
* TclpInitPlatform --
*
- * Initialize all the platform-dependant things like signals and
- * floating-point error handling.
+ * Initialize all the platform-dependant things like signals,
+ * floating-point error handling and sockets.
*
* Called at process initialization time.
*
@@ -130,20 +130,16 @@ static int ToUtf(CONST WCHAR *wSrc, char *dst);
void
TclpInitPlatform(void)
{
- tclPlatform = TCL_PLATFORM_WINDOWS;
+ WSADATA wsaData;
+ WORD wVersionRequested = MAKEWORD(2, 2);
- /*
- * The following code stops Windows 3.X and Windows NT 3.51 from
- * automatically putting up Sharing Violation dialogs, e.g, when someone
- * tries to access a file that is locked or a drive with no disk in it.
- * Tcl already returns the appropriate error to the caller, and they can
- * decide to put up their own dialog in response to that failure.
- *
- * Under 95 and NT 4.0, this is a NOOP because the system doesn't
- * automatically put up dialogs when the above operations fail.
- */
+ tclPlatform = TCL_PLATFORM_WINDOWS;
- SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS);
+ /*
+ * Initialize the winsock library. On Windows XP and higher this
+ * can never fail.
+ */
+ WSAStartup(wVersionRequested, &wsaData);
#ifdef STATIC_BUILD
/*
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index ec9e867..ea6d8f8 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -448,15 +448,6 @@ typedef DWORD_PTR * PDWORD_PTR;
#define TclpSysRealloc(ptr, size) ((void*)HeapReAlloc(GetProcessHeap(), \
(DWORD)0, (LPVOID)ptr, (DWORD)size))
-/*
- * The following defines map from standard socket names to our internal
- * wrappers that redirect through the winSock function table (see the
- * file tclWinSock.c).
- */
-
-#define getservbyname TclWinGetServByName
-#define getsockopt TclWinGetSockOpt
-#define setsockopt TclWinSetSockOpt
/* This type is not defined in the Windows headers */
#define socklen_t int
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index e7b086a..e18a3dd 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -263,8 +263,6 @@ static void
InitSockets(void)
{
DWORD id;
- WSADATA wsaData;
- DWORD err;
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
TclThreadDataKeyGet(&dataKey);
@@ -295,38 +293,6 @@ InitSockets(void)
goto initFailure;
}
- /*
- * Initialize the winsock library and check the interface version
- * actually loaded. We only ask for the 1.1 interface and do require
- * that it not be less than 1.1.
- */
-
-#define WSA_VERSION_MAJOR 1
-#define WSA_VERSION_MINOR 1
-#define WSA_VERSION_REQD MAKEWORD(WSA_VERSION_MAJOR, WSA_VERSION_MINOR)
-
- err = WSAStartup((WORD)WSA_VERSION_REQD, &wsaData);
- if (err != 0) {
- TclWinConvertWSAError(err);
- goto initFailure;
- }
-
- /*
- * Note the byte positions are swapped for the comparison, so that
- * 0x0002 (2.0, MAKEWORD(2,0)) doesn't look less than 0x0101 (1.1).
- * We want the comparison to be 0x0200 < 0x0101.
- */
-
- if (MAKEWORD(HIBYTE(wsaData.wVersion), LOBYTE(wsaData.wVersion))
- < MAKEWORD(WSA_VERSION_MINOR, WSA_VERSION_MAJOR)) {
- TclWinConvertWSAError(WSAVERNOTSUPPORTED);
- WSACleanup();
- goto initFailure;
- }
-
-#undef WSA_VERSION_REQD
-#undef WSA_VERSION_MAJOR
-#undef WSA_VERSION_MINOR
}
/*
@@ -434,7 +400,6 @@ SocketExitHandler(
TclpFinalizeSockets();
UnregisterClass("TclSocket", TclWinGetTclInstance());
- WSACleanup();
initialized = 0;
Tcl_MutexUnlock(&socketMutex);
}
@@ -719,44 +684,52 @@ SocketEventProc(
Tcl_SetMaxBlockTime(&blockTime);
mask |= TCL_READABLE|TCL_WRITABLE;
} else if (events & FD_READ) {
- fd_set readFds;
- struct timeval timeout;
-
/*
- * We must check to see if data is really available, since someone
- * could have consumed the data in the meantime. Turn off async
- * notification so select will work correctly. If the socket is still
- * readable, notify the channel driver, otherwise reset the async
- * select handler and keep waiting.
+ * Throw the readable event if an async connect failed.
*/
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) UNSELECT, (LPARAM) infoPtr);
-
- FD_ZERO(&readFds);
- FD_SET(infoPtr->socket, &readFds);
- timeout.tv_usec = 0;
- timeout.tv_sec = 0;
+ if (infoPtr->lastError) {
- if (select(0, &readFds, NULL, NULL, &timeout) != 0) {
mask |= TCL_READABLE;
+
} else {
- infoPtr->readyEvents &= ~(FD_READ);
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) SELECT, (LPARAM) infoPtr);
- }
- }
- if (events & (FD_WRITE | FD_CONNECT)) {
- mask |= TCL_WRITABLE;
- if (events & FD_CONNECT && infoPtr->lastError != NO_ERROR) {
+ fd_set readFds;
+ struct timeval timeout;
+
/*
- * Connect errors should also fire the readable handler.
+ * We must check to see if data is really available, since someone
+ * could have consumed the data in the meantime. Turn off async
+ * notification so select will work correctly. If the socket is still
+ * readable, notify the channel driver, otherwise reset the async
+ * select handler and keep waiting.
*/
- mask |= TCL_READABLE;
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) UNSELECT, (LPARAM) infoPtr);
+
+ FD_ZERO(&readFds);
+ FD_SET(infoPtr->socket, &readFds);
+ timeout.tv_usec = 0;
+ timeout.tv_sec = 0;
+
+ if (select(0, &readFds, NULL, NULL, &timeout) != 0) {
+ mask |= TCL_READABLE;
+ } else {
+ infoPtr->readyEvents &= ~(FD_READ);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
+ (WPARAM) SELECT, (LPARAM) infoPtr);
+ }
}
}
+ /*
+ * writable event
+ */
+
+ if (events & FD_WRITE) {
+ mask |= TCL_WRITABLE;
+ }
+
if (mask) {
Tcl_NotifyChannel(infoPtr->channel, mask);
}
@@ -2409,19 +2382,18 @@ SocketProc(
*/
if (error != ERROR_SUCCESS) {
+ /* Async Connect error */
TclWinConvertWSAError((DWORD) error);
infoPtr->lastError = Tcl_GetErrno();
+ /* Fire also readable event on connect failure */
+ infoPtr->readyEvents |= FD_READ;
}
- }
- if (infoPtr->flags & SOCKET_ASYNC_CONNECT) {
- infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
- if (error != ERROR_SUCCESS) {
- TclWinConvertWSAError((DWORD) error);
- infoPtr->lastError = Tcl_GetErrno();
- }
+ /* fire writable event on connect */
infoPtr->readyEvents |= FD_WRITE;
+
}
+
infoPtr->readyEvents |= event;
/*
@@ -2557,71 +2529,34 @@ InitializeHostName(
*----------------------------------------------------------------------
*/
+#undef TclWinGetSockOpt
int
TclWinGetSockOpt(SOCKET s, int level, int optname, char *optval,
int *optlen)
{
- /*
- * Check that WinSock is initialized; do not call it if not, to prevent
- * system crashes. This can happen at exit time if the exit handler for
- * WinSock ran before other exit handlers that want to use sockets.
- */
-
- if (!SocketsEnabled()) {
- return SOCKET_ERROR;
- }
-
return getsockopt(s, level, optname, optval, optlen);
}
+#undef TclWinSetSockOpt
int
TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval,
int optlen)
{
- /*
- * Check that WinSock is initialized; do not call it if not, to prevent
- * system crashes. This can happen at exit time if the exit handler for
- * WinSock ran before other exit handlers that want to use sockets.
- */
-
- if (!SocketsEnabled()) {
- return SOCKET_ERROR;
- }
-
return setsockopt(s, level, optname, optval, optlen);
}
char *
TclpInetNtoa(struct in_addr addr)
{
- /*
- * Check that WinSock is initialized; do not call it if not, to prevent
- * system crashes. This can happen at exit time if the exit handler for
- * WinSock ran before other exit handlers that want to use sockets.
- */
-
- if (!SocketsEnabled()) {
- return NULL;
- }
-
return inet_ntoa(addr);
}
+#undef TclWinGetServByName
struct servent *
TclWinGetServByName(
const char *name,
const char *proto)
{
- /*
- * Check that WinSock is initialized; do not call it if not, to prevent
- * system crashes. This can happen at exit time if the exit handler for
- * WinSock ran before other exit handlers that want to use sockets.
- */
-
- if (!SocketsEnabled()) {
- return NULL;
- }
-
return getservbyname(name, proto);
}