1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
-
+
|
# This file contains a collection of tests for the procedures in the file
# tclEvent.c, which includes the "update", and "vwait" Tcl
# commands. Sourcing this file into Tcl runs the tests and generates
# output for errors. No output means no errors were found.
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: event.test,v 1.4 1999/04/16 00:47:26 stanton Exp $
# RCS: @(#) $Id: event.test,v 1.5 1999/04/20 19:19:35 hershey Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
source [file join [pwd] [file dirname [info script]] defs.tcl]
}
set ::tcltest::testConfig(testfilehandler) \
[expr {[info commands testfilehandler] != {}}]
|
390
391
392
393
394
395
396
397
398
399
400
401
402
403
|
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
|
+
|
test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {socket} {
set f1 [open test1 w]
proc accept {s args} {
puts $s foobar
close $s
}
set s1 [socket -server accept 5001]
after 1000
set s2 [socket 127.0.0.1 5001]
close $s1
set x 0
set y 0
set z 0
fileevent $s2 readable { incr z }
vwait z
|