diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/chan.test | 22 | ||||
| -rw-r--r-- | tests/chanio.test | 53 | ||||
| -rw-r--r-- | tests/ioCmd.test | 20 |
3 files changed, 85 insertions, 10 deletions
diff --git a/tests/chan.test b/tests/chan.test index 39dd111..7dccda7 100644 --- a/tests/chan.test +++ b/tests/chan.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: chan.test,v 1.15 2008/07/21 21:02:19 ferrieux Exp $ +# RCS: @(#) $Id: chan.test,v 1.16 2008/12/18 01:14:17 ferrieux Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -29,11 +29,23 @@ test chan-1.2 {chan command general syntax} -body { test chan-2.1 {chan command: blocked subcommand} -body { chan blocked foo bar } -returnCodes error -result "wrong # args: should be \"chan blocked channelId\"" - test chan-3.1 {chan command: close subcommand} -body { - chan close foo bar -} -returnCodes error -result "wrong # args: should be \"chan close channelId\"" - + chan close foo bar zet +} -returnCodes error -result "wrong # args: should be \"chan close channelId ?direction?\"" +test chan-3.2 {chan command: close subcommand} -setup { + set chan [open [info script] r] +} -body { + chan close $chan bar +} -cleanup { + close $chan +} -returnCodes error -result "bad direction \"bar\": must be read or write" +test chan-3.3 {chan command: close subcommand} -setup { + set chan [open [info script] r] +} -body { + chan close $chan write +} -cleanup { + close $chan +} -returnCodes error -result "Half-close of write-side not possible, side not opened or already closed" test chan-4.1 {chan command: configure subcommand} -body { chan configure } -returnCodes error -result "wrong # args: should be \"chan configure channelId ?-option value ...?\"" diff --git a/tests/chanio.test b/tests/chanio.test index 7e53f77..487691a 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.15 2008/06/20 20:48:48 dgp Exp $ +# RCS: @(#) $Id: chanio.test,v 1.16 2008/12/18 01:14:17 ferrieux Exp $ if {[catch {package require tcltest 2}]} { chan puts stderr "Skipping tests in [info script]. tcltest 2 required." @@ -2229,7 +2229,56 @@ test chan-io-28.5 {Tcl_Chan Close vs standard handles} {stdio unix testchannel o chan close $f set l } {file1 file2} - +test chan-io-28.6 {Tcl_CloseEx (half-close) pipe} { + set cat [makeFile { + fconfigure stdout -buffering line + while {[gets stdin line]>=0} {puts $line} + puts DONE + exit 0 + } cat.tcl] + set ::ff [open "|[list tclsh $cat]" r+] + puts $::ff Hey + flush $ff + close $::ff w + after 1000 {set ::done Failed} + set ::acc {} + fileevent $::ff readable { + if {[gets $::ff line]<0} {set ::done Succeeded;return} + lappend ::acc $line + } + vwait ::done + close $::ff r + list $::done $::acc +} {Succeeded {Hey DONE}} +if {0} {test chan-io-28.7 {Tcl_CloseEx (half-close) socket} { + set echo [makeFile { + proc accept {s args} {set ::sok $s} + set s [socket -server accept 0] + puts [lindex [fconfigure $s -sockname] 2] + flush stdout + vwait ::sok + fconfigure $::sok -buffering line + while {[gets $::sok line]>=0} {puts $::sok $line} + puts $::sok DONE + exit 0 + } echo.tcl] + set ::ff [open "|[list tclsh $echo]" r] + gets $::ff port + set ::s [socket 127.0.0.1 $port] + puts $::s Hey + flush $::s + close $::s w + after 1000 {set ::done Failed} + set ::acc {} + fileevent $::s readable { + if {[gets $::s line]<0} {set ::done Succeeded;return} + lappend ::acc $line + } + vwait ::done + close $::s r + close $::ff + list $::done $::acc +} {Succeeded {Hey DONE}}} test chan-io-29.1 {Tcl_WriteChars, channel not writable} { list [catch {chan puts stdin hello} msg] $msg } {1 {channel "stdin" wasn't opened for writing}} diff --git a/tests/ioCmd.test b/tests/ioCmd.test index a38158e..0018f83 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.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: ioCmd.test,v 1.47 2008/07/21 21:12:49 ferrieux Exp $ +# RCS: @(#) $Id: ioCmd.test,v 1.48 2008/12/18 01:14:17 ferrieux Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -182,13 +182,27 @@ test iocmd-6.3 {tell command} { test iocmd-7.1 {close command} { list [catch {close} msg] $msg -} {1 {wrong # args: should be "close channelId"}} +} {1 {wrong # args: should be "close channelId ?direction?"}} test iocmd-7.2 {close command} { list [catch {close a b c d e} msg] $msg -} {1 {wrong # args: should be "close channelId"}} +} {1 {wrong # args: should be "close channelId ?direction?"}} test iocmd-7.3 {close command} { list [catch {close aaa} msg] $msg } {1 {can not find channel named "aaa"}} +test iocmd-7.4 {close command} -setup { + set chan [open [info script] r] +} -body { + chan close $chan bar +} -cleanup { + close $chan +} -returnCodes error -result "bad direction \"bar\": must be read or write" +test iocmd-7.5 {close command} -setup { + set chan [open [info script] r] +} -body { + chan close $chan write +} -cleanup { + close $chan +} -returnCodes error -result "Half-close of write-side not possible, side not opened or already closed" test iocmd-8.1 {fconfigure command} { list [catch {fconfigure} msg] $msg |