diff options
author | dgp <dgp@users.sourceforge.net> | 2014-11-05 16:47:00 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2014-11-05 16:47:00 (GMT) |
commit | db0b450fcc8673487056f6292838cc14ffa54c5e (patch) | |
tree | 9e9241eb3ee147d3a71a3f33119ad7e4d3470cf7 /tests/ioTrans.test | |
parent | 304d9808e44bd74fecea7648fe2a17fc4db0a97b (diff) | |
download | tcl-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/ioTrans.test')
-rw-r--r-- | tests/ioTrans.test | 56 |
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) |