os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/unixNotfy.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/unixNotfy.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,126 @@
1.4 +# This file contains tests for tclUnixNotfy.c.
1.5 +#
1.6 +# This file contains a collection of tests for one or more of the Tcl
1.7 +# built-in commands. Sourcing this file into Tcl runs the tests and
1.8 +# generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1997 by Sun Microsystems, Inc.
1.11 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.12 +#
1.13 +# See the file "license.terms" for information on usage and redistribution
1.14 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.15 +#
1.16 +# RCS: @(#) $Id: unixNotfy.test,v 1.11.2.4 2005/05/14 20:52:31 das Exp $
1.17 +
1.18 +# The tests should not be run if you have a notifier which is unable to
1.19 +# detect infinite vwaits, as the tests below will hang. The presence of
1.20 +# the "testthread" command indicates that this is the case.
1.21 +
1.22 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.23 + package require tcltest 2
1.24 + namespace import -force ::tcltest::*
1.25 +}
1.26 +
1.27 +if {[info exists tk_version]} {
1.28 + puts "When run in a Tk shell, these tests run hang. Skipping tests ..."
1.29 + ::tcltest::cleanupTests
1.30 + return
1.31 +}
1.32 +
1.33 +set ::tcltest::testConstraints(testthread) \
1.34 + [expr {[info commands testthread] != {}}]
1.35 +# Darwin always uses a threaded notifier
1.36 +testConstraint unthreaded [expr {
1.37 + (![info exist tcl_platform(threaded)] || !$tcl_platform(threaded))
1.38 + && $tcl_platform(os) ne "Darwin"
1.39 +}]
1.40 +
1.41 +# The next two tests will hang if threads are enabled because the notifier
1.42 +# will not necessarily wait for ever in this case, so it does not generate
1.43 +# an error.
1.44 +
1.45 +test unixNotfy-1.1 {Tcl_DeleteFileHandler} \
1.46 + -constraints {unixOnly && unthreaded} \
1.47 + -body {
1.48 + catch {vwait x}
1.49 + set f [open [makeFile "" foo] w]
1.50 + fileevent $f writable {set x 1}
1.51 + vwait x
1.52 + close $f
1.53 + list [catch {vwait x} msg] $msg
1.54 + } \
1.55 + -result {1 {can't wait for variable "x": would wait forever}} \
1.56 + -cleanup {
1.57 + catch { close $f }
1.58 + catch { removeFile foo }
1.59 + }
1.60 +
1.61 +test unixNotfy-1.2 {Tcl_DeleteFileHandler} \
1.62 + -constraints {unixOnly && unthreaded} \
1.63 + -body {
1.64 + catch {vwait x}
1.65 + set f1 [open [makeFile "" foo] w]
1.66 + set f2 [open [makeFile "" foo2] w]
1.67 + fileevent $f1 writable {set x 1}
1.68 + fileevent $f2 writable {set y 1}
1.69 + vwait x
1.70 + close $f1
1.71 + vwait y
1.72 + close $f2
1.73 + list [catch {vwait x} msg] $msg
1.74 + } \
1.75 + -result {1 {can't wait for variable "x": would wait forever}} \
1.76 + -cleanup {
1.77 + catch { close $f1 }
1.78 + catch { close $f2 }
1.79 + catch { removeFile foo }
1.80 + catch { removeFile foo2 }
1.81 + }
1.82 +
1.83 +test unixNotfy-2.1 {Tcl_DeleteFileHandler} \
1.84 + -constraints {unixOnly testthread} \
1.85 + -body {
1.86 + update
1.87 + set f [open [makeFile "" foo] w]
1.88 + fileevent $f writable {set x 1}
1.89 + vwait x
1.90 + close $f
1.91 + testthread create "testthread send [testthread id] {set x ok}"
1.92 + vwait x
1.93 + threadReap
1.94 + set x
1.95 + } \
1.96 + -result {ok} \
1.97 + -cleanup {
1.98 + catch { close $f }
1.99 + catch { removeFile foo }
1.100 + }
1.101 +
1.102 +test unixNotfy-2.2 {Tcl_DeleteFileHandler} \
1.103 + -constraints {unixOnly testthread} \
1.104 + -body {
1.105 + update
1.106 + set f1 [open [makeFile "" foo] w]
1.107 + set f2 [open [makeFile "" foo2] w]
1.108 + fileevent $f1 writable {set x 1}
1.109 + fileevent $f2 writable {set y 1}
1.110 + vwait x
1.111 + close $f1
1.112 + vwait y
1.113 + close $f2
1.114 + testthread create "testthread send [testthread id] {set x ok}"
1.115 + vwait x
1.116 + threadReap
1.117 + set x
1.118 + } \
1.119 + -result {ok} \
1.120 + -cleanup {
1.121 + catch { close $f1 }
1.122 + catch { close $f2 }
1.123 + catch { removeFile foo }
1.124 + catch { removeFile foo2 }
1.125 + }
1.126 +
1.127 +# cleanup
1.128 +::tcltest::cleanupTests
1.129 +return