diff options
author | stanton <stanton> | 1999-04-16 00:46:29 (GMT) |
---|---|---|
committer | stanton <stanton> | 1999-04-16 00:46:29 (GMT) |
commit | 97464e6cba8eb0008cf2727c15718671992b913f (patch) | |
tree | ce9959f2747257d98d52ec8d18bf3b0de99b9535 /tests/unixNotfy.test | |
parent | a8c96ddb94d1483a9de5e340b740cb74ef6cafa7 (diff) | |
download | tcl-97464e6cba8eb0008cf2727c15718671992b913f.zip tcl-97464e6cba8eb0008cf2727c15718671992b913f.tar.gz tcl-97464e6cba8eb0008cf2727c15718671992b913f.tar.bz2 |
merged tcl 8.1 branch back into the main trunk
Diffstat (limited to 'tests/unixNotfy.test')
-rw-r--r-- | tests/unixNotfy.test | 73 |
1 files changed, 61 insertions, 12 deletions
diff --git a/tests/unixNotfy.test b/tests/unixNotfy.test index 7c19129..2775597 100644 --- a/tests/unixNotfy.test +++ b/tests/unixNotfy.test @@ -5,27 +5,29 @@ # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 by 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: unixNotfy.test,v 1.3 1998/09/14 18:40:14 stanton Exp $ - -if {[string compare test [info procs test]] == 1} then {source defs} - -if {$tcl_platform(platform) != "unix"} { - return -} +# RCS: @(#) $Id: unixNotfy.test,v 1.4 1999/04/16 00:47:36 stanton Exp $ # The tests should not be run if you have a notifier which is unable to # detect infinite vwaits, as the tests below will hang. The presence of -# the "testeventloop" command indicates that this is the case. +# the "testthread" command indicates that this is the case. -if {"[info commands testeventloop]" == "testeventloop"} { - return +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] } -test unixNotfy-1.1 {Tcl_DeleteFileHandler} { +set ::tcltest::testConfig(testthread) \ + [expr {[info commands testthread] != {}}] + +# The next two tests will hang if threads are enabled because the notifier +# will not necessarily wait for ever in this case, so it does not generate +# an error. + +test unixNotfy-1.1 {Tcl_DeleteFileHandler} {unixOnly && !testthread} { catch {vwait x} set f [open foo w] fileevent $f writable {set x 1} @@ -33,7 +35,7 @@ test unixNotfy-1.1 {Tcl_DeleteFileHandler} { close $f list [catch {vwait x} msg] $msg } {1 {can't wait for variable "x": would wait forever}} -test unixNotfy-1.2 {Tcl_DeleteFileHandler} { +test unixNotfy-1.2 {Tcl_DeleteFileHandler} {unixOnly && !testthread} { catch {vwait x} set f1 [open foo w] set f2 [open foo2 w] @@ -46,5 +48,52 @@ test unixNotfy-1.2 {Tcl_DeleteFileHandler} { list [catch {vwait x} msg] $msg } {1 {can't wait for variable "x": would wait forever}} + +test unixNotfy-2.1 {Tcl_DeleteFileHandler} {unixOnly testthread} { + update + set f [open foo w] + fileevent $f writable {set x 1} + vwait x + close $f + testthread create "after 500 + testthread send [testthread id] {set x ok} + testthread exit" + vwait x + set x +} {ok} +test unixNotfy-1.2 {Tcl_DeleteFileHandler} {unixOnly testthread} { + update + set f1 [open foo w] + set f2 [open foo2 w] + fileevent $f1 writable {set x 1} + fileevent $f2 writable {set y 1} + vwait x + close $f1 + vwait y + close $f2 + testthread create "after 500 + testthread send [testthread id] {set x ok} + testthread exit" + vwait x + set x +} {ok} + + + +# cleanup file delete foo file delete foo2 +::tcltest::cleanupTests +return + + + + + + + + + + + + |