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 ""}]
19 test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} jim {
20 catch {rename bgerror {}}
24 after idle {error "a simple error"}
25 after idle {open non_existent}
26 after idle {set errorInfo foobar; set errorCode xyzzy}
31 } {{a simple error} {non_existent: No such file or directory}}
33 test event-7.1 {bgerror / regular} {
44 test event-7.2 {bgerror / accumulation} {
57 test event-7.3 {bgerror / accumulation / break} {
62 return -code break "skip!";
71 # end of bgerror tests
72 catch {rename bgerror {}}
75 test event-10.1 {Tcl_Exit procedure} exec {
76 set cmd [list exec [info nameofexecutable] "<<exit 3"]
77 list [catch $cmd msg] [lindex $errorCode 0] \
81 test event-11.1 {Tcl_VwaitCmd procedure} {
82 list [catch {vwait} msg] $msg
83 } {1 {wrong # args: should be "vwait name"}}
84 test event-11.2 {Tcl_VwaitCmd procedure} {
85 list [catch {vwait a b} msg] $msg
86 } {1 {wrong # args: should be "vwait name"}}
87 test event-11.3 {Tcl_VwaitCmd procedure} jim {
90 list [catch {vwait x(1)} msg] $msg
91 } {1 {can't read "x(1)": variable isn't array}}
92 test event-11.4 {Tcl_VwaitCmd procedure} {
93 foreach i [after info] {
96 after 10; update; # On Mac make sure update won't take long
97 after 100 {set x x-done}
98 after 200 {set y y-done}
99 after 300 {set z z-done}
100 after idle {set q q-done}
105 list [vwait y] $x $y $z $q
106 } {{} x-done y-done before q-done}
108 foreach i [after info] {
112 test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {jim socket} {
113 set f1 [open test1 w]
114 proc accept {s args} {
118 set s1 [socket stream.server 5001]
120 set s2 [socket stream 127.0.0.1:5001]
125 fileevent $s2 writable { incr z }
127 fileevent $f1 writable { incr x; if { $y == 3 } { set z done } }
128 fileevent $s2 writable { incr y; if { $x == 3 } { set z done } }
132 file delete test1 test2
136 # Note: This one doesn't really require socket, but mingw32 doesn't have socket and
137 # also doesn't allow file events (select) on non-sockets
138 test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {socket} {
139 file delete test1 test2
140 set f1 [open test1 w]
141 set f2 [open test2 w]
146 fileevent $f1 writable { incr x; if { $y == 3 } { set z done } }
147 fileevent $f2 writable { incr y; if { $x == 3 } { set z done } }
151 file delete test1 test2
156 test event-12.1 {Tcl_UpdateCmd procedure} {
157 list [catch {update a b} msg] $msg
158 } {1 {wrong # args: should be "update ?idletasks?"}}
159 test event-12.3 {Tcl_UpdateCmd procedure} {
160 foreach i [after info] {
163 after 500 {set x after}
164 after idle {set y after}
165 after idle {set z "after, y = $y"}
171 } {before after {after, y = after}}
172 test event-12.4 {Tcl_UpdateCmd procedure} {
173 foreach i [after info] {
176 after 10; update; # On Mac make sure update won't take long
177 after 200 {set x x-done}
178 after 400 {set y y-done}
179 after idle {set z z-done}
186 } {x-done before z-done}
189 foreach i [after info] {
193 test event-13.1 "vwait/signal" signal {
195 list [catch -signal {
197 # This is just to prevent the vwait from exiting immediately
198 stdin readable { format test }