summaryrefslogtreecommitdiffstats
path: root/tests/winPipe.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/winPipe.test')
-rw-r--r--tests/winPipe.test60
1 files changed, 39 insertions, 21 deletions
diff --git a/tests/winPipe.test b/tests/winPipe.test
index 3f983e1..d2e804d 100644
--- a/tests/winPipe.test
+++ b/tests/winPipe.test
@@ -9,13 +9,18 @@
# Copyright (c) 1996 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.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
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]
@@ -24,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
@@ -58,7 +65,7 @@ set path(more) [makeFile {
set path(stdout) [makeFile {} stdout]
set path(stderr) [makeFile {} stderr]
-
+
test winpipe-1.1 {32 bit comprehensive tests: from little file} {win exec cat32} {
exec $cat32 < $path(little) > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
@@ -68,15 +75,15 @@ test winpipe-1.2 {32 bit comprehensive tests: from big file} {win exec cat32} {
list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {win nt exec cat32} {
- exec [interpreter] more < little | $cat32 > $path(stdout) 2> $path(stderr)
+ exec [interpreter] $path(more) < $path(little) | $cat32 > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {win nt exec cat32} {
- exec [interpreter] more < big | $cat32 > $path(stdout) 2> $path(stderr)
+ exec [interpreter] $path(more) < $path(big) | $cat32 > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
test winpipe-1.5 {32 bit comprehensive tests: a lot from pipe} {win 95 exec cat32} {
- exec command /c type big |& $cat32 > $path(stdout) 2> $path(stderr)
+ exec command /c type $path(big) |& $cat32 > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
test winpipe-1.6 {32 bit comprehensive tests: from console} \
@@ -171,7 +178,6 @@ test winpipe-1.22 {Checking command.com for Win95/98 hanging} {win 95 exec} {
exec command.com /c dir /b
set result 1
} 1
-file delete more
test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} {
proc readResults {f} {
@@ -184,8 +190,7 @@ test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} {
set result "$result$line"
}
}
-
- set f [open "|[list $cat32] < big 2> $path(stderr)" r]
+ set f [open "|[list $cat32] < $path(big) 2> $path(stderr)" r]
fconfigure $f -buffering none -blocking 0
fileevent $f readable "readResults $f"
set x 0
@@ -193,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]
@@ -234,9 +243,9 @@ set env(TEMP) c:/
test winpipe-5.1 {TclpCreateTempFile: cleanup temp files} {win exec} {
set x {}
set existing [glob -nocomplain c:/tcl*.tmp]
- exec [interpreter] < nothing
+ exec [interpreter] < $path(nothing)
foreach p [glob -nocomplain c:/tcl*.tmp] {
- if {[lsearch $existing $p] == -1} {
+ if {$p ni $existing} {
lappend x $p
}
}
@@ -247,7 +256,7 @@ test winpipe-5.2 {TclpCreateTempFile: TMP and TEMP not defined} {win exec} {
set temp $env(TEMP)
unset env(TMP)
unset env(TEMP)
- exec [interpreter] < nothing
+ exec [interpreter] < $path(nothing)
set env(TMP) $tmp
set env(TEMP) $temp
set x {}
@@ -256,7 +265,7 @@ test winpipe-5.3 {TclpCreateTempFile: TMP specifies non-existent directory} \
{win exec } {
set tmp $env(TMP)
set env(TMP) snarky
- exec [interpreter] < nothing
+ exec [interpreter] < $path(nothing)
set env(TMP) $tmp
set x {}
} {}
@@ -266,7 +275,7 @@ test winpipe-5.4 {TclpCreateTempFile: TEMP specifies non-existent directory} \
set temp $env(TEMP)
unset env(TMP)
set env(TEMP) snarky
- exec [interpreter] < nothing
+ exec [interpreter] < $path(nothing)
set env(TMP) $tmp
set env(TEMP) $temp
set x {}
@@ -311,7 +320,6 @@ set path(echoArgs.tcl) [makeFile {
puts "[list $argv0 $argv]"
} echoArgs.tcl]
-
### validate the raw output of BuildCommandLine().
###
test winpipe-7.1 {BuildCommandLine: null arguments} {win exec} {
@@ -428,7 +436,7 @@ test winpipe-8.18 {BuildCommandLine/parse_cmdline pass-thru: special chars #2} {
test winpipe-8.19 {ensure parse_cmdline isn't doing wildcard replacement} {win exec} {
exec [interpreter] $path(echoArgs.tcl) foo * makefile.?c bar
} [list $path(echoArgs.tcl) [list foo * makefile.?c bar]]
-
+
# restore old values for env(TMP) and env(TEMP)
if {[catch {set env(TMP) $env_tmp}]} {
@@ -439,6 +447,16 @@ if {[catch {set env(TEMP) $env_temp}]} {
}
# cleanup
-file delete big little stdout stderr nothing echoArgs.tcl
+removeFile little
+removeFile big
+removeFile more
+removeFile stdout
+removeFile stderr
+removeFile nothing
+removeFile echoArgs.tcl
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
generated by cgit v0.12 at 2024-07-04 20:30:21 (GMT)