summaryrefslogtreecommitdiffstats
path: root/tests/io.test
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2014-10-10 16:13:53 (GMT)
committerdgp <dgp@users.sourceforge.net>2014-10-10 16:13:53 (GMT)
commit56c0b11912d5ebb08b5693e3613b6981fa77913d (patch)
tree76e8415a83a9004874cad5113493c72a3a4c9e67 /tests/io.test
parent1a08ae6fb4393f0f6b2ecf48dce26cf697daedce (diff)
parent1df1505d690829ae6b10569aaefc7bf012de486b (diff)
downloadtcl-56c0b11912d5ebb08b5693e3613b6981fa77913d.zip
tcl-56c0b11912d5ebb08b5693e3613b6981fa77913d.tar.gz
tcl-56c0b11912d5ebb08b5693e3613b6981fa77913d.tar.bz2
New test io-53.15 for [ed29c4da21].
Diffstat (limited to 'tests/io.test')
-rw-r--r--tests/io.test44
1 files changed, 44 insertions, 0 deletions
diff --git a/tests/io.test b/tests/io.test
index a030200..b657999 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -7708,6 +7708,50 @@ test io-53.14 {TclCopyChannel: write error reporting} -setup {
removeFile in
rename driver {}
} -result {error writing "*": *} -returnCodes error -match glob
+test io-53.15 {[ed29c4da21] DoRead: fblocked seen as error} -setup {
+ proc driver {cmd args} {
+ variable buffer
+ variable index
+ variable blocked
+ set chan [lindex $args 0]
+ switch -- $cmd {
+ initialize {
+ set index($chan) 0
+ set buffer($chan) [encoding convertto utf-8 \
+ [string repeat a 100]]
+ set blocked($chan) 1
+ return {initialize finalize watch read}
+ }
+ finalize {
+ unset index($chan) buffer($chan) blocked($chan)
+ return
+ }
+ watch {}
+ read {
+ if {$blocked($chan)} {
+ set blocked($chan) [expr {!$blocked($chan)}]
+ return -code error EAGAIN
+ }
+ set n [lindex $args 1]
+ set new [expr {$index($chan) + $n}]
+ set result [string range $buffer($chan) $index($chan) $new-1]
+ set index($chan) $new
+ return $result
+ }
+ }
+ }
+ set c [chan create read [namespace which driver]]
+ chan configure $c -encoding utf-8
+ set out [makeFile {} out]
+ set outChan [open $out w]
+ chan configure $outChan -encoding utf-8
+} -body {
+ chan copy $c $outChan
+} -cleanup {
+ close $outChan
+ close $c
+ removeFile out
+} -result 100
test io-54.1 {Recursive channel events} {socket fileevent} {
# This test checks to see if file events are delivered during recursive