diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/io.test | 51 | ||||
| -rw-r--r-- | tests/iogt.test | 5 |
2 files changed, 51 insertions, 5 deletions
diff --git a/tests/io.test b/tests/io.test index 6c1a710..2d535e6 100644 --- a/tests/io.test +++ b/tests/io.test @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: io.test,v 1.21 2001/09/11 17:30:44 andreas_kupries Exp $ +# RCS: @(#) $Id: io.test,v 1.22 2001/12/17 22:55:51 andreas_kupries Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -6610,6 +6610,55 @@ test io-53.6 {CopyData: error during fcopy} {stdio} { set fcopyTestDone ;# 0 for plain end of file } {0} +proc doFcopy {in out {bytes 0} {error {}}} { + global fcopyTestDone fcopyTestCount + incr fcopyTestCount $bytes + if {[string length $error]} { + set fcopyTestDone 1 + } elseif {[eof $in]} { + set fcopyTestDone 0 + } else { + # Delay next fcopy to wait for size>0 input bytes + after 100 [list + fcopy $in $out -size 1000 -command [list doFcopy $in $out] + ] + } +} + +test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio} { + removeFile pipe + removeFile test1 + catch {unset fcopyTestDone} + set fcopyTestCount 0 + set f1 [open pipe w] + puts $f1 { + # Write 10 bytes / 10 msec + proc Write {count} { + puts -nonewline "1234567890" + if {[incr count -1]} { + after 10 [list Write $count] + } else { + set ::ready 1 + } + } + fconfigure stdout -buffering none + Write 345 ;# 3450 bytes ~3.45 sec + vwait ready + exit 0 + } + close $f1 + set in [open "|[list $::tcltest::tcltest pipe &]" r+] + set out [open test1 w] + doFcopy $in $out + if ![info exists fcopyTestDone] { + vwait fcopyTestDone + } + catch {close $in} + close $out + # -1=error 0=script error N=number of bytes + expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1 +} {3450} + test io-54.1 {Recursive channel events} {socket} { # This test checks to see if file events are delivered during recursive # event loops when there is buffered data on the channel. diff --git a/tests/iogt.test b/tests/iogt.test index ebb0ab6..a737634 100644 --- a/tests/iogt.test +++ b/tests/iogt.test @@ -10,7 +10,7 @@ # Copyright (c) 2000 Andreas Kupries. # All rights reserved. # -# RCS: @(#) $Id: iogt.test,v 1.2 2000/09/28 06:38:22 hobbs Exp $ +# RCS: @(#) $Id: iogt.test,v 1.3 2001/12/17 22:55:51 andreas_kupries Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { @@ -512,7 +512,6 @@ query/maxRead read query/maxRead flush/read -query/maxRead delete/read -------- create/write @@ -565,7 +564,6 @@ read { } query/maxRead {} -1 flush/read {} {} -query/maxRead {} -1 delete/read {} *ignored* -------- create/write {} *ignored* @@ -624,7 +622,6 @@ write %^&*()_+-= %^&*()_+-= write { } { } -query/maxRead {} -1 delete/read {} *ignored* flush/write {} {} delete/write {} *ignored*} |