summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2014-10-17 15:20:34 (GMT)
committerdgp <dgp@users.sourceforge.net>2014-10-17 15:20:34 (GMT)
commit65acf25995e78db3c34b4cfd4998caf4edd4a5d8 (patch)
tree51ac3aae97c75ade5379471958a041a26e43d5a8 /tests
parent61bb4f72ffe5a564476a0d33e12ddc2fa4eea9c1 (diff)
downloadtcl-65acf25995e78db3c34b4cfd4998caf4edd4a5d8.zip
tcl-65acf25995e78db3c34b4cfd4998caf4edd4a5d8.tar.gz
tcl-65acf25995e78db3c34b4cfd4998caf4edd4a5d8.tar.bz2
[10dc6daa37] [gets] on a non-blocking channel must take care so that
1) At least one call to the channel driver input proc gets made. Failure to do this locks up the channel - catastrophic FAIL. 2) After any driver call reports BLOCKED, don't call again. This is less serious, but FAILs to respect the non-blocking setting. Code corrections and tests included, to restore 8.5.15 compat.
Diffstat (limited to 'tests')
-rw-r--r--tests/io.test68
1 files changed, 68 insertions, 0 deletions
diff --git a/tests/io.test b/tests/io.test
index 006b403..0d9468d 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -4299,6 +4299,74 @@ 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 {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 -blocking 0
+ list [gets $c] [gets $c] [gets $c] [gets $c]
+} -cleanup {
+ close $c
+ rename driver {}
+} -result {{} {} {} .......}
# Test Tcl_Seek and Tcl_Tell.