1 ;;;; web-uri.test --- URI library -*- mode: scheme; coding: utf-8; -*-
3 ;;;; Copyright (C) 2010, 2011, 2012 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 (with-test-prefix "uri->string"
218 (uri->string (string->uri "ftp:"))))
222 (uri->string (string->uri "ftp:foo"))))
224 (pass-if "ftp://foo/bar"
225 (equal? "ftp://foo/bar"
226 (uri->string (string->uri "ftp://foo/bar"))))
228 (pass-if "ftp://foo@bar:22/baz"
229 (equal? "ftp://foo@bar:22/baz"
230 (uri->string (string->uri "ftp://foo@bar:22/baz"))))
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"))))
237 (pass-if "http://[2001:db8::1]"
238 (equal? "http://[2001:db8::1]"
239 (uri->string (string->uri "http://[2001:db8::1]"))))
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]")))))
245 (pass-if "http://foo:"
247 (uri->string (string->uri "http://foo:"))))
249 (pass-if "http://foo:/"
250 (equal? "http://foo/"
251 (uri->string (string->uri "http://foo:/")))))
253 (with-test-prefix "decode"
255 (equal? "foo bar" (uri-decode "foo%20bar")))
258 (equal? "foo bar" (uri-decode "foo+bar"))))
260 (with-test-prefix "encode"
261 (pass-if (equal? "foo%20bar" (uri-encode "foo bar")))
262 (pass-if (equal? "foo%0A%00bar" (uri-encode "foo\n\x00bar")))
263 (pass-if (equal? "%3C%3E%5C%5E" (uri-encode "<>\\^"))))