read: Support R7RS |...| symbol notation.

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

diff --git a/test-suite/tests/web-uri.test b/test-suite/tests/web-uri.test
index 534380a..3d14d9d 100644 (file)
--- a/test-suite/tests/web-uri.test
+++ b/test-suite/tests/web-uri.test
@@ -1,6 +1,6 @@
 ;;;; 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
@@ -90,6 +90,23 @@
     (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"))
@@ -135,6 +152,30 @@
   (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 ""))
@@ -143,6 +184,10 @@
     (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")))
   
@@ -150,7 +195,22 @@
     (not (string->uri "http://:10")))
 
   (pass-if "http://foo@"
-    (not (string->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 "uri->string"
   (pass-if "ftp:"
@@ -169,6 +229,19 @@
     (equal? "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"
             (uri->string (string->uri "http://foo:"))))
@@ -178,7 +251,13 @@
             (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 "<>\\^"))))