summaryrefslogtreecommitdiffstats
path: root/tests/014/dgram-stream.tl
blob: 5902a84d9fbce819ec1b42a9e87070b66cff8358 (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
35
36
37
38
39
40
41
42
(load "../common.tl")
(load "../sock-common.tl")

(defvar family)

(defun server (svc-sock)
  (whilet ((acc-sock (sock-accept svc-sock))
           (query (read acc-sock)))
    (print query acc-sock)
    (close-stream acc-sock)))

(defun client (addr)
  (with-stream (cli-sock (open-socket family sock-dgram))
    (sock-connect cli-sock addr)
    (dotimes (i 1000)
      (print i cli-sock)
      (flush-stream cli-sock)
      (unless (equal (read cli-sock) i)
        (return-from client nil))
      (clear-error cli-sock))
    (print nil cli-sock)
    (flush-stream cli-sock)))

(defun dgram-test ()
  (let* ((svc-sock (open-socket family sock-dgram))
         (svc-addr (bindfree svc-sock 1025 65535))
         (server-pid (fork)))
    (cond
      ((null server-pid) (error "fork failed"))
      ((zerop server-pid) (server svc-sock) (exit* t))
      (t (prog1
           (client svc-addr)
           (kill server-pid sig-kill)
           (wait server-pid))))))

(if (and (fboundp 'open-socket)
         (fboundp 'fork))
  (let ((maybe-ipv6 (if (memq (os-symbol) '(:linux :macos :cygwin :cygnal))
                      (list af-inet6))))
    (each ((family ^(,af-inet ,*maybe-ipv6)))
      (unless (dgram-test)
        (error "test failed")))))