aio: change to use unix io, not stdio

This changes especially makes buffered I/O work
with non-blocking channels.

- separate read and write buffering
- support for timeout on blocking read
- read/write on same channel in event loop with buffering
- read buffer is the same across read, gets, copyto
- autoflush non-blocking writes via event loop
- copyto can now copy to any filehandle-like command
- add some copyto tests

Signed-off-by: Steve Bennett <steveb@workware.net.au>

4 files changed, 251 insertions, 27 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
diff --git a/tests/runall.tcl b/tests/runall.tcl
index 96a56a9..5c9aa8b 100644
--- a/tests/runall.tcl
+++ b/tests/runall.tcl
@@ -47,11 +47,11 @@ if {[info commands interp] eq ""} {
 				puts [format "%16s:   --- error ($msg)" $script]
 				incr total(fail)
 			} elseif {[info return $opts(-code)] eq "exit"} {
-				# if the test explicitly called exit 99,
+				# if the test explicitly called exit 98 or 99,
 				# it must be from a child process via os.fork, so
-				# silently exit
-				if {$msg eq "99"} {
-					exit 0
+				# silently exit with that return code
+				if {$msg in {98 99}} {
+					exit $msg
 				}
 			}
 
diff --git a/tests/socket.test b/tests/socket.test
index 67fdb9c..1eb98b4 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -129,6 +129,8 @@ test socket-1.6 {pipe} -body {
 
 test socket-1.7 {socketpair} -body {
 	lassign [socket pair] s1 s2
+	$s1 buffering line
+	$s2 buffering line
 	stdout flush
 	if {[os.fork] == 0} {
 		$s1 close
@@ -338,20 +340,18 @@ set s [socket stream.server 0]
 if {[os.fork] == 0} {
 	# child
 	set c [socket stream [socket-connect-addr $s]]
-	# Note: We have to disable buffering here, otherwise
-	# when we read data in $c readable {} we many leave buffered
-	# data and readable won't retrigger.
-	$c buffering none
 	$s close
+	$c ndelay 1
 	$c readable {
-		# when we read we need to also read any pending data,
-		# otherwise readable won't retrigger
-		set buf [$c read 1]
-		if {[string length $buf] == 0} {
+		# read everything available (non-blocking read)
+		set buf [$c read]
+		if {[string length $buf]} {
+			$c puts -nonewline $buf
+			$c flush
+		}
+		if {[$c eof]} {
 			incr readdone
 			$c close
-		} else {
-			$c puts -nonewline $buf
 		}
 	}
 	vwait readdone
@@ -365,6 +365,8 @@ defer {
 }
 $s close
 
+$cs buffering line
+
 # At this point, $cs is the server connection to the client in the child process
 
 test eventloop-1.1 {puts/gets} {
@@ -372,14 +374,67 @@ test eventloop-1.1 {puts/gets} {
 	$cs gets
 } hello
 
-test eventloop-1.2 {puts/gets} {
+test eventloop-1.2 {puts/read} {
 	$cs puts -nonewline again
+	$cs flush
 	lmap p [range 5] {
 		set c [$cs read 1]
 		set c
 	}
 } {a g a i n}
 
+test eventloop-1.3 {gets with no timeout and multiple newlines} {
+	$cs puts a\nb\nc\nd\ne
+	lmap p [range 5] {
+		$cs gets buf
+		set buf
+	}
+} {a b c d e}
+
+test eventloop-1.4 {gets with timeout and multiple newlines} {
+	$cs timeout 100
+	$cs puts a\nb\nc\nd\ne
+	lmap p [range 6] {
+		set rc [$cs gets buf]
+		set buf
+	}
+} {a b c d e {}}
+
+test eventloop-1.5 {gets with timeout and incomplete line} {
+	$cs timeout 100
+	$cs puts -nonewline first
+	list [$cs gets buf] $buf
+} {-1 {}}
+
+test eventloop-1.6 {gets with timeout and complete line} {
+	$cs timeout 100
+	$cs puts second
+	list [$cs gets buf] $buf
+} {11 firstsecond}
+
+test eventloop-1.7 {gets when read with extra data} {
+	$cs timeout 100
+	$cs puts -nonewline abcde
+	$cs flush
+	# This won't get get a line 
+	$cs gets line
+	# now read should read the data
+	set data [$cs read -nonewline]
+	list $line $data
+} {{} abcde}
+
+test eventloop-1.7 {read with timeout and no data} {
+	$cs timeout 100
+	$cs read
+} {}
+
+test eventloop-1.6 {read with timeout and data} {
+	$cs timeout 100
+	$cs puts -nonewline data
+	$cs flush
+	$cs read
+} {data}
+
 test sockopt-1.1 {sockopt} -body {
 	lsort [dict keys [$cs sockopt]]
 } -match glob -result {*tcp_nodelay*}
diff --git a/tests/ssl.test b/tests/ssl.test
index b01069d..d147c92 100644
--- a/tests/ssl.test
+++ b/tests/ssl.test
@@ -17,16 +17,16 @@ if {[os.fork] == 0} {
 	# child
 	set c [[socket stream 127.0.0.1:1443] ssl]
 	$s close
+	$c ndelay 1
 	sleep 0.25
 	$c readable {
-		# when we read we need to also read any pending data,
-		# otherwise readable won't retrigger
-		set buf [$c read -pending]
-		if {[string length $buf] == 0} {
+		# read everything available and echo it back
+		set buf [$c read]
+		$c puts -nonewline $buf
+		$c flush
+		if {[$c eof]} {
 			incr ssldone
 			$c close
-		} else {
-			$c puts -nonewline $buf
 		}
 	}
 	vwait ssldone
@@ -42,6 +42,7 @@ defer {
 }
 
 # At this point, $cs is the server connection to the client in the child process
+$cs buffering line
 
 test ssl-1.1 {puts/gets} {
 	$cs puts hello
@@ -50,6 +51,7 @@ test ssl-1.1 {puts/gets} {
 
 test ssl-1.2 {puts/gets} {
 	$cs puts -nonewline again
+	$cs flush
 	lmap p [range 5] {
 		set c [$cs read 1]
 		set c