summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2014-11-05 16:47:00 (GMT)
committerdgp <dgp@users.sourceforge.net>2014-11-05 16:47:00 (GMT)
commitdb0b450fcc8673487056f6292838cc14ffa54c5e (patch)
tree9e9241eb3ee147d3a71a3f33119ad7e4d3470cf7 /tests
parent304d9808e44bd74fecea7648fe2a17fc4db0a97b (diff)
downloadtcl-db0b450fcc8673487056f6292838cc14ffa54c5e.zip
tcl-db0b450fcc8673487056f6292838cc14ffa54c5e.tar.gz
tcl-db0b450fcc8673487056f6292838cc14ffa54c5e.tar.bz2
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.
Diffstat (limited to 'tests')
-rw-r--r--tests/ioTrans.test56
1 files changed, 56 insertions, 0 deletions
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)