diff options
Diffstat (limited to 'tests/io.test')
| -rw-r--r-- | tests/io.test | 397 |
1 files changed, 394 insertions, 3 deletions
diff --git a/tests/io.test b/tests/io.test index 53fdaf7..c3e63cc 100644 --- a/tests/io.test +++ b/tests/io.test @@ -1445,6 +1445,105 @@ test io-12.5 {ReadChars: fileevents on partial characters} {stdio openpipe filee lappend x [catch {close $f} msg] $msg set x } "{} timeout {} timeout \u7266 {} eof 0 {}" +test io-12.6 {ReadChars: too many chars read} { + proc driver {cmd args} { + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [encoding convertto utf-8 \ + [string repeat \uBEEF 20][string repeat . 20]] + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + 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 + while {![eof $c]} { + read $c 15 + } + close $c +} {} +test io-12.7 {ReadChars: too many chars read [bc5b790099]} { + proc driver {cmd args} { + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [encoding convertto utf-8 \ + [string repeat \uBEEF 10]....\uBEEF] + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + 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 + while {![eof $c]} { + read $c 7 + } + close $c +} {} +test io-12.8 {ReadChars: multibyte chars split} { + set f [open $path(test1) w] + fconfigure $f -translation binary + puts -nonewline $f [string repeat a 9]\xc2\xa0 + close $f + set f [open $path(test1)] + fconfigure $f -encoding utf-8 -buffersize 10 + set in [read $f] + close $f + scan [string index $in end] %c +} 160 +test io-12.9 {ReadChars: multibyte chars split} { + set f [open $path(test1) w] + fconfigure $f -translation binary + puts -nonewline $f [string repeat a 9]\xc2 + close $f + set f [open $path(test1)] + fconfigure $f -encoding utf-8 -buffersize 10 + set in [read $f] + close $f + scan [string index $in end] %c +} 194 +test io-12.10 {ReadChars: multibyte chars split} { + set f [open $path(test1) w] + fconfigure $f -translation binary + puts -nonewline $f [string repeat a 9]\xc2 + close $f + set f [open $path(test1)] + fconfigure $f -encoding utf-8 -buffersize 11 + set in [read $f] + close $f + scan [string index $in end] %c +} 194 test io-13.1 {TranslateInputEOL: cr mode} {} { set f [open $path(test1) w] @@ -2786,7 +2885,7 @@ test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMa variable x running set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz proc writelots {s l} { - for {set i 0} {$i < 2000} {incr i} { + for {set i 0} {$i < 9000} {incr i} { puts $s $l } } @@ -2817,7 +2916,7 @@ test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMa close $ss vwait [namespace which -variable x] set c -} 2000 +} 9000 test io-29.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket tempNotMac fileevent} { # On Mac, this test screws up sockets such that subsequent tests using port 2828 # either cause errors or panic(). @@ -4019,7 +4118,7 @@ test io-32.11.1 {Tcl_Read from a pipe} {stdio openpipe} { } {{hello } {hello }} -test io-32.11.1 {Tcl_Read from a pipe} {stdio openpipe} { +test io-32.11.2 {Tcl_Read from a pipe} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {chan configure stdout -translation crlf} @@ -4233,6 +4332,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. @@ -4888,6 +5091,29 @@ test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio openpipe} { close $f1 set x } {{} 1 hello 0 {} 1} +test io-36.1.1 {Tcl_InputBlocked on nonblocking binary pipe} {stdio openpipe} { + set f1 [open "|[list [interpreter]]" r+] + chan configure $f1 -encoding binary -translation lf -eofchar {} + puts $f1 { + chan configure stdout -encoding binary -translation lf -eofchar {} + puts hello_from_pipe + } + flush $f1 + gets $f1 + fconfigure $f1 -blocking off -buffering full + puts $f1 {puts hello} + set x "" + lappend x [gets $f1] + lappend x [fblocked $f1] + flush $f1 + after 200 + lappend x [gets $f1] + lappend x [fblocked $f1] + lappend x [gets $f1] + lappend x [fblocked $f1] + close $f1 + set x +} {{} 1 hello 0 {} 1} test io-36.2 {Tcl_InputBlocked on blocking pipe} {stdio openpipe} { set f1 [open "|[list [interpreter]]" r+] fconfigure $f1 -buffering line @@ -7552,6 +7778,113 @@ test io-53.11 {Bug 2895565} -setup { removeFile in } -result {40 bytes copied} +# test io-53.12 not backported. Tests feature only in 8.6+ + +test io-53.13 {TclCopyChannel: read error reporting} -setup { + proc driver {cmd args} { + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + return {initialize finalize watch read} + } + finalize { + return + } + watch {} + read { + error FAIL + } + } + } + set outFile [makeFile {} out] +} -body { + set in [chan create read [namespace which driver]] + chan configure $in -translation binary + set out [open $outFile wb] + chan copy $in $out +} -cleanup { + catch {close $in} + catch {close $out} + removeFile out + rename driver {} +} -result {error reading "*": *} -returnCodes error -match glob +test io-53.14 {TclCopyChannel: write error reporting} -setup { + proc driver {cmd args} { + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + return {initialize finalize watch write} + } + finalize { + return + } + watch {} + write { + error FAIL + } + } + } + set inFile [makeFile {aaa} in] +} -body { + set in [open $inFile rb] + set out [chan create write [namespace which driver]] + chan configure $out -translation binary + chan copy $in $out +} -cleanup { + catch {close $in} + catch {close $out} + 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 # event loops when there is buffered data on the channel. @@ -8130,6 +8463,64 @@ test io-73.2 {channel Tcl_Obj SetChannelFromAny, bug 2407783} {} { list $code [string map [list $f @@] $msg] } {1 {can not find channel named "@@"}} +test io-73.3 {[5adc350683] [gets] after EOF} -setup { + set fn [makeFile {} io-73.3] + set rfd [open $fn r] + set wfd [open $fn a] + chan configure $wfd -buffering line + read $rfd +} -body { + set result [eof $rfd] + puts $wfd "more data" + lappend result [eof $rfd] + lappend result [gets $rfd] + lappend result [eof $rfd] + lappend result [gets $rfd] + lappend result [eof $rfd] +} -cleanup { + close $wfd + close $rfd + removeFile io-73.3 +} -result {1 1 {more data} 0 {} 1} + +test io-73.4 {[5adc350683] [read] after EOF} -setup { + set fn [makeFile {} io-73.4] + set rfd [open $fn r] + set wfd [open $fn a] + chan configure $wfd -buffering line + read $rfd +} -body { + set result [eof $rfd] + puts $wfd "more data" + lappend result [eof $rfd] + lappend result [read $rfd] + lappend result [eof $rfd] +} -cleanup { + close $wfd + close $rfd + removeFile io-73.4 +} -result {1 1 {more data +} 1} + +test io-73.5 {effect of eof on encoding end flags} -setup { + set fn [makeFile {} io-73.5] + set rfd [open $fn r] + set wfd [open $fn a] + chan configure $wfd -buffering none -translation binary + chan configure $rfd -buffersize 5 -encoding utf-8 + read $rfd +} -body { + set result [eof $rfd] + puts -nonewline $wfd "more\u00c2\u00a0data" + lappend result [eof $rfd] + lappend result [read $rfd] + lappend result [eof $rfd] +} -cleanup { + close $wfd + close $rfd + removeFile io-73.5 +} -result [list 1 1 more\u00a0data 1] + # ### ### ### ######### ######### ######### # cleanup |