[bpt/guile.git] / test-suite / tests / web-uri.test

;;;; web-uri.test --- URI library          -*- mode: scheme; coding: utf-8; -*-
;;;;
;;;; 	Copyright (C) 2010, 2011, 2012, 2014 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? 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 "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 "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")))))

(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"))))

(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 "<>\\^"))))
Commit	Line	Data
73124c6c AW	1	;;;; web-uri.test --- URI library -- mode: scheme; coding: utf-8; --
73124c6c AW	2	;;;;
18c44b29	3	;;;; Copyright (C) 2010, 2011, 2012, 2014 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
5d312f3c AW	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 ""))
274e2eec	101
5d312f3c AW	102	(pass-if "http://[2001:db8::1]"
	103	(uri=? (build-uri 'http #:host "2001:db8::1")
	104	#:scheme 'http #:host "2001:db8::1" #:path ""))
274e2eec	105
5d312f3c AW	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 "")))
81e7210f	109
5a2f7fb3 AW	110	(pass-if-uri-exception "http://foo:not-a-port"
	111	"Expected.*port"
	112	(build-uri 'http #:host "foo" #:port "not-a-port"))
73124c6c	113
5a2f7fb3 AW	114	(pass-if-uri-exception "http://foo:10 but port as string"
	115	"Expected.*port"
	116	(build-uri 'http #:host "foo" #:port "10"))
73124c6c	117
5a2f7fb3 AW	118	(pass-if-uri-exception "http://:10"
	119	"Expected.*host"
	120	(build-uri 'http #:port 10))
73124c6c	121
5a2f7fb3 AW	122	(pass-if-uri-exception "http://foo@"
	123	"Expected.*host"
	124	(build-uri 'http #:userinfo "foo")))
73124c6c AW	125
73124c6c AW	126
8745c33a	127	(with-test-prefix "string->uri"
73124c6c	128	(pass-if "ftp:"
8745c33a	129	(uri=? (string->uri "ftp:")
73124c6c AW	130	#:scheme 'ftp
	131	#:path ""))
	132
	133	(pass-if "ftp:foo"
8745c33a	134	(uri=? (string->uri "ftp:foo")
73124c6c AW	135	#:scheme 'ftp
	136	#:path "foo"))
	137
	138	(pass-if "ftp://foo/bar"
8745c33a	139	(uri=? (string->uri "ftp://foo/bar")
73124c6c AW	140	#:scheme 'ftp
	141	#:host "foo"
	142	#:path "/bar"))
	143
	144	(pass-if "ftp://foo@bar:22/baz"
8745c33a	145	(uri=? (string->uri "ftp://foo@bar:22/baz")
73124c6c AW	146	#:scheme 'ftp
	147	#:userinfo "foo"
	148	#:host "bar"
	149	#:port 22
	150	#:path "/baz"))
	151
	152	(pass-if "http://bad.host.1"
8745c33a	153	(not (string->uri "http://bad.host.1")))
73124c6c	154
274e2eec DH	155	(pass-if "http://1.good.host"
	156	(uri=? (string->uri "http://1.good.host")
	157	#:scheme 'http #:host "1.good.host" #:path ""))
	158
5d312f3c AW	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 ""))
274e2eec	163
5d312f3c AW	164	(pass-if "http://[2001:db8::1]"
	165	(uri=? (string->uri "http://[2001:db8::1]")
	166	#:scheme 'http #:host "2001:db8::1" #:path ""))
274e2eec	167
5d312f3c AW	168	(pass-if "http://[2001:db8::1]:80"
	169	(uri=? (string->uri "http://[2001:db8::1]:80")
	170	#:scheme 'http
	171	#:host "2001:db8::1"
	172	#:port 80
	173	#:path ""))
274e2eec	174
5d312f3c AW	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 "")))
81e7210f	178
73124c6c	179	(pass-if "http://foo:"
8745c33a	180	(uri=? (string->uri "http://foo:")
73124c6c AW	181	#:scheme 'http #:host "foo" #:path ""))
	182
	183	(pass-if "http://foo:/"
8745c33a	184	(uri=? (string->uri "http://foo:/")
73124c6c AW	185	#:scheme 'http #:host "foo" #:path "/"))
73124c6c AW	186
71cc8d96 AW	187	(pass-if "http://2012.jsconf.us/"
	188	(uri=? (string->uri "http://2012.jsconf.us/")
	189	#:scheme 'http #:host "2012.jsconf.us" #:path "/"))
	190
73124c6c	191	(pass-if "http://foo:not-a-port"
8745c33a	192	(not (string->uri "http://foo:not-a-port")))
73124c6c AW	193
73124c6c AW	194	(pass-if "http://:10"
8745c33a	195	(not (string->uri "http://:10")))
73124c6c AW	196
73124c6c AW	197	(pass-if "http://foo@"
679eea4f AW	198	(not (string->uri "http://foo@")))
	199
	200	(pass-if "file:/"
	201	(uri=? (string->uri "file:/")
	202	#:scheme 'file
	203	#:path "/"))
	204
	205	(pass-if "file:/etc/hosts"
	206	(uri=? (string->uri "file:/etc/hosts")
	207	#:scheme 'file
	208	#:path "/etc/hosts"))
	209
	210	(pass-if "file:///etc/hosts"
	211	(uri=? (string->uri "file:///etc/hosts")
	212	#:scheme 'file
18c44b29 AW	213	#:path "/etc/hosts"))
	214
	215	(pass-if "http://foo#bar"
	216	(uri=? (string->uri "http://foo#bar")
	217	#:scheme 'http
	218	#:host "foo"
	219	#:path ""
	220	#:fragment "bar"))
	221
	222	(pass-if "http://foo:/#bar"
	223	(uri=? (string->uri "http://foo:/#bar")
	224	#:scheme 'http
	225	#:host "foo"
	226	#:path "/"
	227	#:fragment "bar"))
	228
	229	(pass-if "http://foo:100#bar"
	230	(uri=? (string->uri "http://foo:100#bar")
	231	#:scheme 'http
	232	#:host "foo"
	233	#:port 100
	234	#:path ""
	235	#:fragment "bar"))
	236
	237	(pass-if "http://foo:100/#bar"
	238	(uri=? (string->uri "http://foo:100/#bar")
	239	#:scheme 'http
	240	#:host "foo"
	241	#:port 100
	242	#:path "/"
	243	#:fragment "bar"))
	244
	245	(pass-if "http://foo?q#bar"
	246	(uri=? (string->uri "http://foo?q#bar")
	247	#:scheme 'http
	248	#:host "foo"
	249	#:path ""
	250	#:query "q"
	251	#:fragment "bar"))
	252
	253	(pass-if "http://foo:/?q#bar"
	254	(uri=? (string->uri "http://foo:/?q#bar")
	255	#:scheme 'http
	256	#:host "foo"
	257	#:path "/"
	258	#:query "q"
	259	#:fragment "bar"))
	260
	261	(pass-if "http://foo:100?q#bar"
	262	(uri=? (string->uri "http://foo:100?q#bar")
	263	#:scheme 'http
	264	#:host "foo"
	265	#:port 100
	266	#:path ""
	267	#:query "q"
	268	#:fragment "bar"))
	269
	270	(pass-if "http://foo:100/?q#bar"
	271	(uri=? (string->uri "http://foo:100/?q#bar")
	272	#:scheme 'http
	273	#:host "foo"
	274	#:port 100
	275	#:path "/"
	276	#:query "q"
277	#:fragment "bar")))
278
279	(with-test-prefix "string->uri-reference"
280	(pass-if "/foo"
281	(uri=? (string->uri-reference "/foo")
282	#:path "/foo"))
283
284	(pass-if "ftp:/foo"
285	(uri=? (string->uri-reference "ftp:/foo")
286	#:scheme 'ftp
287	#:path "/foo"))
288
289	(pass-if "ftp:foo"
290	(uri=? (string->uri-reference "ftp:foo")
291	#:scheme 'ftp
292	#:path "foo"))
293
294	(pass-if "//foo/bar"
295	(uri=? (string->uri-reference "//foo/bar")
296	#:host "foo"
297	#:path "/bar"))
298
299	(pass-if "ftp://foo@bar:22/baz"
300	(uri=? (string->uri-reference "ftp://foo@bar:22/baz")
301	#:scheme 'ftp
302	#:userinfo "foo"
303	#:host "bar"
304	#:port 22
305	#:path "/baz"))
306
307	(pass-if "//foo@bar:22/baz"
308	(uri=? (string->uri-reference "//foo@bar:22/baz")
309	#:userinfo "foo"
310	#:host "bar"
311	#:port 22
312	#:path "/baz"))
313
314	(pass-if "http://bad.host.1"
315	(not (string->uri-reference "http://bad.host.1")))
316
317	(pass-if "//bad.host.1"
318	(not (string->uri-reference "//bad.host.1")))
319
320	(pass-if "http://1.good.host"
321	(uri=? (string->uri-reference "http://1.good.host")
322	#:scheme 'http #:host "1.good.host" #:path ""))
323
324	(pass-if "//1.good.host"
325	(uri=? (string->uri-reference "//1.good.host")
326	#:host "1.good.host" #:path ""))
327
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 ""))
332
333	(pass-if "//192.0.2.1"
334	(uri=? (string->uri-reference "//192.0.2.1")
335	#:host "192.0.2.1" #:path ""))
336
337	(pass-if "http://[2001:db8::1]"
338	(uri=? (string->uri-reference "http://[2001:db8::1]")
339	#:scheme 'http #:host "2001:db8::1" #:path ""))
340
341	(pass-if "//[2001:db8::1]"
342	(uri=? (string->uri-reference "//[2001:db8::1]")
343	#:host "2001:db8::1" #:path ""))
344
345	(pass-if "http://[2001:db8::1]:80"
346	(uri=? (string->uri-reference "http://[2001:db8::1]:80")
347	#:scheme 'http
348	#:host "2001:db8::1"
349	#:port 80
350	#:path ""))
351
352	(pass-if "//[2001:db8::1]:80"
353	(uri=? (string->uri-reference "//[2001:db8::1]:80")
354	#:host "2001:db8::1"
355	#:port 80
356	#:path ""))
357
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 ""))
361
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 "")))
365
366	(pass-if "http://foo:"
367	(uri=? (string->uri-reference "http://foo:")
368	#:scheme 'http #:host "foo" #:path ""))
369
370	(pass-if "//foo:"
371	(uri=? (string->uri-reference "//foo:")
372	#:host "foo" #:path ""))
373
374	(pass-if "http://foo:/"
375	(uri=? (string->uri-reference "http://foo:/")
376	#:scheme 'http #:host "foo" #:path "/"))
377
378	(pass-if "//foo:/"
379	(uri=? (string->uri-reference "//foo:/")
380	#:host "foo" #:path "/"))
381
382	(pass-if "http://2012.jsconf.us/"
383	(uri=? (string->uri-reference "http://2012.jsconf.us/")
384	#:scheme 'http #:host "2012.jsconf.us" #:path "/"))
385
386	(pass-if "//2012.jsconf.us/"
387	(uri=? (string->uri-reference "//2012.jsconf.us/")
388	#:host "2012.jsconf.us" #:path "/"))
389
390	(pass-if "http://foo:not-a-port"
391	(not (string->uri-reference "http://foo:not-a-port")))
392
393	(pass-if "//foo:not-a-port"
394	(not (string->uri-reference "//foo:not-a-port")))
395
396	(pass-if "http://:10"
397	(not (string->uri-reference "http://:10")))
398
399	(pass-if "//:10"
400	(not (string->uri-reference "//:10")))
401
402	(pass-if "http://foo@"
403	(not (string->uri-reference "http://foo@")))
404
405	(pass-if "//foo@"
406	(not (string->uri-reference "//foo@")))
407
408	(pass-if "file:/"
409	(uri=? (string->uri-reference "file:/")
410	#:scheme 'file
411	#:path "/"))
412
413	(pass-if "/"
414	(uri=? (string->uri-reference "/")
415	#:path "/"))
416
417	(pass-if "foo"
418	(uri=? (string->uri-reference "foo")
419	#:path "foo"))
420
421	(pass-if "file:/etc/hosts"
422	(uri=? (string->uri-reference "file:/etc/hosts")
423	#:scheme 'file
424	#:path "/etc/hosts"))
425
426	(pass-if "/etc/hosts"
427	(uri=? (string->uri-reference "/etc/hosts")
428	#:path "/etc/hosts"))
429
430	(pass-if "file:///etc/hosts"
431	(uri=? (string->uri-reference "file:///etc/hosts")
432	#:scheme 'file
433	#:path "/etc/hosts"))
434
435	(pass-if "///etc/hosts"
436	(uri=? (string->uri-reference "///etc/hosts")
437	#:path "/etc/hosts"))
438
439	(pass-if "/foo#bar"
440	(uri=? (string->uri-reference "/foo#bar")
441	#:path "/foo"
442	#:fragment "bar"))
443
444	(pass-if "//foo#bar"
445	(uri=? (string->uri-reference "//foo#bar")
446	#:host "foo"
447	#:path ""
448	#:fragment "bar"))
449
450	(pass-if "//foo:/#bar"
451	(uri=? (string->uri-reference "//foo:/#bar")
452	#:host "foo"
453	#:path "/"
454	#:fragment "bar"))
455
456	(pass-if "//foo:100#bar"
457	(uri=? (string->uri-reference "//foo:100#bar")
458	#:host "foo"
459	#:port 100
460	#:path ""
461	#:fragment "bar"))
462
463	(pass-if "//foo:100/#bar"
464	(uri=? (string->uri-reference "//foo:100/#bar")
465	#:host "foo"
466	#:port 100
467	#:path "/"
468	#:fragment "bar"))
469
470	(pass-if "/foo?q#bar"
471	(uri=? (string->uri-reference "/foo?q#bar")
472	#:path "/foo"
473	#:query "q"
474	#:fragment "bar"))
475
476	(pass-if "//foo?q#bar"
477	(uri=? (string->uri-reference "//foo?q#bar")
478	#:host "foo"
479	#:path ""
480	#:query "q"
481	#:fragment "bar"))
482
483	(pass-if "//foo:/?q#bar"
484	(uri=? (string->uri-reference "//foo:/?q#bar")
485	#:host "foo"
486	#:path "/"
487	#:query "q"
488	#:fragment "bar"))
489
490	(pass-if "//foo:100?q#bar"
491	(uri=? (string->uri-reference "//foo:100?q#bar")
492	#:host "foo"
493	#:port 100
494	#:path ""
495	#:query "q"
496	#:fragment "bar"))
497
498	(pass-if "//foo:100/?q#bar"
499	(uri=? (string->uri-reference "//foo:100/?q#bar")
500	#:host "foo"
501	#:port 100
502	#:path "/"
503	#:query "q"
504	#:fragment "bar")))
73124c6c	505
8745c33a	506	(with-test-prefix "uri->string"
73124c6c AW	507	(pass-if "ftp:"
73124c6c AW	508	(equal? "ftp:"
8745c33a	509	(uri->string (string->uri "ftp:"))))
73124c6c AW	510
	511	(pass-if "ftp:foo"
	512	(equal? "ftp:foo"
8745c33a	513	(uri->string (string->uri "ftp:foo"))))
73124c6c AW	514
	515	(pass-if "ftp://foo/bar"
	516	(equal? "ftp://foo/bar"
8745c33a	517	(uri->string (string->uri "ftp://foo/bar"))))
73124c6c	518
18c44b29 AW	519	(pass-if "//foo/bar"
	520	(equal? "//foo/bar"
	521	(uri->string (string->uri-reference "//foo/bar"))))
	522
73124c6c AW	523	(pass-if "ftp://foo@bar:22/baz"
73124c6c AW	524	(equal? "ftp://foo@bar:22/baz"
8745c33a	525	(uri->string (string->uri "ftp://foo@bar:22/baz"))))
73124c6c	526
18c44b29 AW	527	(pass-if "//foo@bar:22/baz"
	528	(equal? "//foo@bar:22/baz"
	529	(uri->string (string->uri-reference "//foo@bar:22/baz"))))
	530
5d312f3c AW	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"))))
	535
18c44b29 AW	536	(pass-if "//192.0.2.1"
	537	(equal? "//192.0.2.1"
	538	(uri->string (string->uri-reference "//192.0.2.1"))))
	539
5d312f3c AW	540	(pass-if "http://[2001:db8::1]"
	541	(equal? "http://[2001:db8::1]"
	542	(uri->string (string->uri "http://[2001:db8::1]"))))
	543
18c44b29 AW	544	(pass-if "//[2001:db8::1]"
	545	(equal? "//[2001:db8::1]"
	546	(uri->string (string->uri-reference "//[2001:db8::1]"))))
	547
5d312f3c AW	548	(pass-if "http://[::ffff:192.0.2.1]"
5d312f3c AW	549	(equal? "http://[::ffff:192.0.2.1]"
18c44b29 AW	550	(uri->string (string->uri "http://[::ffff:192.0.2.1]"))))
	551
	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]")))))
274e2eec	555
73124c6c AW	556	(pass-if "http://foo:"
73124c6c AW	557	(equal? "http://foo"
8745c33a	558	(uri->string (string->uri "http://foo:"))))
73124c6c	559
18c44b29 AW	560	(pass-if "//foo"
	561	(equal? "//foo"
	562	(uri->string (string->uri-reference "//foo"))))
	563
73124c6c AW	564	(pass-if "http://foo:/"
73124c6c AW	565	(equal? "http://foo/"
18c44b29 AW	566	(uri->string (string->uri "http://foo:/"))))
	567
	568	(pass-if "//foo:/"
	569	(equal? "//foo/"
	570	(uri->string (string->uri-reference "//foo:/"))))
	571
	572	(pass-if "/"
	573	(equal? "/"
	574	(uri->string (string->uri-reference "/"))))
	575
	576	(pass-if "/foo"
	577	(equal? "/foo"
	578	(uri->string (string->uri-reference "/foo"))))
	579
	580	(pass-if "/foo/"
	581	(equal? "/foo/"
	582	(uri->string (string->uri-reference "/foo/"))))
	583
	584	(pass-if "/foo/?bar#baz"
	585	(equal? "/foo/?bar#baz"
	586	(uri->string (string->uri-reference "/foo/?bar#baz"))))
	587
	588	(pass-if "foo/?bar#baz"
	589	(equal? "foo/?bar#baz"
	590	(uri->string (string->uri-reference "foo/?bar#baz")))))
73124c6c AW	591
73124c6c AW	592	(with-test-prefix "decode"
274e2eec DH	593	(pass-if "foo%20bar"
	594	(equal? "foo bar" (uri-decode "foo%20bar")))
	595
	596	(pass-if "foo+bar"
	597	(equal? "foo bar" (uri-decode "foo+bar"))))
73124c6c AW	598
73124c6c AW	599	(with-test-prefix "encode"
b401fe71	600	(pass-if (equal? "foo%20bar" (uri-encode "foo bar")))
6fe2803b ACF	601	(pass-if (equal? "foo%0A%00bar" (uri-encode "foo\n\x00bar")))
6fe2803b ACF	602	(pass-if (equal? "%3C%3E%5C%5E" (uri-encode "<>\\^"))))