Introduction
Introduction Statistics Contact Development Disclaimer Help
ttest-usocket.lisp - clic - Clic is an command line interactive client for goph…
git clone git://bitreich.org/clic/ git://hg6vgqziawt5s4dj.onion/clic/
Log
Files
Refs
Tags
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-condit…
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) ;; == #(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) ;; == #(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 po…
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-n…
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))
You are viewing proxied material from bitreich.org. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.