diff options
Diffstat (limited to 'tests/event.test')
| -rw-r--r-- | tests/event.test | 606 |
1 files changed, 314 insertions, 292 deletions
diff --git a/tests/event.test b/tests/event.test index 118bfc1..d75c959 100644 --- a/tests/event.test +++ b/tests/event.test @@ -4,148 +4,159 @@ # 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 $ - -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}} +# 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 {}} @@ -275,69 +286,67 @@ test event-7.4 {tkerror is nothing special anymore to tcl} { 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} { @@ -453,115 +462,128 @@ test event-12.4 {Tcl_UpdateCmd procedure} { 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 + + + + + + + + + + + + |