* generic/tclPipe.c (TclCleanupChildren):

	* tests/winPipe.c:
	* win/tclWinPipe.c (Tcl_WaitPid):
	* win/tclWinTest.c:  Gave Tcl_WaitPid the ability to return a
	Win32 exception code translated into a posix style SIG*.  This
	allows [close] to report "CHILDKILLED" without the meaning
	getting lost in a truncated exit code.  In TclCleanupChildren(),
	TclpGetPid() had to get moved to before Tcl_WaitPid() as the
	the handle is removed from the list taking away the ability
	to get the process id after the wait is done.  This shouldn't
	effect the unix implimentaion unless waitpid is called with
	a pid of zero, meaning "any".  I don't think it is..

1 files changed, 29 insertions, 1 deletions

diff --git a/tests/winPipe.test b/tests/winPipe.test
index 28b2708..26a7e33 100644
--- a/tests/winPipe.test
+++ b/tests/winPipe.test
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: winPipe.test,v 1.21 2002/07/18 16:39:50 vincentdarley Exp $
+# RCS: @(#) $Id: winPipe.test,v 1.22 2002/12/17 02:47:39 davygrvy Exp $
 
 package require tcltest
 namespace import -force ::tcltest::*
@@ -198,6 +198,34 @@ test winpipe-4.1 {Tcl_WaitPid} {pcOnly nt exec cat32} {
     vwait x
     list $result $x [contents $path(stderr)]
 } "{$big} 1 stderr32"
+test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {pcOnly exec} {
+    set f [open "|[tcltest::interpreter]" w+]
+    set pid [pid $f]
+    puts $f "testexcept float_underflow"
+    set status [catch {close $f}]
+    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
+} {1 1 SIGFPE}
+test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {pcOnly exec} {
+    set f [open "|[tcltest::interpreter]" w+]
+    set pid [pid $f]
+    puts $f "testexcept access_violation"
+    set status [catch {close $f}]
+    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
+} {1 1 SIGSEGV}
+test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {pcOnly exec} {
+    set f [open "|[tcltest::interpreter]" w+]
+    set pid [pid $f]
+    puts $f "testexcept illegal_instruction"
+    set status [catch {close $f}]
+    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
+} {1 1 SIGILL}
+test winpipe-4.5 {Tcl_WaitPid: return of exception codes, SIGINT} {pcOnly exec} {
+    set f [open "|[tcltest::interpreter]" w+]
+    set pid [pid $f]
+    puts $f "testexcept ctrl+c"
+    set status [catch {close $f}]
+    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
+} {1 1 SIGINT}
 
 set path(nothing) [makeFile {} nothing]
 close [open $path(nothing) w]