diff options
Diffstat (limited to 'tests/unixNotfy.test')
| -rw-r--r-- | tests/unixNotfy.test | 96 |
1 files changed, 74 insertions, 22 deletions
diff --git a/tests/unixNotfy.test b/tests/unixNotfy.test index 7c19129..2f03529 100644 --- a/tests/unixNotfy.test +++ b/tests/unixNotfy.test @@ -5,38 +5,43 @@ # 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 +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest 2 + namespace import -force ::tcltest::* } -# 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. - -if {"[info commands testeventloop]" == "testeventloop"} { - return -} +# When run in a Tk shell, these tests hang. +testConstraint noTk [expr {0 != [catch {package present Tk}]}] +testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}] +# Darwin always uses a threaded notifier +testConstraint unthreaded [expr { + ![::tcl::pkgconfig get threaded] + && $tcl_platform(os) ne "Darwin" +}] -test unixNotfy-1.1 {Tcl_DeleteFileHandler} { +# 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} -constraints {noTk unix unthreaded} -body { catch {vwait x} - set f [open foo w] + set f [open [makeFile "" foo] w] fileevent $f writable {set x 1} vwait x close $f list [catch {vwait x} msg] $msg -} {1 {can't wait for variable "x": would wait forever}} -test unixNotfy-1.2 {Tcl_DeleteFileHandler} { +} -result {1 {can't wait for variable "x": would wait forever}} -cleanup { + catch { close $f } + catch { removeFile foo } +} +test unixNotfy-1.2 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body { catch {vwait x} - set f1 [open foo w] - set f2 [open foo2 w] + set f1 [open [makeFile "" foo] w] + set f2 [open [makeFile "" foo2] w] fileevent $f1 writable {set x 1} fileevent $f2 writable {set y 1} vwait x @@ -44,7 +49,54 @@ test unixNotfy-1.2 {Tcl_DeleteFileHandler} { vwait y close $f2 list [catch {vwait x} msg] $msg -} {1 {can't wait for variable "x": would wait forever}} +} -result {1 {can't wait for variable "x": would wait forever}} -cleanup { + catch { close $f1 } + catch { close $f2 } + catch { removeFile foo } + catch { removeFile foo2 } +} + +test unixNotfy-2.1 {Tcl_DeleteFileHandler} \ + -constraints {noTk unix thread} \ + -body { + update + set f [open [makeFile "" foo] w] + fileevent $f writable {set x 1} + vwait x + close $f + thread::create "thread::send [thread::id] {set x ok}" + vwait x + set x + } \ + -result {ok} \ + -cleanup { + catch { close $f } + catch { removeFile foo } + } +test unixNotfy-2.2 {Tcl_DeleteFileHandler} \ + -constraints {noTk unix thread} \ + -body { + update + set f1 [open [makeFile "" foo] w] + set f2 [open [makeFile "" foo2] w] + fileevent $f1 writable {set x 1} + fileevent $f2 writable {set y 1} + vwait x + close $f1 + vwait y + close $f2 + thread::create "thread::send [thread::id] {set x ok}" + vwait x + set x + } \ + -result {ok} \ + -cleanup { + catch { close $f1 } + catch { close $f2 } + catch { removeFile foo } + catch { removeFile foo2 } + } -file delete foo -file delete foo2 +# cleanup +::tcltest::cleanupTests +return |