test-usocket.lisp - clic - Clic is an command line interactive client for gophe… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
test-usocket.lisp (5716B) | |
--- | |
1 ;;;; -*- Mode: LISP; Base: 10; Syntax: ANSI-Common-lisp; Package: USOCKE… | |
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-condit… | |
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) ;; == #(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) ;; == #(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 po… | |
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-n… | |
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)) |