diff options
-rw-r--r-- | Makefile | 1 | ||||
-rw-r--r-- | tests/014/socket-basic.expected | 0 | ||||
-rw-r--r-- | tests/014/socket-basic.tl | 31 | ||||
-rw-r--r-- | tests/sock-common.tl | 13 |
4 files changed, 45 insertions, 0 deletions
@@ -307,6 +307,7 @@ tst/tests/002/%: TXR_SCRIPT_ON_CMDLINE := y tst/tests/011/%: TXR_DBG_OPTS := tst/tests/012/%: TXR_DBG_OPTS := tst/tests/013/%: TXR_DBG_OPTS := +tst/tests/014/%: TXR_DBG_OPTS := .PRECIOUS: tst/%.out tst/%.out: %.txr diff --git a/tests/014/socket-basic.expected b/tests/014/socket-basic.expected new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/tests/014/socket-basic.expected diff --git a/tests/014/socket-basic.tl b/tests/014/socket-basic.tl new file mode 100644 index 00000000..efeed2d6 --- /dev/null +++ b/tests/014/socket-basic.tl @@ -0,0 +1,31 @@ +(load "../sock-common.tl") + +(defvar socktype) + +(defun client (addr) + (with-stream (cli-sock (open-socket af-inet socktype)) + (sock-connect cli-sock addr) + (put-string "5000" cli-sock) + (sock-shutdown cli-sock) + (equal (read cli-sock) (range 1 5000)))) + +(defun server (svc-sock) + (let* ((acc-sock (sock-accept svc-sock)) + (query (read acc-sock))) + (print (range 1 5000) acc-sock) + (close-stream acc-sock))) + +(defun test () + (let* ((svc-sock (open-socket af-inet socktype)) + (svc-addr (bindfree svc-sock 1025 65535)) + (child-pid (fork))) + (cond + ((null child-pid) (error "fork failed")) + ((zerop child-pid) (server svc-sock) (exit* t)) + (t (prog1 (client svc-addr) (wait child-pid)))))) + +(if (and (fboundp 'open-socket) + (fboundp 'fork)) + (each ((socktype (list sock-dgram sock-stream))) + (unless (test) + (error "test failed")))) diff --git a/tests/sock-common.tl b/tests/sock-common.tl new file mode 100644 index 00000000..63f31c83 --- /dev/null +++ b/tests/sock-common.tl @@ -0,0 +1,13 @@ +(defun local-addr (family port) + (caseql family + (af-inet (new sockaddr-in addr inaddr-loopback port port)) + (af-inet6 (new sockaddr-in6 addr in6addr-loopback port port)))) + +(defun bindfree (sock from to) + (for ((port from)) + ((<= port to) (error "unable to bind socket")) + ((inc port)) + (let ((addr (local-addr (sock-family sock) port))) + (when (ignerr (sock-bind sock addr)) + (sock-listen sock) + (return-from bindfree addr))))) |