diff options
Diffstat (limited to 'tests/unixNotfy.test')
| -rw-r--r-- | tests/unixNotfy.test | 39 |
1 files changed, 25 insertions, 14 deletions
diff --git a/tests/unixNotfy.test b/tests/unixNotfy.test index 8ab0edb..8af8a21 100644 --- a/tests/unixNotfy.test +++ b/tests/unixNotfy.test @@ -4,36 +4,45 @@ # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # -# Copyright © 1997 Sun Microsystems, Inc. -# Copyright © 1998-1999 Scriptics Corporation. +# 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. -if {"::tcltest" ni [namespace children]} { - package require tcltest 2.5 +# 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 "testthread" command indicates that this is the case. + +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest 2 namespace import -force ::tcltest::* } # 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-}]}] +testConstraint noTk [expr {![info exists tk_version]}] +testConstraint testthread [expr {[info commands testthread] != {}}] +# Darwin always uses a threaded notifier +testConstraint unthreaded [expr { + (![info exist tcl_platform(threaded)] || !$tcl_platform(threaded)) + && $tcl_platform(os) ne "Darwin" +}] # 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 nonPortable -body { +test unixNotfy-1.1 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body { catch {vwait x} set f [open [makeFile "" foo] w] fileevent $f writable {set x 1} vwait x close $f list [catch {vwait x} msg] $msg -} -result {1 {can't wait for variable "x": would wait forever}} -cleanup { +} -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 nonPortable -body { +test unixNotfy-1.2 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body { catch {vwait x} set f1 [open [makeFile "" foo] w] set f2 [open [makeFile "" foo2] w] @@ -52,15 +61,16 @@ test unixNotfy-1.2 {Tcl_DeleteFileHandler} -constraints nonPortable -body { } test unixNotfy-2.1 {Tcl_DeleteFileHandler} \ - -constraints {noTk unix thread} \ + -constraints {noTk unix testthread} \ -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}" + testthread create "testthread send [testthread id] {set x ok}" vwait x + threadReap set x } \ -result {ok} \ @@ -69,7 +79,7 @@ test unixNotfy-2.1 {Tcl_DeleteFileHandler} \ catch { removeFile foo } } test unixNotfy-2.2 {Tcl_DeleteFileHandler} \ - -constraints {noTk unix thread} \ + -constraints {noTk unix testthread} \ -body { update set f1 [open [makeFile "" foo] w] @@ -80,12 +90,13 @@ test unixNotfy-2.2 {Tcl_DeleteFileHandler} \ close $f1 vwait y close $f2 - thread::create "thread::send [thread::id] {set x ok}" + testthread create "testthread send [testthread id] {set x ok}" vwait x + threadReap set x } \ -result {ok} \ - -cleanup { + -cleanup { catch { close $f1 } catch { close $f2 } catch { removeFile foo } |