ttest-usocket.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
(HTM) git clone git://bitreich.org/clic/ git://hg6vgqziawt5s4dj.onion/clic/
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) Tags
(DIR) LICENSE
---
ttest-usocket.lisp (5633B)
---
1 ;;;; See LICENSE for licensing information.
2
3 ;;;; Usage: (usoct:run-usocket-tests) or (usoct:do-tests)
4
5 (in-package :usocket-test)
6
7 (defparameter +non-existing-host+ "1.2.3.4")
8 (defparameter +unused-local-port+ 15213)
9
10 (defparameter *fake-usocket*
11 (usocket::make-stream-socket :socket :my-socket
12 :stream :my-stream))
13
14 (eval-when (:compile-toplevel :load-toplevel :execute)
15 (defvar *common-lisp-net*
16 (get-host-by-name "common-lisp.net")))
17
18 (defvar *local-ip*)
19
20 (defmacro with-caught-conditions ((expect throw) &body body)
21 `(catch 'caught-error
22 (handler-case
23 (handler-bind ((unsupported
24 #'(lambda (c)
25 (declare (ignore c)) (continue))))
26 (progn ,@body))
27 (unknown-error (c) (if (typep c ',expect)
28 (throw 'caught-error ,throw)
29 (progn
30 (describe c)
31 (describe
32 (usocket::usocket-real-error c))
33 c)))
34 (error (c) (if (typep c ',expect)
35 (throw 'caught-error ,throw)
36 (progn
37 (describe c)
38 c)))
39 (unknown-condition (c) (if (typep c ',expect)
40 (throw 'caught-error ,throw)
41 (progn
42 (describe c)
43 (describe
44 (usocket::usocket-real-condition c))
45 c)))
46 (condition (c) (if (typep c ',expect)
47 (throw 'caught-error ,throw)
48 (progn
49 (describe c)
50 c))))))
51
52 (deftest make-socket.1 (socket *fake-usocket*) :my-socket)
53 (deftest make-socket.2 (socket-stream *fake-usocket*) :my-stream)
54
55 (deftest socket-no-connect.1
56 (with-caught-conditions (socket-error nil)
57 (socket-connect "127.0.0.1" +unused-local-port+ :timeout 1)
58 t)
59 nil)
60
61 (deftest socket-no-connect.2
62 (with-caught-conditions (socket-error nil)
63 (socket-connect #(127 0 0 1) +unused-local-port+ :timeout 1)
64 t)
65 nil)
66
67 (deftest socket-no-connect.3
68 (with-caught-conditions (socket-error nil)
69 (socket-connect 2130706433 +unused-local-port+ :timeout 1) ;; == #(127 0 0 1)
70 t)
71 nil)
72
73 (deftest socket-failure.1
74 (with-caught-conditions (timeout-error nil)
75 (socket-connect 2130706433 +unused-local-port+ :timeout 1) ;; == #(127 0 0 1)
76 :unreach)
77 nil)
78
79 (deftest socket-failure.2
80 (with-caught-conditions (timeout-error nil)
81 (socket-connect +non-existing-host+ 80 :timeout 1) ;; 80 = just a port
82 :unreach)
83 nil)
84
85 ;; let's hope c-l.net doesn't move soon, or that people start to
86 ;; test usocket like crazy..
87 (deftest socket-connect.1
88 (with-caught-conditions (nil nil)
89 (let ((sock (socket-connect "common-lisp.net" 80)))
90 (unwind-protect
91 (when (typep sock 'usocket) t)
92 (socket-close sock))))
93 t)
94
95 (deftest socket-connect.2
96 (with-caught-conditions (nil nil)
97 (let ((sock (socket-connect *common-lisp-net* 80)))
98 (unwind-protect
99 (when (typep sock 'usocket) t)
100 (socket-close sock))))
101 t)
102
103 (deftest socket-connect.3
104 (with-caught-conditions (nil nil)
105 (let ((sock (socket-connect (usocket::host-byte-order *common-lisp-net*) 80)))
106 (unwind-protect
107 (when (typep sock 'usocket) t)
108 (socket-close sock))))
109 t)
110
111 ;; let's hope c-l.net doesn't change its software any time soon
112 (deftest socket-stream.1
113 (with-caught-conditions (nil nil)
114 (let ((sock (socket-connect "common-lisp.net" 80)))
115 (unwind-protect
116 (progn
117 (format (socket-stream sock)
118 "GET / HTTP/1.0~2%")
119 (force-output (socket-stream sock))
120 (subseq (read-line (socket-stream sock)) 0 4))
121 (socket-close sock))))
122 "HTTP")
123
124 (deftest socket-name.1
125 (with-caught-conditions (nil nil)
126 (let ((sock (socket-connect *common-lisp-net* 80)))
127 (unwind-protect
128 (get-peer-address sock)
129 (socket-close sock))))
130 #.*common-lisp-net*)
131
132 (deftest socket-name.2
133 (with-caught-conditions (nil nil)
134 (let ((sock (socket-connect *common-lisp-net* 80)))
135 (unwind-protect
136 (get-peer-port sock)
137 (socket-close sock))))
138 80)
139
140 (deftest socket-name.3
141 (with-caught-conditions (nil nil)
142 (let ((sock (socket-connect *common-lisp-net* 80)))
143 (unwind-protect
144 (get-peer-name sock)
145 (socket-close sock))))
146 #.*common-lisp-net* 80)
147
148 #+ignore
149 (deftest socket-name.4
150 (with-caught-conditions (nil nil)
151 (let ((sock (socket-connect *common-lisp-net* 80)))
152 (unwind-protect
153 (equal (get-local-address sock) *local-ip*)
154 (socket-close sock))))
155 t)
156
157 (deftest socket-shutdown.1
158 (with-caught-conditions (nil nil)
159 (let ((sock (socket-connect *common-lisp-net* 80)))
160 (unwind-protect
161 (usocket::ignore-unsupported-warnings
162 (socket-shutdown sock :input))
163 (socket-close sock))
164 t))
165 t)
166
167 (deftest socket-shutdown.2
168 (with-caught-conditions (nil nil)
169 (let ((sock (socket-connect *common-lisp-net* 80)))
170 (unwind-protect
171 (usocket::ignore-unsupported-warnings
172 (socket-shutdown sock :output))
173 (socket-close sock))
174 t))
175 t)
176
177 (defun run-usocket-tests ()
178 (do-tests))