diff options
| author | dgp <dgp@users.sourceforge.net> | 2014-10-18 20:03:08 (GMT) |
|---|---|---|
| committer | dgp <dgp@users.sourceforge.net> | 2014-10-18 20:03:08 (GMT) |
| commit | fe445f7962f05b59609189e8ec30cb508705ca37 (patch) | |
| tree | 8794e2066f0ad9b1ea74a3ea72aeb9f3469259ef /tests | |
| parent | fc47c8aae5f8c68455ee588cfbe4f707e91bde7d (diff) | |
| parent | b15488bf6e8d9be3ad5143e3f97d952f33938a83 (diff) | |
| download | tcl-fe445f7962f05b59609189e8ec30cb508705ca37.zip tcl-fe445f7962f05b59609189e8ec30cb508705ca37.tar.gz tcl-fe445f7962f05b59609189e8ec30cb508705ca37.tar.bz2 | |
[10dc6daa37] New fix for [gets] on non-blocking channel. This time properly accounts for the effects of ENCODING_LINESIZE.
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/io.test | 104 |
1 files changed, 104 insertions, 0 deletions
diff --git a/tests/io.test b/tests/io.test index d9a5167..33f91bd 100644 --- a/tests/io.test +++ b/tests/io.test @@ -4325,6 +4325,110 @@ test io-33.10 {Tcl_Gets, exercising double buffering} { close $f set y } 300 +test io-33.11 {TclGetsObjBinary, [10dc6daa37]} -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 { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] + if {$n > 3} {set n 3} + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } + } +} -body { + set c [chan create read [namespace which driver]] + chan configure $c -translation binary -blocking 0 + list [gets $c] [gets $c] [gets $c] [gets $c] +} -cleanup { + close $c + rename driver {} +} -result {{} {} {} .......} +test io-33.12 {Tcl_GetsObj, [10dc6daa37]} -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 { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] + if {$n > 3} {set n 3} + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } + } +} -body { + set c [chan create read [namespace which driver]] + chan configure $c -blocking 0 + list [gets $c] [gets $c] [gets $c] [gets $c] +} -cleanup { + close $c + rename driver {} +} -result {{} {} {} .......} +test io-33.13 {Tcl_GetsObj, [10dc6daa37]} -setup { + proc driver {cmd args} { + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [string repeat \ + [string repeat . 64]\n[string repeat . 25] 2] + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] + if {$n > 65} {set n 65} + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } + } +} -body { + set c [chan create read [namespace which driver]] + chan configure $c -blocking 0 + list [gets $c] [gets $c] [gets $c] [gets $c] [gets $c] +} -cleanup { + close $c + rename driver {} +} -result [list [string repeat . 64] {} [string repeat . 89] \ + [string repeat . 25] {}] # Test Tcl_Seek and Tcl_Tell. |