1# This file contains a collection of tests for the Tcl built-in 'chan' 2# command. Sourcing this file into Tcl runs the tests and generates 3# output for errors. No output means no errors were found. 4# 5# Copyright © 2005 Donal K. Fellows 6# 7# See the file "license.terms" for information on usage and redistribution 8# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 9 10if {"::tcltest" ni [namespace children]} { 11 package require tcltest 2.5 12 namespace import -force ::tcltest::* 13} 14 15# 16# Note: The tests for the chan methods "create" and "postevent" 17# currently reside in the file "ioCmd.test". 18# 19 20test chan-1.1 {chan command general syntax} -body { 21 chan 22} -returnCodes error -result "wrong # args: should be \"chan subcommand ?arg ...?\"" 23test chan-1.2 {chan command general syntax} -body { 24 chan FOOBAR 25} -returnCodes error -match glob -result "unknown or ambiguous subcommand \"FOOBAR\": must be *" 26 27test chan-2.1 {chan command: blocked subcommand} -body { 28 chan blocked foo bar 29} -returnCodes error -result "wrong # args: should be \"chan blocked channelId\"" 30test chan-3.1 {chan command: close subcommand} -body { 31 chan close foo bar zet 32} -returnCodes error -result "wrong # args: should be \"chan close channelId ?direction?\"" 33test chan-3.2 {chan command: close subcommand} -setup { 34 set chan [open [info script] r] 35} -body { 36 chan close $chan bar 37} -cleanup { 38 close $chan 39} -returnCodes error -result "bad direction \"bar\": must be read or write" 40test chan-3.3 {chan command: close subcommand} -setup { 41 set chan [open [info script] r] 42} -body { 43 chan close $chan write 44} -cleanup { 45 close $chan 46} -returnCodes error -result "Half-close of write-side not possible, side not opened or already closed" 47test chan-4.1 {chan command: configure subcommand} -body { 48 chan configure 49} -returnCodes error -result "wrong # args: should be \"chan configure channelId ?-option value ...?\"" 50test chan-4.2 {chan command: [Bug 800753]} -body { 51 chan configure stdout -eofchar Ā 52} -returnCodes error -match glob -result {bad value*} 53test chan-4.3 {chan command: [Bug 800753]} -body { 54 chan configure stdout -eofchar \x00 55} -returnCodes error -match glob -result {bad value*} 56test chan-4.4 {chan command: check valid inValue, no outValue} -body { 57 chan configure stdout -eofchar [list \x27 {}] 58} -returnCodes ok -result {} 59test chan-4.5 {chan command: check valid inValue, invalid outValue} -body { 60 chan configure stdout -eofchar [list \x27 \x80] 61} -returnCodes error -match glob -result {bad value for -eofchar:*} 62test chan-4.6 {chan command: check no inValue, valid outValue} -body { 63 chan configure stdout -eofchar [list {} \x27] 64} -returnCodes ok -result {} -cleanup {chan configure stdout -eofchar [list {} {}]} 65 66test chan-5.1 {chan command: copy subcommand} -body { 67 chan copy foo 68} -returnCodes error -result "wrong # args: should be \"chan copy input output ?-size size? ?-command callback?\"" 69 70test chan-6.1 {chan command: eof subcommand} -body { 71 chan eof foo bar 72} -returnCodes error -result "wrong # args: should be \"chan eof channelId\"" 73 74test chan-7.1 {chan command: event subcommand} -body { 75 chan event foo 76} -returnCodes error -result "wrong # args: should be \"chan event channelId event ?script?\"" 77 78test chan-8.1 {chan command: flush subcommand} -body { 79 chan flush foo bar 80} -returnCodes error -result "wrong # args: should be \"chan flush channelId\"" 81 82test chan-9.1 {chan command: gets subcommand} -body { 83 chan gets 84} -returnCodes error -result "wrong # args: should be \"chan gets channelId ?varName?\"" 85 86test chan-10.1 {chan command: names subcommand} -body { 87 chan names foo bar 88} -returnCodes error -result "wrong # args: should be \"chan names ?pattern?\"" 89 90test chan-11.1 {chan command: puts subcommand} -body { 91 chan puts foo bar foo bar 92} -returnCodes error -result "wrong # args: should be \"chan puts ?-nonewline? ?channelId? string\"" 93 94test chan-12.1 {chan command: read subcommand} -body { 95 chan read 96} -returnCodes error -result "wrong # args: should be \"chan read channelId ?numChars?\" or \"chan read ?-nonewline? channelId\"" 97 98test chan-13.1 {chan command: seek subcommand} -body { 99 chan seek foo bar foo bar 100} -returnCodes error -result "wrong # args: should be \"chan seek channelId offset ?origin?\"" 101 102test chan-14.1 {chan command: tell subcommand} -body { 103 chan tell foo bar 104} -returnCodes error -result "wrong # args: should be \"chan tell channelId\"" 105 106test chan-15.1 {chan command: truncate subcommand} -body { 107 chan truncate foo bar foo bar 108} -returnCodes error -result "wrong \# args: should be \"chan truncate channelId ?length?\"" 109test chan-15.2 {chan command: truncate subcommand} -setup { 110 set file [makeFile {} testTruncate] 111 set f [open $file w+] 112 fconfigure $f -translation binary 113} -body { 114 seek $f 0 115 puts -nonewline $f 12345 116 seek $f 0 117 chan truncate $f 2 118 read $f 119} -result 12 -cleanup { 120 catch {close $f} 121 catch {removeFile $file} 122} 123 124# TIP 287: chan pending 125test chan-16.1 {chan command: pending subcommand} -body { 126 chan pending 127} -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\"" 128test chan-16.2 {chan command: pending subcommand} -body { 129 chan pending stdin 130} -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\"" 131test chan-16.3 {chan command: pending subcommand} -body { 132 chan pending stdin stdout stderr 133} -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\"" 134test chan-16.4 {chan command: pending subcommand} -body { 135 chan pending {input output} stdout 136} -returnCodes error -result "bad mode \"input output\": must be input or output" 137test chan-16.5 {chan command: pending input subcommand} -body { 138 chan pending input stdout 139} -result -1 140test chan-16.6 {chan command: pending input subcommand} -body { 141 chan pending input stdin 142} -result 0 143test chan-16.7 {chan command: pending input subcommand} -body { 144 chan pending input FOOBAR 145} -returnCodes error -result "can not find channel named \"FOOBAR\"" 146test chan-16.8 {chan command: pending input subcommand} -setup { 147 set file [makeFile {} testAvailable] 148 set f [open $file w+] 149 chan configure $f -translation lf -buffering line 150} -body { 151 chan puts $f foo 152 chan puts $f bar 153 chan puts $f baz 154 chan seek $f 0 155 chan gets $f 156 chan pending input $f 157} -result 8 -cleanup { 158 catch {chan close $f} 159 catch {removeFile $file} 160} 161test chan-16.9 {chan command: pending input subcommand} -setup { 162 proc chan-16.9-accept {sock addr port} { 163 chan configure $sock -blocking 0 -buffering line -buffersize 32 164 chan event $sock readable [list chan-16.9-readable $sock] 165 } 166 167 proc chan-16.9-readable {sock} { 168 set r [chan gets $sock line] 169 set l [string length $line] 170 set e [chan eof $sock] 171 set b [chan blocked $sock] 172 set i [chan pending input $sock] 173 174 lappend ::chan-16.9-data $r $l $e $b $i 175 176 if {$r >= 0 || $e || $l || !$b || $i > 128} { 177 set data [read $sock $i] 178 lappend ::chan-16.9-data [string range $data 0 2] 179 lappend ::chan-16.9-data [string range $data end-2 end] 180 set ::chan-16.9-done 1 181 chan event $sock readable {} 182 } else { 183 after idle chan-16.9-client 184 } 185 } 186 187 proc chan-16.9-client {} { 188 chan puts -nonewline $::client ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890 189 chan flush $::client 190 } 191 192 set ::server [socket -server chan-16.9-accept -myaddr 127.0.0.1 0] 193 set ::client [socket 127.0.0.1 [lindex [fconfigure $::server -sockname] 2]] 194 set ::chan-16.9-data [list] 195 set ::chan-16.9-done 0 196} -body { 197 after idle chan-16.9-client 198 vwait ::chan-16.9-done 199 set ::chan-16.9-data 200} -result {-1 0 0 1 36 -1 0 0 1 72 -1 0 0 1 108 -1 0 0 1 144 ABC 890} -cleanup { 201 catch {chan close $client} 202 catch {chan close $server} 203 rename chan-16.9-accept {} 204 rename chan-16.9-readable {} 205 rename chan-16.9-client {} 206 unset -nocomplain ::chan-16.9-data 207 unset -nocomplain ::chan-16.9-done 208 unset -nocomplain ::server 209 unset -nocomplain ::client 210} 211test chan-16.10 {chan command: pending output subcommand} -body { 212 chan pending output stdin 213} -result -1 214test chan-16.11 {chan command: pending output subcommand} -body { 215 chan pending output stdout 216} -result 0 217test chan-16.12 {chan command: pending output subcommand} -body { 218 chan pending output FOOBAR 219} -returnCodes error -result "can not find channel named \"FOOBAR\"" 220test chan-16.13 {chan command: pending output subcommand} -setup { 221 set file [makeFile {} testPendingOutput] 222 set f [open $file w+] 223 chan configure $f -translation lf -buffering full -buffersize 1024 224} -body { 225 set result [list] 226 chan puts $f [string repeat x 512] 227 lappend result [chan pending output $f] 228 chan flush $f 229 lappend result [chan pending output $f] 230} -result [list 513 0] -cleanup { 231 unset -nocomplain result 232 catch {chan close $f} 233 catch {removeFile $file} 234} 235 236# TIP 304: chan pipe 237 238test chan-17.1 {chan command: pipe subcommand} -body { 239 chan pipe foo 240} -returnCodes error -result "wrong # args: should be \"chan pipe \"" 241 242test chan-17.2 {chan command: pipe subcommand} -body { 243 chan pipe foo bar 244} -returnCodes error -result "wrong # args: should be \"chan pipe \"" 245 246test chan-17.3 {chan command: pipe subcommand} -body { 247 set l [chan pipe] 248 foreach {pr pw} $l break 249 list [llength $l] [fconfigure $pr -blocking] [fconfigure $pw -blocking] 250} -result [list 2 1 1] -cleanup { 251 close $pw 252 close $pr 253} 254 255test chan-17.4 {chan command: pipe subcommand} -body { 256 set ::done 0 257 foreach {::pr ::pw} [chan pipe] break 258 after 100 {puts $::pw foo;flush $::pw} 259 fileevent $::pr readable {set ::done 1} 260 after 500 {set ::done -1} 261 vwait ::done 262 set out nope 263 if {$::done==1} {gets $::pr out} 264 list $::done $out 265} -result [list 1 foo] -cleanup { 266 close $::pw 267 close $::pr 268} 269 270cleanupTests 271return 272 273# Local Variables: 274# mode: tcl 275# End: 276