Test file tests/unixForkEvent.test added

1 files changed, 50 insertions, 0 deletions

diff --git a/tests/unixForkEvent.test b/tests/unixForkEvent.test
new file mode 100644
index 0000000..fee45fd
--- /dev/null
+++ b/tests/unixForkEvent.test
@@ -0,0 +1,50 @@
+# This file contains a collection of tests for the procedures in the file
+# tclEvent.c, which includes the "update", and "vwait" Tcl
+# commands.  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]]
+testConstraint threaded [expr {
+    ([info exist tcl_platform(threaded)] && $tcl_platform(threaded))
+    && $tcl_platform(os) ne "Darwin"
+}]
+
+# 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 {threaded 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