source [file dirname [info script]]/testing.tcl

needs constraint jim
needs cmd socket
needs cmd os.fork

constraint eval ipv6 {[socket -ipv6 stream.server ::1:5000] close}
constraint expr linux {$tcl_platform(os) eq "linux"}

# Given an IPv4 or IPv6 server socket, return an address
# that a client can use to connect to the socket.
# This handles the case where the server is listening on (say) 0.0.0.0:5000
# but some systems need the client to connect on localhost:5000
proc socket-connect-addr {s} {
	if {[regexp {(.*):([^:]+)} [$s sockname] -> host port]} {
		if {$host eq "0.0.0.0"} {
			return 127.0.0.1:$port
		} elseif {$host eq {[::]}} {
			return \[::1\]:$port
		}
	}
	return [$s sockname]
}

test socket-1.1 {stream} -body {
	# Let the system choose a port
	set s [socket stream.server 127.0.0.1:0]
	stdout flush
	if {[os.fork] == 0} {
		# child
		set c [socket stream [$s sockname]]
		$s close
		$c puts hello
		$c close
		exit 99
	}
	set cs [$s accept]
	$cs gets buf
	$cs close
	$s close
	set buf
} -result {hello}

test socket-1.2 {dgram - connected} -body {
	# Let the system choose a port
	set s [socket dgram.server 127.0.0.1:0]
	set c [socket dgram [$s sockname]]
	$s buffering none
	$c buffering none
	$c puts -nonewline hello
	set buf [$s recv 1000]
	$c close
	$s close
	set buf
} -result {hello}

test socket-1.3 {dgram - unconnected} -body {
	# Let the system choose a port
	set s [socket dgram.server 127.0.0.1:0]
	set c [socket dgram]
	$s buffering none
	$c buffering none
	$c sendto hello [$s sockname]
	set buf [$s recv 1000]
	$c close
	$s close
	set buf
} -result {hello}

test socket-1.4 {unix} -body {
	set path [file tempfile]
	file delete $path
	set s [socket unix.server $path]
	stdout flush
	if {[os.fork] == 0} {
		# child
		set c [socket unix $path]
		$s close
		$c puts hello
		$c close
		exit 99
	}
	set cs [$s accept]
	$cs gets buf
	$cs close
	$s close
	set buf
} -result {hello}

test socket-1.5 {unix.dgram} -body {
	set path [file tempfile]
	file delete $path
	set s [socket unix.dgram.server $path]
	set c [socket unix.dgram $path]
	$s buffering none
	$c buffering none
	$c puts -nonewline hello
	set buf [$s recv 1000]
	$s close
	$c close
	set buf
} -result {hello}

test socket-1.6 {pipe} -body {
	lassign [socket pipe] r w
	stdout flush
	if {[os.fork] == 0} {
		$r close
		$w puts hello
		$w close
		exit 99
	}
	$w close
	$r gets buf
	$r close
	set buf
} -result {hello}

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
		# Read data and send it back
		$s2 gets buf
		$s2 puts $buf
		$s2 close
		exit 99
	}
	$s2 close
	$s1 puts hello
	$s1 gets buf
	$s1 close
	set buf
} -result {hello}

test socket-1.8 {stream - ipv6} -constraints ipv6 -body {
	# Let the system choose a port
	set s [socket -ipv6 stream.server {[::1]:0}]
	stdout flush
	if {[os.fork] == 0} {
		# child
		set c [socket -ipv6 stream [$s sockname]]
		$s close
		$c puts hello
		$c close
		exit 99
	}
	set cs [$s accept]
	$cs gets buf
	$cs close
	$s close
	set buf
} -result {hello}

test socket-1.9 {dgram - ipv6 - unconnected} -constraints ipv6 -body {
	# Let the system choose a port
	set s [socket -ipv6 dgram.server {[::1]:0}]
	set c [socket -ipv6 dgram]
	$s buffering none
	$c buffering none
	$c sendto hello [$s sockname]
	set buf [$s recv 1000]
	$c close
	$s close
	set buf
} -result {hello}

test socket-1.10 {stream - port only} -body {
	set s [socket stream.server 0]
	stdout flush
	if {[os.fork] == 0} {
		# child
		set c [socket stream [socket-connect-addr $s]]
		$s close
		$c puts hello
		$c close
		exit 99
	}
	set cs [$s accept]
	$cs gets buf
	$cs close
	$s close
	set buf
} -result {hello}

