;;;; web-uri.test --- URI library -*- mode: scheme; coding: utf-8; -*-
;;;;
-;;;; Copyright (C) 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2011, 2012 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
(define-module (test-web-uri)
#:use-module (web uri)
+ #:use-module (ice-9 regex)
#:use-module (test-suite lib))
(equal? (uri-query uri) query)
(equal? (uri-fragment uri) fragment)))
-(define ex:expected '(misc-error . "expected"))
+(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:"
#:port 22
#:path "/baz"))
- (pass-if-exception "non-symbol scheme"
- ex:expected
- (build-uri "nonsym"))
+ (pass-if-uri-exception "non-symbol scheme"
+ "Expected.*symbol"
+ (build-uri "nonsym"))
- (pass-if-exception "http://bad.host.1"
- ex:expected
- (build-uri 'http #:host "bad.host.1"))
+ (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-exception "http://foo:not-a-port"
- ex:expected
- (build-uri 'http #:host "foo" #:port "not-a-port"))
+ (pass-if "http://1.good.host"
+ (uri=? (build-uri 'http #:host "1.good.host")
+ #:scheme 'http #:host "1.good.host" #:path ""))
- (pass-if-exception "http://foo:10 but port as string"
- ex:expected
- (build-uri 'http #:host "foo" #:port "10"))
+ (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-exception "http://:10"
- ex:expected
- (build-uri 'http #:port 10))
+ (pass-if "http://[2001:db8::1]"
+ (uri=? (build-uri 'http #:host "2001:db8::1")
+ #:scheme 'http #:host "2001:db8::1" #:path ""))
- (pass-if-exception "http://foo@"
- ex:expected
- (build-uri 'http #:userinfo "foo")))
+ (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"))
-(with-test-prefix "parse-uri"
+ (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=? (parse-uri "ftp:")
+ (uri=? (string->uri "ftp:")
#:scheme 'ftp
#:path ""))
(pass-if "ftp:foo"
- (uri=? (parse-uri "ftp:foo")
+ (uri=? (string->uri "ftp:foo")
#:scheme 'ftp
#:path "foo"))
(pass-if "ftp://foo/bar"
- (uri=? (parse-uri "ftp://foo/bar")
+ (uri=? (string->uri "ftp://foo/bar")
#:scheme 'ftp
#:host "foo"
#:path "/bar"))
(pass-if "ftp://foo@bar:22/baz"
- (uri=? (parse-uri "ftp://foo@bar:22/baz")
+ (uri=? (string->uri "ftp://foo@bar:22/baz")
#:scheme 'ftp
#:userinfo "foo"
#:host "bar"
#:path "/baz"))
(pass-if "http://bad.host.1"
- (not (parse-uri "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=? (parse-uri "http://foo:")
+ (uri=? (string->uri "http://foo:")
#:scheme 'http #:host "foo" #:path ""))
(pass-if "http://foo:/"
- (uri=? (parse-uri "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 (parse-uri "http://foo:not-a-port")))
+ (not (string->uri "http://foo:not-a-port")))
(pass-if "http://:10"
- (not (parse-uri "http://:10")))
+ (not (string->uri "http://:10")))
(pass-if "http://foo@"
- (not (parse-uri "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")))
-(with-test-prefix "unparse-uri"
+(with-test-prefix "uri->string"
(pass-if "ftp:"
(equal? "ftp:"
- (unparse-uri (parse-uri "ftp:"))))
+ (uri->string (string->uri "ftp:"))))
(pass-if "ftp:foo"
(equal? "ftp:foo"
- (unparse-uri (parse-uri "ftp:foo"))))
+ (uri->string (string->uri "ftp:foo"))))
(pass-if "ftp://foo/bar"
(equal? "ftp://foo/bar"
- (unparse-uri (parse-uri "ftp://foo/bar"))))
+ (uri->string (string->uri "ftp://foo/bar"))))
(pass-if "ftp://foo@bar:22/baz"
(equal? "ftp://foo@bar:22/baz"
- (unparse-uri (parse-uri "ftp://foo@bar:22/baz"))))
+ (uri->string (string->uri "ftp://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 "http://[2001:db8::1]"
+ (equal? "http://[2001:db8::1]"
+ (uri->string (string->uri "http://[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 "http://foo:"
(equal? "http://foo"
- (unparse-uri (parse-uri "http://foo:"))))
+ (uri->string (string->uri "http://foo:"))))
(pass-if "http://foo:/"
(equal? "http://foo/"
- (unparse-uri (parse-uri "http://foo:/")))))
+ (uri->string (string->uri "http://foo:/")))))
(with-test-prefix "decode"
- (pass-if (equal? "foo bar" (uri-decode "foo%20bar"))))
+ (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%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 "<>\\^"))))
HCoop / bpt / guile.git / blobdiff