From 164250cf8605bbfb0f361e639d8bfc656526dd15 Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 15 Nov 2014 21:08:57 +0000 Subject: Tcl_ExternalToUtf appends a terminating NUL to its encoded results. Perhaps this is a welcome convenience for some callers, but not for Tcl's I/O system, which has no need for that. Added a new flag value TCL_ENCODING_NO_TERMINATE that callers can use to suppress this behavior. This means buffers don't require so much padding, and a tiny bit of processing is saved. Update I/O callers to use the feature. --- generic/tcl.h | 17 +++++++++++++++++ generic/tclEncoding.c | 22 +++++++++++++++------- generic/tclIO.c | 44 +++++++++++++++++++++++--------------------- 3 files changed, 55 insertions(+), 28 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index fc477f2..95f2b3f 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2144,11 +2144,28 @@ typedef struct Tcl_EncodingType { * substituting one or more "close" characters in * the destination buffer and then continue to * convert the source. + * TCL_ENCODING_NO_TERMINATE - If set, Tcl_ExternalToUtf will not append a + * terminating NUL byte. Knowing that it will + * not need space to do so, it will fill all + * dstLen bytes with encoded UTF-8 content, as + * other circumstances permit. If clear, the + * default behavior is to reserve a byte in + * the dst space for NUL termination, and to + * append the NUL byte. + * TCL_ENCODING_CHAR_LIMIT - If set and dstCharsPtr is not NULL, then + * Tcl_ExternalToUtf takes the initial value + * of *dstCharsPtr is taken as a limit of the + * maximum number of chars to produce in the + * encoded UTF-8 content. Otherwise, the + * number of chars produced is controlled only + * by other limiting factors. */ #define TCL_ENCODING_START 0x01 #define TCL_ENCODING_END 0x02 #define TCL_ENCODING_STOPONERROR 0x04 +#define TCL_ENCODING_NO_TERMINATE 0x08 +#define TCL_ENCODING_CHAR_LIMIT 0x10 /* * The following definitions are the error codes returned by the conversion diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index d246cb2..0446816 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1204,6 +1204,7 @@ Tcl_ExternalToUtf( { const Encoding *encodingPtr; int result, srcRead, dstWrote, dstChars; + int noTerminate = flags & TCL_ENCODING_NO_TERMINATE; Tcl_EncodingState state; if (encoding == NULL) { @@ -1230,17 +1231,24 @@ Tcl_ExternalToUtf( dstCharsPtr = &dstChars; } - /* - * If there are any null characters in the middle of the buffer, they will - * converted to the UTF-8 null character (\xC080). To get the actual \0 at - * the end of the destination buffer, we need to append it manually. - */ + if (!noTerminate) { + /* + * If there are any null characters in the middle of the buffer, + * they will converted to the UTF-8 null character (\xC080). To get + * the actual \0 at the end of the destination buffer, we need to + * append it manually. First make room for it... + */ - dstLen--; + dstLen--; + } result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr); - dst[*dstWrotePtr] = '\0'; + if (!noTerminate) { + /* ...and then append it */ + + dst[*dstWrotePtr] = '\0'; + } return result; } diff --git a/generic/tclIO.c b/generic/tclIO.c index 2025742..b759c0e 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -4578,14 +4578,14 @@ Tcl_GetsObj( * Skip the raw bytes that make up the '\n'. */ - char tmp[1 + TCL_UTF_MAX]; + char tmp[TCL_UTF_MAX]; int rawRead; bufPtr = gs.bufPtr; Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), - gs.rawRead, statePtr->inputEncodingFlags, - &gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead, NULL, - NULL); + gs.rawRead, statePtr->inputEncodingFlags + | TCL_ENCODING_NO_TERMINATE, &gs.state, tmp, + TCL_UTF_MAX, &rawRead, NULL, NULL); bufPtr->nextRemoved += rawRead; gs.rawRead -= rawRead; gs.bytesWrote--; @@ -4686,8 +4686,9 @@ Tcl_GetsObj( } statePtr->inputEncodingState = gs.state; Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), gs.rawRead, - statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst, - eol - dst + skip + TCL_UTF_MAX, &gs.rawRead, NULL, + statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE, + &statePtr->inputEncodingState, dst, + eol - dst + skip + TCL_UTF_MAX - 1, &gs.rawRead, NULL, &gs.charsWrote); bufPtr->nextRemoved += gs.rawRead; @@ -5219,9 +5220,9 @@ FilterInputBytes( } gsPtr->state = statePtr->inputEncodingState; result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen, - statePtr->inputEncodingFlags, &statePtr->inputEncodingState, - dst, spaceLeft+1, &gsPtr->rawRead, &gsPtr->bytesWrote, - &gsPtr->charsWrote); + statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE, + &statePtr->inputEncodingState, dst, spaceLeft, &gsPtr->rawRead, + &gsPtr->bytesWrote, &gsPtr->charsWrote); /* * Make sure that if we go through 'gets', that we reset the @@ -5975,7 +5976,7 @@ ReadChars( * a consistent set of results. This takes the shape of a loop. */ - dstLimit = dstNeeded + 1; + dstLimit = dstNeeded; while (1) { int dstDecoded, dstRead, dstWrote, srcRead, numChars; @@ -5985,9 +5986,10 @@ ReadChars( */ int code = Tcl_ExternalToUtf(NULL, encoding, src, srcLen, - statePtr->inputEncodingFlags & (bufPtr->nextPtr - ? ~0 : ~TCL_ENCODING_END), &statePtr->inputEncodingState, - dst, dstLimit, &srcRead, &dstDecoded, &numChars); + (statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE) + & (bufPtr->nextPtr ? ~0 : ~TCL_ENCODING_END), + &statePtr->inputEncodingState, dst, dstLimit, &srcRead, + &dstDecoded, &numChars); /* * Perform the translation transformation in place. Read no more @@ -6050,7 +6052,7 @@ ReadChars( * time. */ - dstLimit = dstRead + TCL_UTF_MAX; + dstLimit = dstRead - 1 + TCL_UTF_MAX; statePtr->flags = savedFlags; statePtr->inputEncodingFlags = savedIEFlags; statePtr->inputEncodingState = savedState; @@ -6076,7 +6078,7 @@ ReadChars( * up back here in this call. */ - dstLimit = dstRead + TCL_UTF_MAX; + dstLimit = dstRead - 1 + TCL_UTF_MAX; statePtr->flags = savedFlags; statePtr->inputEncodingFlags = savedIEFlags; statePtr->inputEncodingState = savedState; @@ -6093,7 +6095,7 @@ ReadChars( */ if (code != TCL_OK) { - char buffer[TCL_UTF_MAX + 2]; + char buffer[TCL_UTF_MAX + 1]; int read, decoded, count; /* @@ -6105,9 +6107,10 @@ ReadChars( 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); + (statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE) + & (bufPtr->nextPtr ? ~0 : ~TCL_ENCODING_END), + &statePtr->inputEncodingState, buffer, TCL_UTF_MAX + 1, + &read, &decoded, &count); if (count == 2) { if (buffer[1] == '\n') { @@ -6119,7 +6122,6 @@ ReadChars( bufPtr->nextRemoved += srcRead; } - dst[1] = '\0'; statePtr->inputEncodingFlags &= ~TCL_ENCODING_START; Tcl_SetObjLength(objPtr, numBytes + 1); @@ -6166,7 +6168,7 @@ ReadChars( * Tcl_ExternalToUtf() call! */ - dstLimit = Tcl_UtfAtIndex(dst, charsToRead) + TCL_UTF_MAX - dst; + dstLimit = Tcl_UtfAtIndex(dst, charsToRead) - 1 + TCL_UTF_MAX - dst; statePtr->flags = savedFlags; statePtr->inputEncodingFlags = savedIEFlags; statePtr->inputEncodingState = savedState; -- cgit v0.12 From 3185389da2f0df0ad90dc3564934575fcfa7dca5 Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 15 Nov 2014 21:13:52 +0000 Subject: With no padding needed for a terminating NUL, there no need for a distinction between the dstNeeded and dstLimit values. --- generic/tclIO.c | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index b759c0e..f8b9bfa 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -5929,7 +5929,7 @@ ReadChars( int savedIEFlags = statePtr->inputEncodingFlags; int savedFlags = statePtr->flags; char *dst, *src = RemovePoint(bufPtr); - int dstLimit, numBytes, srcLen = BytesLeft(bufPtr); + int numBytes, srcLen = BytesLeft(bufPtr); /* * One src byte can yield at most one character. So when the @@ -5948,14 +5948,14 @@ ReadChars( */ int factor = *factorPtr; - int dstNeeded = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR; + int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR; (void) TclGetStringFromObj(objPtr, &numBytes); - Tcl_AppendToObj(objPtr, NULL, dstNeeded); + Tcl_AppendToObj(objPtr, NULL, dstLimit); if (toRead == srcLen) { unsigned int size; dst = TclGetStringStorage(objPtr, &size) + numBytes; - dstNeeded = size - numBytes; + dstLimit = size - numBytes; } else { dst = TclGetString(objPtr) + numBytes; } @@ -5976,7 +5976,6 @@ ReadChars( * a consistent set of results. This takes the shape of a loop. */ - dstLimit = dstNeeded; while (1) { int dstDecoded, dstRead, dstWrote, srcRead, numChars; -- cgit v0.12 From 24d57ad4ffaf7d8caef8902d37021866e73f8dbf Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 15 Nov 2014 21:46:19 +0000 Subject: Add to Tcl_ExternalToUtf() a capability to impose a limit on the number of chars produce in the encoding result. When the flag TCL_ENCODING_CHAR_LIMIT is set and dstCharsPtr is not NULL, then the initial value of *dstCharsPtr is taken as the max number of chars to produce. The limit is imposed in a way that does not require the assistance of the encoding's driver procs, but the flag is passed on to them in case they can do better when they know they should. No callers updated yet. No drivers updated yet. One difficulty is that this necessarily imposes a pre-translation limit, and the I/O system has a history of wanting to impose only a post-translation limit. --- generic/tclEncoding.c | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 0446816..f33e0e6 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1203,8 +1203,10 @@ Tcl_ExternalToUtf( * output buffer. */ { const Encoding *encodingPtr; - int result, srcRead, dstWrote, dstChars; + int result, srcRead, dstWrote, dstChars = 0; int noTerminate = flags & TCL_ENCODING_NO_TERMINATE; + int charLimited = (flags & TCL_ENCODING_CHAR_LIMIT) && dstCharsPtr; + int maxChars = INT_MAX; Tcl_EncodingState state; if (encoding == NULL) { @@ -1229,6 +1231,9 @@ Tcl_ExternalToUtf( } if (dstCharsPtr == NULL) { dstCharsPtr = &dstChars; + flags &= ~TCL_ENCODING_CHAR_LIMIT; + } else if (charLimited) { + maxChars = *dstCharsPtr; } if (!noTerminate) { @@ -1241,9 +1246,20 @@ Tcl_ExternalToUtf( dstLen--; } - result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen, - flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, - dstCharsPtr); + do { + int savedFlags = flags; + Tcl_EncodingState savedState = *statePtr; + + result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen, + flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, + dstCharsPtr); + if (*dstCharsPtr <= maxChars) { + break; + } + dstLen = Tcl_UtfAtIndex(dst, maxChars) - 1 - dst + TCL_UTF_MAX; + flags = savedFlags; + *statePtr = savedState; + } while (1); if (!noTerminate) { /* ...and then append it */ -- cgit v0.12 From 7dfd9c5a9656fd1b66fcdc8111b3b49f7d3e1f8a Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 3 Dec 2014 23:54:16 +0000 Subject: Now make the patch by hand that fossil could not merge. --- tests/compile.test | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/tests/compile.test b/tests/compile.test index 7335293..d4a31d4 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -455,8 +455,7 @@ test compile-13.1 {testing underestimate of maxStackSize in list cmd} {exec} { list [catch {exec [interpreter] << $script} msg] $msg } {0 OK} -# Tests compile-14.* for compiling tokens from a copy of the source string. -# [Bug 599788] [Bug 0c043a175a47da8c2342] +# Tests compile-14.* for [Bug 599788] [Bug 0c043a175a47da8c2342] test compile-14.1 {testing errors in element name; segfault?} {} { catch {set a([error])} msg1 catch {set bubba([join $abba $jubba]) $vol} msg2 -- cgit v0.12 From 58bde2cb77be95dfc210c6b7448b9c82cf140025 Mon Sep 17 00:00:00 2001 From: ashok Date: Sat, 6 Dec 2014 11:19:32 +0000 Subject: Potential fix for [c6ed4acfd8]. Simple typo in original fix for [336441ed59]. Was looping on statePtr->next instead of statePtr2->next. Would result in an infinite loop. Definitely a bug but whether it completely fixes the above in all cases needs to be tested. --- win/tclWinSock.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 2c58224..f5658ba 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -1739,7 +1739,7 @@ TcpConnect( */ for (statePtr2 = tsdPtr->socketList; statePtr2 != NULL; - statePtr2 = statePtr->nextPtr) { + statePtr2 = statePtr2->nextPtr) { if (statePtr2 == statePtr) { in_socket_list = 1; break; -- cgit v0.12 From 7466351c908df509ab68c9cd3fdafa793bebfc75 Mon Sep 17 00:00:00 2001 From: oehhar Date: Sun, 7 Dec 2014 12:17:24 +0000 Subject: test for bug [c6ed4acfd8]: running async socket connect with other connect established will block tcl as it goes in an infinite loop in vwait --- tests/socket.test | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/tests/socket.test b/tests/socket.test index eeea044..4f90e51 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -2343,6 +2343,24 @@ test socket-14.17 {empty -sockname while [socket -async] connecting} \ catch {close $client} } -result {} +# test for bug c6ed4acfd8: running async socket connect with other connect +# established will block tcl as it goes in an infinite loop in vwait +test socket-14.18 {bug c6ed4acfd8: running async socket connect made other connect block} \ + -constraints {socket} \ + -body { + proc accept {channel address port} {} + set port [randport] + set ssock [socket -server accept $port] + set csock1 [socket -async localhost [randport]] + set csock2 [socket localhost $port] + after 1000 {set done ok} + vwait done +} -cleanup { + catch {close $ssock} + catch {close $csock1} + catch {close $csock2} + } -result {} + set num 0 set x {localhost {socket} 127.0.0.1 {supported_inet} ::1 {supported_inet6}} -- cgit v0.12 From 59cb45cc1611009330228462969fc508b57498bd Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Sat, 13 Dec 2014 02:47:25 +0000 Subject: Add header install flag to OS X GNUMakefile; thanks to Stephan Houben for patch --- macosx/GNUmakefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/macosx/GNUmakefile b/macosx/GNUmakefile index d7b0d1d..54eea8e 100644 --- a/macosx/GNUmakefile +++ b/macosx/GNUmakefile @@ -100,7 +100,7 @@ INSTALL_TARGET := install export CPPROG := cp -p -INSTALL_TARGETS = install-binaries install-libraries +INSTALL_TARGETS = install-binaries install-headers install-libraries ifeq (${EMBEDDED_BUILD},) INSTALL_TARGETS += install-private-headers endif -- cgit v0.12 From 4e0313afe2507b8fb3f6dbfb4b8470e098c9f53f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 15 Dec 2014 10:20:39 +0000 Subject: 85 -> 86 --- win/README | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/README b/win/README index 1a2d501..5e060ef 100644 --- a/win/README +++ b/win/README @@ -79,7 +79,7 @@ Use the Makefile "install" target to install Tcl. It will install it according to the prefix options you provided in the correct directory structure. -Note that in order to run tclsh85.exe, you must ensure that tcl85.dll is +Note that in order to run tclsh86.exe, you must ensure that tcl86.dll is on your path, in the system directory, or in the directory containing tclsh86.exe. -- cgit v0.12 From d7a9d635208125f64de188de24122509d0c624dc Mon Sep 17 00:00:00 2001 From: oehhar Date: Wed, 17 Dec 2014 08:22:23 +0000 Subject: Documented "fconfigure $h -connecting" on socket man page --- doc/socket.n | 9 +++++++++ 1 file changed, 9 insertions(+) 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 -- cgit v0.12 From 3b7664e77fa5643a858e66e21458dc0eaeaffeb6 Mon Sep 17 00:00:00 2001 From: oehhar Date: Wed, 17 Dec 2014 08:42:24 +0000 Subject: Include option -connecting in test iocmd-8.15.1 --- tests/ioCmd.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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] -- cgit v0.12 From 68b5780dde6d75819809b071fb27d935cee69fdc Mon Sep 17 00:00:00 2001 From: oehhar Date: Wed, 17 Dec 2014 11:21:16 +0000 Subject: changes for TIP427 --- changes | 2 ++ 1 file changed, 2 insertions(+) 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) -- cgit v0.12 From e942227f6e2651032ec7a070d1562c4b050de9b3 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 17 Dec 2014 19:57:40 +0000 Subject: Revise encoding finalization so that it does a more complete job of restoring the pre-initialized state. This makes finalization errors more repeatable and cross-platform. --- generic/tclEncoding.c | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index d246cb2..95c59c0 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) { @@ -2960,7 +2963,9 @@ TableFreeProc( */ ckfree(dataPtr->toUnicode); + dataPtr->toUnicode = NULL; ckfree(dataPtr->fromUnicode); + dataPtr->fromUnicode = NULL; ckfree(dataPtr); } @@ -3433,6 +3438,7 @@ EscapeFreeProc( subTablePtr = dataPtr->subTables; for (i = 0; i < dataPtr->numSubTables; i++) { FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr); + subTablePtr->encodingPtr = NULL; subTablePtr++; } } -- cgit v0.12 From 955507f6352c466740d348d8d89adb8de24de9fd Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 17 Dec 2014 20:47:58 +0000 Subject: Rework the *FinalizeThread*() routines so that the quick exit preference is respected without need to run afoul of encoding finalizations. tests pass now. All changes are fully internal. --- generic/tclEvent.c | 14 +++++++++++--- generic/tclInt.h | 2 +- generic/tclThread.c | 4 ++-- 3 files changed, 14 insertions(+), 6 deletions(-) diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 3985767..6ca22a6 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/tclInt.h b/generic/tclInt.h index c989eda..995da48 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2927,7 +2927,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); 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 */ -- cgit v0.12 From 559113cc4c38b5bc99f503e300671df52b991d13 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 18 Dec 2014 18:06:51 +0000 Subject: [7c187a3773] Fix error in managing inStatePtr->inQueueTail value in the byte-moving optimized path of [chan copy]. Thanks to Benno. --- generic/tclIO.c | 3 +++ tests/io.test | 38 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 41 insertions(+) diff --git a/generic/tclIO.c b/generic/tclIO.c index 2025742..8a35aee 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -9215,6 +9215,9 @@ MBWrite( } outStatePtr->outQueueTail = tail; inStatePtr->inQueueHead = bufPtr; + if (inStatePtr->inQueueTail == tail) { + inStatePtr->inQueueTail = bufPtr; + } if (bufPtr == NULL) { inStatePtr->inQueueTail = NULL; } 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 -- cgit v0.12 From 3faf4cc3b890c8295557932ae4d896c6624e6af7 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 22 Dec 2014 19:57:36 +0000 Subject: More complete use of the TCL_NO_ELEMENT flag to suppress useless actions. --- generic/tclCompCmds.c | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 30c1318..ee9209a 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -3313,7 +3313,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. @@ -3366,7 +3366,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 +3387,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; + } } } } -- cgit v0.12 From 7ac39417f17cf6027ca26576c86d3cf9147ad1e7 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 22 Dec 2014 20:13:29 +0000 Subject: Use (interp == NULL) argument to TclPushVarName() to signal that no compiling is desired. Only a lookup of an index into the compiled variable table. --- generic/tclCompCmds.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index ee9209a..18071b1 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -3328,7 +3328,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] == ')')) { @@ -3429,7 +3429,7 @@ TclPushVarName( localIndex = -1; } } - if (localIndex < 0) { + if (interp && localIndex < 0) { PushLiteral(envPtr, name, nameChars); } @@ -3446,7 +3446,7 @@ TclPushVarName( PushStringLiteral(envPtr, ""); } } - } else { + } else if (interp) { /* * The var name isn't simple: compile and push it. */ -- cgit v0.12 From 2cbec4bf44fad8591fa06185d8cf3f28dd1526a2 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 22 Dec 2014 20:27:14 +0000 Subject: Convert the LocalScalar*() macros to rest on TclPushVarName rather than on TclIsLocalScalar(). --- generic/tclCompCmds.c | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ generic/tclCompile.h | 10 ++++++---- 2 files changed, 54 insertions(+), 4 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 18071b1..bde07bb 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -3234,6 +3234,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 diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 51f0b34..c6c7a7c 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. -- cgit v0.12 From 49e7d0262bb9fcc94ce092927df43261350e319a Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 23 Dec 2014 01:28:30 +0000 Subject: Revise CompileEachloopCmd() to use LocalScalar() in place of TclIsLocalScalar(). --- generic/tclCompCmds.c | 119 +++++++++++++++++--------------------------------- 1 file changed, 40 insertions(+), 79 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index bde07bb..ec398b6 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -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; } -- cgit v0.12 From b0078c812949591757520d79106eae38f21d33f0 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 23 Dec 2014 02:12:59 +0000 Subject: Eliminate TclIsLocalScalar(). No callers left. --- generic/tclInt.h | 1 - generic/tclParse.c | 50 -------------------------------------------------- 2 files changed, 51 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 995da48..3f84717 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2985,7 +2985,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 -- cgit v0.12 From ef6f1ba2c34bd3243b54d46d23d37392d7bf34ba Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 23 Dec 2014 02:41:54 +0000 Subject: Use more suitable variable name pushers. --- generic/tclCompCmds.c | 6 +++--- generic/tclCompCmdsGR.c | 16 ++++++---------- 2 files changed, 9 insertions(+), 13 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index ec398b6..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; } 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); -- cgit v0.12 From 7134cd9399b41471ebbd9126bab51e0ffd6cd9db Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 23 Dec 2014 16:57:02 +0000 Subject: Use the new TCL_ENCODING_CHAR_LIMIT flag to have the encoding system manage the max chars to read constraint. --- generic/tclIO.c | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 79aa667..9bbf2a6 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -5977,16 +5977,21 @@ ReadChars( */ while (1) { - int dstDecoded, dstRead, dstWrote, srcRead, numChars; + int dstDecoded, dstRead, dstWrote, srcRead, numChars, code; + int flags = statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE; + + if (charsToRead > 0) { + flags |= TCL_ENCODING_CHAR_LIMIT; + numChars = charsToRead; + } /* * Perform the encoding transformation. Read no more than * srcLen bytes, write no more than dstLimit bytes. */ - int code = Tcl_ExternalToUtf(NULL, encoding, src, srcLen, - (statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE) - & (bufPtr->nextPtr ? ~0 : ~TCL_ENCODING_END), + code = Tcl_ExternalToUtf(NULL, encoding, src, srcLen, + flags & (bufPtr->nextPtr ? ~0 : ~TCL_ENCODING_END), &statePtr->inputEncodingState, dst, dstLimit, &srcRead, &dstDecoded, &numChars); @@ -6161,6 +6166,8 @@ ReadChars( if (charsToRead > 0 && numChars > charsToRead) { /* + * TODO: This cannot happen anymore. + * * We read more chars than allowed. Reset limits to * prevent that and try again. Don't forget the extra * padding of TCL_UTF_MAX bytes demanded by the -- cgit v0.12 From 5a6443d00ed0e3d2c040b88d322ad08a51fcbfc9 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 23 Dec 2014 17:13:13 +0000 Subject: Support TCL_ENCODING_CHAR_LIMIT in the BinaryProc driver. --- generic/tclEncoding.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 2a766d1..5c5254b 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2131,6 +2131,9 @@ BinaryProc( if (dstLen < 0) { dstLen = 0; } + if ((flags & TCL_ENCODING_CHAR_LIMIT) && srcLen > *dstCharsPtr) { + srcLen = *dstCharsPtr; + } if (srcLen > dstLen) { srcLen = dstLen; result = TCL_CONVERT_NOSPACE; -- cgit v0.12 From 360b5c41eed8a2bc3d2b80f23ca1cdd98fe6e56f Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 23 Dec 2014 17:26:07 +0000 Subject: Support TCL_ENCODING_CHAR_LIMIT in the UtfToUtfProc driver. --- generic/tclEncoding.c | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 5c5254b..f92cabb 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2294,7 +2294,7 @@ UtfToUtfProc( { const char *srcStart, *srcEnd, *srcClose; const char *dstStart, *dstEnd; - int result, numChars; + int result, numChars, charLimit = INT_MAX; Tcl_UniChar ch; result = TCL_OK; @@ -2305,11 +2305,14 @@ UtfToUtfProc( if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } + if (flags & TCL_ENCODING_CHAR_LIMIT) { + charLimit = *dstCharsPtr; + } dstStart = dst; dstEnd = dst + dstLen - TCL_UTF_MAX; - for (numChars = 0; src < srcEnd; numChars++) { + for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) { if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { /* * If there is more string to follow, this will ensure that the -- cgit v0.12 From b6fecacc22a9ba5f13cbab794af7dcc46ebc5bc3 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 23 Dec 2014 17:46:05 +0000 Subject: Support TCL_ENCODING_CHAR_LIMIT in the UnicodeToUtfProc driver. --- generic/tclEncoding.c | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index f92cabb..0fe224e 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2408,9 +2408,12 @@ UnicodeToUtfProc( { const char *srcStart, *srcEnd; const char *dstEnd, *dstStart; - int result, numChars; + int result, numChars, charLimit = INT_MAX; Tcl_UniChar ch; + if (flags & TCL_ENCODING_CHAR_LIMIT) { + charLimit = *dstCharsPtr; + } result = TCL_OK; if ((srcLen % sizeof(Tcl_UniChar)) != 0) { result = TCL_CONVERT_MULTIBYTE; @@ -2424,7 +2427,7 @@ UnicodeToUtfProc( dstStart = dst; dstEnd = dst + dstLen - TCL_UTF_MAX; - for (numChars = 0; src < srcEnd; numChars++) { + for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) { if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; -- cgit v0.12 From a3babfe12a8c12394c0ae2e1a4bf6f4da3e88cbe Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 23 Dec 2014 17:48:36 +0000 Subject: Support TCL_ENCODING_CHAR_LIMIT in the Iso88591ToUtfProc driver. --- generic/tclEncoding.c | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 0fe224e..3df720d 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2826,8 +2826,11 @@ Iso88591ToUtfProc( { const char *srcStart, *srcEnd; const char *dstEnd, *dstStart; - int result, numChars; + int result, numChars, charLimit = INT_MAX; + if (flags & TCL_ENCODING_CHAR_LIMIT) { + charLimit = *dstCharsPtr; + } srcStart = src; srcEnd = src + srcLen; @@ -2835,7 +2838,7 @@ Iso88591ToUtfProc( dstEnd = dst + dstLen - TCL_UTF_MAX; result = TCL_OK; - for (numChars = 0; src < srcEnd; numChars++) { + for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) { Tcl_UniChar ch; if (dst > dstEnd) { -- cgit v0.12 From 1ddabb17f9dbbd2e67b3b2fb230413c7abc6fec8 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 23 Dec 2014 17:53:21 +0000 Subject: Support TCL_ENCODING_CHAR_LIMIT in TableToUtfProc and EscapeToUtfProc drivers. --- generic/tclEncoding.c | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 3df720d..179ca17 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2595,12 +2595,15 @@ TableToUtfProc( { const char *srcStart, *srcEnd; const char *dstEnd, *dstStart, *prefixBytes; - int result, byte, numChars; + int result, byte, numChars, charLimit = INT_MAX; Tcl_UniChar ch; const unsigned short *const *toUnicode; const unsigned short *pageZero; TableEncodingData *dataPtr = clientData; + if (flags & TCL_ENCODING_CHAR_LIMIT) { + charLimit = *dstCharsPtr; + } srcStart = src; srcEnd = src + srcLen; @@ -2612,7 +2615,7 @@ TableToUtfProc( pageZero = toUnicode[0]; result = TCL_OK; - for (numChars = 0; src < srcEnd; numChars++) { + for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) { if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; @@ -3054,9 +3057,12 @@ EscapeToUtfProc( const char *prefixBytes, *tablePrefixBytes, *srcStart, *srcEnd; const unsigned short *const *tableToUnicode; const Encoding *encodingPtr; - int state, result, numChars; + int state, result, numChars, charLimit = INT_MAX; const char *dstStart, *dstEnd; + if (flags & TCL_ENCODING_CHAR_LIMIT) { + charLimit = *dstCharsPtr; + } result = TCL_OK; tablePrefixBytes = NULL; /* lint. */ tableToUnicode = NULL; /* lint. */ @@ -3074,7 +3080,7 @@ EscapeToUtfProc( state = 0; } - for (numChars = 0; src < srcEnd; ) { + for (numChars = 0; src < srcEnd && numChars <= charLimit; ) { int byte, hi, lo, ch; if (dst > dstEnd) { -- cgit v0.12 From f16ec6e776a225afc140af0387b7819427358ba3 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 2 Jan 2015 22:42:12 +0000 Subject: Now that we're using TCL_ENCODING_NO_TERMINATE - be careful about acting on the contents of dst -- they could be leftovers. Only check bytes reported to have been written and take care to get the assertions right. --- generic/tclIO.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 9bbf2a6..a9091af 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -6198,9 +6198,8 @@ ReadChars( * empty string. */ - if (dst[0] == '\n') { + if (dstRead == 1 && dst[0] == '\n') { assert(statePtr->inputTranslation == TCL_TRANSLATE_AUTO); - assert(dstRead == 1); goto consume; } -- cgit v0.12 From 52d37c087d8566c82644d7b61a6dac58999a16a7 Mon Sep 17 00:00:00 2001 From: bch Date: Tue, 20 Jan 2015 23:40:23 +0000 Subject: assert() on missing definitions for Tcl_ChannelCreate() required struct Tcl_ChannelType{} fields. --- generic/tclIO.c | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/generic/tclIO.c b/generic/tclIO.c index a9091af..596ba3f 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -1548,6 +1548,15 @@ Tcl_CreateChannel( */ assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc *)); + assert(NULL!=typePtr->closeProc); + assert(NULL!=typePtr->inputProc); + assert(NULL!=typePtr->outputProc); + assert(NULL!=typePtr->watchProc); + assert(NULL!=typePtr->truncateProc); + assert(NULL!=typePtr->getHandleProc); + if (NULL!=typePtr->wideSeekProc) { + assert(NULL!=typePtr->seekProc && "Must define seekProc if defining wideSeekProc"); + } /* * JH: We could subsequently memset these to 0 to avoid the numerous -- cgit v0.12 From acad5814798a290c3c8bbdeffa55b4e24f3579b2 Mon Sep 17 00:00:00 2001 From: bch Date: Wed, 21 Jan 2015 00:21:18 +0000 Subject: truncateProc *can* be NULL --- generic/tclIO.c | 1 - 1 file changed, 1 deletion(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 596ba3f..eb33106 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -1552,7 +1552,6 @@ Tcl_CreateChannel( assert(NULL!=typePtr->inputProc); assert(NULL!=typePtr->outputProc); assert(NULL!=typePtr->watchProc); - assert(NULL!=typePtr->truncateProc); assert(NULL!=typePtr->getHandleProc); if (NULL!=typePtr->wideSeekProc) { assert(NULL!=typePtr->seekProc && "Must define seekProc if defining wideSeekProc"); -- cgit v0.12 From 3f9555d4c2af861ded30792fc8a9c35b23187a2c Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 29 Jan 2015 18:39:11 +0000 Subject: Fix [08872796bc] --- generic/tclIO.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index a9091af..86ec27a 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -5735,8 +5735,8 @@ DoReadChars( chanPtr = statePtr->topChanPtr; TclChannelPreserve((Tcl_Channel)chanPtr); - /* Must clear the BLOCKED flag here since we check before reading */ - ResetFlag(statePtr, CHANNEL_BLOCKED); + /* Must clear the BLOCKED|EOF flags here since we check before reading */ + ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF); for (copied = 0; (unsigned) toRead > 0; ) { copiedNow = -1; if (statePtr->inQueueHead != NULL) { -- cgit v0.12 From 02cc7437b244b37fbba3c278abf9835c6bd7109a Mon Sep 17 00:00:00 2001 From: bch Date: Sat, 7 Feb 2015 21:19:05 +0000 Subject: switch raw assert() to Tcl_Panic() per discussion w/ dkf --- generic/tclIO.c | 24 +++++++++++++++++------- 1 file changed, 17 insertions(+), 7 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 025708b..702e2a0 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -1548,13 +1548,23 @@ Tcl_CreateChannel( */ assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc *)); - assert(NULL!=typePtr->closeProc); - assert(NULL!=typePtr->inputProc); - assert(NULL!=typePtr->outputProc); - assert(NULL!=typePtr->watchProc); - assert(NULL!=typePtr->getHandleProc); - if (NULL!=typePtr->wideSeekProc) { - assert(NULL!=typePtr->seekProc && "Must define seekProc if defining wideSeekProc"); + if (NULL == typePtr->closeProc) + Tcl_Panic("Required closeProc is unset."); + + if (NULL == typePtr->inputProc) + Tcl_Panic("Required inputProc is unset."); + + if (NULL == typePtr->outputProc) + Tcl_Panic("Required outputProc is unset."); + + if (NULL == typePtr->watchProc) + Tcl_Panic("Required watchProc is unset."); + + if (NULL == typePtr->getHandleProc) + Tcl_Panic("Required getHandleProc is unset."); + + if ((NULL!=typePtr->wideSeekProc) && (NULL == typePtr->seekProc)) { + Tcl_Panic("Must define seekProc if defining wideSeekProc"); } /* -- cgit v0.12 From 4214c7a3a945dc09ed6023d87a28a2a0f85e1157 Mon Sep 17 00:00:00 2001 From: bch Date: Sun, 8 Feb 2015 05:04:33 +0000 Subject: inputProc and outputProc tests run conditionally on TCL_READABLE, TCL_WRITABLE mask --- generic/tclIO.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 702e2a0..0ba864a 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -1551,10 +1551,10 @@ Tcl_CreateChannel( if (NULL == typePtr->closeProc) Tcl_Panic("Required closeProc is unset."); - if (NULL == typePtr->inputProc) + if ((TCL_READABLE & mask) && (NULL == typePtr->inputProc)) Tcl_Panic("Required inputProc is unset."); - if (NULL == typePtr->outputProc) + if ((TCL_WRITABLE & mask) && (NULL == typePtr->outputProc)) Tcl_Panic("Required outputProc is unset."); if (NULL == typePtr->watchProc) -- cgit v0.12 From fc506f9ca941f66152940a0e4821c9308427aa91 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 11 Feb 2015 15:56:27 +0000 Subject: Even clearer failure messages. --- generic/tclIO.c | 33 +++++++++++++++++---------------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 0ba864a..aabae0b 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -1548,23 +1548,24 @@ Tcl_CreateChannel( */ assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc *)); - if (NULL == typePtr->closeProc) - Tcl_Panic("Required closeProc is unset."); - - if ((TCL_READABLE & mask) && (NULL == typePtr->inputProc)) - Tcl_Panic("Required inputProc is unset."); - - if ((TCL_WRITABLE & mask) && (NULL == typePtr->outputProc)) - Tcl_Panic("Required outputProc is unset."); - - if (NULL == typePtr->watchProc) - Tcl_Panic("Required watchProc is unset."); - - if (NULL == typePtr->getHandleProc) - Tcl_Panic("Required getHandleProc is unset."); - + assert(typePtr->typeName != NULL); + if (NULL == typePtr->closeProc) { + Tcl_Panic("channel type %s must define closeProc", typePtr->typeName); + } + if ((TCL_READABLE & mask) && (NULL == typePtr->inputProc)) { + Tcl_Panic("channel type %s must define inputProc when used for reader channel", typePtr->typeName); + } + if ((TCL_WRITABLE & mask) && (NULL == typePtr->outputProc)) { + Tcl_Panic("channel type %s must define outputProc when used for writer channel", typePtr->typeName); + } + if (NULL == typePtr->watchProc) { + Tcl_Panic("channel type %s must define watchProc", typePtr->typeName); + } + if (NULL == typePtr->getHandleProc) { + Tcl_Panic("channel type %s must define getHandleProc", typePtr->typeName); + } if ((NULL!=typePtr->wideSeekProc) && (NULL == typePtr->seekProc)) { - Tcl_Panic("Must define seekProc if defining wideSeekProc"); + Tcl_Panic("channel type %s must define seekProc if defining wideSeekProc", typePtr->typeName); } /* -- cgit v0.12 From 48650316e3373be33455bab6db0a33546169c906 Mon Sep 17 00:00:00 2001 From: aspect Date: Thu, 19 Feb 2015 02:34:43 +0000 Subject: (core ticket [32b6159246]) Fix for [lreplace l x y] where y 0 && idx2 > 0 && idx2 < idx1) { + if (idx1 >= 0 && idx2 > 0 && idx2 < idx1) { idx2 = idx1 - 1; } else if (idx1 < 0 && idx2 < 0 && idx2 < idx1) { idx2 = idx1 - 1; diff --git a/tests/lreplace.test b/tests/lreplace.test index b976788..44f3ac2 100644 --- a/tests/lreplace.test +++ b/tests/lreplace.test @@ -137,6 +137,12 @@ test lreplace-4.1 {Bug ccc2c2cc98: lreplace edge case} { test lreplace-4.2 {Bug ccc2c2cc98: lreplace edge case} { lreplace { } 1 1 } {} +test lreplace-4.3 {lreplace edge case} { + lreplace {1 2 3} 2 0 +} {1 2 3} +test lreplace-4.4 {lreplace edge case} { + lreplace {1 2 3 4 5} 3 1 +} {1 2 3 4 5} # cleanup catch {unset foo} -- cgit v0.12 From b8674e42d217b1b7ed6d7a1d89dc42a59902b108 Mon Sep 17 00:00:00 2001 From: aspect Date: Thu, 19 Feb 2015 02:42:13 +0000 Subject: handle [lreplace l x y ...] where y Date: Thu, 19 Feb 2015 06:29:18 +0000 Subject: undo erroneous change in [1fa2e32e07] --- generic/tclCompCmdsGR.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index e7f6473..b77c43c 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -1551,7 +1551,7 @@ TclCompileLreplaceCmd( idx1 = 0; goto replaceTail; } else { - if (idx1 >= 0 && idx2 > 0 && idx2 < idx1) { + if (idx1 > 0 && idx2 > 0 && idx2 < idx1) { idx2 = idx1 - 1; } else if (idx1 < 0 && idx2 < 0 && idx2 < idx1) { idx2 = idx1 - 1; -- cgit v0.12 From 87e36a4aa9f5a7afcfe25350805190088a6468ff Mon Sep 17 00:00:00 2001 From: bch Date: Thu, 19 Feb 2015 19:16:37 +0000 Subject: backout backwards-incompatible experiment that was accidentally committed --- generic/tclIORChan.c | 30 +----------------------------- 1 file changed, 1 insertion(+), 29 deletions(-) diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 0f7f021..21c766e 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -30,8 +30,6 @@ /* * Signatures of all functions used in the C layer of the reflection. */ -static int ReflectGetHandle( ClientData instanceData, - int direction, ClientData *handlePtr); static int ReflectClose(ClientData clientData, Tcl_Interp *interp); @@ -70,7 +68,7 @@ static const Tcl_ChannelType tclRChannelType = { ReflectSetOption, /* Set options. NULL'able */ ReflectGetOption, /* Get options. NULL'able */ ReflectWatch, /* Initialize notifier */ - ReflectGetHandle, /* Get OS handle from the channel. */ + NULL, /* Get OS handle from the channel. NULL'able */ NULL, /* No close2 support. NULL'able */ ReflectBlock, /* Set blocking/nonblocking. NULL'able */ NULL, /* Flush channel. Not used by core. NULL'able */ @@ -1646,32 +1644,6 @@ ReflectWatch( /* *---------------------------------------------------------------------- * - * ReflectGetHandle -- - * - * This function is invoked to return OS channel handles, or EINVAL - * if not applicable or otherwise invalid. - * - * Results: - * EINVAL. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -ReflectGetHandle( - ClientData instanceData, - int direction, - ClientData *handlePtr) -{ - return EINVAL; -} - -/* - *---------------------------------------------------------------------- - * * ReflectBlock -- * * This function is invoked to tell the channel which blocking behaviour -- cgit v0.12 From 2919fd522137a679ca6de20c893a8a45dc750a52 Mon Sep 17 00:00:00 2001 From: bch Date: Thu, 19 Feb 2015 22:01:36 +0000 Subject: per ticket [e08c2c407b053bbfaab] (and stray code related to [84f208762f172e]) adj code to passing test suite --- generic/tclIO.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index aabae0b..c4757ea 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -1561,9 +1561,6 @@ Tcl_CreateChannel( if (NULL == typePtr->watchProc) { Tcl_Panic("channel type %s must define watchProc", typePtr->typeName); } - if (NULL == typePtr->getHandleProc) { - Tcl_Panic("channel type %s must define getHandleProc", typePtr->typeName); - } if ((NULL!=typePtr->wideSeekProc) && (NULL == typePtr->seekProc)) { Tcl_Panic("channel type %s must define seekProc if defining wideSeekProc", typePtr->typeName); } -- cgit v0.12 From 7e79080ed7bb9d1531c703b34cccad1ccee84dd7 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 26 Feb 2015 16:57:59 +0000 Subject: Bump to 8.6.4. --- README | 2 +- generic/tcl.h | 4 ++-- library/init.tcl | 2 +- unix/configure.in | 2 +- unix/tcl.spec | 2 +- win/configure.in | 2 +- 6 files changed, 7 insertions(+), 7 deletions(-) diff --git a/README b/README index 0fb128d..f63e0e7 100644 --- a/README +++ b/README @@ -1,5 +1,5 @@ README: Tcl - This is the Tcl 8.6.3 source distribution. + This is the Tcl 8.6.4 source distribution. http://sourceforge.net/projects/tcl/files/Tcl/ You can get any source release of Tcl from the URL above. diff --git a/generic/tcl.h b/generic/tcl.h index 95f2b3f..ae425bb 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -56,10 +56,10 @@ extern "C" { #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 6 #define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE -#define TCL_RELEASE_SERIAL 3 +#define TCL_RELEASE_SERIAL 4 #define TCL_VERSION "8.6" -#define TCL_PATCH_LEVEL "8.6.3" +#define TCL_PATCH_LEVEL "8.6.4" /* *---------------------------------------------------------------------------- diff --git a/library/init.tcl b/library/init.tcl index f1f7704..05ac4a3 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -16,7 +16,7 @@ if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } -package require -exact Tcl 8.6.3 +package require -exact Tcl 8.6.4 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: diff --git a/unix/configure.in b/unix/configure.in index e44d554..c7b0edc 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -25,7 +25,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL=".3" +TCL_PATCH_LEVEL=".4" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} diff --git a/unix/tcl.spec b/unix/tcl.spec index 81f31da..1b8693f 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 8.6.3 +Version: 8.6.4 Release: 2 License: BSD Group: Development/Languages diff --git a/win/configure.in b/win/configure.in index 1bf901a..99d78f2 100644 --- a/win/configure.in +++ b/win/configure.in @@ -14,7 +14,7 @@ SHELL=/bin/sh TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL=".3" +TCL_PATCH_LEVEL=".4" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 -- cgit v0.12 From ec9c80bba98db7bd3069c9ad66e7a5adfcc32e58 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 26 Feb 2015 16:58:52 +0000 Subject: autoconf-2.59 --- unix/configure | 2 +- win/configure | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/unix/configure b/unix/configure index a9837d9..6f5311c 100755 --- a/unix/configure +++ b/unix/configure @@ -1335,7 +1335,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL=".3" +TCL_PATCH_LEVEL=".4" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} diff --git a/win/configure b/win/configure index b270648..bdfa908 100755 --- a/win/configure +++ b/win/configure @@ -1311,7 +1311,7 @@ SHELL=/bin/sh TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL=".3" +TCL_PATCH_LEVEL=".4" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 -- cgit v0.12 From dfc57be3b18b7f7e023eb104bbc321809dc93429 Mon Sep 17 00:00:00 2001 From: ashok Date: Mon, 2 Mar 2015 08:54:14 +0000 Subject: Deleted Win95/98-specific documentation as those platforms have long been unsupported. --- doc/Encoding.3 | 48 ++++++----------------------------------- doc/exec.n | 67 +--------------------------------------------------------- doc/file.n | 8 +++---- doc/glob.n | 8 +------ doc/open.n | 4 ++-- doc/tcltest.n | 8 ------- doc/tclvars.n | 9 ++------ 7 files changed, 16 insertions(+), 136 deletions(-) diff --git a/doc/Encoding.3 b/doc/Encoding.3 index 1478c35..6664b3b 100644 --- a/doc/Encoding.3 +++ b/doc/Encoding.3 @@ -257,47 +257,13 @@ is filled with the corresponding number of bytes that were stored in .PP \fBTcl_WinUtfToTChar\fR and \fBTcl_WinTCharToUtf\fR are Windows-only convenience -functions for converting between UTF-8 and Windows strings. On Windows 95 -(as with the Unix operating system), -all strings exchanged between Tcl and the operating system are -.QW "char" -based. On Windows NT, some strings exchanged between Tcl and the -operating system are -.QW "char" -oriented while others are in Unicode. By -convention, in Windows a TCHAR is a character in the ANSI code page -on Windows 95 and a Unicode character on Windows NT. -.PP -If you planned to use the same -.QW "char" -based interfaces on both Windows -95 and Windows NT, you could use \fBTcl_UtfToExternal\fR and -\fBTcl_ExternalToUtf\fR (or their \fBTcl_DString\fR equivalents) with an -encoding of NULL (the current system encoding). On the other hand, -if you planned to use the Unicode interface when running on Windows NT -and the -.QW "char" -interfaces when running on Windows 95, you would have -to perform the following type of test over and over in your program -(as represented in pseudo-code): -.PP -.CS -if (running NT) { - encoding <- Tcl_GetEncoding("unicode"); - nativeBuffer <- Tcl_UtfToExternal(encoding, utfBuffer); - Tcl_FreeEncoding(encoding); -} else { - nativeBuffer <- Tcl_UtfToExternal(NULL, utfBuffer); -} -.CE -.PP -\fBTcl_WinUtfToTChar\fR and \fBTcl_WinTCharToUtf\fR automatically -handle this test and use the proper encoding based on the current -operating system. \fBTcl_WinUtfToTChar\fR returns a pointer to -a TCHAR string, and \fBTcl_WinTCharToUtf\fR expects a TCHAR string -pointer as the \fIsrc\fR string. Otherwise, these functions -behave identically to \fBTcl_UtfToExternalDString\fR and -\fBTcl_ExternalToUtfDString\fR. +functions for converting between UTF-8 and Windows strings +based on the TCHAR type which is by convention +a Unicode character on Windows NT. +These functions are essentially wrappers around +\fBTcl_UtfToExternalDString\fR and +\fBTcl_ExternalToUtfDString\fR that convert to and from the +Unicode encoding. .PP \fBTcl_GetEncodingName\fR is roughly the inverse of \fBTcl_GetEncoding\fR. Given an \fIencoding\fR, the return value is the \fIname\fR argument that diff --git a/doc/exec.n b/doc/exec.n index c3f316b..5b27e40 100644 --- a/doc/exec.n +++ b/doc/exec.n @@ -269,17 +269,13 @@ present, as is done when launching applications under wish. It is desirable to have console applications hidden and detached. This is a designed-in limitation as \fBexec\fR wants to communicate over pipes. The Expect extension addresses this issue when communicating with a TUI application. -.RE -.TP -\fBWindows NT\fR -. +.PP When attempting to execute an application, \fBexec\fR first searches for the name as it was specified. Then, in order, \fB.com\fR, \fB.exe\fR, and \fB.bat\fR are appended to the end of the specified name and it searches for the longer name. If a directory name was not specified as part of the application name, the following directories are automatically searched in order when attempting to locate the application: -.RS .IP \(bu 3 The directory from which the Tcl executable was loaded. .IP \(bu 3 @@ -299,67 +295,6 @@ the caller must prepend the desired command with because built-in commands are not implemented using executables. .RE .TP -\fBWindows 9x\fR -. -When attempting to execute an application, \fBexec\fR first searches for -the name as it was specified. Then, in order, \fB.com\fR, \fB.exe\fR, and -\fB.bat\fR are appended to the end of the specified name and it searches -for the longer name. If a directory name was not specified as part of the -application name, the following directories are automatically searched in -order when attempting to locate the application: -.RS -.IP \(bu 3 -The directory from which the Tcl executable was loaded. -.IP \(bu 3 -The current directory. -.IP \(bu 3 -The Windows 9x system directory. -.IP \(bu 3 -The Windows 9x home directory. -.IP \(bu 3 -The directories listed in the path. -.RE -.RS -.PP -In order to execute shell built-in commands like \fBdir\fR and \fBcopy\fR, -the caller must prepend the desired command with -.QW "\fBcommand.com /c\0\fR" -because built-in commands are not implemented using executables. -.PP -Once a 16-bit DOS application has read standard input from a console and -then quit, all subsequently run 16-bit DOS applications will see the -standard input as already closed. 32-bit applications do not have this -problem and will run correctly, even after a 16-bit DOS application thinks -that standard input is closed. There is no known workaround for this bug -at this time. -.PP -Redirection between the \fBNUL:\fR device and a 16-bit application does not -always work. When redirecting from \fBNUL:\fR, some applications may hang, -others will get an infinite stream of -.QW 0x01 -bytes, and some will actually -correctly get an immediate end-of-file; the behavior seems to depend upon -something compiled into the application itself. When redirecting greater than -4K or so to \fBNUL:\fR, some applications will hang. The above problems do not -happen with 32-bit applications. -.PP -All DOS 16-bit applications are run synchronously. All standard input from -a pipe to a 16-bit DOS application is collected into a temporary file; the -other end of the pipe must be closed before the 16-bit DOS application -begins executing. All standard output or error from a 16-bit DOS -application to a pipe is collected into temporary files; the application -must terminate before the temporary files are redirected to the next stage -of the pipeline. This is due to a workaround for a Windows 95 bug in the -implementation of pipes, and is how the standard Windows 95 DOS shell -handles pipes itself. -.PP -Certain applications, such as \fBcommand.com\fR, should not be executed -interactively. Applications which directly access the console window, -rather than reading from their standard input and writing to their standard -output may fail, hang Tcl, or even hang the system if their own private -console window is not available to them. -.RE -.TP \fBUnix\fR (including Mac OS X) . The \fBexec\fR command is fully functional and works as described. diff --git a/doc/file.n b/doc/file.n index 5ff45fd..4c6465a 100644 --- a/doc/file.n +++ b/doc/file.n @@ -241,11 +241,9 @@ as relative to the cwd). Furthermore, paths are always expanded to absolute form. When creating links on filesystems that either do not support any links, or do not support the specific type requested, an -error message will be returned. In particular Windows 95, 98 and ME do -not support any links at present, but most Unix platforms support both -symbolic and hard links (the latter for files only) and Windows -NT/2000/XP (on NTFS drives) support symbolic -directory links and hard file links. +error message will be returned. Most Unix platforms support both +symbolic and hard links (the latter for files only). Windows +supports symbolic directory links and hard file links on NTFS drives. .RE .TP \fBfile lstat \fIname varName\fR diff --git a/doc/glob.n b/doc/glob.n index 86e450b..a2cbce2 100644 --- a/doc/glob.n +++ b/doc/glob.n @@ -204,13 +204,7 @@ of the form it refers to the home directory of the user whose account information resides on the specified NT domain server. Otherwise, user account information is obtained from -the local computer. On Windows 95 and 98, \fBglob\fR accepted patterns -like -.QW .../ -and -.QW ..../ -for successively higher up parent directories, but later versions of -Windows do not accept these forms. +the local computer. .PP Since the backslash character has a special meaning to the glob command, glob patterns containing Windows style path separators need diff --git a/doc/open.n b/doc/open.n index 7fccdf1..3012460 100644 --- a/doc/open.n +++ b/doc/open.n @@ -370,9 +370,8 @@ works for serial ports from 1 to 9. An attempt to open a serial port that does not exist or has a number greater than 9 will fail. An alternate form of opening serial ports is to use the filename \fB//./comX\fR, where X is any number that corresponds to a serial port. -.RS .PP -. +.RS When running Tcl interactively, there may be some strange interactions between the real console, if one is present, and a command pipeline that uses standard input or output. If a command pipeline is opened for reading, some @@ -384,6 +383,7 @@ application are competing for the console at the same time. If the command pipeline is started from a script, so that Tcl is not accessing the console, or if the command pipeline does not use standard input or output, but is redirected from or to a file, then the above problems do not occur. +.RE .TP \fBUnix\fR\0\0\0\0\0\0\0 . diff --git a/doc/tcltest.n b/doc/tcltest.n index 8d2398b..29265be 100644 --- a/doc/tcltest.n +++ b/doc/tcltest.n @@ -642,14 +642,6 @@ This test can only be run on any Windows platform. . This test can only be run on any Windows NT platform. .TP -\fI95\fR -. -This test can only be run on any Windows 95 platform. -.TP -\fI98\fR -. -This test can only be run on any Windows 98 platform. -.TP \fImac\fR . This test can only be run on any Mac platform. diff --git a/doc/tclvars.n b/doc/tclvars.n index 48ab83a..a8fba47 100644 --- a/doc/tclvars.n +++ b/doc/tclvars.n @@ -308,18 +308,13 @@ is the value returned by \fBuname -m\fR. \fBos\fR . The name of the operating system running on this machine, -such as \fBWindows 95\fR, \fBWindows NT\fR, or \fBSunOS\fR. +such as \fBWindows NT\fR or \fBSunOS\fR. On UNIX machines, this is the value returned by \fBuname -s\fR. -On Windows 95 and Windows 98, the value returned will be \fBWindows -95\fR to provide better backwards compatibility to Windows 95; to -distinguish between the two, check the \fBosVersion\fR. .TP \fBosVersion\fR . The version number for the operating system running on this machine. -On UNIX machines, this is the value returned by \fBuname -r\fR. On -Windows 95, the version will be 4.0; on Windows 98, the version will -be 4.10. +On UNIX machines, this is the value returned by \fBuname -r\fR. .TP \fBpathSeparator\fR .VS 8.6 -- cgit v0.12 From 4a22756b41bef17492d6e93ba24261ccf45bf36c Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 3 Mar 2015 21:29:08 +0000 Subject: update changes --- changes | 16 ++++++++++++++++ tests/lreplace.test | 2 +- 2 files changed, 17 insertions(+), 1 deletion(-) diff --git a/changes b/changes index d92c340..fc11542 100644 --- a/changes +++ b/changes @@ -8498,13 +8498,29 @@ include ::oo::class (fellows) 2014-12-03 (bug)[0c043a] Fix compiled [set var($) val] (porter) +2014-12-04 (bug)[d2ffcc] Limit $... and bareword parsing to ASCII (ladayaroslav,porter) + *** POTENTIAL INCOMPATIBILITY *** + +2014-12-06 (bug)[c6cd4a] Win: hang in async socket connection (shults,nadkarni) + +2014-12-10 tzdata updated to Olson's tzdata2014j (venkat) + +2014-12-13 fix header files installation on OS X (houben) 2014-12-17 (TIP 427) [fconfigure $h -connecting, -peername, -sockname] (oehlmann,rmax) +2014-12-18 (bug)[af08c8] Crash in full finalize encoding teardown (porter) + +2014-12-18 (bug)[7c187a] [chan copy] crash (io-53.17) (benno,porter) +2015-01-26 (bug)[df0848] Trouble with INFINITY macro (dower,nijtmans) +2015-01-29 (bug) Stop crashes when extension var resolvers misbehave (porter) +2015-01-29 (bug)[088727] [read] past EOF (io-73.4) (fenugrec,porter) +2015-02-11 tzdata updated to Olson's tzdata2015a (venkat) +2015-02-20 (bug)[32b615] Fix compiled [lreplace] (lreplace-4.[345]) (aspect) --- Released 8.6.4, March 12, 2015 --- http://core.tcl.tk/tcl/ for details diff --git a/tests/lreplace.test b/tests/lreplace.test index d5c51ae..d1319c6 100644 --- a/tests/lreplace.test +++ b/tests/lreplace.test @@ -143,7 +143,7 @@ test lreplace-4.3 {lreplace edge case} { test lreplace-4.4 {lreplace edge case} { lreplace {1 2 3 4 5} 3 1 } {1 2 3 4 5} -test lreplace-4.4 {lreplace edge case} { +test lreplace-4.5 {lreplace edge case} { lreplace {1 2 3 4 5} 3 0 _ } {1 2 3 _ 4 5} -- cgit v0.12 From f396811dd5ddd0df8a3b1a6f211caa4da185c6c4 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 6 Mar 2015 19:43:42 +0000 Subject: product of a make dist --- unix/tclConfig.h.in | 26 ++++++-------------------- 1 file changed, 6 insertions(+), 20 deletions(-) diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in index e55dcd0..10ae12f 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -4,9 +4,6 @@ #ifndef _TCLCONFIG #define _TCLCONFIG -/* Define if building universal (internal helper macro) */ -#undef AC_APPLE_UNIVERSAL_BUILD - /* Is gettimeofday() actually declared in ? */ #undef GETTOD_NOT_DECLARED @@ -214,10 +211,10 @@ /* Is 'struct stat64' in ? */ #undef HAVE_STRUCT_STAT64 -/* Define to 1 if `st_blksize' is a member of `struct stat'. */ +/* Define to 1 if `st_blksize' is member of `struct stat'. */ #undef HAVE_STRUCT_STAT_ST_BLKSIZE -/* Define to 1 if `st_blocks' is a member of `struct stat'. */ +/* Define to 1 if `st_blocks' is member of `struct stat'. */ #undef HAVE_STRUCT_STAT_ST_BLOCKS /* Define to 1 if you have the header file. */ @@ -361,9 +358,6 @@ /* Define to the one symbol short name of this package. */ #undef PACKAGE_TARNAME -/* Define to the home page for this package. */ -#undef PACKAGE_URL - /* Define to the version of this package. */ #undef PACKAGE_VERSION @@ -442,17 +436,9 @@ /* Should we use vfork() instead of fork()? */ #undef USE_VFORK -/* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most - significant byte first (like Motorola and SPARC, unlike Intel). */ -#if defined AC_APPLE_UNIVERSAL_BUILD -# if defined __BIG_ENDIAN__ -# define WORDS_BIGENDIAN 1 -# endif -#else -# ifndef WORDS_BIGENDIAN -# undef WORDS_BIGENDIAN -# endif -#endif +/* Define to 1 if your processor stores words with the most significant byte + first (like Motorola and SPARC, unlike Intel and VAX). */ +#undef WORDS_BIGENDIAN /* Are Darwin SUSv3 extensions available? */ #undef _DARWIN_C_SOURCE @@ -507,7 +493,7 @@ /* Define to `int' if does not define. */ #undef pid_t -/* Define to `unsigned int' if does not define. */ +/* Define to `unsigned' if does not define. */ #undef size_t /* Define as int if socklen_t is not available */ -- cgit v0.12 From 4f07b1824423cc3d59b4e9475474c4833ccbfb6b Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 6 Mar 2015 19:48:31 +0000 Subject: `make html` must tolerate bundled packages using configure.ac over configure.in. --- tools/tcltk-man2html.tcl | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index 89e8e5c..1ceceb9 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -667,7 +667,11 @@ try { # ... but try to extract (name, version) from subdir contents try { - set f [open [file join $pkgsDir $dir configure.in]] + try { + set f [open [file join $pkgsDir $dir configure.in]] + } trap {POSIX ENOENT} {} { + set f [open [file join $pkgsDir $dir configure.ac]] + } foreach line [split [read $f] \n] { if {2 == [scan $line \ { AC_INIT ( [%[^]]] , [%[^]]] ) } n v]} { -- cgit v0.12 From 8c7378b541bedd8db42bd51c39e93de342833280 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 6 Mar 2015 19:55:38 +0000 Subject: .RS/.RE balance --- doc/socket.n | 1 - 1 file changed, 1 deletion(-) diff --git a/doc/socket.n b/doc/socket.n index 492ca66..275771d 100644 --- a/doc/socket.n +++ b/doc/socket.n @@ -190,7 +190,6 @@ 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 . -- cgit v0.12 From 544df0c1b80d0d889677b4b9e3aab4eb6b511779 Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Tue, 10 Mar 2015 14:41:03 +0000 Subject: Fix or at least improvement for Tcl/Tk Cocoa event loop by forcing Tcl_ServiceAll() event processing: http://core.tcl.tk/tk/tktview/3028676fffffffffffffffffffffffffffffffff --- macosx/tclMacOSXNotify.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c index ef80192..9b7bd1a 100644 --- a/macosx/tclMacOSXNotify.c +++ b/macosx/tclMacOSXNotify.c @@ -1412,7 +1412,8 @@ UpdateWaitingListAndServiceEvents( (tsdPtr->runLoopNestingLevel > 1 || !tsdPtr->runLoopRunning)) { tsdPtr->runLoopServicingEvents = 1; - while (Tcl_ServiceAll() && tsdPtr->waitTime == 0) {} + /* This call seems to simply force event processing through and prevents hangups that have long been observed with Tk-Cocoa. */ + Tcl_ServiceAll(); tsdPtr->runLoopServicingEvents = 0; } break; -- cgit v0.12 From 74708147baa286b9ee3e7d6c5796b082f3758a1e Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 11 Mar 2015 12:30:39 +0000 Subject: update changes --- changes | 3 +++ 1 file changed, 3 insertions(+) diff --git a/changes b/changes index fc11542..8dffa37 100644 --- a/changes +++ b/changes @@ -8523,4 +8523,7 @@ include ::oo::class (fellows) 2015-02-20 (bug)[32b615] Fix compiled [lreplace] (lreplace-4.[345]) (aspect) +2015-03-10 (enhancement) Revise OS X notifier for better Cocoa (walzer) + *** POTENTIAL INCOMPATIBILITY *** + --- Released 8.6.4, March 12, 2015 --- http://core.tcl.tk/tcl/ for details -- cgit v0.12 From 2d6d821ea46c7d154c792103be52269f36cbb884 Mon Sep 17 00:00:00 2001 From: hypnotoad Date: Wed, 10 Jun 2015 21:53:47 +0000 Subject: Patch to add support for higher baud rates under Unix Ticket [e770d92d76]] --- unix/tclUnixChan.c | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index a1fe090..b4b2739 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -988,6 +988,39 @@ static const struct {int baud; speed_t speed;} speeds[] = { #ifdef B460800 {460800, B460800}, #endif +#ifdef B500000 + {500000, B500000}, +#endif +#ifdef B576000 + {576000, B576000}, +#endif +#ifdef B921600 + {921600, B921600}, +#endif +#ifdef B1000000 + {1000000, B1000000}, +#endif +#ifdef B1152000 + {1152000, B1152000}, +#endif +#ifdef B1500000 + {1500000,B1500000}, +#endif +#ifdef B2000000 + {2000000, B2000000}, +#endif +#ifdef B2500000 + {2500000,B2500000}, +#endif +#ifdef B3000000 + {3000000,B3000000}, +#endif +#ifdef B3500000 + {3500000,B3500000}, +#endif +#ifdef B4000000 + {4000000,B4000000}, +#endif {-1, 0} }; -- cgit v0.12