summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordavygrvy <davygrvy@pobox.com>2002-12-17 02:47:38 (GMT)
committerdavygrvy <davygrvy@pobox.com>2002-12-17 02:47:38 (GMT)
commit8fd397ee9ff91c143248a1ad2d38a15501f42489 (patch)
treeb0fb63ee0afd303f5cf38f33ad6b51f21b5830c1 /tests
parent769a60101291f798e16b5919ab9f5879806ccd37 (diff)
downloadtcl-8fd397ee9ff91c143248a1ad2d38a15501f42489.zip
tcl-8fd397ee9ff91c143248a1ad2d38a15501f42489.tar.gz
tcl-8fd397ee9ff91c143248a1ad2d38a15501f42489.tar.bz2
* 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..
Diffstat (limited to 'tests')
-rw-r--r--tests/winPipe.test30
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]