-
Notifications
You must be signed in to change notification settings - Fork 3
/
Copy pathtest-unix-sockets.lisp
108 lines (96 loc) · 4.2 KB
/
test-unix-sockets.lisp
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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
(defpackage :test-unix-sockets
(:use #:cl
#:unix-sockets
#:alexandria
#:fiveam)
(:import-from #:unix-sockets
#:*use-internal-stream-p*)
(:shadow #:test))
(in-package :test-unix-sockets)
(def-suite* :test-unix-sockets)
(defmacro test (name &body body)
`(progn
(fiveam:test ,name
,@body)
(fiveam:test ,(intern (format nil "~a-WITH-INTERNAL-STREAM" name))
(let ((old *use-internal-stream-p*))
(unwind-protect
(progn
(setf *use-internal-stream-p* t)
,@body)
(setf *use-internal-stream-p* old))))))
(test simple-open-and-close
(tmpdir:with-tmpdir (dir)
(let ((sock (make-unix-socket (path:catfile dir "sock"))))
(close-unix-socket sock))))
(test connect
(tmpdir:with-tmpdir (dir)
(let ((file (path:catfile dir "sock")))
(with-unix-socket (sock (make-unix-socket file))
(with-unix-socket (client (connect-unix-socket file)))))))
(test send-and-recv
(tmpdir:with-tmpdir (dir)
(let ((file (path:catfile dir "sock")))
(with-unix-socket (server-sock (make-unix-socket file))
(let ((thread (bt:make-thread (lambda ()
(assert (not (symbolp server-sock)))
(let ((client (accept-unix-socket server-sock))))
))))
(connect-unix-socket file)
(bt:join-thread thread)
(pass))))))
(test send-and-recv-a-single-byte
(tmpdir:with-tmpdir (dir)
(let ((file (path:catfile dir "sock"))
(read-value :unread))
(with-unix-socket (server-sock (make-unix-socket file))
(let ((thread (bt:make-thread (lambda ()
(with-unix-socket (client (accept-unix-socket server-sock))
(let ((stream (unix-socket-stream client)))
(setf read-value
(read-byte stream))
(setf eof-value
(read-byte stream nil :eoff))))))))
(with-unix-socket (client (connect-unix-socket file))
(let ((Stream (unix-socket-stream client)))
(write-byte 22 stream)))
(bt:join-thread thread)
(is (eql 22 read-value))
(is (eql :eoff eof-value)))))))
(test close-from-another-thread
(tmpdir:with-tmpdir (dir)
(let ((file (path:catfile dir "sock")))
(let ((client)
(lock (bt:make-lock))
(cv (bt:make-condition-variable)))
(bt:with-lock-held (lock)
(with-unix-socket (server-sock (make-unix-socket file))
(let ((thread (bt:make-thread (lambda (&aux stream)
(setf client (accept-unix-socket server-sock))
(setf stream (unix-socket-stream client))
(read-byte stream nil nil)))))
(with-unix-socket (client-end (connect-unix-socket file))
(sleep 0.1)
(shutdown-unix-socket client))
(bt:join-thread thread))))))))
(define-condition test-error (error) ())
(test interrupt-recv
(tmpdir:with-tmpdir (dir)
(let ((file (path:catfile dir "sock"))
(read-value 0))
(with-unix-socket (server-sock (make-unix-socket file))
(let ((thread (bt:make-thread
(lambda ()
(handler-case
(with-unix-socket (client (accept-unix-socket server-sock))
(let ((stream (unix-socket-stream client)))
(setf read-value
(read-byte stream))))
(test-error (e)
(setf read-value -1)))))))
(with-unix-socket (client (connect-unix-socket file))
(let ((Stream (unix-socket-stream client)))
(sleep 0.1)
(bt:interrupt-thread thread (lambda () (error 'test-error)))))
(bt:join-thread thread)
(is (eql -1 read-value)))))))