test socket-1.11 {stream - ipv6 - port only} -constraints ipv6 -body {
	# Let the system choose a port
	set s [socket -ipv6 stream.server 0]
	stdout flush
	if {[os.fork] == 0} {
		# child
		set c [socket -ipv6 stream [socket-connect-addr $s]]
		$s close
		$c puts hello
		$c close
		exit 99
	}
	set cs [$s accept]
	$cs gets buf
	$cs close
	$s close
	set buf
} -result {hello}

# On hurd, sockname does not return the path for unix domain sockets
test socket-1.12 {unix} -constraints linux -body {
	set path [file tempfile]
	file delete $path
	set s [socket unix.server $path]
	set equal [expr {[$s sockname] eq $path}]
	$s close
	set equal
} -result {1}

test socket-2.1 {read 1} -body {
	lassign [socket pipe] r w
	$w puts -nonewline hello
	$w close
	set chars {}
	while {1} {
		set c [$r read 1]
		if {$c eq ""} {
			break
		}
		lappend chars $c
	}
	$r close
	set chars
} -result {h e l l o}

test socket-2.2 {read to EOF} -body {
	lassign [socket pipe] r w
	$w puts -nonewline hello
	$w close
	set buf [$r read]
	$r close
	set buf
} -result {hello}

test socket-2.3 {read -nonewline} -body {
	lassign [socket pipe] r w
	$w puts hello
	$w close
	set buf [$r read -nonewline]
	$r close
	set buf
} -result {hello}

test socket-2.4 {isatty} -body {
	lassign [socket pipe] r w
	set result [list [$r isatty] [$w isatty]]
	$r close
	$w close
	set result
} -result {0 0}

test socket-2.5 {peername} -body {
	set s [socket stream.server 0]
	stdout flush
	if {[os.fork] == 0} {
		try {
			set c [socket stream [socket-connect-addr $s]]
			$s close
			$c puts [list [$c sockname] [$c peername]]
			$c close
		} on error msg {
			stderr puts $msg
		}
		exit 99
	}
	set cs [$s accept]
	lassign [$cs gets] c_sockname c_peername
	if {$c_sockname ne [$cs peername]} {
		error "client sockname=$c_sockname not equal to server peername=[$cs peername]"
	}
	if {$c_peername ne [$cs sockname]} {
		error "client peername=$c_peername not equal to server sockname=[$cs sockname]"
	}
	$cs close
	$s close
} -result {}

test socket-3.1 {listen} {
	set s [socket stream.server 0]
	$s listen 10
	$s close
} {}

test socket-3.2 {listen usage} -body {
	set s [socket stream.server 0]
	$s listen
} -returnCodes error -match glob -result {wrong # args: should be "* listen backlog"} -cleanup {
	$s close
}

test socket-3.3 {listen usage} -body {
	set s [socket stream.server 0]
	$s listen blah
} -returnCodes error -match glob -result {expected integer but got "blah"} -cleanup {
	$s close
}

test socket-3.4 {listen not a socket} -body {
	set f [open [info script]]
	$f listen 10
} -returnCodes error -match regexp -result {(bad|socket)} -cleanup {
	$f close
}

test socket-4.1 {invalid ipv6 address} -constraints ipv6 -body {
	socket -ipv6 stream "- invalid - address -"
} -returnCodes error -result {Not a valid address: :::- invalid - address -}

test socket-4.2 {invalid ipv4 address} -body {
	socket stream {9.9.9.9.9:0}
} -returnCodes error -result {Not a valid address: 9.9.9.9.9:0}

test socket-4.3 {sockname on non-socket} -body {
	set f [open [info script]]
	$f sockname
} -returnCodes error -match regexp -result {(bad|socket)} -cleanup {
	$f close
}

test socket-4.4 {peername on non-socket} -body {
	set f [open [info script]]
	$f peername
} -returnCodes error -match regexp -result {(bad|socket)} -cleanup {
	$f close
}

# For the eventloop tests, let's set up a client and a server where the client
# simply echos everything back to the server

set s [socket stream.server 0]
if {[os.fork] == 0} {
	# child
	set c [socket stream [socket-connect-addr $s]]
	$s close
	$c ndelay 1
	$c readable {
		# 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
		}
	}
	vwait readdone
	exit 99
}

# Now set up the server
set cs [$s accept addr]
defer {
	$cs close
}
$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} {
	$cs puts hello
	$cs gets
} hello

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*}

test sockopt-1.2 {sockopt set} {
	$cs sockopt tcp_nodelay 1
	dict get [$cs sockopt] tcp_nodelay
} 1

test sockopt-1.3 {sockopt set invalid} -body {
	$cs sockopt tcp_nodelay badbool
} -returnCodes error -result {expected boolean but got "badbool"}

testreport