[25] | 1 | # This file contains tests for tclUnixNotfy.c. |
---|
| 2 | # |
---|
| 3 | # This file contains a collection of tests for one or more of the Tcl |
---|
| 4 | # built-in commands. Sourcing this file into Tcl runs the tests and |
---|
| 5 | # generates output for errors. No output means no errors were found. |
---|
| 6 | # |
---|
| 7 | # Copyright (c) 1997 by Sun Microsystems, Inc. |
---|
| 8 | # Copyright (c) 1998-1999 by Scriptics Corporation. |
---|
| 9 | # |
---|
| 10 | # See the file "license.terms" for information on usage and redistribution |
---|
| 11 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
| 12 | # |
---|
| 13 | # RCS: @(#) $Id: unixNotfy.test,v 1.19 2005/11/01 16:41:20 dgp Exp $ |
---|
| 14 | |
---|
| 15 | # The tests should not be run if you have a notifier which is unable to |
---|
| 16 | # detect infinite vwaits, as the tests below will hang. The presence of |
---|
| 17 | # the "testthread" command indicates that this is the case. |
---|
| 18 | |
---|
| 19 | if {[lsearch [namespace children] ::tcltest] == -1} { |
---|
| 20 | package require tcltest 2 |
---|
| 21 | namespace import -force ::tcltest::* |
---|
| 22 | } |
---|
| 23 | |
---|
| 24 | # When run in a Tk shell, these tests hang. |
---|
| 25 | testConstraint noTk [expr {![info exists tk_version]}] |
---|
| 26 | testConstraint testthread [expr {[info commands testthread] != {}}] |
---|
| 27 | # Darwin always uses a threaded notifier |
---|
| 28 | testConstraint unthreaded [expr { |
---|
| 29 | (![info exist tcl_platform(threaded)] || !$tcl_platform(threaded)) |
---|
| 30 | && $tcl_platform(os) ne "Darwin" |
---|
| 31 | }] |
---|
| 32 | |
---|
| 33 | # The next two tests will hang if threads are enabled because the notifier |
---|
| 34 | # will not necessarily wait for ever in this case, so it does not generate |
---|
| 35 | # an error. |
---|
| 36 | test unixNotfy-1.1 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body { |
---|
| 37 | catch {vwait x} |
---|
| 38 | set f [open [makeFile "" foo] w] |
---|
| 39 | fileevent $f writable {set x 1} |
---|
| 40 | vwait x |
---|
| 41 | close $f |
---|
| 42 | list [catch {vwait x} msg] $msg |
---|
| 43 | } -result {1 {can't wait for variable "x": would wait forever}} -cleanup { |
---|
| 44 | catch { close $f } |
---|
| 45 | catch { removeFile foo } |
---|
| 46 | } |
---|
| 47 | test unixNotfy-1.2 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body { |
---|
| 48 | catch {vwait x} |
---|
| 49 | set f1 [open [makeFile "" foo] w] |
---|
| 50 | set f2 [open [makeFile "" foo2] w] |
---|
| 51 | fileevent $f1 writable {set x 1} |
---|
| 52 | fileevent $f2 writable {set y 1} |
---|
| 53 | vwait x |
---|
| 54 | close $f1 |
---|
| 55 | vwait y |
---|
| 56 | close $f2 |
---|
| 57 | list [catch {vwait x} msg] $msg |
---|
| 58 | } -result {1 {can't wait for variable "x": would wait forever}} -cleanup { |
---|
| 59 | catch { close $f1 } |
---|
| 60 | catch { close $f2 } |
---|
| 61 | catch { removeFile foo } |
---|
| 62 | catch { removeFile foo2 } |
---|
| 63 | } |
---|
| 64 | |
---|
| 65 | test unixNotfy-2.1 {Tcl_DeleteFileHandler} \ |
---|
| 66 | -constraints {noTk unix testthread} \ |
---|
| 67 | -body { |
---|
| 68 | update |
---|
| 69 | set f [open [makeFile "" foo] w] |
---|
| 70 | fileevent $f writable {set x 1} |
---|
| 71 | vwait x |
---|
| 72 | close $f |
---|
| 73 | testthread create "testthread send [testthread id] {set x ok}" |
---|
| 74 | vwait x |
---|
| 75 | threadReap |
---|
| 76 | set x |
---|
| 77 | } \ |
---|
| 78 | -result {ok} \ |
---|
| 79 | -cleanup { |
---|
| 80 | catch { close $f } |
---|
| 81 | catch { removeFile foo } |
---|
| 82 | } |
---|
| 83 | test unixNotfy-2.2 {Tcl_DeleteFileHandler} \ |
---|
| 84 | -constraints {noTk unix testthread} \ |
---|
| 85 | -body { |
---|
| 86 | update |
---|
| 87 | set f1 [open [makeFile "" foo] w] |
---|
| 88 | set f2 [open [makeFile "" foo2] w] |
---|
| 89 | fileevent $f1 writable {set x 1} |
---|
| 90 | fileevent $f2 writable {set y 1} |
---|
| 91 | vwait x |
---|
| 92 | close $f1 |
---|
| 93 | vwait y |
---|
| 94 | close $f2 |
---|
| 95 | testthread create "testthread send [testthread id] {set x ok}" |
---|
| 96 | vwait x |
---|
| 97 | threadReap |
---|
| 98 | set x |
---|
| 99 | } \ |
---|
| 100 | -result {ok} \ |
---|
| 101 | -cleanup { |
---|
| 102 | catch { close $f1 } |
---|
| 103 | catch { close $f2 } |
---|
| 104 | catch { removeFile foo } |
---|
| 105 | catch { removeFile foo2 } |
---|
| 106 | } |
---|
| 107 | |
---|
| 108 | # cleanup |
---|
| 109 | ::tcltest::cleanupTests |
---|
| 110 | return |
---|