merged tcl 8.1 branch back into the main trunk

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