summaryrefslogtreecommitdiffstats
path: root/tests/chanio.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/chanio.test')
-rw-r--r--tests/chanio.test95
1 files changed, 50 insertions, 45 deletions
diff --git a/tests/chanio.test b/tests/chanio.test
index e79cb97..6e8fb44 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -13,7 +13,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: chanio.test,v 1.11 2008/04/15 18:34:48 andreas_kupries Exp $
+# RCS: @(#) $Id: chanio.test,v 1.12 2008/04/23 15:44:37 dkf Exp $
if {[catch {package require tcltest 2}]} {
chan puts stderr "Skipping tests in [info script]. tcltest 2 required."
@@ -182,8 +182,6 @@ test chan-io-1.9 {Tcl_WriteChars: WriteChars} {
chan puts -nonewline $f $data
chan close $f
lappend sizes [file size $path(test2)]
-
- set sizes
} {19 19 19 19 19}
test chan-io-2.1 {WriteBytes} {
@@ -1700,40 +1698,44 @@ file1
} {file2
}}
catch {interp delete z}
-test chan-io-14.5 {Tcl_GetChannel: stdio name translation} {
+test chan-io-14.5 {Tcl_GetChannel: stdio name translation} -setup {
interp create z
+} -body {
chan eof stdin
catch {z eval chan flush stdin} msg1
catch {z eval chan close stdin} msg2
catch {z eval chan flush stdin} msg3
- set result [list $msg1 $msg2 $msg3]
+ list $msg1 $msg2 $msg3
+} -cleanup {
interp delete z
- set result
-} {{channel "stdin" wasn't opened for writing} {} {can not find channel named "stdin"}}
-test chan-io-14.6 {Tcl_GetChannel: stdio name translation} {
+} -result {{channel "stdin" wasn't opened for writing} {} {can not find channel named "stdin"}}
+test chan-io-14.6 {Tcl_GetChannel: stdio name translation} -setup {
interp create z
+} -body {
chan eof stdout
catch {z eval chan flush stdout} msg1
catch {z eval chan close stdout} msg2
catch {z eval chan flush stdout} msg3
- set result [list $msg1 $msg2 $msg3]
+ list $msg1 $msg2 $msg3
+} -cleanup {
interp delete z
- set result
-} {{} {} {can not find channel named "stdout"}}
-test chan-io-14.7 {Tcl_GetChannel: stdio name translation} {
+} -result {{} {} {can not find channel named "stdout"}}
+test chan-io-14.7 {Tcl_GetChannel: stdio name translation} -setup {
interp create z
+} -body {
chan eof stderr
catch {z eval chan flush stderr} msg1
catch {z eval chan close stderr} msg2
catch {z eval chan flush stderr} msg3
- set result [list $msg1 $msg2 $msg3]
+ list $msg1 $msg2 $msg3
+} -cleanup {
interp delete z
- set result
-} {{} {} {can not find channel named "stderr"}}
+} -result {{} {} {can not find channel named "stderr"}}
set path(script) [makeFile {} script]
-test chan-io-14.8 {reuse of stdio special channels} {stdio openpipe} {
+test chan-io-14.8 {reuse of stdio special channels} -setup {
file delete $path(script)
file delete $path(test1)
+} -constraints {stdio openpipe} -body {
set f [open $path(script) w]
chan puts -nonewline $f {
chan close stderr
@@ -1752,10 +1754,11 @@ test chan-io-14.8 {reuse of stdio special channels} {stdio openpipe} {
set c [chan gets $f]
chan close $f
set c
-} hello
-test chan-io-14.9 {reuse of stdio special channels} {stdio openpipe fileevent} {
+} -result hello
+test chan-io-14.9 {reuse of stdio special channels} -setup {
file delete $path(script)
file delete $path(test1)
+} -constraints {stdio openpipe fileevent} -body {
set f [open $path(script) w]
chan puts $f {
array set path [lindex $argv 0]
@@ -1770,14 +1773,15 @@ test chan-io-14.9 {reuse of stdio special channels} {stdio openpipe fileevent} {
set f [open "|[list [interpreter] $path(script) [array get path]]" r]
set c [chan gets $f]
chan close $f
+ set c
+} -cleanup {
# Added delay to give Windows time to stop the spawned process and clean
# up its grip on the file test1. Added delete as proper test cleanup.
# The failing tests were 18.1 and 18.2 as first re-users of file "test1".
after 10000
file delete $path(script)
file delete $path(test1)
- set c
-} hello
+} -result hello
test chan-io-15.1 {Tcl_CreateChan CloseHandler} emptyTest {
} {}
@@ -1802,7 +1806,6 @@ test chan-io-17.1 {GetChannelTable, DeleteChannelTable on std handles} {testchan
lappend l [expr [testchannel refcount stdin] - $l1]
interp delete x
lappend l [expr [testchannel refcount stdin] - $l1]
- set l
} {0 1 0}
test chan-io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
set l1 [testchannel refcount stdout]
@@ -1814,7 +1817,6 @@ test chan-io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {testchan
lappend l [expr [testchannel refcount stdout] - $l1]
interp delete x
lappend l [expr [testchannel refcount stdout] - $l1]
- set l
} {0 1 0}
test chan-io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
set l1 [testchannel refcount stderr]
@@ -1826,12 +1828,12 @@ test chan-io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {testchan
lappend l [expr [testchannel refcount stderr] - $l1]
interp delete x
lappend l [expr [testchannel refcount stderr] - $l1]
- set l
} {0 1 0}
-test chan-io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
+test chan-io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup {
file delete -force $path(test1)
set l ""
+} -constraints {testchannel} -body {
set f [open $path(test1) w]
lappend l [lindex [testchannel info $f] 15]
chan close $f
@@ -1840,12 +1842,13 @@ test chan-io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
} else {
lappend l "very broken: $f found after being chan closed"
}
- string compare [string tolower $l] \
- [list 1 [format "can not find channel named \"%s\"" $f]]
-} 0
-test chan-io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
+ string equal [string tolower $l] \
+ [list 1 "can not find channel named \"$f\""]
+} -result 1
+test chan-io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup {
file delete -force $path(test1)
set l ""
+} -constraints {testchannel} -body {
set f [open $path(test1) w]
lappend l [lindex [testchannel info $f] 15]
interp create x
@@ -1861,12 +1864,13 @@ test chan-io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
} else {
lappend l "very broken: $f found after being chan closed"
}
- string compare [string tolower $l] \
- [list 1 2 1 1 [format "can not find channel named \"%s\"" $f]]
-} 0
-test chan-io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
+ string equal [string tolower $l] \
+ [list 1 2 1 1 "can not find channel named \"$f\""]
+} -result 1
+test chan-io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup {
file delete $path(test1)
set l ""
+} -constraints {testchannel} -body {
set f [open $path(test1) w]
lappend l [lindex [testchannel info $f] 15]
interp create x
@@ -1880,9 +1884,9 @@ test chan-io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
} else {
lappend l "very broken: $f found after being chan closed"
}
- string compare [string tolower $l] \
- [list 1 2 1 [format "can not find channel named \"%s\"" $f]]
-} 0
+ string equal [string tolower $l] \
+ [list 1 2 1 "can not find channel named \"$f\""]
+} -result 1
test chan-io-19.1 {Tcl_GetChannel->Tcl_GetStdChannel, standard handles} {
chan eof stdin
@@ -1894,13 +1898,14 @@ test chan-io-19.2 {testing Tcl_GetChannel, user opened handle} {
chan close $f
set x
} 0
-test chan-io-19.3 {Tcl_GetChannel, channel not found} {
- list [catch {chan eof file34} msg] $msg
-} {1 {can not find channel named "file34"}}
-test chan-io-19.4 {Tcl_CreateChannel, insertion into channel table} {testchannel} {
+test chan-io-19.3 {Tcl_GetChannel, channel not found} -body {
+ chan eof file34
+} -returnCodes error -result {can not find channel named "file34"}
+test chan-io-19.4 {Tcl_CreateChannel, insertion into channel table} -setup {
file delete $path(test1)
- set f [open $path(test1) w]
set l ""
+} -constraints {testchannel} -body {
+ set f [open $path(test1) w]
lappend l [chan eof $f]
chan close $f
if {[catch {lindex [testchannel info $f] 15} msg]} {
@@ -1908,19 +1913,19 @@ test chan-io-19.4 {Tcl_CreateChannel, insertion into channel table} {testchannel
} else {
lappend l "very broken: $f found after being chan closed"
}
- string compare [string tolower $l] \
- [list 0 [format "can not find channel named \"%s\"" $f]]
-} 0
+ string equal [string tolower $l] \
+ [list 0 "can not find channel named \"$f\""]
+} -result 1
test chan-io-20.1 {Tcl_CreateChannel: initial settings} {
- set a [open $path(test2) w]
+ set a [open $path(test2) w]
set old [encoding system]
encoding system ascii
set f [open $path(test1) w]
set x [chan configure $f -encoding]
chan close $f
encoding system $old
- chan close $a
+ chan close $a
set x
} {ascii}
test chan-io-20.2 {Tcl_CreateChannel: initial settings} {win} {