URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [event.test] - Blame information for rev 1765

Details | Compare with Previous | View Log


# 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.1.1.1 2002-01-16 10:25:35 markom 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
}
 
test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} {
    catch {rename bgerror {}}
    proc bgerror msg {
        global errorInfo errorCode x
        lappend x [list $msg $errorInfo $errorCode]
    }
    after idle {error "a simple error"}
    after idle {open non_existent}
    after idle {set errorInfo foobar; set errorCode xyzzy}
    set x {}
    update idletasks
    rename bgerror {}
    set x
} {{{a simple error} {a simple error
    while executing
"error "a simple error""
    ("after" script)} NONE} {{couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
    while executing
"open non_existent"
    ("after" script)} {POSIX ENOENT {no such file or directory}}}}
test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} {
    catch {rename bgerror {}}
    proc bgerror msg {
        global x
        lappend x $msg
        return -code break
    }
    after idle {error "a simple error"}
    after idle {open non_existent}
    set x {}
    update idletasks
    rename bgerror {}
    set x
} {{a simple error}}
 
test event-6.1 {BgErrorDeleteProc procedure} {
    catch {interp delete foo}
    interp create foo
    foo eval {
        proc bgerror args {
            global errorInfo
            set f [open err.out r+]
            seek $f 0 end
            puts $f "$args $errorInfo"
            close $f
        }
        after 100 {error "first error"}
        after 100 {error "second error"}
    }
    makeFile Unmodified err.out
    after 100 {interp delete foo}
    after 200
    update
    set f [open err.out r]
    set result [read $f]
    close $f
    removeFile err.out
    set result
} {Unmodified
}
 
test event-7.1 {bgerror / regular} {
    set errRes {}
    proc bgerror {err} {
        global errRes;
        set errRes $err;
    }
    after 0 {error err1}
    vwait errRes;
    set errRes;
} err1
 
test event-7.2 {bgerror / accumulation} {
    set errRes {}
    proc bgerror {err} {
        global errRes;
        lappend errRes $err;
    }
    after 0 {error err1}
    after 0 {error err2}
    after 0 {error err3}
    update
    set errRes;
} {err1 err2 err3}
 
test event-7.3 {bgerror / accumulation / break} {
    set errRes {}
    proc bgerror {err} {
        global errRes;
        lappend errRes $err;
        return -code break "skip!";
    }
    after 0 {error err1}
    after 0 {error err2}
    after 0 {error err3}
    update
    set errRes;
} err1
 
test event-7.4 {tkerror is nothing special anymore to tcl} {
    set errRes {}
    # we don't just rename bgerror to empty because it could then
    # be autoloaded...
    proc bgerror {err} {
        global errRes;
        lappend errRes "bg:$err";
    }
    proc tkerror {err} {
        global errRes;
        lappend errRes "tk:$err";
    }
    after 0 {error err1}
    update
    rename tkerror {}
    set errRes
} bg:err1
 
# someday : add a test checking that
# when there is no bgerror, an error msg goes to stderr
# ideally one would use sub interp and transfer a fake stderr
# to it, unfortunatly the current interp tcl API does not allow
# 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
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
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
    } {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
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-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]
} {1 {child process exited abnormally} CHILDSTATUS 3}
 
