diff options
Diffstat (limited to 'tests/ioCmd.test')
| -rw-r--r-- | tests/ioCmd.test | 220 |
1 files changed, 219 insertions, 1 deletions
diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 4c08229..3976d25 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -18,10 +18,13 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + # Custom constraints used in this file testConstraint fcopy [llength [info commands fcopy]] testConstraint testchannel [llength [info commands testchannel]] -testConstraint thread [expr {0 == [catch {package require Thread 2.6}]}] +testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}] #---------------------------------------------------------------------- @@ -790,6 +793,90 @@ test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match g rename foo {} set res } -result {{} {initialize rc* {read write}} 1 {*all required methods*} {}} +test iocmd-21.20 {Bug 88aef05cda} -setup { + proc foo {method chan args} { + switch -- $method blocking { + chan configure $chan -blocking [lindex $args 0] + return + } initialize { + return {initialize finalize watch blocking read write + configure cget cgetall} + } finalize { + return + } + } + set ch [chan create {read write} foo] +} -body { + list [catch {chan configure $ch -blocking 0} m] $m +} -cleanup { + close $ch + rename foo {} +} -match glob -result {1 {*nested eval*}} +test iocmd-21.21 {[close] in [read] segfaults} -setup { + proc foo {method chan args} { + switch -- $method initialize { + return {initialize finalize watch read} + } finalize {} watch {} read { + close $chan + return a + } + } + set ch [chan create read foo] +} -body { + read $ch 0 +} -cleanup { + close $ch + rename foo {} +} -result {} +test iocmd-21.22 {[close] in [read] segfaults} -setup { + proc foo {method chan args} { + switch -- $method initialize { + return {initialize finalize watch read} + } finalize {} watch {} read { + catch {close $chan} + return a + } + } + set ch [chan create read foo] +} -body { + read $ch 1 +} -returnCodes error -cleanup { + catch {close $ch} + rename foo {} +} -match glob -result {*invalid argument*} +test iocmd-21.23 {[close] in [gets] segfaults} -setup { + proc foo {method chan args} { + switch -- $method initialize { + return {initialize finalize watch read} + } finalize {} watch {} read { + catch {close $chan} + return \n + } + } + set ch [chan create read foo] +} -body { + gets $ch +} -cleanup { + catch {close $ch} + rename foo {} +} -result {} +test iocmd-21.24 {[close] in binary [gets] segfaults} -setup { + proc foo {method chan args} { + switch -- $method initialize { + return {initialize finalize watch read} + } finalize {} watch {} read { + catch {close $chan} + return \n + } + } + set ch [chan create read foo] +} -body { + chan configure $ch -translation binary + gets $ch +} -cleanup { + catch {close $ch} + rename foo {} +} -result {} # --- --- --- --------- --------- --------- # Helper commands to record the arguments to handler methods. @@ -1048,6 +1135,20 @@ test iocmd-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glo rename foo {} unset res } -result {{read rc* 4096} {} 0} +test iocmd-23.11 {chan read, close pulls the rug out} -match glob -body { + set res {} + proc foo {args} { + oninit; onfinal; track + set args [lassign $args sub id] + if {$sub ne "read"} {return} + close $id + return {} + } + set c [chan create {r} foo] + note [read $c] + rename foo {} + set res +} -result {{read rc* 4096} {}} # --- === *** ########################### # method write @@ -2575,6 +2676,7 @@ test iocmd.tf-24.15 {chan write, EAGAIN means that writing is not allowed at thi set res } -cleanup { proc foo {args} {onfinal; set ::done-24.15 1; return 3} + after 1000 {set ::done-24.15 2} vwait done-24.15 rename foo {} unset res @@ -2603,16 +2705,132 @@ test iocmd.tf-24.16 {chan write, note the background flush setup by close due to proc foo {args} { onfinal; note BG ; track ; set ::endbody-24.16 1} # Flush (sic!) the event-queue to capture the write from a # BG-flush. + after 1000 {set ::endbody-24.16 2} vwait endbody-24.16 set res } -cleanup { proc foo {args} {onfinal; set ::done-24.16 1; return 3} + after 1000 {set ::done-24.16 2} vwait done-24.16 rename foo {} unset res } -result {{write rc* ABC} {watch rc* write} {} BG {write rc* ABC}} \ -constraints {testchannel thread} +test iocmd.tf-24.17.bug3522560 {postevent for transfered channel} \ + -constraints {testchannel thread} -setup { + # This test exposes how the execution of postevent in the handler thread causes + # a crash if we are not properly injecting the events into the owning thread instead. + # With the injection the test will simply complete without crash. + + set beat 10000 + set drive 999 + set data ...---... + + proc LOG {text} { + #puts stderr "[thread::id]: $text" + return + } + + proc POST {hi} { + LOG "-> [info level 0]" + chan postevent $hi read + LOG "<- [info level 0]" + + set ::timer [after $::drive [info level 0]] + return + } + + proc HANDLER {op ch args} { + lappend ::res [lrange [info level 0] 1 end] + LOG "-> [info level 0]" + set ret {} + switch -glob -- $op { + init* {set ret {initialize finalize watch read}} + watch { + set l [lindex $args 0] + if {[llength $l]} { + set ::timer [after $::drive [list POST $ch]] + } else { + after cancel $::timer + } + } + finalize { + catch { after cancel $::timer } + after 500 {set ::forever now} + } + read { + set ret $::data + set ::data {} ; # Next is EOF. + } + } + LOG "<- [info level 0] : $ret" + return $ret + } +} -body { + LOG BEGIN + set ch [chan create {read} HANDLER] + + set tid [thread::create { + proc LOG {text} { + #puts stderr "\t\t\t\t\t\t[thread::id]: $text" + return + } + LOG THREAD-STARTED + load {} Tcltest + proc bgerror s { + LOG BGERROR:$s + } + vwait forever + LOG THREAD-DONE + }] + + testchannel cut $ch + thread::send $tid [list set thech $ch] + thread::send $tid [list set beat $beat] + thread::send -async $tid { + LOG SPLICE-BEG + testchannel splice $thech + LOG SPLICE-END + proc PROCESS {ch} { + LOG "-> [info level 0]" + if {[eof $ch]} { + close $ch + set ::done 1 + set c <<EOF>> + } else { + set c [read $ch 1] + } + LOG "GOTCHAR: $c" + LOG "<- [info level 0]" + } + LOG THREAD-FILEEVENT + fconfigure $thech -translation binary -blocking 0 + fileevent $thech readable [list PROCESS $thech] + LOG THREAD-NOEVENT-LOOP + set done 0 + while {!$done} { + after $beat + LOG THREAD-HEARTBEAT + update + } + LOG THREAD-LOOP-DONE + thread::exit + } + + LOG MAIN_WAITING + vwait forever + LOG MAIN_DONE + + set res +} -cleanup { + rename LOG {} + rename POST {} + rename HANDLER {} + unset beat drive data forever res tid ch +} -match glob \ + -result {{initialize rc* read} {watch rc* read} {read rc* 4096} {watch rc* {}} {watch rc* read} {read rc* 4096} {watch rc* {}} {finalize rc*}} + # --- === *** ########################### # method cgetall |