test-suite/tests/web-uri.test

   1 ;;;; web-uri.test --- URI library          -*- mode: scheme; coding: utf-8; -*-
   2 ;;;;
   3 ;;;;    Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
   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)
  22   #:use-module (ice-9 regex)
  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
  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))))))))
  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
  81   (pass-if-uri-exception "non-symbol scheme"
  82                          "Expected.*symbol"
  83                          (build-uri "nonsym"))
  84
  85   (pass-if-uri-exception "http://bad.host.1"
  86                          "Expected.*host"
  87                          (build-uri 'http #:host "bad.host.1"))
  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
  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
  97   (pass-if "http://192.0.2.1"
  98     (uri=? (build-uri 'http #:host "192.0.2.1")
  99            #:scheme 'http #:host "192.0.2.1" #:path ""))
 100
 101   (pass-if "http://[2001:db8::1]"
 102     (uri=? (build-uri 'http #:host "2001:db8::1")
 103            #:scheme 'http #:host "2001:db8::1" #:path ""))
 104
 105   (pass-if "http://[::ffff:192.0.2.1]"
 106     (uri=? (build-uri 'http #:host "::ffff:192.0.2.1")
 107            #:scheme 'http #:host "::ffff:192.0.2.1" #:path ""))
 108
 109   (pass-if-uri-exception "http://foo:not-a-port"
 110                          "Expected.*port"
 111                          (build-uri 'http #:host "foo" #:port "not-a-port"))
 112
 113   (pass-if-uri-exception "http://foo:10 but port as string"
 114                          "Expected.*port"
 115                          (build-uri 'http #:host "foo" #:port "10"))
 116
 117   (pass-if-uri-exception "http://:10"
 118                          "Expected.*host"
 119                          (build-uri 'http #:port 10))
 120
 121   (pass-if-uri-exception "http://foo@"
 122                          "Expected.*host"
 123                          (build-uri 'http #:userinfo "foo")))
 124
 125
 126 (with-test-prefix "string->uri"
 127   (pass-if "ftp:"
 128     (uri=? (string->uri "ftp:")
 129            #:scheme 'ftp
 130            #:path ""))
 131
 132   (pass-if "ftp:foo"
 133     (uri=? (string->uri "ftp:foo")
 134            #:scheme 'ftp
 135            #:path "foo"))
 136
 137   (pass-if "ftp://foo/bar"
 138     (uri=? (string->uri "ftp://foo/bar")
 139            #:scheme 'ftp
 140            #:host "foo"
 141            #:path "/bar"))
 142
 143   (pass-if "ftp://foo@bar:22/baz"
 144     (uri=? (string->uri "ftp://foo@bar:22/baz")
 145            #:scheme 'ftp
 146            #:userinfo "foo"
 147            #:host "bar"
 148            #:port 22
 149            #:path "/baz"))
 150
 151   (pass-if "http://bad.host.1"
 152     (not (string->uri "http://bad.host.1")))
 153
 154   (pass-if "http://1.good.host"
 155     (uri=? (string->uri "http://1.good.host")
 156            #:scheme 'http #:host "1.good.host" #:path ""))
 157
 158   (pass-if "http://192.0.2.1"
 159     (uri=? (string->uri "http://192.0.2.1")
 160            #:scheme 'http #:host "192.0.2.1" #:path ""))
 161
 162   (pass-if "http://[2001:db8::1]"
 163     (uri=? (string->uri "http://[2001:db8::1]")
 164            #:scheme 'http #:host "2001:db8::1" #:path ""))
 165
 166   (pass-if "http://[2001:db8::1]:80"
 167     (uri=? (string->uri "http://[2001:db8::1]:80")
 168            #:scheme 'http
 169            #:host "2001:db8::1"
 170            #:port 80
 171            #:path ""))
 172
 173   (pass-if "http://[::ffff:192.0.2.1]"
 174     (uri=? (string->uri "http://[::ffff:192.0.2.1]")
 175            #:scheme 'http #:host "::ffff:192.0.2.1" #:path ""))
 176
 177   (pass-if "http://foo:"
 178     (uri=? (string->uri "http://foo:")
 179            #:scheme 'http #:host "foo" #:path ""))
 180
 181   (pass-if "http://foo:/"
 182     (uri=? (string->uri "http://foo:/")
 183            #:scheme 'http #:host "foo" #:path "/"))
 184
 185   (pass-if "http://2012.jsconf.us/"
 186     (uri=? (string->uri "http://2012.jsconf.us/")
 187            #:scheme 'http #:host "2012.jsconf.us" #:path "/"))
 188
 189   (pass-if "http://foo:not-a-port"
 190     (not (string->uri "http://foo:not-a-port")))
 191
 192   (pass-if "http://:10"
 193     (not (string->uri "http://:10")))
 194
 195   (pass-if "http://foo@"
 196     (not (string->uri "http://foo@")))
 197
 198   (pass-if "file:/"
 199     (uri=? (string->uri "file:/")
 200            #:scheme 'file
 201            #:path "/"))
 202
 203   (pass-if "file:/etc/hosts"
 204     (uri=? (string->uri "file:/etc/hosts")
 205            #:scheme 'file
 206            #:path "/etc/hosts"))
 207
 208   (pass-if "file:///etc/hosts"
 209     (uri=? (string->uri "file:///etc/hosts")
 210            #:scheme 'file
 211            #:path "/etc/hosts")))
 212
 213 (with-test-prefix "uri->string"
 214   (pass-if "ftp:"
 215     (equal? "ftp:"
 216             (uri->string (string->uri "ftp:"))))
 217
 218   (pass-if "ftp:foo"
 219     (equal? "ftp:foo"
 220             (uri->string (string->uri "ftp:foo"))))
 221
 222   (pass-if "ftp://foo/bar"
 223     (equal? "ftp://foo/bar"
 224             (uri->string (string->uri "ftp://foo/bar"))))
 225
 226   (pass-if "ftp://foo@bar:22/baz"
 227     (equal? "ftp://foo@bar:22/baz"
 228             (uri->string (string->uri "ftp://foo@bar:22/baz"))))
 229
 230   (pass-if "http://192.0.2.1"
 231     (equal? "http://192.0.2.1"
 232             (uri->string (string->uri "http://192.0.2.1"))))
 233
 234   (pass-if "http://[2001:db8::1]"
 235     (equal? "http://[2001:db8::1]"
 236             (uri->string (string->uri "http://[2001:db8::1]"))))
 237
 238   (pass-if "http://[::ffff:192.0.2.1]"
 239     (equal? "http://[::ffff:192.0.2.1]"
 240             (uri->string (string->uri "http://[::ffff:192.0.2.1]"))))
 241
 242   (pass-if "http://foo:"
 243     (equal? "http://foo"
 244             (uri->string (string->uri "http://foo:"))))
 245
 246   (pass-if "http://foo:/"
 247     (equal? "http://foo/"
 248             (uri->string (string->uri "http://foo:/")))))
 249
 250 (with-test-prefix "decode"
 251   (pass-if "foo%20bar"
 252     (equal? "foo bar" (uri-decode "foo%20bar")))
 253
 254   (pass-if "foo+bar"
 255     (equal? "foo bar" (uri-decode "foo+bar"))))
 256
 257 (with-test-prefix "encode"
 258   (pass-if (equal? "foo%20bar" (uri-encode "foo bar"))))