tcl/tests/unixNotfy.test

   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$
  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
  21     namespace import -force ::tcltest::*
  22 }
  23
  24 if {[info exists tk_version]} {
  25     puts "When run in a Tk shell, these tests run hang.  Skipping tests ..."
  26     ::tcltest::cleanupTests
  27     return
  28 }
  29
  30 set ::tcltest::testConstraints(testthread) \
  31         [expr {[info commands testthread] != {}}]
  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
  37 test unixNotfy-1.1 {Tcl_DeleteFileHandler} {unixOnly && !testthread} {
  38     catch {vwait x}
  39     set f [open foo w]
  40     fileevent $f writable {set x 1}
  41     vwait x
  42     close $f
  43     list [catch {vwait x} msg] $msg
  44 } {1 {can't wait for variable "x":  would wait forever}}
  45 test unixNotfy-1.2 {Tcl_DeleteFileHandler} {unixOnly && !testthread} {
  46     catch {vwait x}
  47     set f1 [open foo w]
  48     set f2 [open foo2 w]
  49     fileevent $f1 writable {set x 1}
  50     fileevent $f2 writable {set y 1}
  51     vwait x
  52     close $f1
  53     vwait y
  54     close $f2
  55     list [catch {vwait x} msg] $msg
  56 } {1 {can't wait for variable "x":  would wait forever}}
  57
  58
  59 test unixNotfy-2.1 {Tcl_DeleteFileHandler} {unixOnly testthread} {
  60     update
  61     set f [open foo w]
  62     fileevent $f writable {set x 1}
  63     vwait x
  64     close $f
  65     testthread create "after 500
  66     testthread send [testthread id] {set x ok}
  67     testthread exit"
  68     vwait x
  69     set x
  70 } {ok}
  71 test unixNotfy-1.2 {Tcl_DeleteFileHandler} {unixOnly testthread} {
  72     update
  73     set f1 [open foo w]
  74     set f2 [open foo2 w]
  75     fileevent $f1 writable {set x 1}
  76     fileevent $f2 writable {set y 1}
  77     vwait x
  78     close $f1
  79     vwait y
  80     close $f2
  81     testthread create "after 500
  82     testthread send [testthread id] {set x ok}
  83     testthread exit"
  84     vwait x
  85     set x
  86 } {ok}
  87
  88
  89
  90 # cleanup
  91 file delete foo
  92 file delete foo2
  93 ::tcltest::cleanupTests
  94 return
  95
  96
  97
  98
  99
 100
 101
 102
 103
 104
 105
 106
 107