test event-11.1 {Tcl_VwaitCmd procedure} {
    list [catch {vwait} msg] $msg
} {1 {wrong # args: should be "vwait name"}}
test event-11.2 {Tcl_VwaitCmd procedure} {
    list [catch {vwait a b} msg] $msg
} {1 {wrong # args: should be "vwait name"}}
test event-11.3 {Tcl_VwaitCmd procedure} {
    catch {unset x}
    set x 1
    list [catch {vwait x(1)} msg] $msg
} {1 {can't trace "x(1)": variable isn't array}}
test event-11.4 {Tcl_VwaitCmd procedure} {
    foreach i [after info] {
        after cancel $i
    }
    after 10; update; # On Mac make sure update won't take long
    after 100 {set x x-done}
    after 200 {set y y-done}
    after 300 {set z z-done}
    after idle {set q q-done}
    set x before
    set y before
    set z before
    set q before
    list [vwait y] $x $y $z $q
} {{} x-done y-done before q-done}
 
foreach i [after info] {
    after cancel $i
}
 
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]
    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
    fileevent $f1 writable { incr x; if { $y == 3 } { set z done } }
    fileevent $s2 readable { incr y; if { $x == 3 } { set z done } }
    vwait z
    close $f1
    close $s2
    file delete test1 test2
    list $x $y $z
} {3 3 done}
test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {
    file delete test1 test2
    set f1 [open test1 w]
    set f2 [open test2 w]
    set x 0
    set y 0
    set z 0
    update
    fileevent $f1 writable { incr x; if { $y == 3 } { set z done } }
    fileevent $f2 writable { incr y; if { $x == 3 } { set z done } }
    vwait z
    close $f1
    close $f2
    file delete test1 test2
    list $x $y $z
} {3 3 done}
 
 
test event-12.1 {Tcl_UpdateCmd procedure} {
    list [catch {update a b} msg] $msg
} {1 {wrong # args: should be "update ?idletasks?"}}
test event-12.2 {Tcl_UpdateCmd procedure} {
    list [catch {update bogus} msg] $msg
} {1 {bad option "bogus": must be idletasks}}
test event-12.3 {Tcl_UpdateCmd procedure} {
    foreach i [after info] {
        after cancel $i
    }
    after 500 {set x after}
    after idle {set y after}
    after idle {set z "after, y = $y"}
    set x before
    set y before
    set z before
    update idletasks
    list $x $y $z
} {before after {after, y = after}}
test event-12.4 {Tcl_UpdateCmd procedure} {
    foreach i [after info] {
        after cancel $i
    }
    after 10; update; # On Mac make sure update won't take long
    after 200 {set x x-done}
    after 600 {set y y-done}
    after idle {set z z-done}
    set x before
    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}
}
 
foreach i [after info] {
    after cancel $i
}

Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [event.test] - Blame information for rev 1765

Line No.	Rev	Author	Line
1	578	markom	`# 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.`
5			`#`
6			`# Copyright (c) 1995-1997 Sun Microsystems, Inc.`
7			`#`
8			`# See the file "license.terms" for information on usage and redistribution`
9			`# of this file, and for a DISCLAIMER OF ALL WARRANTIES.`
10			`#`
11			`# RCS: @(#) $Id: event.test,v 1.1.1.1 2002-01-16 10:25:35 markom Exp $`
12
13			`if {[string compare test [info procs test]] == 1} then {source defs}`
14
15			`if {[catch {testfilehandler create 0 off off}] == 0 } {`
16			`test event-1.1 {Tcl_CreateFileHandler, reading} {`
17			`testfilehandler close`
18			`testfilehandler create 0 readable off`
19			`testfilehandler clear 0`
20			`testfilehandler oneevent`
21			`set result ""`
22			`lappend result [testfilehandler counts 0]`
23			`testfilehandler fillpartial 0`
24			`testfilehandler oneevent`
25			`lappend result [testfilehandler counts 0]`
26			`testfilehandler oneevent`
27			`lappend result [testfilehandler counts 0]`
28			`testfilehandler close`
29			`set result`
30			`} {{0 0} {1 0} {2 0}}`
31			`test event-1.2 {Tcl_CreateFileHandler, writing} {nonPortable} {`
32			`# This test is non-portable because on some systems (e.g.`
33			`# SunOS 4.1.3) pipes seem to be writable always.`
34			`testfilehandler close`
35			`testfilehandler create 0 off writable`
36			`testfilehandler clear 0`
37			`testfilehandler oneevent`
38			`set result ""`
39			`lappend result [testfilehandler counts 0]`
40			`testfilehandler fillpartial 0`
41			`testfilehandler oneevent`
42			`lappend result [testfilehandler counts 0]`
43			`testfilehandler fill 0`
44			`testfilehandler oneevent`
45			`lappend result [testfilehandler counts 0]`
46			`testfilehandler close`
47			`set result`
48			`} {{0 1} {0 2} {0 2}}`
49			`test event-1.3 {Tcl_DeleteFileHandler} {nonPortable} {`
50			`testfilehandler close`
51			`testfilehandler create 2 disabled disabled`
52			`testfilehandler create 1 readable writable`
53			`testfilehandler create 0 disabled disabled`
54			`testfilehandler fillpartial 1`
55			`set result ""`
56			`testfilehandler oneevent`
57			`lappend result [testfilehandler counts 1]`
58			`testfilehandler oneevent`
59			`lappend result [testfilehandler counts 1]`
60			`testfilehandler oneevent`
61			`lappend result [testfilehandler counts 1]`
62			`testfilehandler create 1 off off`
63			`testfilehandler oneevent`
64			`lappend result [testfilehandler counts 1]`
65			`testfilehandler close`
66			`set result`
67			`} {{0 1} {1 1} {1 2} {0 0}}`
68
69			`test event-2.1 {Tcl_DeleteFileHandler} {nonPortable} {`
70			`testfilehandler close`
71			`testfilehandler create 2 disabled disabled`
72			`testfilehandler create 1 readable writable`
73			`testfilehandler fillpartial 1`
74			`set result ""`
75			`testfilehandler oneevent`
76			`lappend result [testfilehandler counts 1]`
77			`testfilehandler oneevent`
78			`lappend result [testfilehandler counts 1]`
79			`testfilehandler oneevent`
80			`lappend result [testfilehandler counts 1]`
81			`testfilehandler create 1 off off`
82			`testfilehandler oneevent`
83			`lappend result [testfilehandler counts 1]`
84			`testfilehandler close`
85			`set result`
86			`} {{0 1} {1 1} {1 2} {0 0}}`
87			`test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} {nonPortable} {`
88			`testfilehandler close`
89			`testfilehandler create 0 readable writable`
90			`testfilehandler fillpartial 0`
91			`set result ""`
92			`testfilehandler oneevent`
93			`lappend result [testfilehandler counts 0]`
94			`testfilehandler close`
95			`testfilehandler create 0 readable writable`
96			`testfilehandler oneevent`
97			`lappend result [testfilehandler counts 0]`
98			`testfilehandler close`
99			`set result`
100			`} {{0 1} {0 0}}`
101
102			`test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off } {`
103			`testfilehandler close`
104			`testfilehandler create 1 readable writable`
105			`testfilehandler fillpartial 1`
106			`testfilehandler windowevent`
107			`set result [testfilehandler counts 1]`
108			`testfilehandler close`
109			`set result`
110			`} {0 0}`
111
112			`test event-4.1 {FileHandlerEventProc, race between event and disabling} {nonPortable} {`
113			`update`
114			`testfilehandler close`
115			`testfilehandler create 2 disabled disabled`
116			`testfilehandler create 1 readable writable`
117			`testfilehandler fillpartial 1`
118			`set result ""`
119			`testfilehandler oneevent`
120			`lappend result [testfilehandler counts 1]`
121			`testfilehandler oneevent`
122			`lappend result [testfilehandler counts 1]`
123			`testfilehandler oneevent`
124			`lappend result [testfilehandler counts 1]`
125			`testfilehandler create 1 disabled disabled`
126			`testfilehandler oneevent`
127			`lappend result [testfilehandler counts 1]`
128			`testfilehandler close`
129			`set result`
130			`} {{0 1} {1 1} {1 2} {0 0}}`
131			`test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} {nonPortable} {`
132			`update`
133			`testfilehandler close`
134			`testfilehandler create 1 readable writable`
135			`testfilehandler create 2 readable writable`
136			`testfilehandler fillpartial 1`
137			`testfilehandler fillpartial 2`
138			`testfilehandler oneevent`
139			`set result ""`
140			`lappend result [testfilehandler counts 1] [testfilehandler counts 2]`
141			`testfilehandler windowevent`
142			`lappend result [testfilehandler counts 1] [testfilehandler counts 2]`
143			`testfilehandler close`
144			`set result`
145			`} {{0 0} {0 1} {0 0} {0 1}}`
146			`testfilehandler close`
147			`update`
148			`}`
149
150			`test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} {`
151			`catch {rename bgerror {}}`
152			`proc bgerror msg {`
153			`global errorInfo errorCode x`
154			`lappend x [list $msg $errorInfo $errorCode]`
155			`}`
156			`after idle {error "a simple error"}`
157			`after idle {open non_existent}`
158			`after idle {set errorInfo foobar; set errorCode xyzzy}`
159			`set x {}`
160			`update idletasks`
161			`rename bgerror {}`
162			`set x`
163			`} {{{a simple error} {a simple error`
164			`while executing`
165			`"error "a simple error""`
166			`("after" script)} NONE} {{couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory`
167			`while executing`
168			`"open non_existent"`
169			`("after" script)} {POSIX ENOENT {no such file or directory}}}}`
170			`test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} {`
171			`catch {rename bgerror {}}`
172			`proc bgerror msg {`
173			`global x`
174			`lappend x $msg`
175			`return -code break`
176			`}`
177			`after idle {error "a simple error"}`
178			`after idle {open non_existent}`
179			`set x {}`
180			`update idletasks`
181			`rename bgerror {}`
182			`set x`
183			`} {{a simple error}}`
184
185			`test event-6.1 {BgErrorDeleteProc procedure} {`
186			`catch {interp delete foo}`
187			`interp create foo`
188			`foo eval {`
189			`proc bgerror args {`
190			`global errorInfo`
191			`set f [open err.out r+]`
192			`seek $f 0 end`
193			`puts $f "$args $errorInfo"`
194			`close $f`
195			`}`
196			`after 100 {error "first error"}`
197			`after 100 {error "second error"}`
198			`}`
199			`makeFile Unmodified err.out`
200			`after 100 {interp delete foo}`
201			`after 200`
202			`update`
203			`set f [open err.out r]`
204			`set result [read $f]`
205			`close $f`
206			`removeFile err.out`
207			`set result`
208			`} {Unmodified`
209			`}`
210
211			`test event-7.1 {bgerror / regular} {`
212			`set errRes {}`
213			`proc bgerror {err} {`
214			`global errRes;`
215			`set errRes $err;`
216			`}`
217			`after 0 {error err1}`
218			`vwait errRes;`
219			`set errRes;`
220			`} err1`
221
222			`test event-7.2 {bgerror / accumulation} {`
223			`set errRes {}`
224			`proc bgerror {err} {`
225			`global errRes;`
226			`lappend errRes $err;`
227			`}`
228			`after 0 {error err1}`
229			`after 0 {error err2}`
230			`after 0 {error err3}`
231			`update`
232			`set errRes;`
233			`} {err1 err2 err3}`
234
235			`test event-7.3 {bgerror / accumulation / break} {`
236			`set errRes {}`
237			`proc bgerror {err} {`
238			`global errRes;`
239			`lappend errRes $err;`
240			`return -code break "skip!";`
241			`}`
242			`after 0 {error err1}`
243			`after 0 {error err2}`
244			`after 0 {error err3}`
245			`update`
246			`set errRes;`
247			`} err1`
248
249			`test event-7.4 {tkerror is nothing special anymore to tcl} {`
250			`set errRes {}`
251			`# we don't just rename bgerror to empty because it could then`
252			`# be autoloaded...`
253			`proc bgerror {err} {`
254			`global errRes;`
255			`lappend errRes "bg:$err";`
256			`}`
257			`proc tkerror {err} {`
258			`global errRes;`
259			`lappend errRes "tk:$err";`
260			`}`
261			`after 0 {error err1}`
262			`update`
263			`rename tkerror {}`
264			`set errRes`
265			`} bg:err1`
266
267			`# someday : add a test checking that`
268			`# when there is no bgerror, an error msg goes to stderr`
269			`# ideally one would use sub interp and transfer a fake stderr`
270			`# to it, unfortunatly the current interp tcl API does not allow`
271			`# that. the other option would be to use fork a test but it`
272			`# then becomes more a file/exec test than a bgerror test.`
273
274			`# end of bgerror tests`
275			`catch {rename bgerror {}}`
276
277
278			`if {[info commands testexithandler] != ""} {`
279			`test event-8.1 {Tcl_CreateExitHandler procedure} {stdio} {`
280			`set child [open \|[list [info nameofexecutable]] r+]`
281			`puts $child "testexithandler create 41; testexithandler create 4"`
282			`puts $child "testexithandler create 6; exit"`
283			`flush $child`
284			`set result [read $child]`
285			`close $child`
286			`set result`
287			`} {even 6`
288			`even 4`
289			`odd 41`
290			`}`
291
292			`test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio} {`
293			`set child [open \|[list [info nameofexecutable]] r+]`
294			`puts $child "testexithandler create 41; testexithandler create 4"`
295			`puts $child "testexithandler create 6; testexithandler delete 41"`
296			`puts $child "testexithandler create 16; exit"`
297			`flush $child`
298			`set result [read $child]`
299			`close $child`
300			`set result`
301			`} {even 16`
302			`even 6`
303			`even 4`
304			`}`
305			`test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio} {`
306			`set child [open \|[list [info nameofexecutable]] r+]`
307			`puts $child "testexithandler create 41; testexithandler create 4"`
308			`puts $child "testexithandler create 6; testexithandler delete 4"`
309			`puts $child "testexithandler create 16; exit"`
310			`flush $child`
311			`set result [read $child]`
312			`close $child`
313			`set result`
314			`} {even 16`
315			`even 6`
316			`odd 41`
317			`}`
318			`test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio} {`
319			`set child [open \|[list [info nameofexecutable]] r+]`
320			`puts $child "testexithandler create 41; testexithandler create 4"`
321			`puts $child "testexithandler create 6; testexithandler delete 6"`
322			`puts $child "testexithandler create 16; exit"`
323			`flush $child`
324			`set result [read $child]`
325			`close $child`
326			`set result`
327			`} {even 16`
328			`even 4`
329			`odd 41`
330			`}`
331			`test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio} {`
332			`set child [open \|[list [info nameofexecutable]] r+]`
333			`puts $child "testexithandler create 41; testexithandler delete 41"`
334			`puts $child "testexithandler create 16; exit"`
335			`flush $child`
336			`set result [read $child]`
337			`close $child`
338			`set result`
339			`} {even 16`
340			`}`
341			`}`
342
343			`test event-10.1 {Tcl_Exit procedure} {stdio} {`
344			`set child [open \|[list [info nameofexecutable]] r+]`
345			`puts $child "exit 3"`
346			`list [catch {close $child} msg] $msg [lindex $errorCode 0] \`
347			`[lindex $errorCode 2]`
348			`} {1 {child process exited abnormally} CHILDSTATUS 3}`
349
350			`test event-11.1 {Tcl_VwaitCmd procedure} {`
351			`list [catch {vwait} msg] $msg`
352			`} {1 {wrong # args: should be "vwait name"}}`
353			`test event-11.2 {Tcl_VwaitCmd procedure} {`
354			`list [catch {vwait a b} msg] $msg`
355			`} {1 {wrong # args: should be "vwait name"}}`
356			`test event-11.3 {Tcl_VwaitCmd procedure} {`
357			`catch {unset x}`
358			`set x 1`
359			`list [catch {vwait x(1)} msg] $msg`
360			`} {1 {can't trace "x(1)": variable isn't array}}`
361			`test event-11.4 {Tcl_VwaitCmd procedure} {`
362			`foreach i [after info] {`
363			`after cancel $i`
364			`}`
365			`after 10; update; # On Mac make sure update won't take long`
366			`after 100 {set x x-done}`
367			`after 200 {set y y-done}`
368			`after 300 {set z z-done}`
369			`after idle {set q q-done}`
370			`set x before`
371			`set y before`
372			`set z before`
373			`set q before`
374			`list [vwait y] $x $y $z $q`
375			`} {{} x-done y-done before q-done}`
376
377			`foreach i [after info] {`
378			`after cancel $i`
379			`}`
380
381			`test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {socket} {`
382			`set f1 [open test1 w]`
383			`proc accept {s args} {`
384			`puts $s foobar`
385			`close $s`
386			`}`
387			`set s1 [socket -server accept 5001]`
388			`set s2 [socket 127.0.0.1 5001]`
389			`close $s1`
390			`set x 0`
391			`set y 0`
392			`set z 0`
393			`fileevent $s2 readable { incr z }`
394			`vwait z`
395			`fileevent $f1 writable { incr x; if { $y == 3 } { set z done } }`
396			`fileevent $s2 readable { incr y; if { $x == 3 } { set z done } }`
397			`vwait z`
398			`close $f1`
399			`close $s2`
400			`file delete test1 test2`
401			`list $x $y $z`
402			`} {3 3 done}`
403			`test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {`
404			`file delete test1 test2`
405			`set f1 [open test1 w]`
406			`set f2 [open test2 w]`
407			`set x 0`
408			`set y 0`
409			`set z 0`
410			`update`
411			`fileevent $f1 writable { incr x; if { $y == 3 } { set z done } }`
412			`fileevent $f2 writable { incr y; if { $x == 3 } { set z done } }`
413			`vwait z`
414			`close $f1`
415			`close $f2`
416			`file delete test1 test2`
417			`list $x $y $z`
418			`} {3 3 done}`
419
420
421			`test event-12.1 {Tcl_UpdateCmd procedure} {`
422			`list [catch {update a b} msg] $msg`
423			`} {1 {wrong # args: should be "update ?idletasks?"}}`
424			`test event-12.2 {Tcl_UpdateCmd procedure} {`
425			`list [catch {update bogus} msg] $msg`
426			`} {1 {bad option "bogus": must be idletasks}}`
427			`test event-12.3 {Tcl_UpdateCmd procedure} {`
428			`foreach i [after info] {`
429			`after cancel $i`
430			`}`
431			`after 500 {set x after}`
432			`after idle {set y after}`
433			`after idle {set z "after, y = $y"}`
434			`set x before`
435			`set y before`
436			`set z before`
437			`update idletasks`
438			`list $x $y $z`
439			`} {before after {after, y = after}}`
440			`test event-12.4 {Tcl_UpdateCmd procedure} {`
441			`foreach i [after info] {`
442			`after cancel $i`
443			`}`
444			`after 10; update; # On Mac make sure update won't take long`
445			`after 200 {set x x-done}`
446			`after 600 {set y y-done}`
447			`after idle {set z z-done}`
448			`set x before`
449			`set y before`
450			`set z before`
451			`after 300`
452			`update`
453			`list $x $y $z`
454			`} {x-done before z-done}`
455
456			`if {[info commands testfilehandler] != ""} {`
457			`test event-13.1 {Tcl_WaitForFile procedure, readable} unixOnly {`
458			`foreach i [after info] {`
459			`after cancel $i`
460			`}`
461			`after 100 set x timeout`
462			`testfilehandler close`
463			`testfilehandler create 1 off off`
464			`set x "no timeout"`
465			`set result [testfilehandler wait 1 readable 0]`
466			`update`
467			`testfilehandler close`
468			`list $result $x`
469			`} {{} {no timeout}}`
470			`test event-13.2 {Tcl_WaitForFile procedure, readable} unixOnly {`
471			`foreach i [after info] {`
472			`after cancel $i`
473			`}`
474			`after 100 set x timeout`
475			`testfilehandler close`
476			`testfilehandler create 1 off off`
477			`set x "no timeout"`
478			`set result [testfilehandler wait 1 readable 100]`
479			`update`
480			`testfilehandler close`
481			`list $result $x`
482			`} {{} timeout}`
483			`test event-13.3 {Tcl_WaitForFile procedure, readable} unixOnly {`
484			`foreach i [after info] {`
485			`after cancel $i`
486			`}`
487			`after 100 set x timeout`
488			`testfilehandler close`
489			`testfilehandler create 1 off off`
490			`testfilehandler fillpartial 1`
491			`set x "no timeout"`
492			`set result [testfilehandler wait 1 readable 100]`
493			`update`
494			`testfilehandler close`
495			`list $result $x`
496			`} {readable {no timeout}}`
497			`test event-13.4 {Tcl_WaitForFile procedure, writable} {unixOnly nonPortable} {`
498			`foreach i [after info] {`
499			`after cancel $i`
500			`}`
501			`after 100 set x timeout`
502			`testfilehandler close`
503			`testfilehandler create 1 off off`
504			`testfilehandler fill 1`
505			`set x "no timeout"`
506			`set result [testfilehandler wait 1 writable 0]`
507			`update`
508			`testfilehandler close`
509			`list $result $x`
510			`} {{} {no timeout}}`
511			`test event-13.5 {Tcl_WaitForFile procedure, writable} {unixOnly nonPortable} {`
512			`foreach i [after info] {`
513			`after cancel $i`
514			`}`
515			`after 100 set x timeout`
516			`testfilehandler close`
517			`testfilehandler create 1 off off`
518			`testfilehandler fill 1`
519			`set x "no timeout"`
520			`set result [testfilehandler wait 1 writable 100]`
521			`update`
522			`testfilehandler close`
523			`list $result $x`
524			`} {{} timeout}`
525			`test event-13.6 {Tcl_WaitForFile procedure, writable} unixOnly {`
526			`foreach i [after info] {`
527			`after cancel $i`
528			`}`
529			`after 100 set x timeout`
530			`testfilehandler close`
531			`testfilehandler create 1 off off`
532			`set x "no timeout"`
533			`set result [testfilehandler wait 1 writable 100]`
534			`update`
535			`testfilehandler close`
536			`list $result $x`
537			`} {writable {no timeout}}`
538			`test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} unixOnly {`
539			`foreach i [after info] {`
540			`after cancel $i`
541			`}`
542			`after 100 lappend x timeout`
543			`after idle lappend x idle`
544			`testfilehandler close`
545			`testfilehandler create 1 off off`
546			`set x ""`
547			`set result [list [testfilehandler wait 1 readable 200] $x]`
548			`update`
549			`testfilehandler close`
550			`lappend result $x`
551			`} {{} {} {timeout idle}}`
552			`}`
553
554			`if {[info commands testfilewait] != ""} {`
555			`test event-13.8 {Tcl_WaitForFile procedure, waiting indefinitely} unixOnly {`
556			`set f [open "\|sleep 2" r]`
557			`set result ""`
558			`lappend result [testfilewait $f readable 100]`
559			`lappend result [testfilewait $f readable -1]`
560			`close $f`
561			`set result`
562			`} {{} readable}`
563			`}`
564
565			`foreach i [after info] {`
566			`after cancel $i`
567			`}`