diff options
Diffstat (limited to 'test-suite/tests/web-uri.test')
-rw-r--r-- | test-suite/tests/web-uri.test | 661 |
1 files changed, 661 insertions, 0 deletions
diff --git a/test-suite/tests/web-uri.test b/test-suite/tests/web-uri.test new file mode 100644 index 000000000..73391898c --- /dev/null +++ b/test-suite/tests/web-uri.test @@ -0,0 +1,661 @@ +;;;; web-uri.test --- URI library -*- mode: scheme; coding: utf-8; -*- +;;;; +;;;; Copyright (C) 2010-2012, 2014, 2017 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + +(define-module (test-web-uri) + #:use-module (web uri) + #:use-module (ice-9 regex) + #:use-module (test-suite lib)) + + +;; FIXME: need more decode / encode tests + + +(define* (uri=? uri #:key scheme userinfo host port path query fragment) + (and (uri-reference? uri) + (equal? (uri-scheme uri) scheme) + (equal? (uri-userinfo uri) userinfo) + (equal? (uri-host uri) host) + (equal? (uri-port uri) port) + (equal? (uri-path uri) path) + (equal? (uri-query uri) query) + (equal? (uri-fragment uri) fragment))) + +(define-syntax pass-if-uri-exception + (syntax-rules () + ((_ name pat exp) + (pass-if name + (catch 'uri-error + (lambda () exp (error "expected uri-error exception")) + (lambda (k message args) + (if (string-match pat message) + #t + (error "unexpected uri-error exception" message args)))))))) + +(with-test-prefix "build-uri" + (pass-if "ftp:" + (uri=? (build-uri 'ftp) + #:scheme 'ftp + #:path "")) + + (pass-if "ftp:foo" + (uri=? (build-uri 'ftp #:path "foo") + #:scheme 'ftp + #:path "foo")) + + (pass-if "ftp://foo" + (uri=? (build-uri 'ftp #:host "foo") + #:scheme 'ftp + #:host "foo" + #:path "")) + + (pass-if "ftp://foo/bar" + (uri=? (build-uri 'ftp #:host "foo" #:path "/bar") + #:scheme 'ftp + #:host "foo" + #:path "/bar")) + + (pass-if "ftp://foo@bar:22/baz" + (uri=? (build-uri 'ftp #:userinfo "foo" #:host "bar" #:port 22 #:path "/baz") + #:scheme 'ftp + #:userinfo "foo" + #:host "bar" + #:port 22 + #:path "/baz")) + + (pass-if-uri-exception "non-symbol scheme" + "Expected.*symbol" + (build-uri "nonsym")) + + (pass-if-uri-exception "http://bad.host.1" + "Expected.*host" + (build-uri 'http #:host "bad.host.1")) + + (pass-if "http://bad.host.1 (no validation)" + (uri=? (build-uri 'http #:host "bad.host.1" #:validate? #f) + #:scheme 'http #:host "bad.host.1" #:path "")) + + (pass-if "http://1.good.host" + (uri=? (build-uri 'http #:host "1.good.host") + #:scheme 'http #:host "1.good.host" #:path "")) + + (when (memq 'socket *features*) + (pass-if "http://192.0.2.1" + (uri=? (build-uri 'http #:host "192.0.2.1") + #:scheme 'http #:host "192.0.2.1" #:path "")) + + (pass-if "http://[2001:db8::1]" + (uri=? (build-uri 'http #:host "2001:db8::1") + #:scheme 'http #:host "2001:db8::1" #:path "")) + + (pass-if "http://[::ffff:192.0.2.1]" + (uri=? (build-uri 'http #:host "::ffff:192.0.2.1") + #:scheme 'http #:host "::ffff:192.0.2.1" #:path ""))) + + (pass-if-uri-exception "http://foo:not-a-port" + "Expected.*port" + (build-uri 'http #:host "foo" #:port "not-a-port")) + + (pass-if-uri-exception "http://foo:10 but port as string" + "Expected.*port" + (build-uri 'http #:host "foo" #:port "10")) + + (pass-if-uri-exception "http://:10" + "Expected.*host" + (build-uri 'http #:port 10)) + + (pass-if-uri-exception "http://foo@" + "Expected.*host" + (build-uri 'http #:userinfo "foo"))) + +(with-test-prefix "build-uri-reference" + (pass-if "//host/etc/foo" + (uri=? (build-uri-reference #:host "host" + #:path "/etc/foo") + #:host "host" + #:path "/etc/foo")) + + (pass-if "/path/to/some/foo?query" + (uri=? (build-uri-reference #:path "/path/to/some/foo" + #:query "query") + #:path "/path/to/some/foo" + #:query "query")) + + (pass-if "nextdoc/foo" + (uri=? (build-uri-reference #:path "nextdoc/foo") + #:path "nextdoc/foo"))) + +(with-test-prefix "string->uri" + (pass-if "ftp:" + (uri=? (string->uri "ftp:") + #:scheme 'ftp + #:path "")) + + (pass-if "ftp:foo" + (uri=? (string->uri "ftp:foo") + #:scheme 'ftp + #:path "foo")) + + (pass-if "ftp://foo/bar" + (uri=? (string->uri "ftp://foo/bar") + #:scheme 'ftp + #:host "foo" + #:path "/bar")) + + (pass-if "ftp://foo@bar:22/baz" + (uri=? (string->uri "ftp://foo@bar:22/baz") + #:scheme 'ftp + #:userinfo "foo" + #:host "bar" + #:port 22 + #:path "/baz")) + + (pass-if "http://bad.host.1" + (not (string->uri "http://bad.host.1"))) + + (pass-if "http://1.good.host" + (uri=? (string->uri "http://1.good.host") + #:scheme 'http #:host "1.good.host" #:path "")) + + (when (memq 'socket *features*) + (pass-if "http://192.0.2.1" + (uri=? (string->uri "http://192.0.2.1") + #:scheme 'http #:host "192.0.2.1" #:path "")) + + (pass-if "http://[2001:db8::1]" + (uri=? (string->uri "http://[2001:db8::1]") + #:scheme 'http #:host "2001:db8::1" #:path "")) + + (pass-if "http://[2001:db8::1]:80" + (uri=? (string->uri "http://[2001:db8::1]:80") + #:scheme 'http + #:host "2001:db8::1" + #:port 80 + #:path "")) + + (pass-if "http://[::ffff:192.0.2.1]" + (uri=? (string->uri "http://[::ffff:192.0.2.1]") + #:scheme 'http #:host "::ffff:192.0.2.1" #:path ""))) + + (pass-if "http://foo:" + (uri=? (string->uri "http://foo:") + #:scheme 'http #:host "foo" #:path "")) + + (pass-if "http://foo:/" + (uri=? (string->uri "http://foo:/") + #:scheme 'http #:host "foo" #:path "/")) + + (pass-if "http://2012.jsconf.us/" + (uri=? (string->uri "http://2012.jsconf.us/") + #:scheme 'http #:host "2012.jsconf.us" #:path "/")) + + (pass-if "http://foo:not-a-port" + (not (string->uri "http://foo:not-a-port"))) + + (pass-if "http://:10" + (not (string->uri "http://:10"))) + + (pass-if "http://foo@" + (not (string->uri "http://foo@"))) + + (pass-if "file:/" + (uri=? (string->uri "file:/") + #:scheme 'file + #:path "/")) + + (pass-if "file:/etc/hosts" + (uri=? (string->uri "file:/etc/hosts") + #:scheme 'file + #:path "/etc/hosts")) + + (pass-if "file:///etc/hosts" + (uri=? (string->uri "file:///etc/hosts") + #:scheme 'file + #:path "/etc/hosts")) + + (pass-if "http://foo#bar" + (uri=? (string->uri "http://foo#bar") + #:scheme 'http + #:host "foo" + #:path "" + #:fragment "bar")) + + (pass-if "http://foo:/#bar" + (uri=? (string->uri "http://foo:/#bar") + #:scheme 'http + #:host "foo" + #:path "/" + #:fragment "bar")) + + (pass-if "http://foo:100#bar" + (uri=? (string->uri "http://foo:100#bar") + #:scheme 'http + #:host "foo" + #:port 100 + #:path "" + #:fragment "bar")) + + (pass-if "http://foo:100/#bar" + (uri=? (string->uri "http://foo:100/#bar") + #:scheme 'http + #:host "foo" + #:port 100 + #:path "/" + #:fragment "bar")) + + (pass-if "http://foo?q#bar" + (uri=? (string->uri "http://foo?q#bar") + #:scheme 'http + #:host "foo" + #:path "" + #:query "q" + #:fragment "bar")) + + (pass-if "http://foo:/?q#bar" + (uri=? (string->uri "http://foo:/?q#bar") + #:scheme 'http + #:host "foo" + #:path "/" + #:query "q" + #:fragment "bar")) + + (pass-if "http://foo:100?q#bar" + (uri=? (string->uri "http://foo:100?q#bar") + #:scheme 'http + #:host "foo" + #:port 100 + #:path "" + #:query "q" + #:fragment "bar")) + + (pass-if "http://foo:100/?q#bar" + (uri=? (string->uri "http://foo:100/?q#bar") + #:scheme 'http + #:host "foo" + #:port 100 + #:path "/" + #:query "q" + #:fragment "bar"))) + +(with-test-prefix "string->uri-reference" + (pass-if "/foo" + (uri=? (string->uri-reference "/foo") + #:path "/foo")) + + (pass-if "ftp:/foo" + (uri=? (string->uri-reference "ftp:/foo") + #:scheme 'ftp + #:path "/foo")) + + (pass-if "ftp:foo" + (uri=? (string->uri-reference "ftp:foo") + #:scheme 'ftp + #:path "foo")) + + (pass-if "//foo/bar" + (uri=? (string->uri-reference "//foo/bar") + #:host "foo" + #:path "/bar")) + + (pass-if "ftp://foo@bar:22/baz" + (uri=? (string->uri-reference "ftp://foo@bar:22/baz") + #:scheme 'ftp + #:userinfo "foo" + #:host "bar" + #:port 22 + #:path "/baz")) + + (pass-if "//foo@bar:22/baz" + (uri=? (string->uri-reference "//foo@bar:22/baz") + #:userinfo "foo" + #:host "bar" + #:port 22 + #:path "/baz")) + + (pass-if "http://bad.host.1" + (not (string->uri-reference "http://bad.host.1"))) + + (pass-if "//bad.host.1" + (not (string->uri-reference "//bad.host.1"))) + + (pass-if "http://1.good.host" + (uri=? (string->uri-reference "http://1.good.host") + #:scheme 'http #:host "1.good.host" #:path "")) + + (pass-if "//1.good.host" + (uri=? (string->uri-reference "//1.good.host") + #:host "1.good.host" #:path "")) + + (when (memq 'socket *features*) + (pass-if "http://192.0.2.1" + (uri=? (string->uri-reference "http://192.0.2.1") + #:scheme 'http #:host "192.0.2.1" #:path "")) + + (pass-if "//192.0.2.1" + (uri=? (string->uri-reference "//192.0.2.1") + #:host "192.0.2.1" #:path "")) + + (pass-if "http://[2001:db8::1]" + (uri=? (string->uri-reference "http://[2001:db8::1]") + #:scheme 'http #:host "2001:db8::1" #:path "")) + + (pass-if "//[2001:db8::1]" + (uri=? (string->uri-reference "//[2001:db8::1]") + #:host "2001:db8::1" #:path "")) + + (pass-if "http://[2001:db8::1]:80" + (uri=? (string->uri-reference "http://[2001:db8::1]:80") + #:scheme 'http + #:host "2001:db8::1" + #:port 80 + #:path "")) + + (pass-if "//[2001:db8::1]:80" + (uri=? (string->uri-reference "//[2001:db8::1]:80") + #:host "2001:db8::1" + #:port 80 + #:path "")) + + (pass-if "http://[::ffff:192.0.2.1]" + (uri=? (string->uri-reference "http://[::ffff:192.0.2.1]") + #:scheme 'http #:host "::ffff:192.0.2.1" #:path "")) + + (pass-if "//[::ffff:192.0.2.1]" + (uri=? (string->uri-reference "//[::ffff:192.0.2.1]") + #:host "::ffff:192.0.2.1" #:path ""))) + + (pass-if "http://foo:" + (uri=? (string->uri-reference "http://foo:") + #:scheme 'http #:host "foo" #:path "")) + + (pass-if "//foo:" + (uri=? (string->uri-reference "//foo:") + #:host "foo" #:path "")) + + (pass-if "http://foo:/" + (uri=? (string->uri-reference "http://foo:/") + #:scheme 'http #:host "foo" #:path "/")) + + (pass-if "//foo:/" + (uri=? (string->uri-reference "//foo:/") + #:host "foo" #:path "/")) + + (pass-if "http://2012.jsconf.us/" + (uri=? (string->uri-reference "http://2012.jsconf.us/") + #:scheme 'http #:host "2012.jsconf.us" #:path "/")) + + (pass-if "//2012.jsconf.us/" + (uri=? (string->uri-reference "//2012.jsconf.us/") + #:host "2012.jsconf.us" #:path "/")) + + (pass-if "http://foo:not-a-port" + (not (string->uri-reference "http://foo:not-a-port"))) + + (pass-if "//foo:not-a-port" + (not (string->uri-reference "//foo:not-a-port"))) + + (pass-if "http://:10" + (not (string->uri-reference "http://:10"))) + + (pass-if "//:10" + (not (string->uri-reference "//:10"))) + + (pass-if "http://foo@" + (not (string->uri-reference "http://foo@"))) + + (pass-if "//foo@" + (not (string->uri-reference "//foo@"))) + + (pass-if "file:/" + (uri=? (string->uri-reference "file:/") + #:scheme 'file + #:path "/")) + + (pass-if "/" + (uri=? (string->uri-reference "/") + #:path "/")) + + (pass-if "foo" + (uri=? (string->uri-reference "foo") + #:path "foo")) + + (pass-if "file:/etc/hosts" + (uri=? (string->uri-reference "file:/etc/hosts") + #:scheme 'file + #:path "/etc/hosts")) + + (pass-if "/etc/hosts" + (uri=? (string->uri-reference "/etc/hosts") + #:path "/etc/hosts")) + + (pass-if "file:///etc/hosts" + (uri=? (string->uri-reference "file:///etc/hosts") + #:scheme 'file + #:path "/etc/hosts")) + + (pass-if "///etc/hosts" + (uri=? (string->uri-reference "///etc/hosts") + #:path "/etc/hosts")) + + (pass-if "/foo#bar" + (uri=? (string->uri-reference "/foo#bar") + #:path "/foo" + #:fragment "bar")) + + (pass-if "//foo#bar" + (uri=? (string->uri-reference "//foo#bar") + #:host "foo" + #:path "" + #:fragment "bar")) + + (pass-if "//foo:/#bar" + (uri=? (string->uri-reference "//foo:/#bar") + #:host "foo" + #:path "/" + #:fragment "bar")) + + (pass-if "//foo:100#bar" + (uri=? (string->uri-reference "//foo:100#bar") + #:host "foo" + #:port 100 + #:path "" + #:fragment "bar")) + + (pass-if "//foo:100/#bar" + (uri=? (string->uri-reference "//foo:100/#bar") + #:host "foo" + #:port 100 + #:path "/" + #:fragment "bar")) + + (pass-if "/foo?q#bar" + (uri=? (string->uri-reference "/foo?q#bar") + #:path "/foo" + #:query "q" + #:fragment "bar")) + + (pass-if "//foo?q#bar" + (uri=? (string->uri-reference "//foo?q#bar") + #:host "foo" + #:path "" + #:query "q" + #:fragment "bar")) + + (pass-if "//foo:/?q#bar" + (uri=? (string->uri-reference "//foo:/?q#bar") + #:host "foo" + #:path "/" + #:query "q" + #:fragment "bar")) + + (pass-if "//foo:100?q#bar" + (uri=? (string->uri-reference "//foo:100?q#bar") + #:host "foo" + #:port 100 + #:path "" + #:query "q" + #:fragment "bar")) + + (pass-if "//foo:100/?q#bar" + (uri=? (string->uri-reference "//foo:100/?q#bar") + #:host "foo" + #:port 100 + #:path "/" + #:query "q" + #:fragment "bar"))) + +(with-test-prefix "string->uri-reference" + (pass-if "/" + (uri=? (string->uri-reference "/") + #:path "/")) + + (pass-if "/path/to/foo" + (uri=? (string->uri-reference "/path/to/foo") + #:path "/path/to/foo")) + + (pass-if "//example.org" + (uri=? (string->uri-reference "//example.org") + #:host "example.org" + #:path "")) + + (pass-if "//bar@example.org/path/to/foo" + (uri=? (string->uri-reference "//bar@example.org/path/to/foo") + #:userinfo "bar" + #:host "example.org" + #:path "/path/to/foo")) + + (pass-if "nextdoc/foo" + (uri=? (string->uri-reference "nextdoc/foo") + #:path "nextdoc/foo"))) + +(with-test-prefix "uri->string" + (pass-if "ftp:" + (equal? "ftp:" + (uri->string (string->uri "ftp:")))) + + (pass-if "ftp:foo" + (equal? "ftp:foo" + (uri->string (string->uri "ftp:foo")))) + + (pass-if "ftp://foo/bar" + (equal? "ftp://foo/bar" + (uri->string (string->uri "ftp://foo/bar")))) + + (pass-if "//foo/bar" + (equal? "//foo/bar" + (uri->string (string->uri-reference "//foo/bar")))) + + (pass-if "ftp://foo@bar:22/baz" + (equal? "ftp://foo@bar:22/baz" + (uri->string (string->uri "ftp://foo@bar:22/baz")))) + + (pass-if "//foo@bar:22/baz" + (equal? "//foo@bar:22/baz" + (uri->string (string->uri-reference "//foo@bar:22/baz")))) + + (when (memq 'socket *features*) + (pass-if "http://192.0.2.1" + (equal? "http://192.0.2.1" + (uri->string (string->uri "http://192.0.2.1")))) + + (pass-if "//192.0.2.1" + (equal? "//192.0.2.1" + (uri->string (string->uri-reference "//192.0.2.1")))) + + (pass-if "http://[2001:db8::1]" + (equal? "http://[2001:db8::1]" + (uri->string (string->uri "http://[2001:db8::1]")))) + + (pass-if "//[2001:db8::1]" + (equal? "//[2001:db8::1]" + (uri->string (string->uri-reference "//[2001:db8::1]")))) + + (pass-if "http://[::ffff:192.0.2.1]" + (equal? "http://[::ffff:192.0.2.1]" + (uri->string (string->uri "http://[::ffff:192.0.2.1]")))) + + (pass-if "//[::ffff:192.0.2.1]" + (equal? "//[::ffff:192.0.2.1]" + (uri->string (string->uri-reference "//[::ffff:192.0.2.1]"))))) + + (pass-if "http://foo:" + (equal? "http://foo" + (uri->string (string->uri "http://foo:")))) + + (pass-if "//foo" + (equal? "//foo" + (uri->string (string->uri-reference "//foo")))) + + (pass-if "http://foo:/" + (equal? "http://foo/" + (uri->string (string->uri "http://foo:/")))) + + (pass-if "//foo:/" + (equal? "//foo/" + (uri->string (string->uri-reference "//foo:/")))) + + (pass-if "/" + (equal? "/" + (uri->string (string->uri-reference "/")))) + + (pass-if "/foo" + (equal? "/foo" + (uri->string (string->uri-reference "/foo")))) + + (pass-if "/foo/" + (equal? "/foo/" + (uri->string (string->uri-reference "/foo/")))) + + (pass-if "/foo/?bar#baz" + (equal? "/foo/?bar#baz" + (uri->string (string->uri-reference "/foo/?bar#baz")))) + + (pass-if "foo/?bar#baz" + (equal? "foo/?bar#baz" + (uri->string (string->uri-reference "foo/?bar#baz")))) + + (pass-if "/path/to/foo" + (equal? "/path/to/foo" + (uri->string (string->uri-reference "/path/to/foo")))) + + (pass-if "//example.org" + (equal? "//example.org" + (uri->string (string->uri-reference "//example.org")))) + + (pass-if "//bar@example.org/path/to/foo" + (equal? "//bar@example.org/path/to/foo" + (uri->string (string->uri-reference "//bar@example.org/path/to/foo")))) + + (pass-if "nextdoc/foo" + (equal? "nextdoc/foo" + (uri->string (string->uri-reference "nextdoc/foo"))))) + +(with-test-prefix "decode" + (pass-if "foo%20bar" + (equal? "foo bar" (uri-decode "foo%20bar"))) + + (pass-if "foo+bar" + (equal? "foo bar" (uri-decode "foo+bar"))) + + (pass-if "foo+bar" + (equal? '("foo+bar") (split-and-decode-uri-path "foo+bar")))) + +(with-test-prefix "encode" + (pass-if (equal? "foo%20bar" (uri-encode "foo bar"))) + (pass-if (equal? "foo%0A%00bar" (uri-encode "foo\n\x00bar"))) + (pass-if (equal? "%3C%3E%5C%5E" (uri-encode "<>\\^")))) |