diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2016-12-21 22:56:22 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2016-12-21 22:56:22 (GMT) |
commit | d1a6de55efc90f190dee42ab8c4fa9070834e77d (patch) | |
tree | ec633f5608ef498bee52a5f42c12c49493ec8bf8 /tcl8.6/tests/unixForkEvent.test | |
parent | 5514e37335c012cc70f5b9aee3cedfe3d57f583f (diff) | |
parent | 98acd3f494b28ddd8c345a2bb9311e41e2d56ddd (diff) | |
download | blt-d1a6de55efc90f190dee42ab8c4fa9070834e77d.zip blt-d1a6de55efc90f190dee42ab8c4fa9070834e77d.tar.gz blt-d1a6de55efc90f190dee42ab8c4fa9070834e77d.tar.bz2 |
Merge commit '98acd3f494b28ddd8c345a2bb9311e41e2d56ddd' as 'tcl8.6'
Diffstat (limited to 'tcl8.6/tests/unixForkEvent.test')
-rw-r--r-- | tcl8.6/tests/unixForkEvent.test | 45 |
1 files changed, 45 insertions, 0 deletions
diff --git a/tcl8.6/tests/unixForkEvent.test b/tcl8.6/tests/unixForkEvent.test new file mode 100644 index 0000000..120f362 --- /dev/null +++ b/tcl8.6/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 nonPortable} \ + -body { + set myFolder [makeDirectory unixtestfork] + set pid [testfork] + if {$pid == 0} { + # we are the forked process + set result initialized + set h [open [file join $myFolder test.txt] w] + fileevent $h writable\ + "set result writable;\ + after cancel [after 1000 {set result timeout}]" + vwait result + close $h + makeFile $result result.txt $myFolder + exit + } + # we are the original process + while {![file readable [file join $myFolder result.txt]]} {} + viewFile result.txt $myFolder + } \ + -result {writable} \ + -cleanup { + catch { removeFolder $myFolder } + } + +::tcltest::cleanupTests +return |