source: downloads/tcl8.5.2/tests/event.test @ 68

# 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.27 2008/03/10 17:54:47 dgp Exp $

package require tcltest 2
namespace import -force ::tcltest::*

testConstraint testfilehandler [llength [info commands testfilehandler]]
testConstraint testexithandler [llength [info commands testexithandler]]
testConstraint testfilewait [llength [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]
    }
    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 {}
    regsub -all [file join {} non_existent] $x "non_existent" x
    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-5.3 {HandleBgErrors: [Bug 1670155]} -setup {
    variable x
    proc demo args {variable x done}
    variable target [list [namespace which demo] x]
    proc trial args {variable target; string length $target}
    trace add execution demo enter [namespace code trial]
    variable save [interp bgerror {}]
    interp bgerror {} $target
} -body {
    after 0 {error bar}
    vwait [namespace which -variable x]
} -cleanup {
    interp bgerror {} $save
    unset x target save
    rename demo {}
    rename trial {}
} -result {}
test event-5.3 {Default [interp bgerror] handler} -body {
    ::tcl::Bgerror
} -returnCodes error -match glob -result {*msg options*}
test event-5.4 {Default [interp bgerror] handler} -body {
    ::tcl::Bgerror {}
} -returnCodes error -match glob -result {*msg options*}
test event-5.5 {Default [interp bgerror] handler} -body {
    ::tcl::Bgerror {} {} {}
} -returnCodes error -match glob -result {*msg options*}
test event-5.6 {Default [interp bgerror] handler} -body {
    ::tcl::Bgerror {} {}
} -returnCodes error -match glob -result {*-level*}
test event-5.7 {Default [interp bgerror] handler} -body {
    ::tcl::Bgerror {} {-level foo}
} -returnCodes error -match glob -result {*expected integer*}
test event-5.8 {Default [interp bgerror] handler} -body {
    ::tcl::Bgerror {} {-level 0}
} -returnCodes error -match glob -result {*-code*}
test event-5.9 {Default [interp bgerror] handler} -body {
    ::tcl::Bgerror {} {-level 0 -code ok}
} -returnCodes error -match glob -result {*expected integer*}
test event-5.10 {Default [interp bgerror] handler} {
    proc bgerror {m} {append ::res $m}
    set ::res {}
    ::tcl::Bgerror {} {-level 0 -code 0}
    rename bgerror {}
    set ::res
} {}
test event-5.11 {Default [interp bgerror] handler} {
    proc bgerror {m} {append ::res $m}
    set ::res {}
    ::tcl::Bgerror msg {-level 0 -code 1}
    rename bgerror {}
    set ::res
} {msg}
test event-5.12 {Default [interp bgerror] handler} {
    proc bgerror {m} {append ::res $m}
    set ::res {}
    ::tcl::Bgerror msg {-level 0 -code 2}
    rename bgerror {}
    set ::res
} {command returned bad code: 2}
test event-5.13 {Default [interp bgerror] handler} {
    proc bgerror {m} {append ::res $m}
    set ::res {}
    ::tcl::Bgerror msg {-level 0 -code 3}
    rename bgerror {}
    set ::res
} {invoked "break" outside of a loop}
test event-5.14 {Default [interp bgerror] handler} {
    proc bgerror {m} {append ::res $m}
    set ::res {}
    ::tcl::Bgerror msg {-level 0 -code 4}
    rename bgerror {}
    set ::res
} {invoked "continue" outside of a loop}
test event-5.15 {Default [interp bgerror] handler} {
    proc bgerror {m} {append ::res $m}
    set ::res {}
    ::tcl::Bgerror msg {-level 0 -code 5}
    rename bgerror {}
    set ::res
} {command returned bad code: 5}

