summaryrefslogtreecommitdiffstats
path: root/tests/iogt.test
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2016-06-16 16:27:01 (GMT)
committerdgp <dgp@users.sourceforge.net>2016-06-16 16:27:01 (GMT)
commit3cbd3b2bede59c6fd03330ac014e626a0a776522 (patch)
tree8e125264e32e68a389be074bfb8795cd212b9114 /tests/iogt.test
parent95fb48bf07be37ad0717475514d2c444602a0a6c (diff)
parent4fac9b8d0fb5648943635cf4c956c9518e610921 (diff)
downloadtcl-3cbd3b2bede59c6fd03330ac014e626a0a776522.zip
tcl-3cbd3b2bede59c6fd03330ac014e626a0a776522.tar.gz
tcl-3cbd3b2bede59c6fd03330ac014e626a0a776522.tar.bz2
Merge tip of core-8-6-branchbug_16828b3744
Diffstat (limited to 'tests/iogt.test')
-rw-r--r--tests/iogt.test183
1 files changed, 166 insertions, 17 deletions
diff --git a/tests/iogt.test b/tests/iogt.test
index d4c31d2..1ed89f7 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -220,6 +220,36 @@ proc id_fulltrail {var op data} {
return $res
}
+proc id_torture {chan op data} {
+ switch -- $op {
+ create/write -
+ create/read -
+ delete/write -
+ delete/read -
+ clear_read {;#ignore}
+ flush/write -
+ flush/read {}
+ write {
+ global level
+ if {$level} {
+ return
+ }
+ incr level
+ testchannel unstack $chan
+ testchannel transform $chan \
+ -command [namespace code [list id_torture $chan]]
+ return $data
+ }
+ read {
+ testchannel unstack $chan
+ testchannel transform $chan \
+ -command [namespace code [list id_torture $chan]]
+ return $data
+ }
+ query/maxRead {return -1}
+ }
+}
+
proc counter {var op data} {
namespace upvar [namespace current] $var n
@@ -280,7 +310,7 @@ proc counter_audit {var vtrail op data} {
}
proc rblocks {var vtrail n op data} {
- namespace upvar [namespace current] $var n $vtrail trail
+ namespace upvar [namespace current] $var buf $vtrail trail
set res {}
@@ -326,6 +356,11 @@ proc audit_ops {var -attach channel} {
proc audit_flow {var -attach channel} {
testchannel transform $channel -command [namespace code [list id_fulltrail $var]]
}
+
+proc torture {-attach channel} {
+ testchannel transform $channel -command [namespace code [list id_torture $channel]]
+}
+
proc stopafter {var n -attach channel} {
namespace upvar [namespace current] $var vn
set vn $n
@@ -445,6 +480,7 @@ query/maxRead
read
query/maxRead
flush/read
+query/maxRead
delete/read
--------
create/write
@@ -491,6 +527,7 @@ read {
}
query/maxRead {} -1
flush/read {} {}
+query/maxRead {} -1
delete/read {} *ignored*
--------
create/write {} *ignored*
@@ -542,15 +579,35 @@ write %^&*()_+-= %^&*()_+-=
write {
} {
}
+query/maxRead {} -1
delete/read {} *ignored*
flush/write {} {}
delete/write {} *ignored*}
+test iogt-2.4 {basic I/O, mixed trail} {testchannel} {
+ set fh [open $path(dummy) r]
+ torture -attach $fh
+ chan configure $fh -buffersize 2
+ set x [read $fh]
+ testchannel unstack $fh
+ close $fh
+ set x
+} {}
+test iogt-2.5 {basic I/O, mixed trail} {testchannel} {
+ set ::level 0
+ set fh [open $path(dummyout) w]
+ torture -attach $fh
+ puts -nonewline $fh abcdef
+ flush $fh
+ testchannel unstack $fh
+ close $fh
+} {}
+
test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} -setup {
proc DoneCopy {n {err {}}} {
variable copy 1
}
-} -constraints {testchannel hangs} -body {
+} -constraints {testchannel knownBug} -body {
# This test to check the validity of aquired Tcl_Channel references is not
# possible because even a backgrounded fcopy will immediately start to
# copy data, without waiting for the event loop. This is done only in case
@@ -561,6 +618,7 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} -setup {
# delay, causing the fcopy to underflow immediately.
set fin [open $path(dummy) r]
fevent 1000 500 {20 20 20 10 1 1} {
+ variable copy
close $fin
set fout [open dummyout w]
flush $sock; # now, or fcopy will error us out
@@ -594,23 +652,30 @@ test iogt-4.0 {fileevent readable, after transform} -setup {
proc Done {args} {
variable stop 1
}
-} -constraints {testchannel hangs} -body {
+ proc Get {sock} {
+ variable trail
+ variable got
+ if {[eof $sock]} {
+ Done
+ lappend trail "xxxxxxxxxxxxx"
+ close $sock
+ return
+ }
+ lappend trail "vvvvvvvvvvvvv"
+ lappend trail "\tgot: [lappend got "\[\[[read $sock]\]\]"]"
+ lappend trail "============="
+ #puts stdout $__ ; flush stdout
+ #read $sock
+ }
+
+} -constraints {testchannel knownBug} -body {
fevent 1000 500 {20 20 20 10 1} {
+ variable stop
audit_flow trail -attach $sock
rblocks_t rbuf trail 23 -attach $sock
- fileevent $sock readable [namespace code {
- if {[eof $sock]} {
- Done
- lappend trail "xxxxxxxxxxxxx"
- close $sock
- } else {
- lappend trail "vvvvvvvvvvvvv"
- lappend trail "\tgot: [lappend got "\[\[[read $sock]\]\]"]"
- lappend trail "============="
- #puts stdout $__; flush stdout
- #read $sock
- }
- }]
+
+ fileevent $sock readable [namespace code [list Get $sock]]
+
flush $sock; # Now, or fcopy will error us out
# But the 1 second delay should be enough to initialize everything
# else here.
@@ -619,6 +684,7 @@ test iogt-4.0 {fileevent readable, after transform} -setup {
join [list [join $got \n] ~~~~~~~~ [join $trail \n]] \n
} -cleanup {
rename Done {}
+ rename Get {}
} -result {[[]]
[[abcdefghijklmnopqrstuvw]]
[[xyz0123456789,./?><;'\|]]
@@ -706,7 +772,7 @@ test iogt-5.0 {EOF simulation} -setup {
set fin [open $path(dummy) r]
set fout [open $path(dummyout) w]
set trail [list]
-} -constraints {testchannel unknownFailure} -result {
+} -constraints {testchannel knownBug} -result {
audit_flow trail -attach $fin
stopafter_audit d trail 20 -attach $fin
audit_flow trail -attach $fout
@@ -785,6 +851,15 @@ test iogt-6.0 {Push back} -constraints testchannel -body {
close $f
} -result {xxx}
test iogt-6.1 {Push back and up} -constraints {testchannel knownBug} -body {
+
+ # This test demonstrates the bug/misfeature in the stacked
+ # channel implementation that data can be discarded if it is
+ # read into the buffers of one channel in the stack, and then
+ # that channel is popped before anything above it reads.
+ #
+ # This bug can be worked around by always setting -buffersize
+ # to 1, but who wants to do that?
+
set f [open $path(dummy) r]
# contents of dummy = "abcdefghi..."
read $f 3; # skip behind "abc"
@@ -796,6 +871,80 @@ test iogt-6.1 {Push back and up} -constraints {testchannel knownBug} -body {
close $f
} -result {xxxghi}
+
+# Driver for a base channel that emits several short "files"
+# with each terminated by a fleeting EOF
+ 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
+ }
+ }
+ }
+
+test iogt-7.0 {Handle fleeting EOF} -constraints {testchannel} -body {
+ set chan [chan create read [namespace which driver]]
+ identity -attach $chan
+ list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \
+ [read $chan] [eof $chan]
+} -cleanup {
+ close $chan
+} -result {0 ..... 1 {} 0 ..... 1}
+
+proc delay {op data} {
+ variable store
+ switch -- $op {
+ create/write - create/read -
+ delete/write - delete/read -
+ flush/write - write -
+ clear_read {;#ignore}
+ flush/read -
+ read {
+ if {![info exists store]} {set store {}}
+ set reply $store
+ set store $data
+ return $reply
+ }
+ query/maxRead {return -1}
+ }
+}
+
+test iogt-7.1 {Handle fleeting EOF} -constraints {testchannel} -body {
+ set chan [chan create read [namespace which driver]]
+ testchannel transform $chan -command [namespace code delay]
+ list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \
+ [read $chan] [eof $chan]
+} -cleanup {
+ close $chan
+} -result {0 ..... 1 {} 0 ..... 1}
+
+rename delay {}
+rename driver {}
+
# cleanup
foreach file [list dummy dummyout __echo_srv__.tcl] {
removeFile $file