summaryrefslogtreecommitdiffstats
path: root/tests/event.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/event.test')
-rw-r--r--tests/event.test606
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
+
+
+
+
+
+
+
+
+
+
+
+