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