# This file contains a collection of tests for the Tcl built-in 'chan' # command. Sourcing this file into Tcl runs the tests and generates # output for errors. No output means no errors were found. # # Copyright © 2005 Donal K. Fellows # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } source [file join [file dirname [info script]] tcltests.tcl] package require tcltests # # Note: The tests for the chan methods "create" and "postevent" # currently reside in the file "ioCmd.test". # test chan-1.1 {chan command general syntax} -body { chan } -returnCodes error -result "wrong # args: should be \"chan subcommand ?arg ...?\"" test chan-1.2 {chan command general syntax} -body { chan FOOBAR } -returnCodes error -match glob -result "unknown or ambiguous subcommand \"FOOBAR\": must be *" test chan-2.1 {chan command: blocked subcommand} -body { chan blocked foo bar } -returnCodes error -result "wrong # args: should be \"chan blocked channelId\"" test chan-3.1 {chan command: close subcommand} -body { chan close foo bar zet } -returnCodes error -result "wrong # args: should be \"chan close channelId ?direction?\"" test chan-3.2 {chan command: close subcommand} -setup { set chan [open [info script] r] } -body { chan close $chan bar } -cleanup { close $chan } -returnCodes error -result "bad direction \"bar\": must be read or write" test chan-3.3 {chan command: close subcommand} -setup { set chan [open [info script] r] } -body { chan close $chan write } -cleanup { close $chan } -returnCodes error -result "Half-close of write-side not possible, side not opened or already closed" test chan-4.1 {chan command: configure subcommand} -body { chan configure } -returnCodes error -result "wrong # args: should be \"chan configure channelId ?-option value ...?\"" test chan-4.2 {chan command: [Bug 800753]} -body { chan configure stdout -eofchar Ā } -returnCodes error -result {bad value for -eofchar: must be non-NUL ASCII character} test chan-4.3 {chan command: [Bug 800753]} -body { chan configure stdout -eofchar \x00 } -returnCodes error -result {bad value for -eofchar: must be non-NUL ASCII character} test chan-4.4 {chan command: check valid inValue, no outValue} -constraints deprecated -body { chan configure stdout -eofchar [list \x27 {}] } -result {} test chan-4.5 {chan command: check valid inValue, invalid outValue} -body { chan configure stdout -eofchar [list \x27 \x80] } -returnCodes error -result {bad value for -eofchar: must be non-NUL ASCII character} test chan-4.6 {chan command: check no inValue, valid outValue} -body { chan configure stdout -eofchar [list {} \x27] } -returnCodes error -result {bad value for -eofchar: must be non-NUL ASCII character} -cleanup {chan configure stdout -eofchar {}} test chan-5.1 {chan command: copy subcommand} -body { chan copy foo } -returnCodes error -result "wrong # args: should be \"chan copy input output ?-size size? ?-command callback?\"" test chan-6.1 {chan command: eof subcommand} -body { chan eof foo bar } -returnCodes error -result "wrong # args: should be \"chan eof channelId\"" test chan-7.1 {chan command: event subcommand} -body { chan event foo } -returnCodes error -result "wrong # args: should be \"chan event channelId event ?script?\"" test chan-8.1 {chan command: flush subcommand} -body { chan flush foo bar } -returnCodes error -result "wrong # args: should be \"chan flush channelId\"" test chan-9.1 {chan command: gets subcommand} -body { chan gets } -returnCodes error -result "wrong # args: should be \"chan gets channelId ?varName?\"" test chan-10.1 {chan command: names subcommand} -body { chan names foo bar } -returnCodes error -result "wrong # args: should be \"chan names ?pattern?\"" test chan-11.1 {chan command: puts subcommand} -body { chan puts foo bar foo bar } -returnCodes error -result "wrong # args: should be \"chan puts ?-nonewline? ?channelId? string\"" test chan-12.1 {chan command: read subcommand} -body { chan read } -returnCodes error -result "wrong # args: should be \"chan read channelId ?numChars?\" or \"chan read ?-nonewline? channelId\"" test chan-13.1 {chan command: seek subcommand} -body { chan seek foo bar foo bar } -returnCodes error -result "wrong # args: should be \"chan seek channelId offset ?origin?\"" test chan-14.1 {chan command: tell subcommand} -body { chan tell foo bar } -returnCodes error -result "wrong # args: should be \"chan tell channelId\"" test chan-15.1 {chan command: truncate subcommand} -body { chan truncate foo bar foo bar } -returnCodes error -result "wrong \# args: should be \"chan truncate channelId ?length?\"" test chan-15.2 {chan command: truncate subcommand} -setup { set file [makeFile {} testTruncate] set f [open $file w+] fconfigure $f -translation binary } -body { seek $f 0 puts -nonewline $f 12345 seek $f 0 chan truncate $f 2 read $f } -result 12 -cleanup { catch {close $f} catch {removeFile $file} } # TIP 287: chan pending test chan-16.1 {chan command: pending subcommand} -body { chan pending } -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\"" test chan-16.2 {chan command: pending subcommand} -body { chan pending stdin } -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\"" test chan-16.3 {chan command: pending subcommand} -body { chan pending stdin stdout stderr } -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\"" test chan-16.4 {chan command: pending subcommand} -body { chan pending {input output} stdout } -returnCodes error -result "bad mode \"input output\": must be input or output" test chan-16.5 {chan command: pending input subcommand} -body { chan pending input stdout } -result -1 test chan-16.6 {chan command: pending input subcommand} -body { chan pending input stdin } -result 0 test chan-16.7 {chan command: pending input subcommand} -body { chan pending input FOOBAR } -returnCodes error -result "can not find channel named \"FOOBAR\"" test chan-16.8 {chan command: pending input subcommand} -setup { set file [makeFile {} testAvailable] set f [open $file w+] chan configure $f -translation lf -buffering line } -body { chan puts $f foo chan puts $f bar chan puts $f baz chan seek $f 0 chan gets $f chan pending input $f } -result 8 -cleanup { catch {chan close $f} catch {removeFile $file} } test chan-16.9 {chan command: pending input subcommand} -setup { proc chan-16.9-accept {sock addr port} { chan configure $sock -blocking 0 -buffering line -buffersize 32 chan event $sock readable [list chan-16.9-readable $sock] } proc chan-16.9-readable {sock} { set r [chan gets $sock line] set l [string length $line] set e [chan eof $sock] set b [chan blocked $sock] set i [chan pending input $sock] lappend ::chan-16.9-data $r $l $e $b $i if {$r >= 0 || $e || $l || !$b || $i > 128} { set data [read $sock $i] lappend ::chan-16.9-data [string range $data 0 2] lappend ::chan-16.9-data [string range $data end-2 end] set ::chan-16.9-done 1 chan event $sock readable {} } else { after idle chan-16.9-client } } proc chan-16.9-client {} { chan puts -nonewline $::client ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890 chan flush $::client } set ::server [socket -server chan-16.9-accept -myaddr 127.0.0.1 0] set ::client [socket 127.0.0.1 [lindex [fconfigure $::server -sockname] 2]] set ::chan-16.9-data [list] set ::chan-16.9-done 0 } -body { after idle chan-16.9-client vwait ::chan-16.9-done set ::chan-16.9-data } -result {-1 0 0 1 36 -1 0 0 1 72 -1 0 0 1 108 -1 0 0 1 144 ABC 890} -cleanup { catch {chan close $client} catch {chan close $server} rename chan-16.9-accept {} rename chan-16.9-readable {} rename chan-16.9-client {} unset -nocomplain ::chan-16.9-data unset -nocomplain ::chan-16.9-done unset -nocomplain ::server unset -nocomplain ::client } test chan-16.10 {chan command: pending output subcommand} -body { chan pending output stdin } -result -1 test chan-16.11 {chan command: pending output subcommand} -body { chan pending output stdout } -result 0 test chan-16.12 {chan command: pending output subcommand} -body { chan pending output FOOBAR } -returnCodes error -result "can not find channel named \"FOOBAR\"" test chan-16.13 {chan command: pending output subcommand} -setup { set file [makeFile {} testPendingOutput] set f [open $file w+] chan configure $f -translation lf -buffering full -buffersize 1024 } -body { set result [list] chan puts $f [string repeat x 512] lappend result [chan pending output $f] chan flush $f lappend result [chan pending output $f] } -result [list 513 0] -cleanup { unset -nocomplain result catch {chan close $f} catch {removeFile $file} } # TIP 304: chan pipe test chan-17.1 {chan command: pipe subcommand} -body { chan pipe foo } -returnCodes error -result "wrong # args: should be \"chan pipe \"" test chan-17.2 {chan command: pipe subcommand} -body { chan pipe foo bar } -returnCodes error -result "wrong # args: should be \"chan pipe \"" test chan-17.3 {chan command: pipe subcommand} -body { set l [chan pipe] foreach {pr pw} $l break list [llength $l] [fconfigure $pr -blocking] [fconfigure $pw -blocking] } -result [list 2 1 1] -cleanup { close $pw close $pr } test chan-17.4 {chan command: pipe subcommand} -body { set ::done 0 foreach {::pr ::pw} [chan pipe] break after 100 {puts $::pw foo;flush $::pw} fileevent $::pr readable {set ::done 1} after 500 {set ::done -1} vwait ::done set out nope if {$::done==1} {gets $::pr out} list $::done $out } -result [list 1 foo] -cleanup { close $::pw close $::pr } cleanupTests return # Local Variables: # mode: tcl # End: