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-uri-exception "http://foo:not-a-port"
95 (build-uri 'http #:host "foo" #:port "not-a-port"))
97 (pass-if-uri-exception "http://foo:10 but port as string"
99 (build-uri 'http #:host "foo" #:port "10"))
101 (pass-if-uri-exception "http://:10"
103 (build-uri 'http #:port 10))
105 (pass-if-uri-exception "http://foo@"
107 (build-uri 'http #:userinfo "foo")))
110 (with-test-prefix "string->uri"
112 (uri=? (string->uri "ftp:")
117 (uri=? (string->uri "ftp:foo")
121 (pass-if "ftp://foo/bar"
122 (uri=? (string->uri "ftp://foo/bar")
127 (pass-if "ftp://foo@bar:22/baz"
128 (uri=? (string->uri "ftp://foo@bar:22/baz")
135 (pass-if "http://bad.host.1"
136 (not (string->uri "http://bad.host.1")))
138 (pass-if "http://foo:"
139 (uri=? (string->uri "http://foo:")
140 #:scheme 'http #:host "foo" #:path ""))
142 (pass-if "http://foo:/"
143 (uri=? (string->uri "http://foo:/")
144 #:scheme 'http #:host "foo" #:path "/"))
146 (pass-if "http://2012.jsconf.us/"
147 (uri=? (string->uri "http://2012.jsconf.us/")
148 #:scheme 'http #:host "2012.jsconf.us" #:path "/"))
150 (pass-if "http://foo:not-a-port"
151 (not (string->uri "http://foo:not-a-port")))
153 (pass-if "http://:10"
154 (not (string->uri "http://:10")))
156 (pass-if "http://foo@"
157 (not (string->uri "http://foo@")))
160 (uri=? (string->uri "file:/")
164 (pass-if "file:/etc/hosts"
165 (uri=? (string->uri "file:/etc/hosts")
167 #:path "/etc/hosts"))
169 (pass-if "file:///etc/hosts"
170 (uri=? (string->uri "file:///etc/hosts")
172 #:path "/etc/hosts")))
174 (with-test-prefix "uri->string"
177 (uri->string (string->uri "ftp:"))))
181 (uri->string (string->uri "ftp:foo"))))
183 (pass-if "ftp://foo/bar"
184 (equal? "ftp://foo/bar"
185 (uri->string (string->uri "ftp://foo/bar"))))
187 (pass-if "ftp://foo@bar:22/baz"
188 (equal? "ftp://foo@bar:22/baz"
189 (uri->string (string->uri "ftp://foo@bar:22/baz"))))
191 (pass-if "http://foo:"
193 (uri->string (string->uri "http://foo:"))))
195 (pass-if "http://foo:/"
196 (equal? "http://foo/"
197 (uri->string (string->uri "http://foo:/")))))
199 (with-test-prefix "decode"
200 (pass-if (equal? "foo bar" (uri-decode "foo%20bar"))))
202 (with-test-prefix "encode"
203 (pass-if (equal? "foo%20bar" (uri-encode "foo bar"))))