summaryrefslogtreecommitdiffstats
path: root/tests/winPipe.test
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2012-08-08 20:30:37 (GMT)
committerdgp <dgp@users.sourceforge.net>2012-08-08 20:30:37 (GMT)
commit1e5b4c061fd012e8814dd840bb9bd3f35d742c05 (patch)
treea6fadf3d6bc55a704065f4543ea894d5ebddfe46 /tests/winPipe.test
parent92740dd9047be0dac46bae7af8bb3e8b3291e27d (diff)
parent3489422b6ee1589effd0dadf0556985e331d689b (diff)
downloadtcl-1e5b4c061fd012e8814dd840bb9bd3f35d742c05.zip
tcl-1e5b4c061fd012e8814dd840bb9bd3f35d742c05.tar.gz
tcl-1e5b4c061fd012e8814dd840bb9bd3f35d742c05.tar.bz2
merge trunk
Diffstat (limited to 'tests/winPipe.test')
-rw-r--r--tests/winPipe.test20
1 files changed, 16 insertions, 4 deletions
diff --git a/tests/winPipe.test b/tests/winPipe.test
index 62d7d0d..d2e804d 100644
--- a/tests/winPipe.test
+++ b/tests/winPipe.test
@@ -16,6 +16,12 @@ package require tcltest
namespace import -force ::tcltest::*
unset -nocomplain path
+catch {
+ ::tcltest::loadTestedCommands
+ package require -exact Tcltest [info patchlevel]
+ set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
+}
+
set bindir [file join [pwd] [file dirname [info nameofexecutable]]]
set cat32 [file join $bindir cat32.exe]
@@ -23,6 +29,8 @@ testConstraint exec [llength [info commands exec]]
testConstraint cat32 [file exists $cat32]
testConstraint AllocConsole [catch {puts console1 ""}]
testConstraint RealConsole [expr {![testConstraint AllocConsole]}]
+testConstraint testexcept [llength [info commands testexcept]]
+
set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
append big $big
@@ -190,30 +198,34 @@ test winpipe-4.1 {Tcl_WaitPid} {win 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} {win exec} {
+test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec testexcept} {
set f [open "|[list [interpreter]]" w+]
set pid [pid $f]
+ puts $f "load $::tcltestlib Tcltest"
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} {win exec} {
+test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec testexcept} {
set f [open "|[list [interpreter]]" w+]
set pid [pid $f]
+ puts $f "load $::tcltestlib Tcltest"
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} {win exec} {
+test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec testexcept} {
set f [open "|[list [interpreter]]" w+]
set pid [pid $f]
+ puts $f "load $::tcltestlib Tcltest"
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} {win exec} {
+test winpipe-4.5 {Tcl_WaitPid: return of exception codes, SIGINT} {win exec testexcept} {
set f [open "|[list [interpreter]]" w+]
set pid [pid $f]
+ puts $f "load $::tcltestlib Tcltest"
puts $f "testexcept ctrl+c"
set status [catch {close $f}]
list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]