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