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 | 3916ce9d4c7f235a49acf158efd4f366ebfe35cf (patch) | |
tree | 718bdfc911fdf789bdc48e4e637474db7f705c2e /tests | |
parent | 84e92af6dc25e59e12d8f7ad4b12016464e030d2 (diff) | |
parent | 41afeeec2bc072a4327f6e45826cddf2cedcb066 (diff) | |
download | tcl-3916ce9d4c7f235a49acf158efd4f366ebfe35cf.zip tcl-3916ce9d4c7f235a49acf158efd4f366ebfe35cf.tar.gz tcl-3916ce9d4c7f235a49acf158efd4f366ebfe35cf.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 |