1 ;;;; web-uri.test --- URI library -*- mode: scheme; coding: utf-8; -*-
3 ;;;; Copyright (C) 2010, 2011, 2012, 2014 Free Software Foundation, Inc.
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.
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.
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
20 (define-module (test-web-uri)
21 #:use-module (web uri)
22 #:use-module (ice-9 regex)
23 #:use-module (test-suite lib))
26 ;; FIXME: need more decode / encode tests
29 (define* (uri=? uri #:key scheme userinfo host port path query fragment)
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)))
39 (define-syntax pass-if-uri-exception
44 (lambda () exp (error "expected uri-error exception"))
45 (lambda (k message args)
46 (if (string-match pat message)
48 (error "unexpected uri-error exception" message args))))))))
50 (with-test-prefix "build-uri"
52 (uri=? (build-uri 'ftp)
57 (uri=? (build-uri 'ftp #:path "foo")
62 (uri=? (build-uri 'ftp #:host "foo")
67 (pass-if "ftp://foo/bar"
68 (uri=? (build-uri 'ftp #:host "foo" #:path "/bar")
73 (pass-if "ftp://foo@bar:22/baz"
74 (uri=? (build-uri 'ftp #:userinfo "foo" #:host "bar" #:port 22 #:path "/baz")
81 (pass-if-uri-exception "non-symbol scheme"
85 (pass-if-uri-exception "http://bad.host.1"
87 (build-uri 'http #:host "bad.host.1"))
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 ""))
93 (pass-if "http://1.good.host"
94 (uri=? (build-uri 'http #:host "1.good.host")
95 #:scheme 'http #:host "1.good.host" #:path ""))
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 ""))
102 (pass-if "http://[2001:db8::1]"
103 (uri=? (build-uri 'http #:host "2001:db8::1")
104 #:scheme 'http #:host "2001:db8::1" #:path ""))
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 "")))
110 (pass-if-uri-exception "http://foo:not-a-port"
112 (build-uri 'http #:host "foo" #:port "not-a-port"))
114 (pass-if-uri-exception "http://foo:10 but port as string"
116 (build-uri 'http #:host "foo" #:port "10"))
118 (pass-if-uri-exception "http://:10"
120 (build-uri 'http #:port 10))
122 (pass-if-uri-exception "http://foo@"
124 (build-uri 'http #:userinfo "foo")))
127 (with-test-prefix "string->uri"
129 (uri=? (string->uri "ftp:")
134 (uri=? (string->uri "ftp:foo")
138 (pass-if "ftp://foo/bar"
139 (uri=? (string->uri "ftp://foo/bar")
144 (pass-if "ftp://foo@bar:22/baz"
145 (uri=? (string->uri "ftp://foo@bar:22/baz")
152 (pass-if "http://bad.host.1"
153 (not (string->uri "http://bad.host.1")))
155 (pass-if "http://1.good.host"
156 (uri=? (string->uri "http://1.good.host")
157 #:scheme 'http #:host "1.good.host" #:path ""))
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 ""))
164 (pass-if "http://[2001:db8::1]"
165 (uri=? (string->uri "http://[2001:db8::1]")
166 #:scheme 'http #:host "2001:db8::1" #:path ""))
168 (pass-if "http://[2001:db8::1]:80"
169 (uri=? (string->uri "http://[2001:db8::1]:80")
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 "")))
179 (pass-if "http://foo:"
180 (uri=? (string->uri "http://foo:")
181 #:scheme 'http #:host "foo" #:path ""))
183 (pass-if "http://foo:/"
184 (uri=? (string->uri "http://foo:/")
185 #:scheme 'http #:host "foo" #:path "/"))
187 (pass-if "http://2012.jsconf.us/"
188 (uri=? (string->uri "http://2012.jsconf.us/")
189 #:scheme 'http #:host "2012.jsconf.us" #:path "/"))
191 (pass-if "http://foo:not-a-port"
192 (not (string->uri "http://foo:not-a-port")))
194 (pass-if "http://:10"
195 (not (string->uri "http://:10")))
197 (pass-if "http://foo@"
198 (not (string->uri "http://foo@")))
201 (uri=? (string->uri "file:/")
205 (pass-if "file:/etc/hosts"
206 (uri=? (string->uri "file:/etc/hosts")
208 #:path "/etc/hosts"))
210 (pass-if "file:///etc/hosts"
211 (uri=? (string->uri "file:///etc/hosts")
213 #:path "/etc/hosts"))
215 (pass-if "http://foo#bar"
216 (uri=? (string->uri "http://foo#bar")
222 (pass-if "http://foo:/#bar"
223 (uri=? (string->uri "http://foo:/#bar")
229 (pass-if "http://foo:100#bar"
230 (uri=? (string->uri "http://foo:100#bar")
237 (pass-if "http://foo:100/#bar"
238 (uri=? (string->uri "http://foo:100/#bar")
245 (pass-if "http://foo?q#bar"
246 (uri=? (string->uri "http://foo?q#bar")
253 (pass-if "http://foo:/?q#bar"
254 (uri=? (string->uri "http://foo:/?q#bar")
261 (pass-if "http://foo:100?q#bar"
262 (uri=? (string->uri "http://foo:100?q#bar")
270 (pass-if "http://foo:100/?q#bar"
271 (uri=? (string->uri "http://foo:100/?q#bar")
279 (with-test-prefix "string->uri-reference"
281 (uri=? (string->uri-reference "/foo")
285 (uri=? (string->uri-reference "ftp:/foo")
290 (uri=? (string->uri-reference "ftp:foo")
295 (uri=? (string->uri-reference "//foo/bar")
299 (pass-if "ftp://foo@bar:22/baz"
300 (uri=? (string->uri-reference "ftp://foo@bar:22/baz")
307 (pass-if "//foo@bar:22/baz"
308 (uri=? (string->uri-reference "//foo@bar:22/baz")
314 (pass-if "http://bad.host.1"
315 (not (string->uri-reference "http://bad.host.1")))
317 (pass-if "//bad.host.1"
318 (not (string->uri-reference "//bad.host.1")))
320 (pass-if "http://1.good.host"
321 (uri=? (string->uri-reference "http://1.good.host")
322 #:scheme 'http #:host "1.good.host" #:path ""))
324 (pass-if "//1.good.host"
325 (uri=? (string->uri-reference "//1.good.host")
326 #:host "1.good.host" #:path ""))
328 (when (memq 'socket *features*)
329 (pass-if "http://192.0.2.1"
330 (uri=? (string->uri-reference "http://192.0.2.1")
331 #:scheme 'http #:host "192.0.2.1" #:path ""))
333 (pass-if "//192.0.2.1"
334 (uri=? (string->uri-reference "//192.0.2.1")
335 #:host "192.0.2.1" #:path ""))
337 (pass-if "http://[2001:db8::1]"
338 (uri=? (string->uri-reference "http://[2001:db8::1]")
339 #:scheme 'http #:host "2001:db8::1" #:path ""))
341 (pass-if "//[2001:db8::1]"
342 (uri=? (string->uri-reference "//[2001:db8::1]")
343 #:host "2001:db8::1" #:path ""))
345 (pass-if "http://[2001:db8::1]:80"
346 (uri=? (string->uri-reference "http://[2001:db8::1]:80")
352 (pass-if "//[2001:db8::1]:80"
353 (uri=? (string->uri-reference "//[2001:db8::1]:80")
358 (pass-if "http://[::ffff:192.0.2.1]"
359 (uri=? (string->uri-reference "http://[::ffff:192.0.2.1]")
360 #:scheme 'http #:host "::ffff:192.0.2.1" #:path ""))
362 (pass-if "//[::ffff:192.0.2.1]"
363 (uri=? (string->uri-reference "//[::ffff:192.0.2.1]")
364 #:host "::ffff:192.0.2.1" #:path "")))
366 (pass-if "http://foo:"
367 (uri=? (string->uri-reference "http://foo:")
368 #:scheme 'http #:host "foo" #:path ""))
371 (uri=? (string->uri-reference "//foo:")
372 #:host "foo" #:path ""))
374 (pass-if "http://foo:/"
375 (uri=? (string->uri-reference "http://foo:/")
376 #:scheme 'http #:host "foo" #:path "/"))
379 (uri=? (string->uri-reference "//foo:/")
380 #:host "foo" #:path "/"))
382 (pass-if "http://2012.jsconf.us/"
383 (uri=? (string->uri-reference "http://2012.jsconf.us/")
384 #:scheme 'http #:host "2012.jsconf.us" #:path "/"))
386 (pass-if "//2012.jsconf.us/"
387 (uri=? (string->uri-reference "//2012.jsconf.us/")
388 #:host "2012.jsconf.us" #:path "/"))
390 (pass-if "http://foo:not-a-port"
391 (not (string->uri-reference "http://foo:not-a-port")))
393 (pass-if "//foo:not-a-port"
394 (not (string->uri-reference "//foo:not-a-port")))
396 (pass-if "http://:10"
397 (not (string->uri-reference "http://:10")))
400 (not (string->uri-reference "//:10")))
402 (pass-if "http://foo@"
403 (not (string->uri-reference "http://foo@")))
406 (not (string->uri-reference "//foo@")))
409 (uri=? (string->uri-reference "file:/")
414 (uri=? (string->uri-reference "/")
418 (uri=? (string->uri-reference "foo")
421 (pass-if "file:/etc/hosts"
422 (uri=? (string->uri-reference "file:/etc/hosts")
424 #:path "/etc/hosts"))
426 (pass-if "/etc/hosts"
427 (uri=? (string->uri-reference "/etc/hosts")
428 #:path "/etc/hosts"))
430 (pass-if "file:///etc/hosts"
431 (uri=? (string->uri-reference "file:///etc/hosts")
433 #:path "/etc/hosts"))
435 (pass-if "///etc/hosts"
436 (uri=? (string->uri-reference "///etc/hosts")
437 #:path "/etc/hosts"))
440 (uri=? (string->uri-reference "/foo#bar")
445 (uri=? (string->uri-reference "//foo#bar")
450 (pass-if "//foo:/#bar"
451 (uri=? (string->uri-reference "//foo:/#bar")
456 (pass-if "//foo:100#bar"
457 (uri=? (string->uri-reference "//foo:100#bar")
463 (pass-if "//foo:100/#bar"
464 (uri=? (string->uri-reference "//foo:100/#bar")
470 (pass-if "/foo?q#bar"
471 (uri=? (string->uri-reference "/foo?q#bar")
476 (pass-if "//foo?q#bar"
477 (uri=? (string->uri-reference "//foo?q#bar")
483 (pass-if "//foo:/?q#bar"
484 (uri=? (string->uri-reference "//foo:/?q#bar")
490 (pass-if "//foo:100?q#bar"
491 (uri=? (string->uri-reference "//foo:100?q#bar")
498 (pass-if "//foo:100/?q#bar"
499 (uri=? (string->uri-reference "//foo:100/?q#bar")
506 (with-test-prefix "uri->string"
509 (uri->string (string->uri "ftp:"))))
513 (uri->string (string->uri "ftp:foo"))))
515 (pass-if "ftp://foo/bar"
516 (equal? "ftp://foo/bar"
517 (uri->string (string->uri "ftp://foo/bar"))))
521 (uri->string (string->uri-reference "//foo/bar"))))
523 (pass-if "ftp://foo@bar:22/baz"
524 (equal? "ftp://foo@bar:22/baz"
525 (uri->string (string->uri "ftp://foo@bar:22/baz"))))
527 (pass-if "//foo@bar:22/baz"
528 (equal? "//foo@bar:22/baz"
529 (uri->string (string->uri-reference "//foo@bar:22/baz"))))
531 (when (memq 'socket *features*)
532 (pass-if "http://192.0.2.1"
533 (equal? "http://192.0.2.1"
534 (uri->string (string->uri "http://192.0.2.1"))))
536 (pass-if "//192.0.2.1"
537 (equal? "//192.0.2.1"
538 (uri->string (string->uri-reference "//192.0.2.1"))))
540 (pass-if "http://[2001:db8::1]"
541 (equal? "http://[2001:db8::1]"
542 (uri->string (string->uri "http://[2001:db8::1]"))))
544 (pass-if "//[2001:db8::1]"
545 (equal? "//[2001:db8::1]"
546 (uri->string (string->uri-reference "//[2001:db8::1]"))))
548 (pass-if "http://[::ffff:192.0.2.1]"
549 (equal? "http://[::ffff:192.0.2.1]"
550 (uri->string (string->uri "http://[::ffff:192.0.2.1]"))))
552 (pass-if "//[::ffff:192.0.2.1]"
553 (equal? "//[::ffff:192.0.2.1]"
554 (uri->string (string->uri-reference "//[::ffff:192.0.2.1]")))))
556 (pass-if "http://foo:"
558 (uri->string (string->uri "http://foo:"))))
562 (uri->string (string->uri-reference "//foo"))))
564 (pass-if "http://foo:/"
565 (equal? "http://foo/"
566 (uri->string (string->uri "http://foo:/"))))
570 (uri->string (string->uri-reference "//foo:/"))))
574 (uri->string (string->uri-reference "/"))))
578 (uri->string (string->uri-reference "/foo"))))
582 (uri->string (string->uri-reference "/foo/"))))
584 (pass-if "/foo/?bar#baz"
585 (equal? "/foo/?bar#baz"
586 (uri->string (string->uri-reference "/foo/?bar#baz"))))
588 (pass-if "foo/?bar#baz"
589 (equal? "foo/?bar#baz"
590 (uri->string (string->uri-reference "foo/?bar#baz")))))
592 (with-test-prefix "decode"
594 (equal? "foo bar" (uri-decode "foo%20bar")))
597 (equal? "foo bar" (uri-decode "foo+bar"))))
599 (with-test-prefix "encode"
600 (pass-if (equal? "foo%20bar" (uri-encode "foo bar")))
601 (pass-if (equal? "foo%0A%00bar" (uri-encode "foo\n\x00bar")))
602 (pass-if (equal? "%3C%3E%5C%5E" (uri-encode "<>\\^"))))