diff options
Diffstat (limited to 'tests/aio.test')
| -rw-r--r-- | tests/aio.test | 179 |
1 files changed, 173 insertions, 6 deletions
diff --git a/tests/aio.test b/tests/aio.test index a012518..f6852b9 100644 --- a/tests/aio.test +++ b/tests/aio.test @@ -8,11 +8,20 @@ testConstraint posixaio [expr {$tcl_platform(platform) eq {unix} && !$tcl_platfo set f [open testdata.in wb] $f puts test-data $f close +# create a test file file with several lines +set f [open copy.in wb] +$f puts line1 +$f puts line2 +$f puts line3 +$f close + set f [open testdata.in rb] defer { $f close file delete testdata.in + file delete copy.in + file delete copy.out } test aio-1.1 {seek usage} -body { @@ -72,11 +81,7 @@ test aio-2.3 {read -ve len} -body { test aio-2.4 {read too many args} -body { $f read 20 extra -} -returnCodes error -match glob -result {wrong # args: should be "* read ?-nonewline|-pending|len?"} - -test aio-2.5 {read -pending on non-ssl} -body { - $f read -pending -} -returnCodes error -result {-pending not supported on this connection type} +} -returnCodes error -match glob -result {wrong # args: should be "* read ?-nonewline|len?"} test aio-3.1 {copy to invalid fh} -body { $f copy lambda @@ -137,7 +142,7 @@ test aio-9.1 {open: posix modes} -constraints posixaio -body { test aio-9.2 {open: posix modes, bad modes} -constraints posixaio -body { open testdata.in {CREAT TRUNC} -} -returnCodes error -result {testdata.in: Invalid argument} +} -returnCodes error -result {testdata.in: invalid open mode 'CREAT TRUNC'} test aio-9.3 {open: posix modes, bad modes} -constraints posixaio -body { open testdata.in {WRONG TRUNC} @@ -156,4 +161,166 @@ test aio-9.4 {open: posix modes} -constraints posixaio -cleanup { set buf } -result {write-data} +test copyto-1.1 {basic copyto} { + set in [open copy.in] + set out [open copy.out w] + $in copyto $out + $in close + $out close + set ff [open copy.out] + set result [list [$ff gets] [$ff gets] [$ff gets]] + $ff close + set result +} {line1 line2 line3} + +test copyto-1.2 {copyto with limit} { + set in [open copy.in] + set out [open copy.out w] + $in copyto $out 8 + $in close + $out close + set ff [open copy.out] + set result [list [$ff gets] [$ff gets] [$ff gets]] + $ff close + set result +} {line1 li {}} + +test copyto-1.3 {copyto after gets} { + set in [open copy.in] + set out [open copy.out w] + $in gets + $in copyto $out + $in close + $out close + set ff [open copy.out] + set result [list [$ff gets] [$ff gets] [$ff gets]] + $ff close + set result +} {line2 line3 {}} + +test copyto-1.4 {copyto after read} { + set in [open copy.in] + $in read 3 + set out [open copy.out w] + $in copyto $out + $in close + $out close + set ff [open copy.out] + set result [list [$ff gets] [$ff gets] [$ff gets]] + $ff close + set result +} {e1 line2 line3} + +test copyto-1.5 {copyto after gets, seek} { + set in [open copy.in] + $in gets + $in seek 2 start + set out [open copy.out w] + $in copyto $out + $in close + $out close + set ff [open copy.out] + set result [list [$ff gets] [$ff gets] [$ff gets]] + $ff close + set result +} {ne1 line2 line3} + +test copyto-1.6 {copyto from pipe} { + set in [open "|cat copy.in"] + set out [open copy.out w] + $in copyto $out + $in close + $out close + set ff [open copy.out] + set result [list [$ff gets] [$ff gets] [$ff gets]] + $ff close + set result +} {line1 line2 line3} + +test copyto-1.6 {copyto to pipe} { + set out [open "|cat >copy.out" w] + set in [open copy.in] + $in copyto $out + $in close + $out close + set ff [open copy.out] + set result [list [$ff gets] [$ff gets] [$ff gets]] + $ff close + set result +} {line1 line2 line3} + +# Creates a child process and returns {pid writehandle} +# The child expects to read $numlines lines of input and exits with a return +# code of 0 if ok +proc child_reader {numlines} { + # create a pipe with the child as a slightly slow reader + lassign [socket pipe] r w + + set pid [os.fork] + if {$pid == 0} { + # child + $w close + # sleep a moment to make sure the parent fills up the send buffer + sleep 0.5 + set n 0 + while {[$r gets buf] >= 0} { + incr n + } + #puts "child got $n/$numlines lines" + $r close + if {$n == $numlines} { + # This is what we expect + exit 99 + } + # This is not expected + exit 98 + } + # parent + $r close + + list $pid $w +} + +test autoflush-1.1 {pipe writer, blocking} -constraints socket -body { + lassign [child_reader 10000] pid w + + # Send data fast enough to fill up the send buffer + loop i 10000 { + $w puts "this is line $i" + } + + # No autoflush needed. The write won't return + # until queued + $w close + + lassign [wait $pid] - - rc + + list $rc +} -result {99} + +test autoflush-1.2 {pipe writer, non blocking} -constraints socket -body { + lassign [child_reader 10000] pid w + + $w ndelay 1 + + # Send data fast enough to fill up the send buffer + # With older jimtcl this would return an error "pipe: Resource temporarily unavailable" + loop i 10000 { + $w puts "this is line $i" + } + + # Now data should still be queued, wait for autoflush + lassign [time { + after idle {} + vwait done + }] t1 + + # puts "autoflush finished in ${t1}us, closing pipe" + $w close + + lassign [wait $pid] - - rc + + list $rc $t1 +} -match glob -result {99 *} + testreport |