summaryrefslogtreecommitdiffstats
path: root/tests/014/socket-basic.tl
blob: ae591c9b1f0b1fda66380c7c2db6a9148ae1957f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
(load "../sock-common.tl")
(load "../common.tl")

(defvar *socktype*)

(defvarl %iters% (if (meql (os-symbol) :macos :openbsd) 2000 5000))

(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 %iters%))))

(defun server (svc-sock)
  (let* ((acc-sock (sock-accept svc-sock))
         (query (read acc-sock)))
    (print (range 1 %iters%) acc-sock)
    (close-stream acc-sock)))

(defun sock-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 (sock-test)
      (error "test failed"))))