summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--changes2
-rw-r--r--doc/socket.n9
-rw-r--r--generic/tclCompCmds.c187
-rw-r--r--generic/tclCompCmdsGR.c16
-rw-r--r--generic/tclCompile.h10
-rw-r--r--generic/tclEncoding.c12
-rw-r--r--generic/tclEvent.c14
-rw-r--r--generic/tclIO.c3
-rw-r--r--generic/tclInt.h3
-rw-r--r--generic/tclParse.c50
-rw-r--r--generic/tclThread.c4
-rw-r--r--tests/io.test38
-rw-r--r--tests/ioCmd.test2
-rw-r--r--unix/tclUnixSock.c2
-rw-r--r--win/tclWinSock.c4
15 files changed, 190 insertions, 166 deletions
diff --git a/changes b/changes
index 1decfe2..79a242d 100644
--- a/changes
+++ b/changes
@@ -8491,3 +8491,5 @@ include ::oo::class (fellows)
2014-11-06 (bug)[5adc35] Stop forcing EOF to be permanent (porter)
--- Released 8.6.3, November 12, 2014 --- http://core.tcl.tk/tcl/ for details
+
+2014-12-17 (TIP 427) [fconfigure $h -connecting, -peername, -sockname] (oehlmann,rmax)
diff --git a/doc/socket.n b/doc/socket.n
index b7a4a45..492ca66 100644
--- a/doc/socket.n
+++ b/doc/socket.n
@@ -97,6 +97,10 @@ writable channel event on the socket to get notified when the
asynchronous connection has succeeded or failed. See the \fBvwait\fR
and the \fBchan\fR commands for more details on the event loop and
channel events.
+.PP
+The \fBchan configure\fR option \fB-connecting\fR may be used to check if the connect is still running. To verify a successful connect, the option \fB-error\fR may be checked when \fB-connecting\fR returned 0.
+.PP
+Operation without the event queue requires at the moment calls to \fBchan configure\fR to advance the internal state machine.
.RE
.SH "SERVER SOCKETS"
.PP
@@ -186,6 +190,11 @@ sockets, this option returns a list of three elements; these are the
address, the host name and the port to which the peer socket is connected
or bound. If the host name cannot be computed, the second element of the
list is identical to the address, its first element.
+.RE
+.TP
+\fB\-connecting\fR
+.
+This option is not supported by server sockets. For client sockets, this option returns 1 if an asyncroneous connect is still in progress, 0 otherwise.
.PP
.SH "EXAMPLES"
.PP
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 30c1318..6a22a30 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -177,9 +177,9 @@ TclCompileAppendCmd(
*/
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
- &localIndex, &isScalar, 1);
- if (!isScalar || localIndex < 0) {
+
+ localIndex = LocalScalarFromToken(varTokenPtr, envPtr);
+ if (localIndex < 0) {
return TCL_ERROR;
}
@@ -2527,25 +2527,17 @@ CompileEachloopCmd(
* (TCL_EACH_*) */
{
Proc *procPtr = envPtr->procPtr;
- ForeachInfo *infoPtr; /* Points to the structure describing this
+ ForeachInfo *infoPtr=NULL; /* Points to the structure describing this
* foreach command. Stored in a AuxData
* record in the ByteCode. */
Tcl_Token *tokenPtr, *bodyTokenPtr;
int jumpBackOffset, infoIndex, range;
- int numWords, numLists, numVars, loopIndex, i, j, code;
+ int numWords, numLists, i, j, code = TCL_OK;
+ Tcl_Obj *varListObj = NULL;
DefineLineInformation; /* TIP #280 */
/*
- * We parse the variable list argument words and create two arrays:
- * varcList[i] is number of variables in i-th var list.
- * varvList[i] points to array of var names in i-th var list.
- */
-
- int *varcList;
- const char ***varvList;
-
- /*
* If the foreach command isn't in a procedure, don't compile it inline:
* the payoff is too small.
*/
@@ -2573,105 +2565,73 @@ CompileEachloopCmd(
}
/*
- * Allocate storage for the varcList and varvList arrays if necessary.
+ * Create and initialize the ForeachInfo and ForeachVarList data
+ * structures describing this command. Then create a AuxData record
+ * pointing to the ForeachInfo structure.
*/
numLists = (numWords - 2)/2;
- varcList = TclStackAlloc(interp, numLists * sizeof(int));
- memset(varcList, 0, numLists * sizeof(int));
- varvList = (const char ***) TclStackAlloc(interp,
- numLists * sizeof(const char **));
- memset((char*) varvList, 0, numLists * sizeof(const char **));
+ infoPtr = ckalloc(sizeof(ForeachInfo)
+ + (numLists - 1) * sizeof(ForeachVarList *));
+ infoPtr->numLists = 0; /* Count this up as we go */
/*
- * Break up each var list and set the varcList and varvList arrays. Don't
+ * Parse each var list into sequence of var names. Don't
* compile the foreach inline if any var name needs substitutions or isn't
* a scalar, or if any var list needs substitutions.
*/
- loopIndex = 0;
+ varListObj = Tcl_NewObj();
for (i = 0, tokenPtr = parsePtr->tokenPtr;
i < numWords-1;
i++, tokenPtr = TokenAfter(tokenPtr)) {
- Tcl_DString varList;
+ ForeachVarList *varListPtr;
+ int numVars;
if (i%2 != 1) {
continue;
}
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- code = TCL_ERROR;
- goto done;
- }
-
- /*
- * Lots of copying going on here. Need a ListObj wizard to show a
- * better way.
- */
-
- Tcl_DStringInit(&varList);
- TclDStringAppendToken(&varList, &tokenPtr[1]);
- code = Tcl_SplitList(NULL, Tcl_DStringValue(&varList),
- &varcList[loopIndex], &varvList[loopIndex]);
- Tcl_DStringFree(&varList);
- if (code != TCL_OK) {
- code = TCL_ERROR;
- goto done;
- }
- numVars = varcList[loopIndex];
/*
* If the variable list is empty, we can enter an infinite loop when
- * the interpreted version would not. Take care to ensure this does
- * not happen. [Bug 1671138]
+ * the interpreted version would not. Take care to ensure this does
+ * not happen. [Bug 1671138]
*/
- if (numVars == 0) {
+ if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
+ TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
+ numVars == 0) {
code = TCL_ERROR;
goto done;
}
- for (j = 0; j < numVars; j++) {
- const char *varName = varvList[loopIndex][j];
+ varListPtr = ckalloc(sizeof(ForeachVarList)
+ + (numVars - 1) * sizeof(int));
+ varListPtr->numVars = numVars;
+ infoPtr->varLists[i/2] = varListPtr;
+ infoPtr->numLists++;
- if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
+ for (j = 0; j < numVars; j++) {
+ Tcl_Obj *varNameObj;
+ const char *bytes;
+ int numBytes, varIndex;
+
+ Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
+ bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
+ varIndex = LocalScalar(bytes, numBytes, envPtr);
+ if (varIndex < 0) {
code = TCL_ERROR;
goto done;
}
+ varListPtr->varIndexes[j] = varIndex;
}
- loopIndex++;
+ Tcl_SetObjLength(varListObj, 0);
}
/*
* We will compile the foreach command.
*/
- code = TCL_OK;
-
- /*
- * Create and initialize the ForeachInfo and ForeachVarList data
- * structures describing this command. Then create a AuxData record
- * pointing to the ForeachInfo structure.
- */
-
- infoPtr = ckalloc(sizeof(ForeachInfo)
- + (numLists - 1) * sizeof(ForeachVarList *));
- infoPtr->numLists = numLists;
- for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
- ForeachVarList *varListPtr;
-
- numVars = varcList[loopIndex];
- varListPtr = ckalloc(sizeof(ForeachVarList)
- + (numVars - 1) * sizeof(int));
- varListPtr->numVars = numVars;
- for (j = 0; j < numVars; j++) {
- const char *varName = varvList[loopIndex][j];
- int nameChars = strlen(varName);
-
- varListPtr->varIndexes[j] = TclFindCompiledLocal(varName,
- nameChars, /*create*/ 1, envPtr);
- }
- infoPtr->varLists[loopIndex] = varListPtr;
- }
infoIndex = TclCreateAuxData(infoPtr, &tclNewForeachInfoType, envPtr);
/*
@@ -2743,13 +2703,14 @@ CompileEachloopCmd(
}
done:
- for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
- if (varvList[loopIndex] != NULL) {
- ckfree(varvList[loopIndex]);
+ if (code == TCL_ERROR) {
+ if (infoPtr) {
+ FreeForeachInfo(infoPtr);
}
}
- TclStackFree(interp, (void *)varvList);
- TclStackFree(interp, varcList);
+ if (varListObj) {
+ Tcl_DecrRefCount(varListObj);
+ }
return code;
}
@@ -3234,6 +3195,54 @@ TclCompileFormatCmd(
/*
*----------------------------------------------------------------------
*
+ * TclLocalScalarFromToken --
+ *
+ * Get the index into the table of compiled locals that corresponds
+ * to a local scalar variable name.
+ *
+ * Results:
+ * Returns the non-negative integer index value into the table of
+ * compiled locals corresponding to a local scalar variable name.
+ * If the arguments passed in do not identify a local scalar variable
+ * then return -1.
+ *
+ * Side effects:
+ * May add an entery into the table of compiled locals.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclLocalScalarFromToken(
+ Tcl_Token *tokenPtr,
+ CompileEnv *envPtr)
+{
+ int isScalar, index;
+
+ TclPushVarName(NULL, tokenPtr, envPtr, TCL_NO_ELEMENT, &index, &isScalar);
+ if (!isScalar) {
+ index = -1;
+ }
+ return index;
+}
+
+int
+TclLocalScalar(
+ const char *bytes,
+ int numBytes,
+ CompileEnv *envPtr)
+{
+ Tcl_Token token[2] = {{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1},
+ {TCL_TOKEN_TEXT, NULL, 0, 0}};
+
+ token[1].start = bytes;
+ token[1].size = numBytes;
+ return TclLocalScalarFromToken(token, envPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclPushVarName --
*
* Procedure used in the compiling where pushing a variable name is
@@ -3313,7 +3322,7 @@ TclPushVarName(
}
}
- if ((elName != NULL) && elNameChars) {
+ if (!(flags & TCL_NO_ELEMENT) && (elName != NULL) && elNameChars) {
/*
* An array element, the element name is a simple string:
* assemble the corresponding token.
@@ -3328,7 +3337,7 @@ TclPushVarName(
elemTokenCount = 1;
}
}
- } else if (((n = varTokenPtr->numComponents) > 1)
+ } else if (interp && ((n = varTokenPtr->numComponents) > 1)
&& (varTokenPtr[1].type == TCL_TOKEN_TEXT)
&& (varTokenPtr[n].type == TCL_TOKEN_TEXT)
&& (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
@@ -3366,7 +3375,8 @@ TclPushVarName(
remainingChars = (varTokenPtr[2].start - p) - 1;
elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 1;
- if (remainingChars) {
+ if (!(flags & TCL_NO_ELEMENT)) {
+ if (remainingChars) {
/*
* Make a first token with the extra characters in the first
* token.
@@ -3386,13 +3396,14 @@ TclPushVarName(
memcpy(elemTokenPtr+1, varTokenPtr+2,
(n-1) * sizeof(Tcl_Token));
- } else {
+ } else {
/*
* Use the already available tokens.
*/
elemTokenPtr = &varTokenPtr[2];
elemTokenCount = n - 1;
+ }
}
}
}
@@ -3427,7 +3438,7 @@ TclPushVarName(
localIndex = -1;
}
}
- if (localIndex < 0) {
+ if (interp && localIndex < 0) {
PushLiteral(envPtr, name, nameChars);
}
@@ -3444,7 +3455,7 @@ TclPushVarName(
PushStringLiteral(envPtr, "");
}
}
- } else {
+ } else if (interp) {
/*
* The var name isn't simple: compile and push it.
*/
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 98407f7..e2fb43d 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -2044,7 +2044,7 @@ TclCompileNamespaceUpvarCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
- int isScalar, localIndex, numWords, i;
+ int localIndex, numWords, i;
DefineLineInformation; /* TIP #280 */
if (envPtr->procPtr == NULL) {
@@ -2079,10 +2079,8 @@ TclCompileNamespaceUpvarCmd(
localTokenPtr = TokenAfter(otherTokenPtr);
CompileWord(envPtr, otherTokenPtr, interp, i);
- PushVarNameWord(interp, localTokenPtr, envPtr, 0,
- &localIndex, &isScalar, i+1);
-
- if ((localIndex < 0) || !isScalar) {
+ localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
+ if (localIndex < 0) {
return TCL_ERROR;
}
TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr);
@@ -2763,7 +2761,7 @@ TclCompileUpvarCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
- int isScalar, localIndex, numWords, i;
+ int localIndex, numWords, i;
DefineLineInformation; /* TIP #280 */
Tcl_Obj *objPtr;
@@ -2826,10 +2824,8 @@ TclCompileUpvarCmd(
localTokenPtr = TokenAfter(otherTokenPtr);
CompileWord(envPtr, otherTokenPtr, interp, i);
- PushVarNameWord(interp, localTokenPtr, envPtr, 0,
- &localIndex, &isScalar, i+1);
-
- if ((localIndex < 0) || !isScalar) {
+ localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
+ if (localIndex < 0) {
return TCL_ERROR;
}
TclEmitInstInt4( INST_UPVAR, localIndex, envPtr);
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index c097d6b..800e6af 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1151,6 +1151,10 @@ MODULE_SCOPE void TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr);
MODULE_SCOPE int TclLog2(int value);
#endif
+MODULE_SCOPE int TclLocalScalar(const char *bytes, int numBytes,
+ CompileEnv *envPtr);
+MODULE_SCOPE int TclLocalScalarFromToken(Tcl_Token *tokenPtr,
+ CompileEnv *envPtr);
MODULE_SCOPE void TclOptimizeBytecode(void *envPtr);
#ifdef TCL_COMPILE_DEBUG
MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp,
@@ -1678,11 +1682,9 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData,
#define AnonymousLocal(envPtr) \
(TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, (envPtr)))
#define LocalScalar(chars,len,envPtr) \
- (!TclIsLocalScalar((chars), (len)) ? -1 : \
- TclFindCompiledLocal((chars), (len), /*create*/ 1, (envPtr)))
+ TclLocalScalar(chars, len, envPtr)
#define LocalScalarFromToken(tokenPtr,envPtr) \
- ((tokenPtr)->type != TCL_TOKEN_SIMPLE_WORD ? -1 : \
- LocalScalar((tokenPtr)[1].start, (tokenPtr)[1].size, (envPtr)))
+ TclLocalScalarFromToken(tokenPtr, envPtr)
/*
* Flags bits used by TclPushVarName.
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 7ad3d0e..4f776e1 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -180,9 +180,9 @@ TCL_DECLARE_MUTEX(encodingMutex)
* the system encoding will be used to perform the conversion.
*/
-static Tcl_Encoding defaultEncoding;
-static Tcl_Encoding systemEncoding;
-Tcl_Encoding tclIdentityEncoding;
+static Tcl_Encoding defaultEncoding = NULL;
+static Tcl_Encoding systemEncoding = NULL;
+Tcl_Encoding tclIdentityEncoding = NULL;
/*
* The following variable is used in the sparse matrix code for a
@@ -652,7 +652,10 @@ TclFinalizeEncodingSubsystem(void)
Tcl_MutexLock(&encodingMutex);
encodingsInitialized = 0;
FreeEncoding(systemEncoding);
+ systemEncoding = NULL;
+ defaultEncoding = NULL;
FreeEncoding(tclIdentityEncoding);
+ tclIdentityEncoding = NULL;
hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
while (hPtr != NULL) {
@@ -2898,7 +2901,9 @@ TableFreeProc(
*/
ckfree(dataPtr->toUnicode);
+ dataPtr->toUnicode = NULL;
ckfree(dataPtr->fromUnicode);
+ dataPtr->fromUnicode = NULL;
ckfree(dataPtr);
}
@@ -3371,6 +3376,7 @@ EscapeFreeProc(
subTablePtr = dataPtr->subTables;
for (i = 0; i < dataPtr->numSubTables; i++) {
FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
+ subTablePtr->encodingPtr = NULL;
subTablePtr++;
}
}
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 7f42362..95c69dd 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -119,6 +119,7 @@ static char * VwaitVarProc(ClientData clientData,
Tcl_Interp *interp, const char *name1,
const char *name2, int flags);
static void InvokeExitHandlers(void);
+static void FinalizeThread(int quick);
/*
*----------------------------------------------------------------------
@@ -983,7 +984,7 @@ Tcl_Exit(
* Tcl_Channels that may have data enqueued.
*/
- Tcl_FinalizeThread();
+ FinalizeThread(/* quick */ 1);
}
TclpExit(status);
Tcl_Panic("OS exit failed!");
@@ -1183,7 +1184,7 @@ Tcl_Finalize(void)
* This fixes the Tcl Bug #990552.
*/
- TclFinalizeThreadData();
+ TclFinalizeThreadData(/* quick */ 0);
/*
* Now we can free constants for conversions to/from double.
@@ -1269,6 +1270,13 @@ Tcl_Finalize(void)
void
Tcl_FinalizeThread(void)
{
+ FinalizeThread(/* quick */ 0);
+}
+
+void
+FinalizeThread(
+ int quick)
+{
ExitHandler *exitPtr;
ThreadSpecificData *tsdPtr;
@@ -1309,7 +1317,7 @@ Tcl_FinalizeThread(void)
*
* Fix [Bug #571002]
*/
- TclFinalizeThreadData();
+ TclFinalizeThreadData(quick);
}
/*
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 6f9dbfe..59a6a93 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -9162,6 +9162,9 @@ MBWrite(
}
outStatePtr->outQueueTail = tail;
inStatePtr->inQueueHead = bufPtr;
+ if (inStatePtr->inQueueTail == tail) {
+ inStatePtr->inQueueTail = bufPtr;
+ }
if (bufPtr == NULL) {
inStatePtr->inQueueTail = NULL;
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1ce5fe8..9a25db9 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2882,7 +2882,7 @@ 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 TclFinalizeThreadData(int quick);
MODULE_SCOPE void TclFinalizeThreadObjects(void);
MODULE_SCOPE double TclFloor(const mp_int *a);
MODULE_SCOPE void TclFormatNaN(double value, char *buffer);
@@ -2937,7 +2937,6 @@ MODULE_SCOPE void TclInitNotifier(void);
MODULE_SCOPE void TclInitObjSubsystem(void);
MODULE_SCOPE void TclInitSubsystems(void);
MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp);
-MODULE_SCOPE int TclIsLocalScalar(const char *src, int len);
MODULE_SCOPE int TclIsSpaceProc(char byte);
MODULE_SCOPE int TclIsBareword(char byte);
MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[]);
diff --git a/generic/tclParse.c b/generic/tclParse.c
index ca12be5..5524979 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -2526,56 +2526,6 @@ TclObjCommandComplete(
}
/*
- *----------------------------------------------------------------------
- *
- * TclIsLocalScalar --
- *
- * Check to see if a given string is a legal scalar variable name with no
- * namespace qualifiers or substitutions.
- *
- * Results:
- * Returns 1 if the variable is a local scalar.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclIsLocalScalar(
- const char *src,
- int len)
-{
- const char *p;
- const char *lastChar = src + (len - 1);
-
- for (p=src ; p<=lastChar ; p++) {
- if ((CHAR_TYPE(*p) != TYPE_NORMAL)
- && (CHAR_TYPE(*p) != TYPE_COMMAND_END)) {
- /*
- * TCL_COMMAND_END is returned for the last character of the
- * string. By this point we know it isn't an array or namespace
- * reference.
- */
-
- return 0;
- }
- if (*p == '(') {
- if (*lastChar == ')') { /* We have an array element */
- return 0;
- }
- } else if (*p == ':') {
- if ((p != lastChar) && *(p+1) == ':') { /* qualified name */
- return 0;
- }
- }
- }
-
- return 1;
-}
-
-/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/generic/tclThread.c b/generic/tclThread.c
index 5ac6a8d..198fa6a 100644
--- a/generic/tclThread.c
+++ b/generic/tclThread.c
@@ -353,11 +353,11 @@ Tcl_ConditionFinalize(
*/
void
-TclFinalizeThreadData(void)
+TclFinalizeThreadData(int quick)
{
TclFinalizeThreadDataThread();
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
- if ((!TclInExit())||TclFullFinalizationRequested()) {
+ if (!quick) {
/*
* Quick exit principle makes it useless to terminate allocators
*/
diff --git a/tests/io.test b/tests/io.test
index b09d55a..cd8b014 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -7900,6 +7900,44 @@ test io-53.16 {[ed29c4da21] MBRead: fblocked seen as error} -setup {
close $c
removeFile out
} -result 100
+test io-53.17 {[7c187a3773] MBWrite: proper inQueueTail handling} -setup {
+ proc driver {cmd args} {
+ variable buffer
+ variable index
+ set chan [lindex $args 0]
+ switch -- $cmd {
+ initialize {
+ set index($chan) 0
+ set buffer($chan) [encoding convertto utf-8 \
+ line\n[string repeat a 100]line\n]
+ return {initialize finalize watch read}
+ }
+ finalize {
+ unset index($chan) buffer($chan)
+ return
+ }
+ watch {}
+ read {
+ set n [lindex $args 1]
+ set new [expr {$index($chan) + $n}]
+ set result [string range $buffer($chan) $index($chan) $new-1]
+ set index($chan) $new
+ return $result
+ }
+ }
+ }
+ set c [chan create read [namespace which driver]]
+ chan configure $c -encoding utf-8 -translation lf -buffersize 107
+ set out [makeFile {} out]
+ set outChan [open $out w]
+ chan configure $outChan -encoding utf-8 -translation lf
+} -body {
+ list [gets $c] [chan copy $c $outChan -size 100] [gets $c]
+} -cleanup {
+ close $outChan
+ close $c
+ removeFile out
+} -result {line 100 line}
test io-54.1 {Recursive channel events} {socket fileevent} {
# This test checks to see if file events are delivered during recursive
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 57f8d47..4fbc380 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -294,7 +294,7 @@ test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOr
close $srv
unset cli srv port
rename iocmdSRV {}
-} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -peername, or -sockname}
+} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -connecting, -peername, or -sockname}
test iocmd-8.16 {fconfigure command / tcp channel} -constraints socket -setup {
set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
set port [lindex [fconfigure $srv -sockname] 2]
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 0188ea6..9c5cd4b 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -905,7 +905,7 @@ TcpGetOptionProc(
}
if (len > 0) {
- return Tcl_BadChannelOption(interp, optionName, "peername sockname");
+ return Tcl_BadChannelOption(interp, optionName, "connecting peername sockname");
}
return TCL_OK;
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index e2116fc..08de678 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -1501,9 +1501,9 @@ TcpGetOptionProc(
if (len > 0) {
#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
return Tcl_BadChannelOption(interp, optionName,
- "peername sockname keepalive nagle");
+ "connecting peername sockname keepalive nagle");
#else
- return Tcl_BadChannelOption(interp, optionName, "peername sockname");
+ return Tcl_BadChannelOption(interp, optionName, "connecting peername sockname");
#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
}
generated by cgit v0.12 at 2025-03-29 10:02:09 (GMT)