1 # This file contains a collection of tests for the procedures in the file
2 # tclEvent.c, which includes the "update", and "vwait" Tcl
3 # commands. Sourcing this file into Tcl runs the tests and generates
4 # output for errors. No output means no errors were found.
6 # Copyright (c) 1995-1997 Sun Microsystems, Inc.
7 # Copyright (c) 1998-1999 by Scriptics Corporation.
9 # See the file "license.terms" for information on usage and redistribution
10 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 source [file dirname [info script]]/testing.tcl
14 needs cmd after eventloop
15 testConstraint socket [expr {[info commands socket] ne ""}]
16 testConstraint exec [expr {[info commands exec] ne ""}]
17 testConstraint signal [expr {[info commands signal] ne ""}]
18 catch {[socket -ipv6 stream ::1:5000]} ipv6res
19 testConstraint ipv6 [expr {$ipv6res ne "ipv6 not supported"}]
21 test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} jim {
22 catch {rename bgerror {}}
26 after idle {error "a simple error"}
27 after idle {open non_existent}
28 after idle {set errorInfo foobar; set errorCode xyzzy}
33 } {{a simple error} {non_existent: No such file or directory}}
35 test event-7.1 {bgerror / regular} {
46 test event-7.2 {bgerror / accumulation} {
59 test event-7.3 {bgerror / accumulation / break} {
64 return -code break "skip!";
73 # end of bgerror tests
74 catch {rename bgerror {}}
77 test event-10.1 {Tcl_Exit procedure} exec {
78 set cmd [list exec [info nameofexecutable] "<<exit 3"]
79 list [catch $cmd msg] [lindex $errorCode 0] \
83 test event-11.1 {Tcl_VwaitCmd procedure} {
84 list [catch {vwait} msg] $msg
85 } {1 {wrong # args: should be "vwait name"}}
86 test event-11.2 {Tcl_VwaitCmd procedure} {
87 list [catch {vwait a b} msg] $msg
88 } {1 {wrong # args: should be "vwait name"}}
89 test event-11.3 {Tcl_VwaitCmd procedure} jim {
92 list [catch {vwait x(1)} msg] $msg
93 } {1 {can't read "x(1)": variable isn't array}}
94 test event-11.4 {Tcl_VwaitCmd procedure} {
95 foreach i [after info] {
98 after 10; update; # On Mac make sure update won't take long
99 after 100 {set x x-done}
100 after 200 {set y y-done}
101 after 300 {set z z-done}
102 after idle {set q q-done}
107 list [vwait y] $x $y $z $q
108 } {{} x-done y-done before q-done}
110 foreach i [after info] {
114 test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {jim socket} {
115 set f1 [open test1 w]
116 proc accept {s args} {
120 set s1 [socket stream.server 5001]
122 set s2 [socket stream 127.0.0.1:5001]
127 fileevent $s2 writable { incr z }
129 fileevent $f1 writable { incr x; if { $y == 3 } { set z done } }
130 fileevent $s2 writable { incr y; if { $x == 3 } { set z done } }
134 file delete test1 test2
138 # Note: This one doesn't really require socket, but mingw32 doesn't have socket and
139 # also doesn't allow file events (select) on non-sockets
140 test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {socket} {
141 file delete test1 test2
142 set f1 [open test1 w]
143 set f2 [open test2 w]
148 fileevent $f1 writable { incr x; if { $y == 3 } { set z done } }
149 fileevent $f2 writable { incr y; if { $x == 3 } { set z done } }
153 file delete test1 test2
157 test event-12.1 {Tcl_UpdateCmd procedure} {
158 list [catch {update a b} msg] $msg
159 } {1 {wrong # args: should be "update ?idletasks?"}}
160 test event-12.3 {Tcl_UpdateCmd procedure} {
161 foreach i [after info] {
164 after 500 {set x after}
165 after idle {set y after}
166 after idle {set z "after, y = $y"}
172 } {before after {after, y = after}}
173 test event-12.4 {Tcl_UpdateCmd procedure} {
174 foreach i [after info] {
177 after 10; update; # On Mac make sure update won't take long
178 after 200 {set x x-done}
179 after 400 {set y y-done}
180 after idle {set z z-done}
187 } {x-done before z-done}
190 foreach i [after info] {
194 test event-13.1 "vwait/signal" signal {
196 list [catch -signal {
198 # This is just to prevent the vwait from exiting immediately
199 stdin readable { format test }
205 test event-14.1 {socket stream.server client address} {jim socket} {
206 set s1 [socket stream.server 5001]
208 set s2 [socket stream 127.0.0.1:5001]
216 # Return client address without the port.
217 list [lindex [split $addr :] 0]
220 test event-14.2 {IPv6 socket stream.server client address} {jim socket ipv6} {
221 set s1 [socket -ipv6 stream.server ::1:5001]
223 set s2 [socket -ipv6 stream ::1:5001]
231 # Return client IPv6 address without the port.
232 list [join [lrange [split $addr6 :] 0 end-1] :]