Diff
Not logged in
Home Timeline Branches Tags Tickets Wiki Login
Annotate Patch Side-by-side Diff

Differences From Artifact [c9987cb08b]:

To Artifact [d0c5fbc3b5]:

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

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.3 1998/09/14 18:40:08 stanton Exp $
# 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]
}
if {[string compare test [info procs test]] == 1} then {source defs}

set ::tcltest::testConfig(testfilehandler) \
	[expr {[info commands testfilehandler] != {}}]
set ::tcltest::testConfig(testexithandler) \
	[expr {[info commands testexithandler] != {}}]
set ::tcltest::testConfig(testfilewait) \
	[expr {[info commands testfilewait] != {}}]

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-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} {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-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 close
	testfilehandler create 1 readable writable
	testfilehandler fillpartial 1
	testfilehandler windowevent
	set result [testfilehandler counts 1]
	testfilehandler close
	set result
    } {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} {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}}
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}}
    testfilehandler close
    update
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

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 {}}


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-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} {
	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.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} {
	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.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} {
	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.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} {
	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-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















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}

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}}
}
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}}


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}
}

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
This page was created in about 0.04s by Fossil version [1205ec86cb] 2025-04-30 16:57:32