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   (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 ""))
 101
 102     (pass-if "http://[2001:db8::1]"
 103       (uri=? (build-uri 'http #:host "2001:db8::1")
 104              #:scheme 'http #:host "2001:db8::1" #:path ""))
 105
 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 "")))
 109
 110   (pass-if-uri-exception "http://foo:not-a-port"
 111                          "Expected.*port"
 112                          (build-uri 'http #:host "foo" #:port "not-a-port"))
 113
 114   (pass-if-uri-exception "http://foo:10 but port as string"
 115                          "Expected.*port"
 116                          (build-uri 'http #:host "foo" #:port "10"))
 117
 118   (pass-if-uri-exception "http://:10"
 119                          "Expected.*host"
 120                          (build-uri 'http #:port 10))
 121
 122   (pass-if-uri-exception "http://foo@"
 123                          "Expected.*host"
 124                          (build-uri 'http #:userinfo "foo")))
 125
 126
 127 (with-test-prefix "string->uri"
 128   (pass-if "ftp:"
 129     (uri=? (string->uri "ftp:")
 130            #:scheme 'ftp
 131            #:path ""))
 132
 133   (pass-if "ftp:foo"
 134     (uri=? (string->uri "ftp:foo")
 135            #:scheme 'ftp
 136            #:path "foo"))
 137
 138   (pass-if "ftp://foo/bar"
 139     (uri=? (string->uri "ftp://foo/bar")
 140            #:scheme 'ftp
 141            #:host "foo"
 142            #:path "/bar"))
 143
 144   (pass-if "ftp://foo@bar:22/baz"
 145     (uri=? (string->uri "ftp://foo@bar:22/baz")
 146            #:scheme 'ftp
 147            #:userinfo "foo"
 148            #:host "bar"
 149            #:port 22
 150            #:path "/baz"))
 151
 152   (pass-if "http://bad.host.1"
 153     (not (string->uri "http://bad.host.1")))
 154
 155   (pass-if "http://1.good.host"
 156     (uri=? (string->uri "http://1.good.host")
 157            #:scheme 'http #:host "1.good.host" #:path ""))
 158
 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 ""))
 163
 164     (pass-if "http://[2001:db8::1]"
 165       (uri=? (string->uri "http://[2001:db8::1]")
 166              #:scheme 'http #:host "2001:db8::1" #:path ""))
 167
 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 ""))
 174
 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 "")))
 178
 179   (pass-if "http://foo:"
 180     (uri=? (string->uri "http://foo:")
 181            #:scheme 'http #:host "foo" #:path ""))
 182
 183   (pass-if "http://foo:/"
 184     (uri=? (string->uri "http://foo:/")
 185            #:scheme 'http #:host "foo" #:path "/"))
 186
 187   (pass-if "http://2012.jsconf.us/"
 188     (uri=? (string->uri "http://2012.jsconf.us/")
 189            #:scheme 'http #:host "2012.jsconf.us" #:path "/"))
 190
 191   (pass-if "http://foo:not-a-port"
 192     (not (string->uri "http://foo:not-a-port")))
 193
 194   (pass-if "http://:10"
 195     (not (string->uri "http://:10")))
 196
 197   (pass-if "http://foo@"
 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
 213            #:path "/etc/hosts")))
 214
 215 (with-test-prefix "uri->string"
 216   (pass-if "ftp:"
 217     (equal? "ftp:"
 218             (uri->string (string->uri "ftp:"))))
 219
 220   (pass-if "ftp:foo"
 221     (equal? "ftp:foo"
 222             (uri->string (string->uri "ftp:foo"))))
 223
 224   (pass-if "ftp://foo/bar"
 225     (equal? "ftp://foo/bar"
 226             (uri->string (string->uri "ftp://foo/bar"))))
 227
 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"))))
 231
 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"))))
 236
 237     (pass-if "http://[2001:db8::1]"
 238       (equal? "http://[2001:db8::1]"
 239               (uri->string (string->uri "http://[2001:db8::1]"))))
 240
 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]")))))
 244
 245   (pass-if "http://foo:"
 246     (equal? "http://foo"
 247             (uri->string (string->uri "http://foo:"))))
 248
 249   (pass-if "http://foo:/"
 250     (equal? "http://foo/"
 251             (uri->string (string->uri "http://foo:/")))))
 252
 253 (with-test-prefix "decode"
 254   (pass-if "foo%20bar"
 255     (equal? "foo bar" (uri-decode "foo%20bar")))
 256
 257   (pass-if "foo+bar"
 258     (equal? "foo bar" (uri-decode "foo+bar"))))
 259
 260 (with-test-prefix "encode"
 261   (pass-if (equal? "foo%20bar" (uri-encode "foo bar"))))