Changeset 13212 in project for release/3/uri-generic/trunk/tests/run.scm

Timestamp:

02/08/09 15:09:50 (12 years ago)

Author:

sjamaan

Message:

Merge latest changes in release 4 trunk

Location:

release/3/uri-generic/trunk

Files:

• . (modified) (1 prop)
• tests/run.scm (modified) (1 diff)

release/3/uri-generic/trunk/tests/run.scm

@@ -287 +287 @@
             internal-representation-cases))
 
+;; I wonder if there's a term for this :)
+(define non-relative-non-absolute-uri-references
+  '("http://foo#frag"
+    "http://foo?a=b#frag"
+    "http://foo/bar#frag"
+    "http://foo/bar?a=b#frag"))
+
+(define absolute-uris
+  '("http://foo"
+    "http://foo?a=b"
+    "http://foo/bar"
+    "http://foo/bar?a=b"))
+
+(define relative-refs
+  `(""
+    "bar"
+    "bar?a=b"
+    "bar#frag"
+    "bar?a=b#frag"
+    "/"
+    "/bar"
+    "/bar?a=b"
+    "/bar#frag"
+    "/bar?a=b#frag"
+    "//foo"
+    "//foo?a=b"
+    "//foo#frag"
+    "//foo?a=b#frag"
+    "//foo/bar"
+    "//foo/bar?a=b"
+    "//foo/bar#frag"
+    "//foo/bar?a=b#frag"))
+
+(test-group "absolute/relative distinction"
+  (for-each (lambda (s)
+              (test-assert (sprintf "~S is relative" s)
+                           (relative-ref? (uri-reference s)))
+              (test-assert (sprintf "~S is not absolute" s)
+                           (not (absolute-uri? (uri-reference s))))
+              (test-error (absolute-uri s)))
+            relative-refs)
+  (for-each (lambda (s)
+              (test-assert (sprintf "~S is not relative" s)
+                           (not (relative-ref? (uri-reference s))))
+              (test-assert (sprintf "~S is absolute" s)
+                           (absolute-uri? (uri-reference s)))
+              (test (uri-reference s) (absolute-uri s)))
+            absolute-uris)
+  (for-each (lambda (s)
+              (test-assert (sprintf "~S is not relative" s)
+                           (not (relative-ref? (uri-reference s))))
+              (test-assert (sprintf "~S is not absolute" s)
+                           (not (absolute-uri? (uri-reference s))))
+              ;; Should this give an error in the fragment case?
+              (test-error (absolute-uri s)))
+            non-relative-non-absolute-uri-references))
+
 (test-group "miscellaneous"
   ;; Special case, see section 4.2