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 | ||
97 | (pass-if "http://192.0.2.1" | |
98 | (uri=? (build-uri 'http #:host "192.0.2.1") | |
99 | #:scheme 'http #:host "192.0.2.1" #:path "")) | |
100 | ||
101 | (pass-if "http://[2001:db8::1]" | |
3fabb2d2 AW |
102 | (uri=? (build-uri 'http #:host "2001:db8::1") |
103 | #:scheme 'http #:host "2001:db8::1" #:path "")) | |
274e2eec | 104 | |
81e7210f | 105 | (pass-if "http://[::ffff:192.0.2.1]" |
3fabb2d2 AW |
106 | (uri=? (build-uri 'http #:host "::ffff:192.0.2.1") |
107 | #:scheme 'http #:host "::ffff:192.0.2.1" #:path "")) | |
81e7210f | 108 | |
5a2f7fb3 AW |
109 | (pass-if-uri-exception "http://foo:not-a-port" |
110 | "Expected.*port" | |
111 | (build-uri 'http #:host "foo" #:port "not-a-port")) | |
73124c6c | 112 | |
5a2f7fb3 AW |
113 | (pass-if-uri-exception "http://foo:10 but port as string" |
114 | "Expected.*port" | |
115 | (build-uri 'http #:host "foo" #:port "10")) | |
73124c6c | 116 | |
5a2f7fb3 AW |
117 | (pass-if-uri-exception "http://:10" |
118 | "Expected.*host" | |
119 | (build-uri 'http #:port 10)) | |
73124c6c | 120 | |
5a2f7fb3 AW |
121 | (pass-if-uri-exception "http://foo@" |
122 | "Expected.*host" | |
123 | (build-uri 'http #:userinfo "foo"))) | |
73124c6c AW |
124 | |
125 | ||
8745c33a | 126 | (with-test-prefix "string->uri" |
73124c6c | 127 | (pass-if "ftp:" |
8745c33a | 128 | (uri=? (string->uri "ftp:") |
73124c6c AW |
129 | #:scheme 'ftp |
130 | #:path "")) | |
131 | ||
132 | (pass-if "ftp:foo" | |
8745c33a | 133 | (uri=? (string->uri "ftp:foo") |
73124c6c AW |
134 | #:scheme 'ftp |
135 | #:path "foo")) | |
136 | ||
137 | (pass-if "ftp://foo/bar" | |
8745c33a | 138 | (uri=? (string->uri "ftp://foo/bar") |
73124c6c AW |
139 | #:scheme 'ftp |
140 | #:host "foo" | |
141 | #:path "/bar")) | |
142 | ||
143 | (pass-if "ftp://foo@bar:22/baz" | |
8745c33a | 144 | (uri=? (string->uri "ftp://foo@bar:22/baz") |
73124c6c AW |
145 | #:scheme 'ftp |
146 | #:userinfo "foo" | |
147 | #:host "bar" | |
148 | #:port 22 | |
149 | #:path "/baz")) | |
150 | ||
151 | (pass-if "http://bad.host.1" | |
8745c33a | 152 | (not (string->uri "http://bad.host.1"))) |
73124c6c | 153 | |
274e2eec DH |
154 | (pass-if "http://1.good.host" |
155 | (uri=? (string->uri "http://1.good.host") | |
156 | #:scheme 'http #:host "1.good.host" #:path "")) | |
157 | ||
158 | (pass-if "http://192.0.2.1" | |
159 | (uri=? (string->uri "http://192.0.2.1") | |
160 | #:scheme 'http #:host "192.0.2.1" #:path "")) | |
161 | ||
162 | (pass-if "http://[2001:db8::1]" | |
163 | (uri=? (string->uri "http://[2001:db8::1]") | |
3fabb2d2 | 164 | #:scheme 'http #:host "2001:db8::1" #:path "")) |
274e2eec DH |
165 | |
166 | (pass-if "http://[2001:db8::1]:80" | |
81e7210f | 167 | (uri=? (string->uri "http://[2001:db8::1]:80") |
274e2eec | 168 | #:scheme 'http |
3fabb2d2 | 169 | #:host "2001:db8::1" |
274e2eec DH |
170 | #:port 80 |
171 | #:path "")) | |
172 | ||
81e7210f DH |
173 | (pass-if "http://[::ffff:192.0.2.1]" |
174 | (uri=? (string->uri "http://[::ffff:192.0.2.1]") | |
3fabb2d2 | 175 | #:scheme 'http #:host "::ffff:192.0.2.1" #:path "")) |
81e7210f | 176 | |
73124c6c | 177 | (pass-if "http://foo:" |
8745c33a | 178 | (uri=? (string->uri "http://foo:") |
73124c6c AW |
179 | #:scheme 'http #:host "foo" #:path "")) |
180 | ||
181 | (pass-if "http://foo:/" | |
8745c33a | 182 | (uri=? (string->uri "http://foo:/") |
73124c6c AW |
183 | #:scheme 'http #:host "foo" #:path "/")) |
184 | ||
71cc8d96 AW |
185 | (pass-if "http://2012.jsconf.us/" |
186 | (uri=? (string->uri "http://2012.jsconf.us/") | |
187 | #:scheme 'http #:host "2012.jsconf.us" #:path "/")) | |
188 | ||
73124c6c | 189 | (pass-if "http://foo:not-a-port" |
8745c33a | 190 | (not (string->uri "http://foo:not-a-port"))) |
73124c6c AW |
191 | |
192 | (pass-if "http://:10" | |
8745c33a | 193 | (not (string->uri "http://:10"))) |
73124c6c AW |
194 | |
195 | (pass-if "http://foo@" | |
679eea4f AW |
196 | (not (string->uri "http://foo@"))) |
197 | ||
198 | (pass-if "file:/" | |
199 | (uri=? (string->uri "file:/") | |
200 | #:scheme 'file | |
201 | #:path "/")) | |
202 | ||
203 | (pass-if "file:/etc/hosts" | |
204 | (uri=? (string->uri "file:/etc/hosts") | |
205 | #:scheme 'file | |
206 | #:path "/etc/hosts")) | |
207 | ||
208 | (pass-if "file:///etc/hosts" | |
209 | (uri=? (string->uri "file:///etc/hosts") | |
210 | #:scheme 'file | |
211 | #:path "/etc/hosts"))) | |
73124c6c | 212 | |
8745c33a | 213 | (with-test-prefix "uri->string" |
73124c6c AW |
214 | (pass-if "ftp:" |
215 | (equal? "ftp:" | |
8745c33a | 216 | (uri->string (string->uri "ftp:")))) |
73124c6c AW |
217 | |
218 | (pass-if "ftp:foo" | |
219 | (equal? "ftp:foo" | |
8745c33a | 220 | (uri->string (string->uri "ftp:foo")))) |
73124c6c AW |
221 | |
222 | (pass-if "ftp://foo/bar" | |
223 | (equal? "ftp://foo/bar" | |
8745c33a | 224 | (uri->string (string->uri "ftp://foo/bar")))) |
73124c6c AW |
225 | |
226 | (pass-if "ftp://foo@bar:22/baz" | |
227 | (equal? "ftp://foo@bar:22/baz" | |
8745c33a | 228 | (uri->string (string->uri "ftp://foo@bar:22/baz")))) |
73124c6c | 229 | |
274e2eec DH |
230 | (pass-if "http://192.0.2.1" |
231 | (equal? "http://192.0.2.1" | |
232 | (uri->string (string->uri "http://192.0.2.1")))) | |
233 | ||
234 | (pass-if "http://[2001:db8::1]" | |
235 | (equal? "http://[2001:db8::1]" | |
236 | (uri->string (string->uri "http://[2001:db8::1]")))) | |
237 | ||
81e7210f DH |
238 | (pass-if "http://[::ffff:192.0.2.1]" |
239 | (equal? "http://[::ffff:192.0.2.1]" | |
240 | (uri->string (string->uri "http://[::ffff:192.0.2.1]")))) | |
274e2eec | 241 | |
73124c6c AW |
242 | (pass-if "http://foo:" |
243 | (equal? "http://foo" | |
8745c33a | 244 | (uri->string (string->uri "http://foo:")))) |
73124c6c AW |
245 | |
246 | (pass-if "http://foo:/" | |
247 | (equal? "http://foo/" | |
8745c33a | 248 | (uri->string (string->uri "http://foo:/"))))) |
73124c6c AW |
249 | |
250 | (with-test-prefix "decode" | |
274e2eec DH |
251 | (pass-if "foo%20bar" |
252 | (equal? "foo bar" (uri-decode "foo%20bar"))) | |
253 | ||
254 | (pass-if "foo+bar" | |
255 | (equal? "foo bar" (uri-decode "foo+bar")))) | |
73124c6c AW |
256 | |
257 | (with-test-prefix "encode" | |
258 | (pass-if (equal? "foo%20bar" (uri-encode "foo bar")))) |