From 866ad1ea378141901e68603ec8f10f83bf45dac3 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 10 Oct 2014 20:17:12 +0000 Subject: Bump to 8.5.17 --- README | 2 +- generic/tcl.h | 2 +- library/init.tcl | 2 +- unix/configure | 2 +- unix/configure.in | 2 +- unix/tcl.spec | 2 +- win/configure | 2 +- win/configure.in | 2 +- 8 files changed, 8 insertions(+), 8 deletions(-) diff --git a/README b/README index 256174f..425ca16 100644 --- a/README +++ b/README @@ -1,5 +1,5 @@ README: Tcl - This is the Tcl 8.5.16 source distribution. + This is the Tcl 8.5.17 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 e915452..07e48c3 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -61,7 +61,7 @@ extern "C" { #define TCL_RELEASE_SERIAL 16 #define TCL_VERSION "8.5" -#define TCL_PATCH_LEVEL "8.5.16" +#define TCL_PATCH_LEVEL "8.5.17" /* * The following definitions set up the proper options for Windows compilers. diff --git a/library/init.tcl b/library/init.tcl index 61a80a5..5004e0c 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.5.16 +package require -exact Tcl 8.5.17 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: diff --git a/unix/configure b/unix/configure index ff7791e..1264916 100755 --- a/unix/configure +++ b/unix/configure @@ -1335,7 +1335,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".16" +TCL_PATCH_LEVEL=".17" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ diff --git a/unix/configure.in b/unix/configure.in index 3228353..22c8985 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -25,7 +25,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".16" +TCL_PATCH_LEVEL=".17" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ diff --git a/unix/tcl.spec b/unix/tcl.spec index bdc6e27..4b6a6a0 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 8.5.16 +Version: 8.5.17 Release: 2 License: BSD Group: Development/Languages diff --git a/win/configure b/win/configure index 8e33eb3..dc24431 100755 --- a/win/configure +++ b/win/configure @@ -1311,7 +1311,7 @@ SHELL=/bin/sh TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".16" +TCL_PATCH_LEVEL=".17" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.3 diff --git a/win/configure.in b/win/configure.in index aa42036..14d9b0f 100644 --- a/win/configure.in +++ b/win/configure.in @@ -14,7 +14,7 @@ SHELL=/bin/sh TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".16" +TCL_PATCH_LEVEL=".17" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.3 -- cgit v0.12 From 3b9d194ccde9669b9b28b6be675f09f83ac9b891 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 13 Oct 2014 17:15:55 +0000 Subject: update changes file --- changes | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/changes b/changes index 4b5ba55..4bfe0e4 100644 --- a/changes +++ b/changes @@ -7894,3 +7894,13 @@ of Tcl_Channel (porter) 2014-08-12 tzdata updated to Olson's tzdata2014f (kenny) --- Released 8.5.16, August 25, 2014 --- http://core.tcl.tk/tcl/ for details + +2014-10-02 (bug)[bc5b79] Hang in some [read]s of limited size (rogers,porter) + +2014-10-08 (bug)[59a2e7] MSVC14 compile support (dower,nijtmans) + +2014-10-10 (bug)[ed29c4] [fcopy] treats [blocked] as error (rowen,porter) + +2014-10-10 (bug)[bf7135] regression in Tcl_Write() interface (porter) + +--- Released 8.5.17, October 25, 2014 --- http://core.tcl.tk/tcl/ for details -- cgit v0.12 From 73df1e04588ba22154d42e7eedee8f709d3e26fa Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 13 Oct 2014 17:34:12 +0000 Subject: missed a bump --- generic/tcl.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tcl.h b/generic/tcl.h index 07e48c3..98cd577 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -58,7 +58,7 @@ extern "C" { #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 5 #define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE -#define TCL_RELEASE_SERIAL 16 +#define TCL_RELEASE_SERIAL 17 #define TCL_VERSION "8.5" #define TCL_PATCH_LEVEL "8.5.17" -- cgit v0.12 From f270cc876db91a80fda35fd57e55859d3a9331f6 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 14 Oct 2014 18:12:36 +0000 Subject: Bump to Tcl 8.6.3, TclOO 1.0.3, and update changes file. --- README | 2 +- changes | 29 +++++++++++++++++++++++++++++ generic/tcl.h | 4 ++-- generic/tclOO.h | 2 +- library/init.tcl | 2 +- tests/oo.test | 2 +- tests/ooNext2.test | 2 +- unix/configure | 2 +- unix/configure.in | 2 +- unix/tcl.spec | 2 +- unix/tclooConfig.sh | 2 +- win/configure | 2 +- win/configure.in | 2 +- win/tclooConfig.sh | 2 +- 14 files changed, 43 insertions(+), 14 deletions(-) diff --git a/README b/README index 66e1b76..0fb128d 100644 --- a/README +++ b/README @@ -1,5 +1,5 @@ README: Tcl - This is the Tcl 8.6.2 source distribution. + This is the Tcl 8.6.3 source distribution. http://sourceforge.net/projects/tcl/files/Tcl/ You can get any source release of Tcl from the URL above. diff --git a/changes b/changes index ba0854b..02b6ddc 100644 --- a/changes +++ b/changes @@ -8452,3 +8452,32 @@ include ::oo::class (fellows) 2014-08-25 (TIP 429) New command [string cat] (leitgeb,ferrieux) --- Released 8.6.2, August 27, 2014 --- http://core.tcl.tk/tcl/ for details + +2014-08-28 (bug)[b9e1a3] Correct Method Search Order (nadkarni,fellows) +=> TclOO 1.0.3 + +2014-09-05 (bug)[ccc2c2] Regression [lreplace {} 1 1] (bron,fellows) + +2014-09-08 (bug) Crash regression in [oo::class destroy] (porter) + +2014-09-09 (bug)[84af11] Regress [regsub -all {\(.*} a(b) {}] (oehlmann,fellows) + +2014-09-10 (bug)[cee90e] [try {} on ok {} - on return {} {}] panic (porter) + +2014-09-20 (feature) [tcl::unsupported::getbytecode] disassember (fellows) + +2014-09-27 (enhancement) [string cat] bytecode optimization (leitgeb,ferrieux) + +2014-09-27 (bug)[82521b] segfault in mangled bytecode (ogilvie,sofer) + +2014-10-02 (bug)[bc5b79] Hang in some [read]s of limited size (rogers,porter) + +2014-10-03 (bug)[bc1a96] segfault in [array set] of traced array (tab,porter) + +2014-10-08 (bug)[59a2e7] MSVC14 compile support (dower,nijtmans) + +2014-10-10 (bug)[ed29c4] [fcopy] treats [blocked] as error (rowen,porter) + +2014-10-10 (bug)[bf7135] regression in Tcl_Write() interface (porter) + +--- Released 8.6.3, October 29, 2014 --- http://core.tcl.tk/tcl/ for details diff --git a/generic/tcl.h b/generic/tcl.h index 7531242..fc477f2 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 2 +#define TCL_RELEASE_SERIAL 3 #define TCL_VERSION "8.6" -#define TCL_PATCH_LEVEL "8.6.2" +#define TCL_PATCH_LEVEL "8.6.3" /* *---------------------------------------------------------------------------- diff --git a/generic/tclOO.h b/generic/tclOO.h index 24d3e6f..a7116dc 100644 --- a/generic/tclOO.h +++ b/generic/tclOO.h @@ -24,7 +24,7 @@ * win/tclooConfig.sh */ -#define TCLOO_VERSION "1.0.2" +#define TCLOO_VERSION "1.0.3" #define TCLOO_PATCHLEVEL TCLOO_VERSION #include "tcl.h" diff --git a/library/init.tcl b/library/init.tcl index 265f928..f1f7704 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.2 +package require -exact Tcl 8.6.3 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: diff --git a/tests/oo.test b/tests/oo.test index 2c189ca..5fa760b 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require TclOO 1.0.1 +package require TclOO 1.0.3 package require tcltest 2 if {"::tcltest" in [namespace children]} { namespace import -force ::tcltest::* diff --git a/tests/ooNext2.test b/tests/ooNext2.test index 9a63577..5ecd209 100644 --- a/tests/ooNext2.test +++ b/tests/ooNext2.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require TclOO 1.0.1 +package require TclOO 1.0.3 package require tcltest 2 if {"::tcltest" in [namespace children]} { namespace import -force ::tcltest::* diff --git a/unix/configure b/unix/configure index 5291bf7..a9837d9 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=".2" +TCL_PATCH_LEVEL=".3" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} diff --git a/unix/configure.in b/unix/configure.in index 85bd7ee..e44d554 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=".2" +TCL_PATCH_LEVEL=".3" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} diff --git a/unix/tcl.spec b/unix/tcl.spec index 50aacc6..d660f74 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 8.6.2 +Version: 8.6.3 Release: 2 License: BSD Group: Development/Languages diff --git a/unix/tclooConfig.sh b/unix/tclooConfig.sh index 14b0d8d..55fe75f 100644 --- a/unix/tclooConfig.sh +++ b/unix/tclooConfig.sh @@ -16,4 +16,4 @@ TCLOO_STUB_LIB_SPEC="" TCLOO_INCLUDE_SPEC="" TCLOO_PRIVATE_INCLUDE_SPEC="" TCLOO_CFLAGS="" -TCLOO_VERSION=1.0.2 +TCLOO_VERSION=1.0.3 diff --git a/win/configure b/win/configure index cf2b201..b270648 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=".2" +TCL_PATCH_LEVEL=".3" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 diff --git a/win/configure.in b/win/configure.in index aa47505..1bf901a 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=".2" +TCL_PATCH_LEVEL=".3" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 diff --git a/win/tclooConfig.sh b/win/tclooConfig.sh index 14b0d8d..55fe75f 100644 --- a/win/tclooConfig.sh +++ b/win/tclooConfig.sh @@ -16,4 +16,4 @@ TCLOO_STUB_LIB_SPEC="" TCLOO_INCLUDE_SPEC="" TCLOO_PRIVATE_INCLUDE_SPEC="" TCLOO_CFLAGS="" -TCLOO_VERSION=1.0.2 +TCLOO_VERSION=1.0.3 -- cgit v0.12 From 5af269e0994dcffae3ea5df62337b8c7aae7722c Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 18 Oct 2014 20:11:36 +0000 Subject: update changes --- changes | 2 ++ 1 file changed, 2 insertions(+) diff --git a/changes b/changes index 4bfe0e4..6a617fa 100644 --- a/changes +++ b/changes @@ -7903,4 +7903,6 @@ of Tcl_Channel (porter) 2014-10-10 (bug)[bf7135] regression in Tcl_Write() interface (porter) +2014-10-18 (bug)[10dc6d] fix [gets] on non-blocking channels (fassel,porter) + --- Released 8.5.17, October 25, 2014 --- http://core.tcl.tk/tcl/ for details -- cgit v0.12 From c9267414a3fbeea5ffd03e6b3c60a07edb013a78 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 22 Oct 2014 14:46:33 +0000 Subject: by request --- changes | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/changes b/changes index 3e6e53b..03184e4 100644 --- a/changes +++ b/changes @@ -8460,7 +8460,7 @@ include ::oo::class (fellows) 2014-09-08 (bug) Crash regression in [oo::class destroy] (porter) -2014-09-09 (bug)[84af11] Regress [regsub -all {\(.*} a(b) {}] (oehlmann,fellows) +2014-09-09 (bug)[84af11] Regress [regsub -all {\(.*} a(b) {}] (fellows) 2014-09-10 (bug)[cee90e] [try {} on ok {} - on return {} {}] panic (porter) -- cgit v0.12 From aa669c0d1cbe8d3fd7e7ce23cca9a9bfa3807631 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 26 Oct 2014 07:51:22 +0000 Subject: Support for Windows 10 --- win/tclsh.exe.manifest.in | 2 ++ 1 file changed, 2 insertions(+) diff --git a/win/tclsh.exe.manifest.in b/win/tclsh.exe.manifest.in index b7c4381..8b06fce 100644 --- a/win/tclsh.exe.manifest.in +++ b/win/tclsh.exe.manifest.in @@ -20,6 +20,8 @@ + + -- cgit v0.12 From 7ab8a9b2efc85997d0a6f576c20a69d272bd98ff Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 28 Oct 2014 20:10:32 +0000 Subject: Work in progress restoring ability to [read] after [eof] and get non-empty strings back in those cases where the channel has them to offer. Also working through all the implications of this possibility on Tcl's more exotic channel features, like stacking. --- generic/tclIO.c | 88 ++++++++++++++++++++++++++++++++++++++++++------------- generic/tclIOGT.c | 20 ++++++++----- 2 files changed, 79 insertions(+), 29 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 0122ec9..c55c118 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -4414,6 +4414,17 @@ TclGetsObjBinary( if (bufPtr == NULL) { goto restore; } + } else { + /* + * There's something already in the buffer. If + * CHANNEL_STICKY_EOF is set we know that something begins + * with the eofchar. Otherwise, if CHANNEL_EOF is set, we + * know some earlier inputproc call returned zero bytes when + * we were trying to get more bytes to put in the buffer. + * which means..... ???? Place to probe with tests. + */ + assert (GotFlag(statePtr, CHANNEL_STICKY_EOF) + || !GotFlag(statePtr, CHANNEL_EOF) ); } dst = (unsigned char *) RemovePoint(bufPtr); @@ -4694,6 +4705,9 @@ FilterInputBytes( gsPtr->rawRead = 0; return -1; } + } else { + assert( GotFlag(statePtr, CHANNEL_STICKY_EOF) + || !GotFlag(statePtr, CHANNEL_EOF) ); } /* @@ -5018,6 +5032,7 @@ Tcl_ReadRaw( /* State info for channel */ int copied = 0; + assert(bytesToRead > 0); if (CheckChannelErrors(statePtr, TCL_READABLE | CHANNEL_RAW_MODE) != 0) { return -1; } @@ -5049,8 +5064,19 @@ Tcl_ReadRaw( } } - /* Go to the driver if more data needed. */ + /* + * Go to the driver only if we got nothing from pushback. + * Have to do it this way to avoid EOF mis-timings when we + * consider the ability that EOF may not be a permanent + * condition in the driver, and in that case we have to + * synchronize. + */ + + if (copied) { + return copied; + } + /* This test not needed. */ if (bytesToRead > 0) { int nread = ChanRead(chanPtr, readBuf, bytesToRead); @@ -5073,12 +5099,10 @@ Tcl_ReadRaw( if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) { copied = -1; } - } else if (copied > 0) { + } else { /* - * nread == 0. Driver is at EOF, but if copied>0 bytes - * from pushback, then we should not signal it yet. + * nread == 0. Driver is at EOF. Let that state filter up. */ - ResetFlag(statePtr, CHANNEL_EOF); } } return copied; @@ -6120,18 +6144,39 @@ GetInput( } /* - * For a channel at EOF do not bother allocating buffers; there's - * nothing more to read. Avoid calling the driver inputproc in - * case some of them do not react well to additional calls after - * they've reported an eof state.. - * TODO: Candidate for a can't happen panic. + * Strangely named "STICKY_EOF" really means we've seen the + * eofchar for this channel, and nothing since has reset it. + * (changed the eofchar, [seek]ed to a new offset, etc.) So, + * we know we're still poised to read that eofchar again, and + * there's no need to actually do it. */ - if (GotFlag(statePtr, CHANNEL_EOF)) { + if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) { + assert(statePtr->inEofChar); + assert(statePtr->inQueueHead); + assert(RemovePoint(statePtr->inQueueHead)[0] == statePtr->inEofChar); return 0; } /* + * WARNING: There was once a comment here claiming that it was + * a bad idea to make another call to the inputproc of a channel + * driver when EOF has already been detected on the channel. Through + * much of Tcl's history, this warning was then completely negated + * by having all (most?) read paths clear the EOF setting before + * reaching here. So we had a guard that was never triggered. + * + * Don't be tempted to restore the guard. Even if EOF is set on + * the channel, continue through and call the inputproc again. This + * is the way to enable the ability to [read] again beyond the EOF, + * which seems a strange thing to do, but for which use cases exist + * [Tcl Bug 5adc350683] and which may even be essential for channels + * representing things like ttys or other devices where the stream + * might take the logical form of a series of 'files' separated by + * an EOF condition. + */ + + /* * First check for more buffers in the pushback area of the topmost * channel in the stack and use them. They can be the result of a * transformation which went away without reading all the information @@ -8848,16 +8893,6 @@ DoRead( ChannelBuffer *bufPtr = statePtr->inQueueHead; /* - * When there's no buffered data to read, and we're at EOF, - * escape to the caller. - */ - - if (GotFlag(statePtr, CHANNEL_EOF) - && (bufPtr == NULL || IsBufferEmpty(bufPtr))) { - break; - } - - /* * Don't read more data if we have what we need. */ @@ -8969,12 +9004,23 @@ DoRead( statePtr->inQueueTail = NULL; } RecycleBuffer(statePtr, bufPtr, 0); + bufPtr = statePtr->inQueueHead; } if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED) == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) { break; } + + /* + * When there's no buffered data to read, and we're at EOF, + * escape to the caller. + */ + + if (GotFlag(statePtr, CHANNEL_EOF) + && (bufPtr == NULL || IsBufferEmpty(bufPtr))) { + break; + } } if (bytesToRead == 0) { ResetFlag(statePtr, CHANNEL_BLOCKED); diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index fe0a880..a78a5b4 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -677,6 +677,18 @@ TransformInputProc( break; } + if (dataPtr->readIsFlushed) { + /* + * Already saw EOF from downChan; don't ask again. + * NOTE: Could move this up to avoid the last maxRead + * execution. Believe this would still be correct behavior, + * but the test suite tests the whole command callback + * sequence, so leave it unchanged for now. + */ + + break; + } + /* * Get bytes from the underlying channel. */ @@ -712,14 +724,6 @@ TransformInputProc( * on the down channel. */ - if (dataPtr->readIsFlushed) { - /* - * Already flushed, nothing to do anymore. - */ - - break; - } - dataPtr->readIsFlushed = 1; ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0, TRANSMIT_IBUF, P_PRESERVE); -- cgit v0.12 From 75e9bc701fe237f31e8d1467070fadbcc5457a32 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 29 Oct 2014 14:54:11 +0000 Subject: Base test for [5adc350683]. --- tests/io.test | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/tests/io.test b/tests/io.test index f6690ad..d533957 100644 --- a/tests/io.test +++ b/tests/io.test @@ -8399,6 +8399,26 @@ test io-73.2 {channel Tcl_Obj SetChannelFromAny, bug 2407783} {} { list $code [string map [list $f @@] $msg] } {1 {can not find channel named "@@"}} +test io-73.3 {[5adc350683] [gets] after EOF} -setup { + set fn [makeFile {} io-73.3] + set rfd [open $fn r] + set wfd [open $fn a] + chan configure $wfd -buffering line + read $rfd +} -body { + set result [eof $rfd] + puts $wfd "more data" + lappend result [eof $rfd] + lappend result [gets $rfd] + lappend result [eof $rfd] + lappend result [gets $rfd] + lappend result [eof $rfd] +} -cleanup { + close $wfd + close $rfd + removeFile io-73.3 +} -result {1 1 {more data} 0 {} 1} + # ### ### ### ######### ######### ######### # cleanup -- cgit v0.12 From f6161cafab22785e5a346b26bd0ef59cdb950c57 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 31 Oct 2014 09:59:36 +0000 Subject: When translating a reserved devicename to native pathname, strip ':' postfix. Possible fix for [dcc03414f5], but anyway a good idea. --- win/tclWinFile.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 9bf63b1..163050e 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -3203,7 +3203,10 @@ TclNativeCreateNativeRep( Tcl_WinUtfToTChar(str, len, &ds); if (tclWinProcs->useWide) { WCHAR *wp = (WCHAR *) Tcl_DStringValue(&ds); - len = Tcl_DStringLength(&ds)>>1; + /* For a reserved device, strip a possible postfix ':' */ + len = WinIsReserved(str); + /* For normal devices */ + if (len == 0) len = Tcl_DStringLength(&ds)>>1; /* ** If path starts with "//?/" or "\\?\" (extended path), translate ** any slashes to backslashes but accept the '?' as being valid. -- cgit v0.12 From 384950b6d12f0e3d0da23ed08707b41eb609c9cd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 31 Oct 2014 10:57:25 +0000 Subject: Extend WinIsReserved() to recognize COM[5-9]: as valid com ports as well. --- win/tclWinFile.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 163050e..7487022 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -1225,9 +1225,9 @@ WinIsReserved( if ((path[0] == 'c' || path[0] == 'C') && (path[1] == 'o' || path[1] == 'O')) { if ((path[2] == 'm' || path[2] == 'M') - && path[3] >= '1' && path[3] <= '4') { + && path[3] >= '1' && path[3] <= '9') { /* - * May have match for 'com[1-4]:?', which is a serial port. + * May have match for 'com[1-9]:?', which is a serial port. */ if (path[4] == '\0') { -- cgit v0.12 From 9d91e28e770e770f99f3c3115ab9e86e9d481a2d Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 1 Nov 2014 14:52:55 +0000 Subject: Disable assertion until tls bug it detects is fixed. --- generic/tclIO.c | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 207ce19..9cbc72c 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -2811,9 +2811,15 @@ FlushChannel( * write in this call, and we've completed the BG flush. * These are the two cases above. If we get here, that means * there is some kind failure in the writable event machinery. - */ + * + * The tls extension indeed suffers from flaws in its channel + * event mgmt. See http://core.tcl.tk/tcl/info/c31ca233ca. + * Until that patch is broadly distributed, disable the + * assertion checking here, so that programs using Tcl and + * tls can be debugged. assert(!calledFromAsyncFlush); + */ } } -- cgit v0.12 From 746cb2938e7c4bf900a55899aa1445ece67d52ea Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 3 Nov 2014 10:14:48 +0000 Subject: Better errormessage when file path contains invalid characters. See: [03414f517b7a74]. --- win/tclWinChan.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 6d480a8..a271919 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -840,6 +840,11 @@ TclpOpenFileChannel( nativeName = (TCHAR*) Tcl_FSGetNativePath(pathPtr); if (nativeName == NULL) { + if (interp != (Tcl_Interp *) NULL) { + Tcl_AppendResult(interp, "couldn't open \"", + TclGetString(pathPtr), "\": filename is invalid on this platform", + NULL); + } return NULL; } -- cgit v0.12 From bce5edef8b197d622f6f22b25021afd987743698 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 3 Nov 2014 12:44:55 +0000 Subject: Add test-case for previous commit, which shows that when trying to open a filename with invalid characters gives the right error-message. (same bug existed on UNIX too, which is now fixed) --- tests/fileSystem.test | 3 +++ unix/tclUnixChan.c | 5 +++++ 2 files changed, 8 insertions(+) diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 161ebc3..c255b1e 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -708,6 +708,9 @@ test filesystem-6.32 {empty file name} { test filesystem-6.33 {empty file name} { list [catch {file writable ""} msg] $msg } {0 0} +test filesystem-6.34 {file name with (invalid) nul character} { + list [catch "open foo\x00" msg] $msg +} [list 1 "couldn't open \"foo\x00\": filename is invalid on this platform"] # Make sure the testfilesystem hasn't been registered. if {[testConstraint testfilesystem]} { diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 1d60340..89c9a27 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -1647,6 +1647,11 @@ TclpOpenFileChannel( native = Tcl_FSGetNativePath(pathPtr); if (native == NULL) { + if (interp != (Tcl_Interp *) NULL) { + Tcl_AppendResult(interp, "couldn't open \"", + TclGetString(pathPtr), "\": filename is invalid on this platform", + NULL); + } return NULL; } -- cgit v0.12 From c40bcd39bfbe1d61ef75fd3cc9a6604b6cd20193 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 3 Nov 2014 20:39:25 +0000 Subject: [5adc350683] Reworked the management of the EOF states to re-enable the ability to read beyond EOF. Plenty of assert()s to keep thing from going off track again. --- generic/tclIO.c | 182 +++++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 139 insertions(+), 43 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index c55c118..b3af1f5 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -3977,6 +3977,21 @@ Tcl_GetsObj( } /* + * If we're sitting ready to read the eofchar, there's no need to + * do it. + */ + + if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) { + SetFlag(statePtr, CHANNEL_EOF); + assert( statePtr->inputEncodingFlags & TCL_ENCODING_END ); + assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) ); + + /* TODO: Do we need this? */ + UpdateInterest(chanPtr); + return -1; + } + + /* * A binary version of Tcl_GetsObj. This could also handle encodings that * are ascii-7 pure (iso8859, utf-8, ...) with a final encoding conversion * done on objPtr. @@ -4194,6 +4209,7 @@ Tcl_GetsObj( dstEnd = eof; SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF); statePtr->inputEncodingFlags |= TCL_ENCODING_END; + ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR); } if (GotFlag(statePtr, CHANNEL_EOF)) { skip = 0; @@ -4307,6 +4323,13 @@ Tcl_GetsObj( */ done: + assert(!GotFlag(statePtr, CHANNEL_EOF) + || GotFlag(statePtr, CHANNEL_STICKY_EOF) + || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); + + assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) + == (CHANNEL_EOF|CHANNEL_BLOCKED)) ); + /* * Regenerate the top channel, in case it was changed due to * self-modifying reflected transforms. @@ -4330,6 +4353,11 @@ Tcl_GetsObj( * end-of-line or end-of-file has been seen. Bytes read from the input * channel return as a ByteArray obj. * + * WARNING! The notion of "binary" used here is different from + * notions of "binary" used in other places. In particular, this + * "binary" routine may be called when an -eofchar is set on the + * channel. + * * Results: * Number of characters accumulated in the object or -1 if error, * blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the POSIX error @@ -4416,15 +4444,15 @@ TclGetsObjBinary( } } else { /* - * There's something already in the buffer. If - * CHANNEL_STICKY_EOF is set we know that something begins - * with the eofchar. Otherwise, if CHANNEL_EOF is set, we - * know some earlier inputproc call returned zero bytes when - * we were trying to get more bytes to put in the buffer. - * which means..... ???? Place to probe with tests. - */ - assert (GotFlag(statePtr, CHANNEL_STICKY_EOF) - || !GotFlag(statePtr, CHANNEL_EOF) ); + * Incoming CHANNEL_STICKY_EOF is filtered out on entry. + * A new CHANNEL_STICKY_EOF set in this routine leads to + * return before coming back here. When we are not dealing + * with CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an + * empty buffer. Here the buffer is non-empty so we know + * we're a non-EOF */ + + assert ( !GotFlag(statePtr, CHANNEL_STICKY_EOF) ); + assert ( !GotFlag(statePtr, CHANNEL_EOF) ); } dst = (unsigned char *) RemovePoint(bufPtr); @@ -4466,6 +4494,7 @@ TclGetsObjBinary( SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF); statePtr->inputEncodingFlags |= TCL_ENCODING_END; + ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR); } if (GotFlag(statePtr, CHANNEL_EOF)) { skip = 0; @@ -4575,6 +4604,11 @@ TclGetsObjBinary( */ done: + assert(!GotFlag(statePtr, CHANNEL_EOF) + || GotFlag(statePtr, CHANNEL_STICKY_EOF) + || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); + assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) + == (CHANNEL_EOF|CHANNEL_BLOCKED)) ); UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); return copiedTotal; @@ -4706,8 +4740,16 @@ FilterInputBytes( return -1; } } else { - assert( GotFlag(statePtr, CHANNEL_STICKY_EOF) - || !GotFlag(statePtr, CHANNEL_EOF) ); + /* + * Incoming CHANNEL_STICKY_EOF is filtered out on entry. + * A new CHANNEL_STICKY_EOF set in this routine leads to + * return before coming back here. When we are not dealing + * with CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an + * empty buffer. Here the buffer is non-empty so we know + * we're a non-EOF */ + + assert ( !GotFlag(statePtr, CHANNEL_STICKY_EOF) ); + assert ( !GotFlag(statePtr, CHANNEL_EOF) ); } /* @@ -5201,19 +5243,11 @@ DoReadChars( ChannelState *statePtr = chanPtr->state; /* State info for channel */ ChannelBuffer *bufPtr; - int factor, copied, copiedNow, result; - Tcl_Encoding encoding; + int copied, copiedNow, result; + Tcl_Encoding encoding = statePtr->encoding; int binaryMode; #define UTF_EXPANSION_FACTOR 1024 - - /* - * This operation should occur at the top of a channel stack. - */ - - chanPtr = statePtr->topChanPtr; - encoding = statePtr->encoding; - factor = UTF_EXPANSION_FACTOR; - TclChannelPreserve((Tcl_Channel)chanPtr); + int factor = UTF_EXPANSION_FACTOR; binaryMode = (encoding == NULL) && (statePtr->inputTranslation == TCL_TRANSLATE_LF) @@ -5237,6 +5271,36 @@ DoReadChars( } } + /* + * Early out when next read will see eofchar. + * + * NOTE: See DoRead for argument that it's a bug (one we're keeping) + * to have this escape before the one for zero-char read request. + */ + + if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) { + SetFlag(statePtr, CHANNEL_EOF); + assert( statePtr->inputEncodingFlags & TCL_ENCODING_END ); + assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) ); + + UpdateInterest(chanPtr); + return 0; + } + + /* Special handling for zero-char read request. */ + if (toRead == 0) { + ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF); + UpdateInterest(chanPtr); + return 0; + } + + /* + * This operation should occur at the top of a channel stack. + */ + + chanPtr = statePtr->topChanPtr; + TclChannelPreserve((Tcl_Channel)chanPtr); + /* Must clear the BLOCKED flag here since we check before reading */ ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF); for (copied = 0; (unsigned) toRead > 0; ) { @@ -5314,6 +5378,11 @@ DoReadChars( * Update the notifier state so we don't block while there is still data * in the buffers. */ + assert(!GotFlag(statePtr, CHANNEL_EOF) + || GotFlag(statePtr, CHANNEL_STICKY_EOF) + || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); + assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) + == (CHANNEL_EOF|CHANNEL_BLOCKED)) ); UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); return copied; @@ -5922,7 +5991,7 @@ TranslateInputEOL( SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF); statePtr->inputEncodingFlags |= TCL_ENCODING_END; - ResetFlag(statePtr, INPUT_SAW_CR); + ResetFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR); } } @@ -6132,6 +6201,14 @@ GetInput( ChannelState *statePtr = chanPtr->state; /* State info for channel */ + /* + * Verify that all callers know better than to call us when + * it's recorded that the next char waiting to be read is the + * eofchar. + */ + + assert( !GotFlag(statePtr, CHANNEL_STICKY_EOF) ); + /* * Prevent reading from a dead channel -- a channel that has been closed * but not yet deallocated, which can happen if the exit handler for @@ -6143,21 +6220,6 @@ GetInput( return EINVAL; } - /* - * Strangely named "STICKY_EOF" really means we've seen the - * eofchar for this channel, and nothing since has reset it. - * (changed the eofchar, [seek]ed to a new offset, etc.) So, - * we know we're still poised to read that eofchar again, and - * there's no need to actually do it. - */ - - if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) { - assert(statePtr->inEofChar); - assert(statePtr->inQueueHead); - assert(RemovePoint(statePtr->inQueueHead)[0] == statePtr->inEofChar); - return 0; - } - /* * WARNING: There was once a comment here claiming that it was * a bad idea to make another call to the inputproc of a channel @@ -6185,6 +6247,7 @@ GetInput( if (chanPtr->inQueueHead != NULL) { + /* TODO: Tests to cover this. */ assert(statePtr->inQueueHead == NULL); statePtr->inQueueHead = chanPtr->inQueueHead; @@ -6215,6 +6278,7 @@ GetInput( * Check the actual buffersize against the requested buffersize. * Saved buffers of the wrong size are squashed. This is done * to honor dynamic changes of the buffersize made by the user. + * TODO: Tests to cover this. */ if ((bufPtr != NULL) @@ -6758,9 +6822,7 @@ Tcl_Eof( ChannelState *statePtr = ((Channel *) chan)->state; /* State of real channel structure. */ - return (GotFlag(statePtr, CHANNEL_STICKY_EOF) || - (GotFlag(statePtr, CHANNEL_EOF) && - (Tcl_InputBuffered(chan) == 0))) ? 1 : 0; + return GotFlag(statePtr, CHANNEL_EOF) ? 1 : 0; } /* @@ -8882,6 +8944,36 @@ DoRead( ChannelState *statePtr = chanPtr->state; char *p = dst; + assert (bytesToRead >= 0); + + /* + * Early out when we know a read will get the eofchar. + * + * NOTE: This seems to be a bug. The special handling for + * a zero-char read request ought to come first. As coded + * the EOF due to eofchar has distinguishing behavior from + * the EOF due to reported EOF on the underlying device, and + * that seems undesirable. However recent history indicates + * that new inconsistent behavior in a patchlevel has problems + * too. Keep on keeping on for now. + */ + + if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) { + SetFlag(statePtr, CHANNEL_EOF); + assert( statePtr->inputEncodingFlags & TCL_ENCODING_END ); + assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) ); + + UpdateInterest(chanPtr); + return 0; + } + + /* Special handling for zero-char read request. */ + if (bytesToRead == 0) { + ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF); + UpdateInterest(chanPtr); + return 0; + } + TclChannelPreserve((Tcl_Channel)chanPtr); while (bytesToRead) { /* @@ -8952,8 +9044,7 @@ DoRead( * 1) We're @EOF because we saw eof char. */ - if (statePtr->inEofChar - && RemovePoint(bufPtr)[0] == statePtr->inEofChar) { + if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) { UpdateInterest(chanPtr); break; } @@ -9026,6 +9117,11 @@ DoRead( ResetFlag(statePtr, CHANNEL_BLOCKED); } + assert(!GotFlag(statePtr, CHANNEL_EOF) + || GotFlag(statePtr, CHANNEL_STICKY_EOF) + || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); + assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) + == (CHANNEL_EOF|CHANNEL_BLOCKED)) ); TclChannelRelease((Tcl_Channel)chanPtr); return (int)(p - dst); } -- cgit v0.12 From 77d8108158b1e45e8dc31209eccbe00787a73fb2 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 3 Nov 2014 21:37:37 +0000 Subject: Make sure reflected channels do not make a double call to Tcl_ReadRaw(), with the unwarranted assumption that EOF is a permanent condition. --- generic/tclIORTrans.c | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 45ee08d..8f3ef3c 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -1097,6 +1097,11 @@ ReflectInput( goto stop; } + if (rtPtr->readIsDrained) { + goto stop; + } + + /* * The buffer is exhausted, but the caller wants even more. We now * have to go to the underlying channel, get more bytes and then @@ -1166,10 +1171,6 @@ ReflectInput( * on the down channel. */ - if (rtPtr->readIsDrained) { - goto stop; - } - /* * Now this is a bit different. The partial data waiting is * converted and returned. -- cgit v0.12 From 6329a786eedb7e86de0fb843dfa3c3a1faac5986 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 5 Nov 2014 06:36:07 +0000 Subject: [214cc0eb22] Restore [lappend $var] return value to the 8.6.1- behavior. If this is going to change, lets not do it by accident. --- generic/tclCompCmdsGR.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index 9d258fc..98407f7 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -871,7 +871,7 @@ TclCompileLappendCmd( /* TODO: Consider support for compiling expanded args. */ numWords = parsePtr->numWords; - if (numWords == 1) { + if (numWords < 3) { return TCL_ERROR; } -- cgit v0.12 From db0b450fcc8673487056f6292838cc14ffa54c5e Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 5 Nov 2014 16:47:00 +0000 Subject: New test iortrans-4.10 to demo failure of channel transformation to handle fleeting EOF in the base channel. Falls into infinite block. Regression compared with Tcl 8.6.1. --- tests/ioTrans.test | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) diff --git a/tests/ioTrans.test b/tests/ioTrans.test index 53078f7..f1fa733 100644 --- a/tests/ioTrans.test +++ b/tests/ioTrans.test @@ -597,6 +597,62 @@ test iortrans-4.9 {chan read, gets, bug 2921116} -setup { rename foo {} } -result {{read rt* {test data }} {}} +test iortrans-4.10 {[5adbc350683] chan read, handle fleeting EOF} -setup { + proc driver {cmd args} { + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) ..... + return {initialize finalize watch read} + } + finalize { + if {![info exists index($chan)]} {return} + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] + if {![info exists index($chan)]} { + driver initialize $chan + } + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + if {[string length $result] == 0} { + driver finalize $chan + } + return $result + } + } + } + proc idxform {cmd handle args} { + switch -- $cmd { + initialize { + return {initialize finalize read} + } + finalize { + return + } + read { + lassign $args buffer + return $buffer + } + } + } +} -body { + set chan [chan push [chan create read driver] idxform] + list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \ + [read $chan] [eof $chan] +} -cleanup { + close $chan + rename idxform {} + rename driver {} +} -result {0 ..... 1 {} 0 ..... 1} + # --- === *** ########################### # method write (via puts) -- cgit v0.12 From 836a10622561a68136fe41a106892b55aafb9fc3 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 5 Nov 2014 20:34:03 +0000 Subject: Reflected Transform channel fix. Be sure each EOF on the base channel gets passed up to become an eof of the transform before continuing on to additional ReadRaw() from the base channel. This way we don't miss fleeting EOFs. --- generic/tclIORTrans.c | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 8f3ef3c..8baa9ad 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -161,6 +161,7 @@ typedef struct { int mode; /* Mask of R/W mode */ int nonblocking; /* Flag: Channel is blocking or not. */ int readIsDrained; /* Flag: Read buffers are flushed. */ + int eofPending; /* Flag: EOF seen down, but not raised up */ int dead; /* Boolean signal that some operations * should no longer be attempted. */ ResultBuffer result; @@ -1082,6 +1083,10 @@ ReflectInput( bufObj = Tcl_NewByteArrayObj(NULL, toRead); Tcl_IncrRefCount(bufObj); gotBytes = 0; + if (rtPtr->eofPending) { + goto stop; + } + rtPtr->readIsDrained = 0; while (toRead > 0) { /* * Loop until the request is satisfied (or no data available from @@ -1097,9 +1102,9 @@ ReflectInput( goto stop; } - if (rtPtr->readIsDrained) { - goto stop; - } + if (rtPtr->eofPending) { + goto stop; + } /* @@ -1170,6 +1175,8 @@ ReflectInput( * Zero returned from Tcl_ReadRaw() always indicates EOF * on the down channel. */ + + rtPtr->eofPending = 1; /* * Now this is a bit different. The partial data waiting is @@ -1212,6 +1219,9 @@ ReflectInput( } /* while toRead > 0 */ stop: + if (gotBytes == 0) { + rtPtr->eofPending = 0; + } Tcl_DecrRefCount(bufObj); Tcl_Release(rtPtr); return gotBytes; @@ -1767,6 +1777,7 @@ NewReflectedTransform( rtPtr->timer = NULL; rtPtr->mode = 0; rtPtr->readIsDrained = 0; + rtPtr->eofPending = 0; rtPtr->nonblocking = (((Channel *) parentChan)->state->flags & CHANNEL_NONBLOCKING); rtPtr->dead = 0; @@ -3319,6 +3330,7 @@ TransformClear( (void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL); rtPtr->readIsDrained = 0; + rtPtr->eofPending = 0; ResultClear(&rtPtr->result); } -- cgit v0.12 From 7cc4c83aed245ab7ec48a2d037c43b8b59cfdddb Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 6 Nov 2014 13:38:01 +0000 Subject: New tests iortrans-4.11* demonstrate what was wrong with the "leaky EOF flag" approach in 8.6.1 and earlier. If each level of the channel stack is to have control over its EOF independently, we have to provide for that, even though the Filesystem read APIs make it a big pain. Also test robustness against varing buffer sizes. --- tests/ioTrans.test | 89 +++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 85 insertions(+), 4 deletions(-) diff --git a/tests/ioTrans.test b/tests/ioTrans.test index f1fa733..faae9d8 100644 --- a/tests/ioTrans.test +++ b/tests/ioTrans.test @@ -597,7 +597,9 @@ test iortrans-4.9 {chan read, gets, bug 2921116} -setup { rename foo {} } -result {{read rt* {test data }} {}} -test iortrans-4.10 {[5adbc350683] chan read, handle fleeting EOF} -setup { + +# Driver for a base channel that emits several short "files" +# with each terminated by a fleeting EOF proc driver {cmd args} { variable buffer variable index @@ -629,6 +631,8 @@ test iortrans-4.10 {[5adbc350683] chan read, handle fleeting EOF} -setup { } } } + +# Channel read transform that is just the identity - pass all through proc idxform {cmd handle args} { switch -- $cmd { initialize { @@ -643,15 +647,92 @@ test iortrans-4.10 {[5adbc350683] chan read, handle fleeting EOF} -setup { } } } -} -body { + +# Test that all EOFs pass through full xform stack. Proper data boundaries. +# Check robustness against buffer sizes. +test iortrans-4.10 {[5adbc350683] chan read, handle fleeting EOF} -body { set chan [chan push [chan create read driver] idxform] list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \ [read $chan] [eof $chan] } -cleanup { close $chan - rename idxform {} - rename driver {} } -result {0 ..... 1 {} 0 ..... 1} +test iortrans-4.10.1 {[5adbc350683] chan read, handle fleeting EOF} -body { + set chan [chan push [chan create read driver] idxform] + chan configure $chan -buffersize 3 + list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \ + [read $chan] [eof $chan] +} -cleanup { + close $chan +} -result {0 ..... 1 {} 0 ..... 1} +test iortrans-4.10.2 {[5adbc350683] chan read, handle fleeting EOF} -body { + set chan [chan push [chan create read driver] idxform] + chan configure $chan -buffersize 5 + list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \ + [read $chan] [eof $chan] +} -cleanup { + close $chan +} -result {0 ..... 1 {} 0 ..... 1} + +rename idxform {} + +# Channel read transform that delays the data + proc delayxform {cmd handle args} { + variable store + switch -- $cmd { + initialize { + set store($handle) {} + return {initialize finalize read drain} + } + finalize { + unset store($handle) + return + } + read { + lassign $args buffer + if {$store($handle) eq {}} { + set reply [string index $buffer 0] + set store($handle) [string range $buffer 1 end] + } else { + set reply $store($handle) + set store($handle) $buffer + } + return $reply + } + drain { + delayxform read $handle {} + } + } + } + +# Test that all EOFs pass through full xform stack. Proper data boundaries. +# Check robustness against buffer sizes. +test iortrans-4.11 {[5adbc350683] chan read, handle fleeting EOF} -body { + set chan [chan push [chan create read driver] delayxform] + list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \ + [read $chan] [eof $chan] +} -cleanup { + close $chan +} -result {0 ..... 1 {} 0 ..... 1} +test iortrans-4.11.1 {[5adbc350683] chan read, handle fleeting EOF} -body { + set chan [chan push [chan create read driver] delayxform] + chan configure $chan -buffersize 3 + list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \ + [read $chan] [eof $chan] +} -cleanup { + close $chan +} -result {0 ..... 1 {} 0 ..... 1} +test iortrans-4.11.2 {[5adbc350683] chan read, handle fleeting EOF} -body { + set chan [chan push [chan create read driver] delayxform] + chan configure $chan -buffersize 5 + list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \ + [read $chan] [eof $chan] +} -cleanup { + close $chan +} -result {0 ..... 1 {} 0 ..... 1} + + rename delayxform {} + rename driver {} # --- === *** ########################### -- cgit v0.12 From 06fa92e9a424d57ed4c9458474f5f8a7b42cc654 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 6 Nov 2014 14:52:36 +0000 Subject: Another test checking that handling when transform returns nothing is right. --- tests/ioTrans.test | 36 +++++++++++++++++++++++++++++++++++- 1 file changed, 35 insertions(+), 1 deletion(-) diff --git a/tests/ioTrans.test b/tests/ioTrans.test index faae9d8..aa2fbc7 100644 --- a/tests/ioTrans.test +++ b/tests/ioTrans.test @@ -676,7 +676,7 @@ test iortrans-4.10.2 {[5adbc350683] chan read, handle fleeting EOF} -body { rename idxform {} -# Channel read transform that delays the data +# Channel read transform that delays the data and always returns something proc delayxform {cmd handle args} { variable store switch -- $cmd { @@ -732,6 +732,40 @@ test iortrans-4.11.2 {[5adbc350683] chan read, handle fleeting EOF} -body { } -result {0 ..... 1 {} 0 ..... 1} rename delayxform {} + +# Channel read transform that delays the data and may return {} + proc delay2xform {cmd handle args} { + variable store + switch -- $cmd { + initialize { + set store($handle) {} + return {initialize finalize read drain} + } + finalize { + unset store($handle) + return + } + read { + lassign $args buffer + set reply $store($handle) + set store($handle) $buffer + return $reply + } + drain { + delay2xform read $handle {} + } + } + } + +test iortrans-4.12 {[5adbc350683] chan read, handle fleeting EOF} -body { + set chan [chan push [chan create read driver] delay2xform] + list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \ + [read $chan] [eof $chan] +} -cleanup { + close $chan +} -result {0 ..... 1 {} 0 ..... 1} + + rename delay2xform {} rename driver {} -- cgit v0.12 From a8c6a73058b823dbb1ea5e3832d016284820400e Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 6 Nov 2014 15:06:52 +0000 Subject: New test iogt-7.0 demos bug in [testchannel transform]. --- tests/iogt.test | 42 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) diff --git a/tests/iogt.test b/tests/iogt.test index 5fe3dc2..1a18afc 100644 --- a/tests/iogt.test +++ b/tests/iogt.test @@ -996,6 +996,48 @@ test iogt-6.1 {Push back and up} {testchannel knownBug} { set res } {xxxghi} +# Driver for a base channel that emits several short "files" +# with each terminated by a fleeting EOF + proc driver {cmd args} { + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) ..... + return {initialize finalize watch read} + } + finalize { + if {![info exists index($chan)]} {return} + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] + if {![info exists index($chan)]} { + driver initialize $chan + } + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + if {[string length $result] == 0} { + driver finalize $chan + } + return $result + } + } + } + +test iogt-7.0 {Handle fleeting EOF} -constraints {testchannel} -body { + set chan [chan create read [namespace which driver]] + identity -attach $chan + list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \ + [read $chan] [eof $chan] +} -cleanup { + close $chan +} -result {0 ..... 1 {} 0 ..... 1} # cleanup foreach file [list dummy dummyout __echo_srv__.tcl] { -- cgit v0.12 From 4ec8e3c11c2a7fdc1fd9efce21a8e6d92ce8a0e5 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 6 Nov 2014 15:49:30 +0000 Subject: fix failing test --- generic/tclIOGT.c | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index a78a5b4..7ba2f2a 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -187,6 +187,7 @@ struct TransformChannelData { Tcl_Channel self; /* Our own Channel handle. */ int readIsFlushed; /* Flag to note whether in.flushProc was * called or not. */ + int eofPending; /* Flag: EOF seen down, not raised up */ int flags; /* Currently CHANNEL_ASYNC or zero. */ int watchMask; /* Current watch/event/interest mask. */ int mode; /* Mode of parent channel, OR'ed combination @@ -292,6 +293,7 @@ TclChannelTransform( Tcl_DStringInit(&ds); Tcl_GetChannelOption(interp, chan, "-blocking", &ds); dataPtr->readIsFlushed = 0; + dataPtr->eofPending = 0; dataPtr->flags = 0; if (ds.string[0] == '0') { dataPtr->flags |= CHANNEL_ASYNC; @@ -624,7 +626,7 @@ TransformInputProc( if (toRead == 0 || dataPtr->self == NULL) { /* - * Catch a no-op. + * Catch a no-op. TODO: Is this a panic()? */ return 0; } @@ -676,8 +678,7 @@ TransformInputProc( if (toRead <= 0) { break; } - - if (dataPtr->readIsFlushed) { + if (dataPtr->eofPending) { /* * Already saw EOF from downChan; don't ask again. * NOTE: Could move this up to avoid the last maxRead @@ -724,6 +725,7 @@ TransformInputProc( * on the down channel. */ + dataPtr->eofPending = 1; dataPtr->readIsFlushed = 1; ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0, TRANSMIT_IBUF, P_PRESERVE); @@ -751,8 +753,11 @@ TransformInputProc( break; } } /* while toRead > 0 */ - ReleaseData(dataPtr); + if (gotBytes == 0) { + dataPtr->eofPending = 0; + } + ReleaseData(dataPtr); return gotBytes; } @@ -863,6 +868,7 @@ TransformSeekProc( P_NO_PRESERVE); ResultClear(&dataPtr->result); dataPtr->readIsFlushed = 0; + dataPtr->eofPending = 0; } ReleaseData(dataPtr); @@ -936,6 +942,7 @@ TransformWideSeekProc( P_NO_PRESERVE); ResultClear(&dataPtr->result); dataPtr->readIsFlushed = 0; + dataPtr->eofPending = 0; } ReleaseData(dataPtr); -- cgit v0.12 From 4cb80cd4e64044f5891b073788734efd753e5100 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 6 Nov 2014 16:12:26 +0000 Subject: Also test transfroms that delay. --- tests/iogt.test | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/tests/iogt.test b/tests/iogt.test index 1a18afc..89e62d4 100644 --- a/tests/iogt.test +++ b/tests/iogt.test @@ -1039,6 +1039,36 @@ test iogt-7.0 {Handle fleeting EOF} -constraints {testchannel} -body { close $chan } -result {0 ..... 1 {} 0 ..... 1} +proc delay {op data} { + variable store + switch -- $op { + create/write - create/read - + delete/write - delete/read - + flush/write - write - + clear_read {;#ignore} + flush/read - + read { + if {![info exists store]} {set store {}} + set reply $store + set store $data + return $reply + } + query/maxRead {return -1} + } +} + +test iogt-7.1 {Handle fleeting EOF} -constraints {testchannel} -body { + set chan [chan create read [namespace which driver]] + testchannel transform $chan -command [namespace code delay] + list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \ + [read $chan] [eof $chan] +} -cleanup { + close $chan +} -result {0 ..... 1 {} 0 ..... 1} + +rename delay {} +rename driver {} + # cleanup foreach file [list dummy dummyout __echo_srv__.tcl] { removeFile $file -- cgit v0.12 From f033a745db5e733d99ebc0a7895320435de1bd82 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 6 Nov 2014 17:34:40 +0000 Subject: cleanup global namespace litter --- tests/ioTrans.test | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/ioTrans.test b/tests/ioTrans.test index aa2fbc7..f82c610 100644 --- a/tests/ioTrans.test +++ b/tests/ioTrans.test @@ -613,6 +613,8 @@ test iortrans-4.9 {chan read, gets, bug 2921116} -setup { finalize { if {![info exists index($chan)]} {return} unset index($chan) buffer($chan) + array unset index + array unset buffer return } watch {} -- cgit v0.12 From 4ec954d30638d7601c2f884c6a70f30ebab5ac11 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 7 Nov 2014 13:59:27 +0000 Subject: Make sure all uses of the [testbytestring] command are constrained. --- tests/parse.test | 6 ++++-- tests/parseOld.test | 12 ++++++------ tests/subst.test | 4 ++-- tests/utf.test | 40 ++++++++++++++++++++-------------------- 4 files changed, 32 insertions(+), 30 deletions(-) diff --git a/tests/parse.test b/tests/parse.test index fe6026d..4e3139c 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -303,8 +303,10 @@ test parse-6.16 {ParseTokens procedure, backslash substitution} testparser { testparser {\n\a\x7f} 0 } {- {\n\a\x7f} 1 word {\n\a\x7f} 3 backslash {\n} 0 backslash {\a} 0 backslash {\x7f} 0 {}} test parse-6.17 {ParseTokens procedure, null characters} {testparser testbytestring} { - testparser [testbytestring "foo\0zz"] 0 -} "- [testbytestring foo\0zz] 1 word [testbytestring foo\0zz] 3 text foo 0 text [testbytestring \0] 0 text zz 0 {}" + expr {[testparser [testbytestring "foo\0zz"] 0] eq +"- [testbytestring foo\0zz] 1 word [testbytestring foo\0zz] 3 text foo 0 text [testbytestring \0] 0 text zz 0 {}" + } +} 1 test parse-6.18 {ParseTokens procedure, seek past numBytes for close-bracket} testparser { # Test for Bug 681841 list [catch {testparser {[a]} 2} msg] $msg diff --git a/tests/parseOld.test b/tests/parseOld.test index 4c08b5d..a6e07a2 100644 --- a/tests/parseOld.test +++ b/tests/parseOld.test @@ -263,14 +263,14 @@ test parseOld-7.11 {backslash substitution} { eval "list a \"b c\"\\\nd e" } {a {b c} d e} test parseOld-7.12 {backslash substitution} testbytestring { - list \ua2 -} [testbytestring "\xc2\xa2"] + expr {[list \ua2] eq [testbytestring "\xc2\xa2"]} +} 1 test parseOld-7.13 {backslash substitution} testbytestring { - list \u4e21 -} [testbytestring "\xe4\xb8\xa1"] + expr {[list \u4e21] eq [testbytestring "\xe4\xb8\xa1"]} +} 1 test parseOld-7.14 {backslash substitution} testbytestring { - list \u4e2k -} [testbytestring "\xd3\xa2k"] + expr {[list \u4e2k] eq [testbytestring "\xd3\xa2k"]} +} 1 # Semi-colon. diff --git a/tests/subst.test b/tests/subst.test index 256b7f7..2115772 100644 --- a/tests/subst.test +++ b/tests/subst.test @@ -38,8 +38,8 @@ test subst-2.3 {simple strings} { } abcdefg test subst-2.4 {simple strings} testbytestring { # Tcl Bug 685106 - subst [testbytestring bar\x00soom] -} [testbytestring bar\x00soom] + expr {[subst [testbytestring bar\x00soom]] eq [testbytestring bar\x00soom]} +} 1 test subst-3.1 {backslash substitutions} { subst {\x\$x\[foo bar]\\} diff --git a/tests/utf.test b/tests/utf.test index 83daddf..ceb1af7 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -21,23 +21,23 @@ testConstraint testbytestring [llength [info commands testbytestring]] catch {unset x} test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} testbytestring { - set x \x01 -} [testbytestring "\x01"] + expr {"\x01" eq [testbytestring "\x01"]} +} 1 test utf-1.2 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring { - set x "\x00" -} [testbytestring "\xc0\x80"] + expr {"\x00" eq [testbytestring "\xc0\x80"]} +} 1 test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} testbytestring { - set x "\xe0" -} [testbytestring "\xc3\xa0"] + expr {"\xe0" eq [testbytestring "\xc3\xa0"]} +} 1 test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} testbytestring { - set x "\u4e4e" -} [testbytestring "\xe4\xb9\x8e"] + expr {"\u4e4e" eq [testbytestring "\xe4\xb9\x8e"]} +} 1 test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} testbytestring { - format %c 0x110000 -} [testbytestring "\xef\xbf\xbd"] + expr {[format %c 0x110000] eq [testbytestring "\xef\xbf\xbd"]} +} 1 test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} testbytestring { - format %c -1 -} [testbytestring "\xef\xbf\xbd"] + expr {[format %c -1] eq [testbytestring "\xef\xbf\xbd"]} +} 1 test utf-2.1 {Tcl_UtfToUniChar: low ascii} { string length "abc" @@ -128,17 +128,17 @@ test utf-10.1 {Tcl_UtfBackslash: dst == NULL} { } { } test utf-10.2 {Tcl_UtfBackslash: \u subst} testbytestring { - set x \ua2 -} [testbytestring "\xc2\xa2"] + expr {"\ua2" eq [testbytestring "\xc2\xa2"]} +} 1 test utf-10.3 {Tcl_UtfBackslash: longer \u subst} testbytestring { - set x \u4e21 -} [testbytestring "\xe4\xb8\xa1"] + expr {"\u4e21" eq [testbytestring "\xe4\xb8\xa1"]} +} 1 test utf-10.4 {Tcl_UtfBackslash: stops at first non-hex} testbytestring { - set x \u4e2k -} "[testbytestring \xd3\xa2]k" + expr {"\u4e2k" eq "[testbytestring \xd3\xa2]k"} +} 1 test utf-10.5 {Tcl_UtfBackslash: stops after 4 hex chars} testbytestring { - set x \u4e216 -} "[testbytestring \xe4\xb8\xa1]6" + expr {"\u4e216" eq "[testbytestring \xe4\xb8\xa1]6"} +} 1 proc bsCheck {char num} { global errNum test utf-10.$errNum {backslash substitution} { -- cgit v0.12 From e783e0d809bd84c85d8cf7914540f409b503df4b Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 7 Nov 2014 14:10:23 +0000 Subject: update changes; more test suite polishing. --- changes | 10 +++++++++- tests/parse.test | 2 +- tests/socket.test | 2 +- 3 files changed, 11 insertions(+), 3 deletions(-) diff --git a/changes b/changes index 03184e4..945b167 100644 --- a/changes +++ b/changes @@ -8482,4 +8482,12 @@ include ::oo::class (fellows) 2014-10-18 (bug)[10dc6d] fix [gets] on non-blocking channels (fassel,porter) ---- Released 8.6.3, October 29, 2014 --- http://core.tcl.tk/tcl/ for details +2014-10-26 Support for Windows 10 (nijtmans) + +2014-10-31 (bug)[dcc034] restore [open comX: r+] (lll,nijtmans) + +2014-11-05 (bug)[214cc0] Restore [lappend v] return value (sayers,porter) + +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 diff --git a/tests/parse.test b/tests/parse.test index 4e3139c..5d8afeb 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -918,7 +918,7 @@ test parse-15.57 {CommandComplete procedure} { test parse-15.58 {CommandComplete procedure, memory leaks} { info complete "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22" } 1 -test parse-15.59 {CommandComplete procedure} { +test parse-15.59 {CommandComplete procedure} testbytestring { # Test for Tcl Bug 684744 info complete [testbytestring "\x00;if 1 \{"] } 0 diff --git a/tests/socket.test b/tests/socket.test index d6cee30..eeea044 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -2249,7 +2249,7 @@ test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener unset x } -result {socket is not connected} -returnCodes 1 test socket-14.11.1 {pending [socket -async] and nonblocking [puts], no listener, flush} \ - -constraints {socket} \ + -constraints {socket nonportable} \ -body { set sock [socket -async localhost [randport]] fconfigure $sock -blocking 0 -- cgit v0.12 From 3e48a2fd72b0b60f4e8f3d59eccd73a3c39d8d9d Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 7 Nov 2014 17:48:31 +0000 Subject: Correct -singleproc 1 testing flaws. --- tests/interp.test | 4 ++-- tests/ioTrans.test | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/interp.test b/tests/interp.test index ad99fac..4bc9fe2 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -3615,10 +3615,10 @@ test interp-38.3 {interp debug wrong args} -body { } -returnCodes { error } -result {wrong # args: should be "interp debug path ?-frame ?bool??"} -test interp-38.4 {interp debug basic setup} -body { +test interp-38.4 {interp debug basic setup} -constraints {!singleTestInterp} -body { interp debug {} } -result {-frame 0} -test interp-38.5 {interp debug basic setup} -body { +test interp-38.5 {interp debug basic setup} -constraints {!singleTestInterp} -body { interp debug {} -f } -result {0} test interp-38.6 {interp debug basic setup} -body { diff --git a/tests/ioTrans.test b/tests/ioTrans.test index f82c610..e179eab 100644 --- a/tests/ioTrans.test +++ b/tests/ioTrans.test @@ -601,8 +601,8 @@ test iortrans-4.9 {chan read, gets, bug 2921116} -setup { # Driver for a base channel that emits several short "files" # with each terminated by a fleeting EOF proc driver {cmd args} { - variable buffer - variable index + variable ::tcl::buffer + variable ::tcl::index set chan [lindex $args 0] switch -- $cmd { initialize { -- cgit v0.12 From 69d586c18ca336c0b7eafea4bdebcf7c01b769ce Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 8 Nov 2014 07:06:52 +0000 Subject: [214cc0eb22] Add tests to make sure that this bug stays fixed. --- tests/append.test | 17 +++++++++++++++++ tests/appendComp.test | 21 +++++++++++++++++++++ 2 files changed, 38 insertions(+) diff --git a/tests/append.test b/tests/append.test index 69c6381..8fa4e61 100644 --- a/tests/append.test +++ b/tests/append.test @@ -292,6 +292,23 @@ test append-9.3 {bug 3057639, append direct eval, read trace on non-existing env } -cleanup { unset -nocomplain ::env(__DUMMY__) } -result {0 {new value}} + +test append-10.1 {Bug 214cc0eb22: lappend with no values} { + set lst "# 1 2 3" + [subst lappend] lst +} "# 1 2 3" +test append-10.2 {Bug 214cc0eb22: lappend with no values} -body { + set lst "1 \{ 2" + [subst lappend] lst +} -returnCodes error -result {unmatched open brace in list} +test append-10.3 {Bug 214cc0eb22: expanded lappend with no values} { + set lst "# 1 2 3" + [subst lappend] lst {*}[list] +} "# 1 2 3" +test append-10.4 {Bug 214cc0eb22: expanded lappend with no values} -body { + set lst "1 \{ 2" + [subst lappend] lst {*}[list] +} -returnCodes error -result {unmatched open brace in list} unset -nocomplain i x result y catch {rename foo ""} diff --git a/tests/appendComp.test b/tests/appendComp.test index f85c3ba..bbf5f9c 100644 --- a/tests/appendComp.test +++ b/tests/appendComp.test @@ -438,6 +438,27 @@ test appendComp-9.3 {bug 3057639, append direct eval, read trace on non-existing } -cleanup { unset -nocomplain ::env(__DUMMY__) } -result {0 {new value}} + +test appendComp-10.1 {Bug 214cc0eb22: lappend with no values} { + apply {lst { + lappend lst + }} "# 1 2 3" +} "# 1 2 3" +test appendComp-10.2 {Bug 214cc0eb22: lappend with no values} -body { + apply {lst { + lappend lst + }} "1 \{ 2" +} -returnCodes error -result {unmatched open brace in list} +test appendComp-10.3 {Bug 214cc0eb22: expanded lappend with no values} { + apply {lst { + lappend lst {*}[list] + }} "# 1 2 3" +} "# 1 2 3" +test appendComp-10.4 {Bug 214cc0eb22: expanded lappend with no values} -body { + apply {lst { + lappend lst {*}[list] + }} "1 \{ 2" +} -returnCodes error -result {unmatched open brace in list} catch {unset i x result y} catch {rename foo ""} -- cgit v0.12 From d18e6da3e471bdaecc24da3e4dfb28620b880daa Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 11 Nov 2014 22:23:57 +0000 Subject: Likely fix for channel mem leaks. --- generic/tclIO.c | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 8ec2a1e..2025742 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -155,6 +155,7 @@ static ChannelBuffer * AllocChannelBuffer(int length); static void PreserveChannelBuffer(ChannelBuffer *bufPtr); static void ReleaseChannelBuffer(ChannelBuffer *bufPtr); static int IsShared(ChannelBuffer *bufPtr); +static void ChannelFree(Channel *chanPtr); static void ChannelTimerProc(ClientData clientData); static int ChanRead(Channel *chanPtr, char *dst, int dstSize); static int CheckChannelErrors(ChannelState *statePtr, @@ -1914,6 +1915,16 @@ TclChannelRelease( } } +static void +ChannelFree( + Channel *chanPtr) +{ + if (chanPtr->refCount == 0) { + ckfree(chanPtr); + return; + } + chanPtr->typePtr = NULL; +} /* *---------------------------------------------------------------------- @@ -2060,7 +2071,7 @@ Tcl_UnstackChannel( */ result = ChanClose(chanPtr, interp); - chanPtr->typePtr = NULL; + ChannelFree(chanPtr); UpdateInterest(statePtr->topChanPtr); @@ -3018,7 +3029,8 @@ CloseChannel( statePtr->topChanPtr = downChanPtr; downChanPtr->upChanPtr = NULL; - chanPtr->typePtr = NULL; + + ChannelFree(chanPtr); return Tcl_Close(interp, (Tcl_Channel) downChanPtr); } @@ -3029,7 +3041,7 @@ CloseChannel( * stack, make sure to free the ChannelState structure associated with it. */ - chanPtr->typePtr = NULL; + ChannelFree(chanPtr); Tcl_EventuallyFree(statePtr, TCL_DYNAMIC); -- cgit v0.12 From b7b8194d8178e6ed5b12f5b2ea3eef30bb132c99 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 13 Nov 2014 12:29:04 +0000 Subject: Improve documentation on the use of com ports (remove references to Windows 95, deprecate the use of postfix ':'). Allow lpt[5-9] just as com[5-9], and make sure that path normalization works as expected for ports > 4. --- doc/open.n | 60 +++++++++++---------------------------------------- generic/tclFileName.c | 8 +++---- tests/winFCmd.test | 13 +++++++---- win/tclWinFile.c | 4 ++-- 4 files changed, 28 insertions(+), 57 deletions(-) diff --git a/doc/open.n b/doc/open.n index b888126..7216607 100644 --- a/doc/open.n +++ b/doc/open.n @@ -331,61 +331,27 @@ may cause this error. A BREAK condition has been detected by your UART (see above). .SH "PORTABILITY ISSUES" .TP -\fBWindows \fR(all versions) +\fBWindows \fR Valid values for \fIfileName\fR to open a serial port are of the form -\fBcom\fIX\fB:\fR, where \fIX\fR is a number, generally from 1 to 4. -This notation only works for serial ports from 1 to 9, if the system -happens to have more than four. An attempt to open a serial port that +\fBcom\fIX\fB\fR, where \fIX\fR is a number, generally from 1 to 9. +A legacy form accepted as well is \fBcom\fIX\fB:\fR. This notation only +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\e\e.\ecomX\fR, -where X is any number that corresponds to a serial port; please note -that this method is considerably slower on Windows 95 and Windows 98. -.TP -\fBWindows NT\fR +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 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 of the lines entered at the console will be sent to the command pipeline and some will be sent to the Tcl evaluator. If a command pipeline is opened for writing, keystrokes entered into the console are not visible until the -pipe is closed. This behavior occurs whether the command pipeline is -executing 16-bit or 32-bit applications. These problems only occur because -both Tcl and the child 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. -.TP -\fBWindows 95\fR -A command pipeline that executes a 16-bit DOS application cannot be opened -for both reading and writing, since 16-bit DOS applications that receive -standard input from a pipe and send standard output to a pipe run -synchronously. Command pipelines that do not execute 16-bit DOS -applications run asynchronously and can be opened for both reading and -writing. -.RS -.PP -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 from -a 32-bit application, some of the keystrokes entered at the console will be -sent to the command pipeline and some will be sent to the Tcl evaluator. If -a command pipeline is opened for writing to a 32-bit application, no output -is visible on the console until the pipe is closed. These problems only -occur because both Tcl and the child 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. -.PP -Whether or not Tcl is running interactively, if a command pipeline is opened -for reading from a 16-bit DOS application, the call to \fBopen\fR will not -return until end-of-file has been received from the command pipeline's -standard output. If a command pipeline is opened for writing to a 16-bit DOS -application, no data will be sent to the command pipeline's standard output -until the pipe is actually closed. This problem occurs because 16-bit DOS -applications are run synchronously, as described above. -.RE +pipe is closed. These problems only occur because both Tcl and the child +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. .TP \fBUnix\fR\0\0\0\0\0\0\0 Valid values for \fIfileName\fR to open a serial port are generally of the diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 07757d9..a8360fc 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -225,9 +225,9 @@ ExtractWinRoot( if ((path[0] == 'c' || path[0] == 'C') && (path[1] == 'o' || path[1] == 'O')) { if ((path[2] == 'm' || path[2] == 'M') - && path[3] >= '1' && path[3] <= '4') { + && path[3] >= '1' && path[3] <= '9') { /* - * May have match for 'com[1-4]:?', which is a serial port. + * May have match for 'com[1-9]:?', which is a serial port. */ if (path[4] == '\0') { @@ -247,9 +247,9 @@ ExtractWinRoot( } else if ((path[0] == 'l' || path[0] == 'L') && (path[1] == 'p' || path[1] == 'P') && (path[2] == 't' || path[2] == 'T')) { - if (path[3] >= '1' && path[3] <= '3') { + if (path[3] >= '1' && path[3] <= '9') { /* - * May have match for 'lpt[1-3]:?' + * May have match for 'lpt[1-9]:?' */ if (path[4] == '\0') { diff --git a/tests/winFCmd.test b/tests/winFCmd.test index ef1c4e7..f0cb406 100644 --- a/tests/winFCmd.test +++ b/tests/winFCmd.test @@ -1110,16 +1110,16 @@ test winFCmd-18.1.2 {Windows reserved path names} -constraints win -body { } -result "absolute" test winFCmd-18.1.3 {Windows reserved path names} -constraints win -body { - file pathtype com5 -} -result "relative" + file pathtype com9 +} -result "absolute" test winFCmd-18.1.4 {Windows reserved path names} -constraints win -body { file pathtype lpt3 } -result "absolute" test winFCmd-18.1.5 {Windows reserved path names} -constraints win -body { - file pathtype lpt4 -} -result "relative" + file pathtype lpt9 +} -result "absolute" test winFCmd-18.1.6 {Windows reserved path names} -constraints win -body { file pathtype nul @@ -1238,6 +1238,11 @@ test winFCmd-19.8 {Windows extended path names} -constraints nt -setup { catch {file delete $tmpfile} } -result [list 0 {} [list "tcl[pid].tmp "]] +test winFCmd-19.9 {Windows devices path names} -constraints nt -body { + file normalize //./com1 +} -result //./com1 + + # This block of code used to occur after the "return" call, so I'm # commenting it out and assuming that this code is still under construction. #foreach source {tef ted tnf tnd "" nul com1} { diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 7487022..76cd561 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -1246,9 +1246,9 @@ WinIsReserved( } else if ((path[0] == 'l' || path[0] == 'L') && (path[1] == 'p' || path[1] == 'P') && (path[2] == 't' || path[2] == 'T')) { - if (path[3] >= '1' && path[3] <= '3') { + if (path[3] >= '1' && path[3] <= '9') { /* - * May have match for 'lpt[1-3]:?' + * May have match for 'lpt[1-9]:?' */ if (path[4] == '\0') { -- cgit v0.12