summaryrefslogtreecommitdiffstats
path: root/tests/winPipe.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/winPipe.test')
-rw-r--r--tests/winPipe.test66
1 files changed, 28 insertions, 38 deletions
diff --git a/tests/winPipe.test b/tests/winPipe.test
index 9c6f94d..3f983e1 100644
--- a/tests/winPipe.test
+++ b/tests/winPipe.test
@@ -9,18 +9,13 @@
# 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]
@@ -29,8 +24,6 @@ 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
@@ -65,7 +58,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)]
@@ -75,11 +68,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] $path(more) < $path(little) | $cat32 > $path(stdout) 2> $path(stderr)
+ exec [interpreter] more < 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] $path(more) < $path(big) | $cat32 > $path(stdout) 2> $path(stderr)
+ exec [interpreter] more < 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)
list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
test winpipe-1.6 {32 bit comprehensive tests: from console} \
@@ -170,6 +167,11 @@ test winpipe-1.21 {32 bit comprehensive tests: read/write application} \
catch {close $f}
set r
} "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
+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} {
@@ -182,7 +184,8 @@ test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} {
set result "$result$line"
}
}
- set f [open "|[list $cat32] < $path(big) 2> $path(stderr)" r]
+
+ set f [open "|[list $cat32] < big 2> $path(stderr)" r]
fconfigure $f -buffering none -blocking 0
fileevent $f readable "readResults $f"
set x 0
@@ -190,34 +193,30 @@ 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 testexcept} {
+test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec} {
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 testexcept} {
+test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec} {
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 testexcept} {
+test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec} {
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 testexcept} {
+test winpipe-4.5 {Tcl_WaitPid: return of exception codes, SIGINT} {win exec} {
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]
@@ -235,9 +234,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] < $path(nothing)
+ exec [interpreter] < nothing
foreach p [glob -nocomplain c:/tcl*.tmp] {
- if {$p ni $existing} {
+ if {[lsearch $existing $p] == -1} {
lappend x $p
}
}
@@ -248,7 +247,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] < $path(nothing)
+ exec [interpreter] < nothing
set env(TMP) $tmp
set env(TEMP) $temp
set x {}
@@ -257,7 +256,7 @@ test winpipe-5.3 {TclpCreateTempFile: TMP specifies non-existent directory} \
{win exec } {
set tmp $env(TMP)
set env(TMP) snarky
- exec [interpreter] < $path(nothing)
+ exec [interpreter] < nothing
set env(TMP) $tmp
set x {}
} {}
@@ -267,7 +266,7 @@ test winpipe-5.4 {TclpCreateTempFile: TEMP specifies non-existent directory} \
set temp $env(TEMP)
unset env(TMP)
set env(TEMP) snarky
- exec [interpreter] < $path(nothing)
+ exec [interpreter] < nothing
set env(TMP) $tmp
set env(TEMP) $temp
set x {}
@@ -312,6 +311,7 @@ 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 +428,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,16 +439,6 @@ if {[catch {set env(TEMP) $env_temp}]} {
}
# cleanup
-removeFile little
-removeFile big
-removeFile more
-removeFile stdout
-removeFile stderr
-removeFile nothing
-removeFile echoArgs.tcl
+file delete big little stdout stderr nothing echoArgs.tcl
::tcltest::cleanupTests
return
-
-# Local Variables:
-# mode: tcl
-# End:
generated by cgit v0.12 at 2024-11-01 02:38:24 (GMT)