test event-6.1 {BgErrorDeleteProc procedure} {
    catch {interp delete foo}
    interp create foo
    set erroutfile [makeFile Unmodified err.out]
    foo eval [list set erroutfile $erroutfile]
    foo eval {
        proc bgerror args {
            global errorInfo erroutfile
            set f [open $erroutfile r+]
            seek $f 0 end
            puts $f "$args $errorInfo"
            close $f
        }
        after 100 {error "first error"}
        after 100 {error "second error"}
    }
    after 100 {interp delete foo}
    after 200
    update
    set f [open $erroutfile r]
    set result [read $f]
    close $f
    removeFile $erroutfile
    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

testConstraint exec [llength [info commands exec]]

test event-7.5 {correct behaviour when there is no bgerror [Bug 219142]} {exec} {
    set script {
        after 1000 error hello
        after 2000 set a 0
        vwait a
    }

    list [catch {exec [interpreter] << $script} errMsg] $errMsg
} {1 {hello
    while executing
"error hello"
    ("after" script)}}

test event-7.6 {safe hidden bgerror fallback} {
    variable result {}
    interp create -safe safe
    safe alias puts puts
    safe alias result ::append [namespace which -variable result]
    safe eval {proc bgerror m {result $m\n$::errorCode\n$::errorInfo\n}}
    safe hide bgerror
    safe eval after 0 error foo
    update
    interp delete safe
    set result
} {foo
NONE
foo
    while executing
"error foo"
    ("after" script)
}

test event-7.7 {safe hidden bgerror fallback} {
    variable result {}
    interp create -safe safe
    safe alias puts puts
    safe alias result ::append [namespace which -variable result]
    safe eval {proc bgerror m {result $m\n$::errorCode\n$::errorInfo\n}}
    safe hide bgerror
    safe eval {proc bgerror m {error bar soom baz}}
    safe eval after 0 error foo
    update
    interp delete safe
    set result
} {foo
NONE
foo
    while executing
"error foo"
    ("after" script)
}


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


test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} {
    set child [open |[list [interpreter]] 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 [interpreter]] 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 [interpreter]] 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 [interpreter]] 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 [interpreter]] 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 [interpreter]] 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 test1file [makeFile "" test1]
    set f1 [open $test1file w]
    proc accept {s args} {
        puts $s foobar
        close $s
    }
    catch {set s1 [socket -server accept -myaddr 127.0.0.1 0]}
    after 1000
    catch {set s2 [socket 127.0.0.1 [lindex [fconfigure $s1 -sockname] 2]]}
    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
    removeFile $test1file
    list $x $y $z
} {3 3 done}
test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {
    set test1file [makeFile "" test1]
    set test2file [makeFile "" test2]
    set f1 [open $test1file w]
    set f2 [open $test2file 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
    removeFile $test1file
    removeFile $test2file
    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}

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}


test event-14.1 {Tcl_WaitForFile procedure, readable, big fd} \
    -constraints {testfilehandler unix} \
    -setup {
        set chanList {}
        for {set i 0} {$i < 32} {incr i} {
            lappend chanList [open /dev/null r]
        }
    } \
    -body {
        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
    } \
    -result {{} {no timeout}} \
    -cleanup {
        foreach chan $chanList {close $chan}
    }

test event-14.2 {Tcl_WaitForFile procedure, readable, big fd} \
    -constraints {testfilehandler unix} \
    -setup {
        set chanList {}
        for {set i 0} {$i < 32} {incr i} {
            lappend chanList [open /dev/null r]
        }
    } \
    -body {
        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
    } \
    -result {{} timeout} \
    -cleanup {
        foreach chan $chanList {close $chan}
    }

test event-14.3 {Tcl_WaitForFile procedure, readable, big fd} \
    -constraints {testfilehandler unix} \
    -setup {
        set chanList {}
        for {set i 0} {$i < 32} {incr i} {
            lappend chanList [open /dev/null r]
        }
    } \
    -body {
        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
    } \
    -result {readable {no timeout}} \
    -cleanup {
        foreach chan $chanList {close $chan}
    }

test event-14.4 {Tcl_WaitForFile procedure, writable, big fd} \
    -constraints {testfilehandler unix nonPortable} \
    -setup {
        set chanList {}
        for {set i 0} {$i < 32} {incr i} {
            lappend chanList [open /dev/null r]
        }
    } \
    -body {
        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 $
    } \
    -result {{} {no timeout}} \
    -cleanup {
        foreach chan $chanList {close $chan}
    }

test event-14.5 {Tcl_WaitForFile procedure, writable, big fd} \
    -constraints {testfilehandler unix nonPortable} \
    -setup {
        set chanList {}
        for {set i 0} {$i < 32} {incr i} {
            lappend chanList [open /dev/null r]
        }
    } \
    -body {
        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
    } \
    -result {{} timeout} \
    -cleanup {
        foreach chan $chanList {close $chan}
    }

test event-14.6 {Tcl_WaitForFile procedure, writable, big fd} \
    -constraints {testfilehandler unix} \
    -setup {
        set chanList {}
        for {set i 0} {$i < 32} {incr i} {
            lappend chanList [open /dev/null r]
        }
    } \
    -body {
        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
    } \
    -result {writable {no timeout}} \
    -cleanup {
        foreach chan $chanList {close $chan}
    }

test event-14.7 {Tcl_WaitForFile, don't call other event handlers, big fd} \
    -constraints {testfilehandler unix} \
    -setup {
        set chanList {}
        for {set i 0} {$i < 32} {incr i} {
            lappend chanList [open /dev/null r]
        }
    } \
    -body {
        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
    } \
    -result {{} {} {timeout idle}} \
    -cleanup {
        foreach chan $chanList {close $chan}
    }


test event-14.8 {Tcl_WaitForFile procedure, waiting indefinitely, big fd} \
    -constraints {testfilewait unix} \
    -body {
        set f [open "|sleep 2" r]
        set result ""
        lappend result [testfilewait $f readable 100]
        lappend result [testfilewait $f readable -1]
        close $f
        set result
    } \
    -setup {
        set chanList {}
        for {set i 0} {$i < 32} {incr i} {
            lappend chanList [open /dev/null r]
        }
    } \
    -result {{} readable} \
    -cleanup {
        foreach chan $chanList {close $chan}
    }

# cleanup
foreach i [after info] {
    after cancel $i
}
::tcltest::cleanupTests
return