Commit | Line | Data |
---|---|---|
73124c6c AW |
1 | ;;;; web-uri.test --- URI library -*- mode: scheme; coding: utf-8; -*- |
2 | ;;;; | |
71cc8d96 | 3 | ;;;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc. |
73124c6c AW |
4 | ;;;; |
5 | ;;;; This library is free software; you can redistribute it and/or | |
6 | ;;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;;; License as published by the Free Software Foundation; either | |
8 | ;;;; version 3 of the License, or (at your option) any later version. | |
9 | ;;;; | |
10 | ;;;; This library is distributed in the hope that it will be useful, | |
11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 | ;;;; Lesser General Public License for more details. | |
14 | ;;;; | |
15 | ;;;; You should have received a copy of the GNU Lesser General Public | |
16 | ;;;; License along with this library; if not, write to the Free Software | |
17 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
18 | ||
19 | ||
20 | (define-module (test-web-uri) | |
21 | #:use-module (web uri) | |
5a2f7fb3 | 22 | #:use-module (ice-9 regex) |
73124c6c AW |
23 | #:use-module (test-suite lib)) |
24 | ||
25 | ||
26 | ;; FIXME: need more decode / encode tests | |
27 | ||
28 | ||
29 | (define* (uri=? uri #:key scheme userinfo host port path query fragment) | |
30 | (and (uri? uri) | |
31 | (equal? (uri-scheme uri) scheme) | |
32 | (equal? (uri-userinfo uri) userinfo) | |
33 | (equal? (uri-host uri) host) | |
34 | (equal? (uri-port uri) port) | |
35 | (equal? (uri-path uri) path) | |
36 | (equal? (uri-query uri) query) | |
37 | (equal? (uri-fragment uri) fragment))) | |
38 | ||
5a2f7fb3 AW |
39 | (define-syntax pass-if-uri-exception |
40 | (syntax-rules () | |
41 | ((_ name pat exp) | |
42 | (pass-if name | |
43 | (catch 'uri-error | |
44 | (lambda () exp (error "expected uri-error exception")) | |
45 | (lambda (k message args) | |
46 | (if (string-match pat message) | |
47 | #t | |
48 | (error "unexpected uri-error exception" message args)))))))) | |
73124c6c AW |
49 | |
50 | (with-test-prefix "build-uri" | |
51 | (pass-if "ftp:" | |
52 | (uri=? (build-uri 'ftp) | |
53 | #:scheme 'ftp | |
54 | #:path "")) | |
55 | ||
56 | (pass-if "ftp:foo" | |
57 | (uri=? (build-uri 'ftp #:path "foo") | |
58 | #:scheme 'ftp | |
59 | #:path "foo")) | |
60 | ||
61 | (pass-if "ftp://foo" | |
62 | (uri=? (build-uri 'ftp #:host "foo") | |
63 | #:scheme 'ftp | |
64 | #:host "foo" | |
65 | #:path "")) | |
66 | ||
67 | (pass-if "ftp://foo/bar" | |
68 | (uri=? (build-uri 'ftp #:host "foo" #:path "/bar") | |
69 | #:scheme 'ftp | |
70 | #:host "foo" | |
71 | #:path "/bar")) | |
72 | ||
73 | (pass-if "ftp://foo@bar:22/baz" | |
74 | (uri=? (build-uri 'ftp #:userinfo "foo" #:host "bar" #:port 22 #:path "/baz") | |
75 | #:scheme 'ftp | |
76 | #:userinfo "foo" | |
77 | #:host "bar" | |
78 | #:port 22 | |
79 | #:path "/baz")) | |
80 | ||
5a2f7fb3 AW |
81 | (pass-if-uri-exception "non-symbol scheme" |
82 | "Expected.*symbol" | |
83 | (build-uri "nonsym")) | |
73124c6c | 84 | |
5a2f7fb3 AW |
85 | (pass-if-uri-exception "http://bad.host.1" |
86 | "Expected.*host" | |
87 | (build-uri 'http #:host "bad.host.1")) | |
73124c6c AW |
88 | |
89 | (pass-if "http://bad.host.1 (no validation)" | |
90 | (uri=? (build-uri 'http #:host "bad.host.1" #:validate? #f) | |
91 | #:scheme 'http #:host "bad.host.1" #:path "")) | |
92 | ||
274e2eec DH |
93 | (pass-if "http://1.good.host" |
94 | (uri=? (build-uri 'http #:host "1.good.host") | |
95 | #:scheme 'http #:host "1.good.host" #:path "")) | |
96 | ||
5d312f3c AW |
97 | (when (memq 'socket *features*) |
98 | (pass-if "http://192.0.2.1" | |
99 | (uri=? (build-uri 'http #:host "192.0.2.1") | |
100 | #:scheme 'http #:host "192.0.2.1" #:path "")) | |
274e2eec | 101 | |
5d312f3c AW |
102 | (pass-if "http://[2001:db8::1]" |
103 | (uri=? (build-uri 'http #:host "2001:db8::1") | |
104 | #:scheme 'http #:host "2001:db8::1" #:path "")) | |
274e2eec | 105 | |
5d312f3c AW |
106 | (pass-if "http://[::ffff:192.0.2.1]" |
107 | (uri=? (build-uri 'http #:host "::ffff:192.0.2.1") | |
108 | #:scheme 'http #:host "::ffff:192.0.2.1" #:path ""))) | |
81e7210f | 109 | |
5a2f7fb3 AW |
110 | (pass-if-uri-exception "http://foo:not-a-port" |
111 | "Expected.*port" | |
112 | (build-uri 'http #:host "foo" #:port "not-a-port")) | |
73124c6c | 113 | |
5a2f7fb3 AW |
114 | (pass-if-uri-exception "http://foo:10 but port as string" |
115 | "Expected.*port" | |
116 | (build-uri 'http #:host "foo" #:port "10")) | |
73124c6c | 117 | |
5a2f7fb3 AW |
118 | (pass-if-uri-exception "http://:10" |
119 | "Expected.*host" | |
120 | (build-uri 'http #:port 10)) | |
73124c6c | 121 | |
5a2f7fb3 AW |
122 | (pass-if-uri-exception "http://foo@" |
123 | "Expected.*host" | |
124 | (build-uri 'http #:userinfo "foo"))) | |
73124c6c AW |
125 | |
126 | ||
8745c33a | 127 | (with-test-prefix "string->uri" |
73124c6c | 128 | (pass-if "ftp:" |
8745c33a | 129 | (uri=? (string->uri "ftp:") |
73124c6c AW |
130 | #:scheme 'ftp |
131 | #:path "")) | |
132 | ||
133 | (pass-if "ftp:foo" | |
8745c33a | 134 | (uri=? (string->uri "ftp:foo") |
73124c6c AW |
135 | #:scheme 'ftp |
136 | #:path "foo")) | |
137 | ||
138 | (pass-if "ftp://foo/bar" | |
8745c33a | 139 | (uri=? (string->uri "ftp://foo/bar") |
73124c6c AW |
140 | #:scheme 'ftp |
141 | #:host "foo" | |
142 | #:path "/bar")) | |
143 | ||
144 | (pass-if "ftp://foo@bar:22/baz" | |
8745c33a | 145 | (uri=? (string->uri "ftp://foo@bar:22/baz") |
73124c6c AW |
146 | #:scheme 'ftp |
147 | #:userinfo "foo" | |
148 | #:host "bar" | |
149 | #:port 22 | |
150 | #:path "/baz")) | |
151 | ||
152 | (pass-if "http://bad.host.1" | |
8745c33a | 153 | (not (string->uri "http://bad.host.1"))) |
73124c6c | 154 | |
274e2eec DH |
155 | (pass-if "http://1.good.host" |
156 | (uri=? (string->uri "http://1.good.host") | |
157 | #:scheme 'http #:host "1.good.host" #:path "")) | |
158 | ||
5d312f3c AW |
159 | (when (memq 'socket *features*) |
160 | (pass-if "http://192.0.2.1" | |
161 | (uri=? (string->uri "http://192.0.2.1") | |
162 | #:scheme 'http #:host "192.0.2.1" #:path "")) | |
274e2eec | 163 | |
5d312f3c AW |
164 | (pass-if "http://[2001:db8::1]" |
165 | (uri=? (string->uri "http://[2001:db8::1]") | |
166 | #:scheme 'http #:host "2001:db8::1" #:path "")) | |
274e2eec | 167 | |
5d312f3c AW |
168 | (pass-if "http://[2001:db8::1]:80" |
169 | (uri=? (string->uri "http://[2001:db8::1]:80") | |
170 | #:scheme 'http | |
171 | #:host "2001:db8::1" | |
172 | #:port 80 | |
173 | #:path "")) | |
274e2eec | 174 | |
5d312f3c AW |
175 | (pass-if "http://[::ffff:192.0.2.1]" |
176 | (uri=? (string->uri "http://[::ffff:192.0.2.1]") | |
177 | #:scheme 'http #:host "::ffff:192.0.2.1" #:path ""))) | |
81e7210f | 178 | |
73124c6c | 179 | (pass-if "http://foo:" |
8745c33a | 180 | (uri=? (string->uri "http://foo:") |
73124c6c AW |
181 | #:scheme 'http #:host "foo" #:path "")) |
182 | ||
183 | (pass-if "http://foo:/" | |
8745c33a | 184 | (uri=? (string->uri "http://foo:/") |
73124c6c AW |
185 | #:scheme 'http #:host "foo" #:path "/")) |
186 | ||
71cc8d96 AW |
187 | (pass-if "http://2012.jsconf.us/" |
188 | (uri=? (string->uri "http://2012.jsconf.us/") | |
189 | #:scheme 'http #:host "2012.jsconf.us" #:path "/")) | |
190 | ||
73124c6c | 191 | (pass-if "http://foo:not-a-port" |
8745c33a | 192 | (not (string->uri "http://foo:not-a-port"))) |
73124c6c AW |
193 | |
194 | (pass-if "http://:10" | |
8745c33a | 195 | (not (string->uri "http://:10"))) |
73124c6c AW |
196 | |
197 | (pass-if "http://foo@" | |
679eea4f AW |
198 | (not (string->uri "http://foo@"))) |
199 | ||
200 | (pass-if "file:/" | |
201 | (uri=? (string->uri "file:/") | |
202 | #:scheme 'file | |
203 | #:path "/")) | |
204 | ||
205 | (pass-if "file:/etc/hosts" | |
206 | (uri=? (string->uri "file:/etc/hosts") | |
207 | #:scheme 'file | |
208 | #:path "/etc/hosts")) | |
209 | ||
210 | (pass-if "file:///etc/hosts" | |
211 | (uri=? (string->uri "file:///etc/hosts") | |
212 | #:scheme 'file | |
213 | #:path "/etc/hosts"))) | |
73124c6c | 214 | |
8745c33a | 215 | (with-test-prefix "uri->string" |
73124c6c AW |
216 | (pass-if "ftp:" |
217 | (equal? "ftp:" | |
8745c33a | 218 | (uri->string (string->uri "ftp:")))) |
73124c6c AW |
219 | |
220 | (pass-if "ftp:foo" | |
221 | (equal? "ftp:foo" | |
8745c33a | 222 | (uri->string (string->uri "ftp:foo")))) |
73124c6c AW |
223 | |
224 | (pass-if "ftp://foo/bar" | |
225 | (equal? "ftp://foo/bar" | |
8745c33a | 226 | (uri->string (string->uri "ftp://foo/bar")))) |
73124c6c AW |
227 | |
228 | (pass-if "ftp://foo@bar:22/baz" | |
229 | (equal? "ftp://foo@bar:22/baz" | |
8745c33a | 230 | (uri->string (string->uri "ftp://foo@bar:22/baz")))) |
73124c6c | 231 | |
5d312f3c AW |
232 | (when (memq 'socket *features*) |
233 | (pass-if "http://192.0.2.1" | |
234 | (equal? "http://192.0.2.1" | |
235 | (uri->string (string->uri "http://192.0.2.1")))) | |
236 | ||
237 | (pass-if "http://[2001:db8::1]" | |
238 | (equal? "http://[2001:db8::1]" | |
239 | (uri->string (string->uri "http://[2001:db8::1]")))) | |
240 | ||
241 | (pass-if "http://[::ffff:192.0.2.1]" | |
242 | (equal? "http://[::ffff:192.0.2.1]" | |
243 | (uri->string (string->uri "http://[::ffff:192.0.2.1]"))))) | |
274e2eec | 244 | |
73124c6c AW |
245 | (pass-if "http://foo:" |
246 | (equal? "http://foo" | |
8745c33a | 247 | (uri->string (string->uri "http://foo:")))) |
73124c6c AW |
248 | |
249 | (pass-if "http://foo:/" | |
250 | (equal? "http://foo/" | |
8745c33a | 251 | (uri->string (string->uri "http://foo:/"))))) |
73124c6c AW |
252 | |
253 | (with-test-prefix "decode" | |
274e2eec DH |
254 | (pass-if "foo%20bar" |
255 | (equal? "foo bar" (uri-decode "foo%20bar"))) | |
256 | ||
257 | (pass-if "foo+bar" | |
258 | (equal? "foo bar" (uri-decode "foo+bar")))) | |
73124c6c AW |
259 | |
260 | (with-test-prefix "encode" | |
b401fe71 | 261 | (pass-if (equal? "foo%20bar" (uri-encode "foo bar"))) |
6fe2803b ACF |
262 | (pass-if (equal? "foo%0A%00bar" (uri-encode "foo\n\x00bar"))) |
263 | (pass-if (equal? "%3C%3E%5C%5E" (uri-encode "<>\\^")))) |