diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2013-08-01 12:38:04 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2013-08-01 12:38:04 (GMT) |
commit | 5a3ead51fc13cea189ea37817652f2fd83cd5b43 (patch) | |
tree | 718bdfc911fdf789bdc48e4e637474db7f705c2e /tests | |
parent | 35f064fd91f1a987c493f4740df59d3a0f162a42 (diff) | |
parent | 9b087e12907c940eed87b510213ca363ef8d5a4b (diff) | |
download | tcl-5a3ead51fc13cea189ea37817652f2fd83cd5b43.zip tcl-5a3ead51fc13cea189ea37817652f2fd83cd5b43.tar.gz tcl-5a3ead51fc13cea189ea37817652f2fd83cd5b43.tar.bz2 |
Tcl_InitNotifier: Bug [a0bc856dcd].
Start notifier thread again if we were forked, to solve Rivet bug 55153
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..cbe582e --- /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 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 |