1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
# 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.
#
# 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.3 1998/09/14 18:40:08 stanton Exp $
if {[string compare test [info procs test]] == 1} then {source defs}
if {[catch {testfilehandler create 0 off off}] == 0 } {
test event-1.1 {Tcl_CreateFileHandler, reading} {
testfilehandler close
testfilehandler create 0 readable off
testfilehandler clear 0
testfilehandler oneevent
set result ""
lappend result [testfilehandler counts 0]
testfilehandler fillpartial 0
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler close
set result
} {{0 0} {1 0} {2 0}}
test event-1.2 {Tcl_CreateFileHandler, writing} {nonPortable} {
# This test is non-portable because on some systems (e.g.
# SunOS 4.1.3) pipes seem to be writable always.
testfilehandler close
testfilehandler create 0 off writable
testfilehandler clear 0
testfilehandler oneevent
set result ""
lappend result [testfilehandler counts 0]
testfilehandler fillpartial 0
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler fill 0
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler close
set result
} {{0 1} {0 2} {0 2}}
test event-1.3 {Tcl_DeleteFileHandler} {nonPortable} {
testfilehandler close
testfilehandler create 2 disabled disabled
testfilehandler create 1 readable writable
testfilehandler create 0 disabled disabled
testfilehandler fillpartial 1
set result ""
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler create 1 off off
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler close
set result
} {{0 1} {1 1} {1 2} {0 0}}
test event-2.1 {Tcl_DeleteFileHandler} {nonPortable} {
testfilehandler close
testfilehandler create 2 disabled disabled
testfilehandler create 1 readable writable
testfilehandler fillpartial 1
set result ""
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler create 1 off off
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler close
set result
} {{0 1} {1 1} {1 2} {0 0}}
test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} {nonPortable} {
testfilehandler close
testfilehandler create 0 readable writable
testfilehandler fillpartial 0
set result ""
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler close
testfilehandler create 0 readable writable
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler close
set result
} {{0 1} {0 0}}
test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off } {
testfilehandler close
testfilehandler create 1 readable writable
testfilehandler fillpartial 1
testfilehandler windowevent
set result [testfilehandler counts 1]
testfilehandler close
set result
} {0 0}
test event-4.1 {FileHandlerEventProc, race between event and disabling} {nonPortable} {
update
testfilehandler close
testfilehandler create 2 disabled disabled
testfilehandler create 1 readable writable
testfilehandler fillpartial 1
set result ""
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler create 1 disabled disabled
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler close
set result
} {{0 1} {1 1} {1 2} {0 0}}
test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} {nonPortable} {
update
testfilehandler close
testfilehandler create 1 readable writable
testfilehandler create 2 readable writable
testfilehandler fillpartial 1
testfilehandler fillpartial 2
testfilehandler oneevent
set result ""
lappend result [testfilehandler counts 1] [testfilehandler counts 2]
testfilehandler windowevent
lappend result [testfilehandler counts 1] [testfilehandler counts 2]
testfilehandler close
set result
} {{0 0} {0 1} {0 0} {0 1}}
testfilehandler close
update
}
|
>
|
>
>
>
|
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
|
<
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
|
# 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 $
if {[lsearch [namespace children] ::tcltest] == -1} {
source [file join [pwd] [file dirname [info script]] defs.tcl]
}
set ::tcltest::testConfig(testfilehandler) \
[expr {[info commands testfilehandler] != {}}]
set ::tcltest::testConfig(testexithandler) \
[expr {[info commands testexithandler] != {}}]
set ::tcltest::testConfig(testfilewait) \
[expr {[info commands testfilewait] != {}}]
test event-1.1 {Tcl_CreateFileHandler, reading} {testfilehandler} {
testfilehandler close
testfilehandler create 0 readable off
testfilehandler clear 0
testfilehandler oneevent
set result ""
lappend result [testfilehandler counts 0]
testfilehandler fillpartial 0
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler close
set result
} {{0 0} {1 0} {2 0}}
test event-1.2 {Tcl_CreateFileHandler, writing} {testfilehandler nonPortable} {
# This test is non-portable because on some systems (e.g.
# SunOS 4.1.3) pipes seem to be writable always.
testfilehandler close
testfilehandler create 0 off writable
testfilehandler clear 0
testfilehandler oneevent
set result ""
lappend result [testfilehandler counts 0]
testfilehandler fillpartial 0
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler fill 0
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler close
set result
} {{0 1} {0 2} {0 2}}
test event-1.3 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
testfilehandler close
testfilehandler create 2 disabled disabled
testfilehandler create 1 readable writable
testfilehandler create 0 disabled disabled
testfilehandler fillpartial 1
set result ""
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler create 1 off off
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler close
set result
} {{0 1} {1 1} {1 2} {0 0}}
test event-2.1 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
testfilehandler close
testfilehandler create 2 disabled disabled
testfilehandler create 1 readable writable
testfilehandler fillpartial 1
set result ""
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler create 1 off off
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler close
set result
} {{0 1} {1 1} {1 2} {0 0}}
test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} \
{testfilehandler nonPortable} {
testfilehandler close
testfilehandler create 0 readable writable
testfilehandler fillpartial 0
set result ""
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler close
testfilehandler create 0 readable writable
testfilehandler oneevent
lappend result [testfilehandler counts 0]
testfilehandler close
set result
} {{0 1} {0 0}}
test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off } {testfilehandler} {
testfilehandler close
testfilehandler create 1 readable writable
testfilehandler fillpartial 1
testfilehandler windowevent
set result [testfilehandler counts 1]
testfilehandler close
set result
} {0 0}
test event-4.1 {FileHandlerEventProc, race between event and disabling} \
{testfilehandler nonPortable} {
update
testfilehandler close
testfilehandler create 2 disabled disabled
testfilehandler create 1 readable writable
testfilehandler fillpartial 1
set result ""
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler create 1 disabled disabled
testfilehandler oneevent
lappend result [testfilehandler counts 1]
testfilehandler close
set result
} {{0 1} {1 1} {1 2} {0 0}}
test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} \
{testfilehandler nonPortable} {
update
testfilehandler close
testfilehandler create 1 readable writable
testfilehandler create 2 readable writable
testfilehandler fillpartial 1
testfilehandler fillpartial 2
testfilehandler oneevent
set result ""
lappend result [testfilehandler counts 1] [testfilehandler counts 2]
testfilehandler windowevent
lappend result [testfilehandler counts 1] [testfilehandler counts 2]
testfilehandler close
set result
} {{0 0} {0 1} {0 0} {0 1}}
update
test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} {
catch {rename bgerror {}}
proc bgerror msg {
global errorInfo errorCode x
lappend x [list $msg $errorInfo $errorCode]
}
|
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
|
# that. the other option would be to use fork a test but it
# then becomes more a file/exec test than a bgerror test.
# end of bgerror tests
catch {rename bgerror {}}
if {[info commands testexithandler] != ""} {
test event-8.1 {Tcl_CreateExitHandler procedure} {stdio} {
set child [open |[list [info nameofexecutable]] r+]
puts $child "testexithandler create 41; testexithandler create 4"
puts $child "testexithandler create 6; exit"
flush $child
set result [read $child]
close $child
set result
} {even 6
test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio} {
set child [open |[list [info nameofexecutable]] r+]
puts $child "testexithandler create 41; testexithandler create 4"
puts $child "testexithandler create 6; testexithandler delete 41"
puts $child "testexithandler create 16; exit"
flush $child
set result [read $child]
close $child
set result
} {even 16
test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio} {
set child [open |[list [info nameofexecutable]] r+]
puts $child "testexithandler create 41; testexithandler create 4"
puts $child "testexithandler create 6; testexithandler delete 4"
puts $child "testexithandler create 16; exit"
flush $child
set result [read $child]
close $child
set result
test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio} {
set child [open |[list [info nameofexecutable]] r+]
puts $child "testexithandler create 41; testexithandler create 4"
puts $child "testexithandler create 6; testexithandler delete 6"
puts $child "testexithandler create 16; exit"
flush $child
set result [read $child]
close $child
set result
} {even 16
test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio} {
set child [open |[list [info nameofexecutable]] r+]
puts $child "testexithandler create 41; testexithandler delete 41"
puts $child "testexithandler create 16; exit"
flush $child
set result [read $child]
close $child
set result
} {even 16
}
|
<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
|
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
|
# that. the other option would be to use fork a test but it
# then becomes more a file/exec test than a bgerror test.
# end of bgerror tests
catch {rename bgerror {}}
test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} {
set child [open |[list [info nameofexecutable]] r+]
puts $child "testexithandler create 41; testexithandler create 4"
puts $child "testexithandler create 6; exit"
flush $child
set result [read $child]
close $child
set result
} {even 6
even 4
odd 41
}
test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
set child [open |[list [info nameofexecutable]] r+]
puts $child "testexithandler create 41; testexithandler create 4"
puts $child "testexithandler create 6; testexithandler delete 41"
puts $child "testexithandler create 16; exit"
flush $child
set result [read $child]
close $child
set result
} {even 16
even 6
even 4
}
test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
set child [open |[list [info nameofexecutable]] r+]
puts $child "testexithandler create 41; testexithandler create 4"
puts $child "testexithandler create 6; testexithandler delete 4"
puts $child "testexithandler create 16; exit"
flush $child
set result [read $child]
close $child
set result
} {even 16
even 6
odd 41
}
test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
set child [open |[list [info nameofexecutable]] r+]
puts $child "testexithandler create 41; testexithandler create 4"
puts $child "testexithandler create 6; testexithandler delete 6"
puts $child "testexithandler create 16; exit"
flush $child
set result [read $child]
close $child
set result
} {even 16
even 4
odd 41
}
test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
set child [open |[list [info nameofexecutable]] r+]
puts $child "testexithandler create 41; testexithandler delete 41"
puts $child "testexithandler create 16; exit"
flush $child
set result [read $child]
close $child
set result
} {even 16
}
test event-10.1 {Tcl_Exit procedure} {stdio} {
set child [open |[list [info nameofexecutable]] r+]
puts $child "exit 3"
list [catch {close $child} msg] $msg [lindex $errorCode 0] \
[lindex $errorCode 2]
|
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
|
set y before
set z before
after 300
update
list $x $y $z
} {x-done before z-done}
if {[info commands testfilehandler] != ""} {
test event-13.1 {Tcl_WaitForFile procedure, readable} unixOnly {
foreach i [after info] {
after cancel $i
}
after 100 set x timeout
testfilehandler close
testfilehandler create 1 off off
set x "no timeout"
set result [testfilehandler wait 1 readable 0]
update
testfilehandler close
list $result $x
} {{} {no timeout}}
test event-13.2 {Tcl_WaitForFile procedure, readable} unixOnly {
foreach i [after info] {
after cancel $i
}
after 100 set x timeout
testfilehandler close
testfilehandler create 1 off off
set x "no timeout"
set result [testfilehandler wait 1 readable 100]
update
testfilehandler close
list $result $x
} {{} timeout}
test event-13.3 {Tcl_WaitForFile procedure, readable} unixOnly {
foreach i [after info] {
after cancel $i
}
after 100 set x timeout
testfilehandler close
testfilehandler create 1 off off
testfilehandler fillpartial 1
set x "no timeout"
set result [testfilehandler wait 1 readable 100]
update
testfilehandler close
list $result $x
} {readable {no timeout}}
test event-13.4 {Tcl_WaitForFile procedure, writable} {unixOnly nonPortable} {
foreach i [after info] {
after cancel $i
}
after 100 set x timeout
testfilehandler close
testfilehandler create 1 off off
testfilehandler fill 1
set x "no timeout"
set result [testfilehandler wait 1 writable 0]
update
testfilehandler close
list $result $x
} {{} {no timeout}}
test event-13.5 {Tcl_WaitForFile procedure, writable} {unixOnly nonPortable} {
foreach i [after info] {
after cancel $i
}
after 100 set x timeout
testfilehandler close
testfilehandler create 1 off off
testfilehandler fill 1
set x "no timeout"
set result [testfilehandler wait 1 writable 100]
update
testfilehandler close
list $result $x
} {{} timeout}
test event-13.6 {Tcl_WaitForFile procedure, writable} unixOnly {
foreach i [after info] {
after cancel $i
}
after 100 set x timeout
testfilehandler close
testfilehandler create 1 off off
set x "no timeout"
set result [testfilehandler wait 1 writable 100]
update
testfilehandler close
list $result $x
} {writable {no timeout}}
test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} unixOnly {
foreach i [after info] {
after cancel $i
}
after 100 lappend x timeout
after idle lappend x idle
testfilehandler close
testfilehandler create 1 off off
set x ""
set result [list [testfilehandler wait 1 readable 200] $x]
update
testfilehandler close
lappend result $x
} {{} {} {timeout idle}}
}
if {[info commands testfilewait] != ""} {
test event-13.8 {Tcl_WaitForFile procedure, waiting indefinitely} unixOnly {
set f [open "|sleep 2" r]
set result ""
lappend result [testfilewait $f readable 100]
lappend result [testfilewait $f readable -1]
close $f
set result
} {{} readable}
}
|
<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
<
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
|
set y before
set z before
after 300
update
list $x $y $z
} {x-done before z-done}
test event-13.1 {Tcl_WaitForFile procedure, readable} {testfilehandler} {
foreach i [after info] {
after cancel $i
}
after 100 set x timeout
testfilehandler close
testfilehandler create 1 off off
set x "no timeout"
set result [testfilehandler wait 1 readable 0]
update
testfilehandler close
list $result $x
} {{} {no timeout}}
test event-13.2 {Tcl_WaitForFile procedure, readable} testfilehandler {
foreach i [after info] {
after cancel $i
}
after 100 set x timeout
testfilehandler close
testfilehandler create 1 off off
set x "no timeout"
set result [testfilehandler wait 1 readable 100]
update
testfilehandler close
list $result $x
} {{} timeout}
test event-13.3 {Tcl_WaitForFile procedure, readable} testfilehandler {
foreach i [after info] {
after cancel $i
}
after 100 set x timeout
testfilehandler close
testfilehandler create 1 off off
testfilehandler fillpartial 1
set x "no timeout"
set result [testfilehandler wait 1 readable 100]
update
testfilehandler close
list $result $x
} {readable {no timeout}}
test event-13.4 {Tcl_WaitForFile procedure, writable} \
{testfilehandler nonPortable} {
foreach i [after info] {
after cancel $i
}
after 100 set x timeout
testfilehandler close
testfilehandler create 1 off off
testfilehandler fill 1
set x "no timeout"
set result [testfilehandler wait 1 writable 0]
update
testfilehandler close
list $result $x
} {{} {no timeout}}
test event-13.5 {Tcl_WaitForFile procedure, writable} \
{testfilehandler nonPortable} {
foreach i [after info] {
after cancel $i
}
after 100 set x timeout
testfilehandler close
testfilehandler create 1 off off
testfilehandler fill 1
set x "no timeout"
set result [testfilehandler wait 1 writable 100]
update
testfilehandler close
list $result $x
} {{} timeout}
test event-13.6 {Tcl_WaitForFile procedure, writable} testfilehandler {
foreach i [after info] {
after cancel $i
}
after 100 set x timeout
testfilehandler close
testfilehandler create 1 off off
set x "no timeout"
set result [testfilehandler wait 1 writable 100]
update
testfilehandler close
list $result $x
} {writable {no timeout}}
test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} testfilehandler {
foreach i [after info] {
after cancel $i
}
after 100 lappend x timeout
after idle lappend x idle
testfilehandler close
testfilehandler create 1 off off
set x ""
set result [list [testfilehandler wait 1 readable 200] $x]
update
testfilehandler close
lappend result $x
} {{} {} {timeout idle}}
test event-13.8 {Tcl_WaitForFile procedure, waiting indefinitely} testfilewait {
set f [open "|sleep 2" r]
set result ""
lappend result [testfilewait $f readable 100]
lappend result [testfilewait $f readable -1]
close $f
set result
} {{} readable}
# cleanup
foreach i [after info] {
after cancel $i
}
::tcltest::cleanupTests
return
|