diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2013-07-25 07:02:59 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2013-07-25 07:02:59 (GMT) |
commit | 752ab085d6a8bfb6cf8e6660e49398602b724801 (patch) | |
tree | b501748fb15ab8ff53d622fe8d36477988f9e36e /tests | |
parent | 8f2d19b95103df07e718125efcd772ff582c2be1 (diff) | |
parent | 0185dd6477393cbc026ba2f915de1ef95cec8edc (diff) | |
download | tcl-752ab085d6a8bfb6cf8e6660e49398602b724801.zip tcl-752ab085d6a8bfb6cf8e6660e49398602b724801.tar.gz tcl-752ab085d6a8bfb6cf8e6660e49398602b724801.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 |