diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2013-07-23 09:54:05 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2013-07-23 09:54:05 (GMT) |
commit | 0185dd6477393cbc026ba2f915de1ef95cec8edc (patch) | |
tree | d6544668243bc8a0c9398620b3e8fb008edcc88d /tests | |
parent | bc28cd1ac82705c2452e11f441e3fd0796c6d692 (diff) | |
parent | 9350513d164aa683ea09806945eef90a924a936b (diff) | |
download | tcl-0185dd6477393cbc026ba2f915de1ef95cec8edc.zip tcl-0185dd6477393cbc026ba2f915de1ef95cec8edc.tar.gz tcl-0185dd6477393cbc026ba2f915de1ef95cec8edc.tar.bz2 |
rebase
Diffstat (limited to 'tests')
-rw-r--r-- | tests/unixForkEvent.test | 45 |
1 files changed, 45 insertions, 0 deletions
diff --git a/tests/unixForkEvent.test b/tests/unixForkEvent.test new file mode 100644 index 0000000..a0c3f19 --- /dev/null +++ b/tests/unixForkEvent.test @@ -0,0 +1,45 @@ +# This file contains a collection of tests for the procedures in the file +# tclUnixNotify.c. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 1995-1997 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. + +package require tcltest 2 +namespace import -force ::tcltest::* + +testConstraint testfork [llength [info commands testfork]] + +# Test if the notifier thread is well initialized in a forked interpreter +# by Tcl_InitNotifier +test unixforkevent-1.1 {fork and test writeable event} \ + -constraints testfork \ + -body { + set folder [makeDirectory unixtestfork] + set pid [testfork] + if {$pid == 0} { + # we are the forked process + set result initialized + set h [open [file join $folder test.txt] w] + fileevent $h writable\ + "set result writable;\ + after cancel [after 1000 {set result timeout}]" + vwait result + close $h + makeFile $result result.txt $folder + exit + } + # we are the original process + while {![file readable [file join $folder result.txt]]} {} + viewFile result.txt $folder + } \ + -result {writable} \ + -cleanup { + catch { removeFolder $folder } + } + +::tcltest::cleanupTests +return |